Type
TNetUsers = Class(TComponent)
Private
FAboutMe: TAboutBox;
fServer : String;
Function GetUsers : Boolean;
Protected
Procedure SetServer(Server : String);
Public
List : TStringList;
Constructor Create(Owner:TComponent); Override;
Destructor Destroy; Override;
Function GetDomain: Boolean;
Function GetPCsInDomain: Boolean; overload;
Function GetPCsInDomain(const Domain: string): Boolean; overload;
Published
property AboutMe: TAboutBox read FAboutMe write FAboutMe;
Property Server : String Read fServer Write SetServer;
End;
PNetResourceArr = ^TNetResource;
Implementation
{$R NetUsers.dcr}
Procedure TNetUsers.SetServer(Server : String);
Begin
If fServer <> Server Then
fServer := Server;
End;
Constructor TNetUsers.Create(Owner:TComponent);
Begin
Inherited Create(Owner);
If Not (csDesigning in ComponentState) Then
Begin
List := TStringList.Create;
List.Sorted := True;
End;
End;
Destructor TNetUsers.Destroy;
Begin
If Not(csDesigning In ComponentState) Then
List.Destroy;
Inherited Destroy;
End;
Function TNetUsers.GetDomain : Boolean;
Type
{$H+}
PMyRec = ^MyRec;
MyRec = Record
dwScope : Integer;
dwType : Integer;
dwDisplayType : Integer;
dwUsage : Integer;
LocalName : String;
RemoteName : String;
Comment : String;
Provider : String;
End;
{H-}
Var
NetResource : TNetResource;
TempRec : PMyRec;
Buf : Pointer;
Count,
BufSize,
Res : DWORD;
lphEnum : THandle;
p : PNetResourceArr;
i,
j : SmallInt;
NetworkTypeList : TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;
GetMem(Buf, 8192);
Try
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
If Res <> 0 Then Raise Exception(Res);
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Exit;
If (Res <> 0) Then Raise Exception(Res);
P := PNetResourceArr(Buf);
For I := 0 To Count - 1 Do
Begin
New(TempRec);
TempRec^.dwScope := P^.dwScope;
TempRec^.dwType := P^.dwType ;
TempRec^.dwDisplayType := P^.dwDisplayType ;
TempRec^.dwUsage := P^.dwUsage ;
TempRec^.LocalName := StrPas(P^.lpLocalName);
TempRec^.RemoteName := StrPas(P^.lpRemoteName);
TempRec^.Comment := StrPas(P^.lpComment);
TempRec^.Provider := StrPas(P^.lpProvider);
NetworkTypeList.Add(TempRec);
Inc(P);
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
For J := 0 To NetworkTypeList.Count-1 Do
Begin
TempRec := NetworkTypeList.Items[J];
NetResource := TNetResource(TempRec^);
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> 0 Then Raise Exception(Res);
While true Do
Begin
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Break;
If (Res <> 0) Then Raise Exception(Res);
P := PNetResourceArr(Buf);
For I := 0 To Count - 1 Do
Begin
List.Add(P^.lpRemoteName);
Inc(P);
End;
End;
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
Result := True;
Finally
FreeMem(Buf);
NetworkTypeList.Destroy;
End;
End;
Function TNetUsers.GetUsers : Boolean;
Var
NetResource : TNetResource;
Buf : Pointer;
Count,
BufSize,
Res : DWord;
Ind : Integer;
lphEnum : THandle;
Temp : PNetResourceArr;
Begin
Result := False;
List.Clear;
GetMem(Buf, 8192);
Try
FillChar(NetResource, SizeOf(NetResource), 0);
NetResource.lpRemoteName := @fServer[1];
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK;
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
If Res <> 0 Then Exit;
While True Do
Begin
Count := $FFFFFFFF;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS Then Exit;
If (Res <> 0) then Exit;
Temp := PNetResourceArr(Buf);
For Ind := 0 to Count - 1 do
Begin
List.Add(Temp^.lpRemoteName + 2);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 Then Raise Exception(Res);
Result := True;
Finally
FreeMem(Buf);
End;
End;
Function TNetUsers.GetPCsInDomain(const Domain: string): Boolean;
begin
Server := Domain;
Result := GetPCsInDomain;
end;
Function TNetUsers.GetPCsInDomain: Boolean;
Var
ServerList : TStringList;
TempInt,
Ind : Integer;
MaxLen : Cardinal;
Buf : PChar;
MachineName : String;
Begin
Result := False;
If fServer = '' Then
Begin
If GetDomain Then
Begin
ServerList := List;
GetMem(Buf,255);
MaxLen := 255;
GetComputerName(Buf, MaxLen);
MachineName := StrPas(Buf);
Freemem(Buf,255);
For Ind := 0 to ServerList.Count-1 Do
Begin
fServer := ServerList.Strings[Ind];
If GetUsers Then
If List.Find(MachineName, TempInt) Then
Begin
Result := True;
Exit;
End;
End;
End;
End
Else
Result := GetUsers;
End;