Codec By GeNiUS !
genius@turkiye.com
Ağ ortamındayken, aynı ağa giriş yapmaya yetkili kullanıcıların (bilgisayarların), isimlerini bulup getiren bir bileşene ait unit aşağıdadır.
Kullanılabilmesi için, sisteme bileşen olarak tanımlanması gereklidir. Bunun için, Components | Install components menüsü kullanılır.
unit NetUsers;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TNetUsers = class(TComponent)
private
{ Private declarations }
fServer : String;
protected
{ Protected declarations }
Procedure SetServer(Server : String);
public
{ Public declarations }
UserList: TStringList;
Constructor Create(Owner:TComponent); override;
Destructor Destroy; override;
Function Execute : Boolean;
published
{ Published declarations }
property Server :String read fServer write SetServer;
end;
PnetResourceArr = ^TNetResource;
procedure Register;
implementation
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
UserList := TStringList.Create;
UserList.Sorted := True;
End;
End;
Destructor TNetUsers.Destroy;
Begin
If Not( csDesigning in ComponentState ) Then
UserList.Destroy;
Inherited Destroy;
End;
Function TNetUsers.Execute : Boolean;
Var
NetResource: TNetResource;
Buf:Pointer;
Count, BufSize, Res: DWORD;
i : Integer;
lphEnum: THandle;
p : PnetResourceArr;
Begin
Execute := False;
UserList.Clear;
GetMem(Buf, 8192);
Try
FillChar(NetResource, SizeOf(NetResource), 0);
NetResource.lpRemoteName := PChar(fServer);
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 := -1;
BufSize := 8192;
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
If Res = ERROR_NO_MORE_ITEMS then Exit;
If (Res <> 0) then Exit;
p := PNetResourceArr(Buf);
For i := 0 to Count - 1 do
Begin
{ Ağdaki kullanıcı isimlerini Userlist listesine ekle}
UserList.Add(p^.lpRemoteName + 2);
Inc(p);
End;
End;
Res := WNetCloseEnum(lphEnum);
If Res <> 0 then Raise Exception(Res);
Finally
FreeMem(Buf);
Execute := True;
End;
End;
procedure Register;
begin
RegisterComponents('Sil', [TNetUsers]);
end;
end.
//kullanımı
{
procedure TForm1.Button1Click(Sender: TObject);
begin
NETUSERS1.EXECUTE;
listbox1.items.assign(netusers1.userlist)
end;}