unit DSFolderMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type TDlgSFolderMain = class(TForm) btnExtrSF: TButton; mmInfo: TMemo; procedure btnExtrSFClick(Sender: TObject); private { Private declarations } procedure EnumFunc(NetResource: PNetResource); procedure EnumerateShares1(const Server : PChar; const Pfx: String = ''); public { Public declarations } Constructor Create(aOwner: TComponent); override; Destructor Destroy; override; end; var DlgSFolderMain: TDlgSFolderMain; implementation uses Winapi.ActiveX, Tocsg.Network, Tocsg.Safe, System.DateUtils, Tocsg.DateTime, Tocsg.Files, GetShare, Tocsg.WinInfo; {$R *.dfm} Constructor TDlgSFolderMain.Create(aOwner: TComponent); begin Inherited Create(aOwner); CoInitialize(nil); end; Destructor TDlgSFolderMain.Destroy; begin CoUninitialize; Inherited; end; procedure TDlgSFolderMain.EnumFunc(NetResource: PNetResource); var Enum: THandle; Count, BufferSize: DWORD; Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource; i: Integer; begin if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NetResource, Enum) = NO_ERROR then try Count := $FFFFFFFF; BufferSize := SizeOf(Buffer); Buffer[0].lpRemoteName := PChar(GetComName); Buffer[0].dwUsage := RESOURCEUSAGE_CONTAINER; Buffer[0].dwScope := RESOURCE_GLOBALNET; Buffer[0].dwType := RESOURCETYPE_DISK; while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do for i := 0 to Count - 1 do begin case 0 of 0: begin {Network Machines} if Buffer[i].dwType = RESOURCETYPE_ANY then mmInfo.Lines.Add(Buffer[i].lpRemoteName); end; 1: begin {Shared Drives} if Buffer[i].dwType = RESOURCETYPE_DISK then mmInfo.Lines.Add(Buffer[i].lpRemoteName); end; 2: begin {Printers} if Buffer[i].dwType = RESOURCETYPE_PRINT then mmInfo.Lines.Add(Buffer[i].lpRemoteName); end; end; if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then EnumFunc(@Buffer[i]) end; finally WNetCloseEnum(Enum); end; end; function ShareTypeToStr(SType : DWORD) : String; begin case SType and $FFFF of STYPE_DISKTREE: Result := '[Disk]'; STYPE_PRINTQ: Result := '[Printer]'; STYPE_DEVICE: Result := '[Device]'; STYPE_IPC: Result := '[IPC]'; else Result := '[Type0x' + IntToHex(SType, 8) + ']'; end; if (SType and STYPE_SPECIAL) <> 0 then Result := Result + '[Special]'; if (STYpe and STYPE_TEMPORARY) <> 0 then Result := Result + '[Temporary]'; end; procedure TDlgSFolderMain.EnumerateShares1(const Server : PChar; const Pfx: String = ''); const MAX_PREFERRED_LENGTH = -1; NERR_SUCCESS = 0; var EntriesRead : DWORD; TotalEntries : DWORD; ResHandle : DWORD; // ShareInfo1 : PSHARE_INFO_1; // P : PSHARE_INFO_1; ShareInfo2 : PSHARE_INFO_2; P : PSHARE_INFO_2; Status : NET_API_STATUS; I : Integer; begin ResHandle := 0; Status := NetShareEnum(Server, 2, Pointer(ShareInfo2), DWORD(MAX_PREFERRED_LENGTH), EntriesRead, TotalEntries, ResHandle); try if Status <> NERR_SUCCESS then Exit; P := ShareInfo2; for I := 0 to TotalEntries - 1 do begin mmInfo.Lines.Add(Pfx + P.shi2_netname + ' ' + ShareTypeToStr(P.shi2_type) + ' Path=' + P.shi2_path); Inc(P); end; finally NetApiBufferFree(ShareInfo2); end; end; procedure TDlgSFolderMain.btnExtrSFClick(Sender: TObject); var SFldList: TSharedFolder; i: Integer; StrList: TStringList; begin Guard(SFldList, TSharedFolder.Create(true)); for i := 0 to SFldList.Count - 1 do begin mmInfo.Lines.Add('Name : ' + SFldList[i].sName); mmInfo.Lines.Add('Path: ' + SFldList[i].sPath); mmInfo.Lines.Add(''); end; end; end.