One of the most rich Directory Access Technologies of Microsoft is the Active Directory Service Interfaces (ADSI) which is a set of interfaces designed to access the features of directory services from different network providers, in this case we will use the WinNT Provider to access the shared resources of a local or remote machine. The aim of this post is show you how you can obtain the information related to the shared resources from a Delphi application.
Getting the interfaces
The common way to access the ADSI Interfaces from Delphi is importing the Active DS type library.
After of import the type library you will got a large unit file with many interfaces , constants and types which we will not need in this case, and only increase the final size of our application. So we can extract the interfaces for access the network shared resources (see the next source that shows the interfaces to the task)
const
IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
ADS_SECURE_AUTHENTICATION = $00000001;
type
IADsCollection = interface(IDispatch)
['{72B945E0-253B-11CF-A988-00AA006BC149}']
function Get__NewEnum: IUnknown; safecall;
procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
function GetObject(const bstrName: WideString): OleVariant; safecall;
property _NewEnum: IUnknown read Get__NewEnum;
end;
IADs = interface(IDispatch)
['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
function Get_Name: WideString; safecall;
function Get_Class_: WideString; safecall;
function Get_GUID: WideString; safecall;
function Get_ADsPath: WideString; safecall;
function Get_Parent: WideString; safecall;
function Get_Schema: WideString; safecall;
procedure GetInfo; safecall;
procedure SetInfo; safecall;
function Get(const bstrName: WideString): OleVariant; safecall;
procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
function GetEx(const bstrName: WideString): OleVariant; safecall;
procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
property Name: WideString read Get_Name;
property Class_: WideString read Get_Class_;
property GUID: WideString read Get_GUID;
property ADsPath: WideString read Get_ADsPath;
property Parent: WideString read Get_Parent;
property Schema: WideString read Get_Schema;
end;
IADsContainer = interface(IDispatch)
['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
function Get_Count: Integer; safecall;
function Get__NewEnum: IUnknown; safecall;
function Get_Filter: OleVariant; safecall;
procedure Set_Filter(pVar: OleVariant); safecall;
function Get_Hints: OleVariant; safecall;
procedure Set_Hints(pvFilter: OleVariant); safecall;
function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
property Count: Integer read Get_Count;
property _NewEnum: IUnknown read Get__NewEnum;
property Filter: OleVariant read Get_Filter write Set_Filter;
property Hints: OleVariant read Get_Hints write Set_Hints;
end;
IADsServiceOperations = interface(IADs)
['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
function Get_Status: Integer; safecall;
procedure Start; safecall;
procedure Stop; safecall;
procedure Pause; safecall;
procedure Continue; safecall;
procedure SetPassword(const bstrNewPassword: WideString); safecall;
property Status: Integer read Get_Status;
end;
IADsFileServiceOperations = interface(IADsServiceOperations)
['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
function Sessions: IADsCollection; safecall;
function Resources: IADsCollection; safecall;
end;
IADsResource = interface(IADs)
['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
function Get_User: WideString; safecall;
function Get_UserPath: WideString; safecall;
function Get_Path: WideString; safecall;
function Get_LockCount: Integer; safecall;
property User: WideString read Get_User;
property UserPath: WideString read Get_UserPath;
property Path: WideString read Get_Path;
property LockCount: Integer read Get_LockCount;
end;
IADsSession = interface(IADs)
['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
function Get_User: WideString; safecall;
function Get_UserPath: WideString; safecall;
function Get_Computer: WideString; safecall;
function Get_ComputerPath: WideString; safecall;
function Get_ConnectTime: Integer; safecall;
function Get_IdleTime: Integer; safecall;
property User: WideString read Get_User;
property UserPath: WideString read Get_UserPath;
property Computer: WideString read Get_Computer;
property ComputerPath: WideString read Get_ComputerPath;
property ConnectTime: Integer read Get_ConnectTime;
property IdleTime: Integer read Get_IdleTime;
end;
IADsFileShare = interface(IADs)
['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
function Get_CurrentUserCount: Integer; safecall;
function Get_Description: WideString; safecall;
procedure Set_Description(const retval: WideString); safecall;
function Get_HostComputer: WideString; safecall;
procedure Set_HostComputer(const retval: WideString); safecall;
function Get_Path: WideString; safecall;
procedure Set_Path(const retval: WideString); safecall;
function Get_MaxUserCount: Integer; safecall;
procedure Set_MaxUserCount(retval: Integer); safecall;
property CurrentUserCount: Integer read Get_CurrentUserCount;
property Description: WideString read Get_Description write Set_Description;
property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
property Path: WideString read Get_Path write Set_Path;
property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
end;
In addition to the interfaces we need the ADsOpenObject function which allow you binds to an ADSI interface.
check the syntax of this function
HRESULT ADsOpenObject( __in LPCWSTR lpszPathName, __in LPCWSTR lpszUserName, __in LPCWSTR lpszPassword, __in DWORD dwReserved, __in REFIID riid, __out VOID **ppObject );
The Delphi equivalent can be
function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString; dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; safecall; external 'activeds.dll';
or
function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString; dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';
As you can see the only difference is the calling convention (safecall vs stdcall), if you want which Delphi check the value of the returned HResult and raises the exception for you then use the safecall calling convention else if you want check manually the HResult returned by the function use stdcall
Listing the Connected Sessions
To list the Open Sessions (Machines connected) to the shared resources we must use the IADsFileServiceOperations interface and the Sessions function which return a collection of the open sessions for the service.
const
lpszUserName =''; // set the user name used to establish the connection to the remote machine
lpszPassword =''; // set the password used to establish the connection to the remote machine
lpszComputer ='.'; // the "." is for the local machine, you can set the name of the remote machine
var
FSO : IADsFileServiceOperations;
Sessions : IADsCollection;
Session : IADsSession;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
dt : TDateTime;
begin
//connect to the file service of the loal o remote machine
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
//obtain the sessions
Sessions := FSO.Sessions;
//Get the enumerator
oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
//cast the current element to IADsSession
Session:=IUnknown(rgvar) as IADsSession;
try
Writeln('Computer '+Session.Computer);
dt := Session.ConnectTime / SecsPerDay; // the ConnectTime property return the value in seconds
Writeln('Connected Time '+FormatDateTime('hh:nn:ss',dt));
dt := Session.IdleTime / SecsPerDay; // the IdleTime property return the value in seconds
Writeln('Idle Time '+FormatDateTime('hh:nn:ss',dt));
Writeln('Name '+Session.Name);
Writeln('User '+Session.User);
Writeln('');
finally
rgvar:=Unassigned; //clear the variant used for hold the values avoiding meory leaks
end;
end;
end;
With this simple code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Sessions
Listing the shared resources in use (opened)
To List the opened resources like folders and files we must use the IADsFileServiceOperations interface and the Resources function which return a collection of the open resources for the service.
procedure ListSharedResourcesInUse;
const
lpszUserName ='';
lpszPassword ='';
lpszComputer ='.';
var
FSO : IADsFileServiceOperations;
Resources : IADsCollection;
Resource : IADsResource;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
begin
//connect to the WinNt provider of the local or remote machine and get an instance to the file service
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
//Get the opened resources
Resources := FSO.Resources;
//get the enumerator
oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
//cast the current element of the collection to the IADsResource interface
Resource:=IUnknown(rgvar) as IADsResource;
try
try
Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
except
on E:EOleException do
if E.ErrorCode<> HResult($80070002) then //in some cases this exception (path not found) is raised when you enumerate the opened resources, you can ignore without problems
raise;
end;
finally
rgvar:=Unassigned; //avoid a memory leak
end;
end;
end;
With this code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Open files
Listing the Shared Resources
Finally to List the shared resources we must connect to the local or remote machine using the ADsOpenObject function passing a IADsContainer interface which return a collection with the resources.
procedure ListShared;
const
lpszUserName ='';
lpszPassword ='';
lpszComputer ='.';
var
Shares : IADsContainer;
Share : IADsFileShare;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
begin
//connect to the network provider and get the collection of shared resources
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
//get the enumerator
oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
//cast the current element to IADsFileShare
Share:=IUnknown(rgvar) as IADsFileShare;
try
Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
Writeln('Host Computer '+Share.HostComputer);
Writeln('Description '+Share.Description);
Writeln('Path '+Share.Path);
Writeln('Max User Count '+IntToStr(Share.MaxUserCount));
Writeln('');
finally
rgvar:=Unassigned; //avoid memory leaks
end;
end;
end;
The Console application
This is the full source code of a console application to show all the tasks described in this post.
{$APPTYPE CONSOLE}
{.$DEFINE USE_ActiveDs_TLB}
uses
{$IFDEF USE_ActiveDs_TLB}
ActiveDs_TLB,
{$ENDIF}
Windows,
ComObj,
Variants,
ActiveX,
SysUtils;
{$IFNDEF USE_ActiveDs_TLB}
const
IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
ADS_SECURE_AUTHENTICATION = $00000001;
type
IADsCollection = interface(IDispatch)
['{72B945E0-253B-11CF-A988-00AA006BC149}']
function Get__NewEnum: IUnknown; safecall;
procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
function GetObject(const bstrName: WideString): OleVariant; safecall;
property _NewEnum: IUnknown read Get__NewEnum;
end;
IADs = interface(IDispatch)
['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
function Get_Name: WideString; safecall;
function Get_Class_: WideString; safecall;
function Get_GUID: WideString; safecall;
function Get_ADsPath: WideString; safecall;
function Get_Parent: WideString; safecall;
function Get_Schema: WideString; safecall;
procedure GetInfo; safecall;
procedure SetInfo; safecall;
function Get(const bstrName: WideString): OleVariant; safecall;
procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
function GetEx(const bstrName: WideString): OleVariant; safecall;
procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
property Name: WideString read Get_Name;
property Class_: WideString read Get_Class_;
property GUID: WideString read Get_GUID;
property ADsPath: WideString read Get_ADsPath;
property Parent: WideString read Get_Parent;
property Schema: WideString read Get_Schema;
end;
IADsContainer = interface(IDispatch)
['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
function Get_Count: Integer; safecall;
function Get__NewEnum: IUnknown; safecall;
function Get_Filter: OleVariant; safecall;
procedure Set_Filter(pVar: OleVariant); safecall;
function Get_Hints: OleVariant; safecall;
procedure Set_Hints(pvFilter: OleVariant); safecall;
function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
property Count: Integer read Get_Count;
property _NewEnum: IUnknown read Get__NewEnum;
property Filter: OleVariant read Get_Filter write Set_Filter;
property Hints: OleVariant read Get_Hints write Set_Hints;
end;
IADsServiceOperations = interface(IADs)
['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
function Get_Status: Integer; safecall;
procedure Start; safecall;
procedure Stop; safecall;
procedure Pause; safecall;
procedure Continue; safecall;
procedure SetPassword(const bstrNewPassword: WideString); safecall;
property Status: Integer read Get_Status;
end;
IADsFileServiceOperations = interface(IADsServiceOperations)
['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
function Sessions: IADsCollection; safecall;
function Resources: IADsCollection; safecall;
end;
IADsResource = interface(IADs)
['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
function Get_User: WideString; safecall;
function Get_UserPath: WideString; safecall;
function Get_Path: WideString; safecall;
function Get_LockCount: Integer; safecall;
property User: WideString read Get_User;
property UserPath: WideString read Get_UserPath;
property Path: WideString read Get_Path;
property LockCount: Integer read Get_LockCount;
end;
IADsSession = interface(IADs)
['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
function Get_User: WideString; safecall;
function Get_UserPath: WideString; safecall;
function Get_Computer: WideString; safecall;
function Get_ComputerPath: WideString; safecall;
function Get_ConnectTime: Integer; safecall;
function Get_IdleTime: Integer; safecall;
property User: WideString read Get_User;
property UserPath: WideString read Get_UserPath;
property Computer: WideString read Get_Computer;
property ComputerPath: WideString read Get_ComputerPath;
property ConnectTime: Integer read Get_ConnectTime;
property IdleTime: Integer read Get_IdleTime;
end;
IADsFileShare = interface(IADs)
['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
function Get_CurrentUserCount: Integer; safecall;
function Get_Description: WideString; safecall;
procedure Set_Description(const retval: WideString); safecall;
function Get_HostComputer: WideString; safecall;
procedure Set_HostComputer(const retval: WideString); safecall;
function Get_Path: WideString; safecall;
procedure Set_Path(const retval: WideString); safecall;
function Get_MaxUserCount: Integer; safecall;
procedure Set_MaxUserCount(retval: Integer); safecall;
property CurrentUserCount: Integer read Get_CurrentUserCount;
property Description: WideString read Get_Description write Set_Description;
property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
property Path: WideString read Get_Path write Set_Path;
property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
end;
{$ENDIF}
function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';
procedure ListConnectedSessions;
const
lpszUserName ='';
lpszPassword ='';
lpszComputer ='.';
var
FSO : IADsFileServiceOperations;
Sessions : IADsCollection;
Session : IADsSession;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
dt : TDateTime;
begin
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
Sessions := FSO.Sessions;
oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
Session:=IUnknown(rgvar) as IADsSession;
try
Writeln('Computer '+Session.Computer);
dt := Session.ConnectTime / SecsPerDay;
Writeln('Connected Time '+FormatDateTime('hh:nn:ss',dt));
dt := Session.IdleTime / SecsPerDay;
Writeln('Idle Time '+FormatDateTime('hh:nn:ss',dt));
Writeln('Name '+Session.Name);
Writeln('User '+Session.User);
Writeln('');
finally
rgvar:=Unassigned;
end;
end;
end;
procedure ListSharedResourcesInUse;
const
lpszUserName ='';
lpszPassword ='';
lpszComputer ='.';
var
FSO : IADsFileServiceOperations;
Resources : IADsCollection;
Resource : IADsResource;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
begin
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
Resources := FSO.Resources;
oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
Resource:=IUnknown(rgvar) as IADsResource;
try
try
Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
except
on E:EOleException do
if E.ErrorCode<> HResult($80070002) then //ignore path not found exception
raise;
end;
finally
rgvar:=Unassigned;
end;
end;
end;
procedure ListShared;
const
lpszUserName ='';
lpszPassword ='';
lpszComputer ='.';
var
Shares : IADsContainer;
Share : IADsFileShare;
rgvar : OleVariant;
pceltFetched : Cardinal;
oEnum : IEnumvariant;
begin
OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
while oEnum.Next(1, rgvar, pceltFetched) = 0 do
begin
Share:=IUnknown(rgvar) as IADsFileShare;
try
Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
Writeln('Host Computer '+Share.HostComputer);
Writeln('Description '+Share.Description);
Writeln('Path '+Share.Path);
Writeln('Max User Count '+IntToStr(Share.MaxUserCount));
Writeln('');
finally
rgvar:=Unassigned;
end;
end;
end;
begin
try
CoInitialize(nil);
try
ListSharedResourcesInUse;
ListConnectedSessions;
ListShared;
finally
CoUninitialize;
end;
except
on E:EOleException do
Writeln(Format('EOleException %s Code %x',[E.Message,E.ErrorCode]));
on E:EOleSysError do
Writeln(Format('EOleSysError %s Code %x',[E.Message,E.ErrorCode]));
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
The Road to Delphi 