unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, JvExMask, JvSpin;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button2: TButton;
T3: TEdit;
T1: TEdit;
T2: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;
Function CreateNetResourceList(ResourceType: DWord;
NetResource: PNetResource;
out Entries: DWord;
out List: PNetResourceArray): Boolean;
var EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET, ResourceType,0,NetResource,EnumHandle) = NO_ERROR then
begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
ReAllocMem(List, BufSize);
until Res <> ERROR_MORE_DATA;
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;
procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);
procedure ScanLevel(NetResource: PNetResource);
var Entries : DWord;
var NetResourceList : PNetResourceArray;
var i : Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then
try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then
begin
List.AddObject(NetResourceList[i].lpRemoteName,
Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(Nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
var LB : TStringList;
var S1 : TDateTime;
begin
T1.Text := FormatDateTime('hh:nn:ss', Now());
T1.Repaint;
S1 := Now();
LB := TStringList.Create;
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, LB);
ListBox1.Items.Text := LB.Text;
LB.Free;
T2.Text := FormatDateTime('hh:nn:ss', Now());
T3.Text := FormatDateTime('hh:nn:ss', Now() - S1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.