BSOne.SFC/Tocsg.Module/SharedFolder/DSFolderMain.pas

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.