Delphi實現對注冊表的監視和掃描

　　    在去年寫的‘使用SQLSERVER的擴展存儲過程實現遠程備份與恢復  （http://www.csdn.Net/Develop/read_article.ASP?id=21304）’一文中許多人都提到如何在程序中創建共享文件夾的問題，我當時因為工作忙，只看到了留言沒有及時去回復，對讀者造成的不便深感抱歉。在此文中，我就把如何在WIN2000與WIN98中創建共享文件夾的代碼一一列出（包括相關的一系列網絡函數等），以慰大家。

　　unit PubLib;

　　interface

　　uses
　　  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　　  Menus, ComCtrls, ToolWin, Db, ADODB, DBCtrls, StdCtrls,Math,dbgrids,
　　  Buttons, ExtCtrls,clipbrd,Registry, variants;

　　const
　　  NTlib  = 'NETAPI32.DLL';
　　  MElib  = 'SVRAPI.DLL';
　　  {共享類型}
　　  STYPE_DISKTREE = 0 ;
　　  STYPE_PRINTQ = 1 ;
　　  STYPE_DEVICE = 2 ;
　　  STYPE_IPC = 3 ;
　　  {訪問權限}
　　  Access_READ = 0 ;
　　  Access_WRITE = 1 ;
　　  Access_CREATE = 2 ;
　　  Access_EXEC = 3 ;
　　  Access_DELETE = 4 ;
　　  Access_ALL = 7 ;

　　type
　　  NET_API_STATUS = DWord;
　　  //紀錄類型聲明，注意參數類型的正確對應，最好別看 Delphi 的幫助，引起誤導
　　  TSHARE_INFO_502 = record
　　    shi502_netname: PWideChar;
　　    shi502_type: DWord;
　　    shi502_remark: PWideChar;
　　    shi502_permissions: DWord;
　　    shi502_max_uses: DWord;
　　    shi502_current_uses: DWord;
　　    shi502_path: PWideChar;
　　    shi502_passwd: PWideChar;
　　    shi502_reserved: DWord;
　　    shi502_security_descriptor: PSECURITY_DESCRIPTOR;
　　  end;
　　  Share_Info50 = packed record
　　    shi50_netname : array[0..12] of Char; {13}
　　    shi50_type    : Byte;
　　    shi50_flags   : Word;
　　    shi50_remark  : PChar;
　　    shi50_path    : PChar;
　　    shi50_rw_passWord : array[0..8] of Char; {9}
　　    shi50_ro_passWord : array[0..8] of Char;
　　  end;
　　
　　//******************************************網絡函數********************
　　function IsWinNT: Boolean;  //判斷是否NT系統
　　function GetPDCName: string; //取得主域控制器名稱
　　function GetDomainName: AnsiString; //獲取域名
　　//建立、刪除共享文件夾
　　//for win2000,winnt
　　function AppendShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
　　function DeleteShareResource(ServerName: string; NetName: string): Integer;
　　//for win98
　　function AddShareResource (ServerName : PChar; FilePath : PChar;
　　                      NetName : PChar; Remark : PChar ) : Integer;
　　function DelShareResource(ServerName: string; NetName: string): Integer;

　　var NTNetGetDCName : function(Server, Domain: pWideChar; var DC: pWideChar): NET_API_STATUS; StdCall; NTNetApiBufferFree: function(lpBuffer: Pointer):NET_API_STATUS; StdCall; NTNetShareAdd : function (servername:Widestring; level: DWORD; Buf: PBYTE; var parm_err: PDWORD ): DWORD; stdcall;//建立共享目錄函數 NTNetShareDel : function (ServerName:Widestring; NetName: Widestring; Reserved: DWord): Integer; stdcall; //撤銷共享目錄函數 MENetShareAdd : function (ServerName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word) : Integer; StdCall; MENetShareDel : function (ServerName : PChar; NetName : PChar; Reserved : Word) : Integer; StdCall;
　　

　　implementation
　　

　　function IsWinNT: Boolean;
　　var
　　  VersionInfo: TOSVersionInfo;
　　begin
　　  VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
　　  Result := GetVersionEx(VersionInfo);
　　  if Result then
　　    Result := VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT;
　　end;

　　function GetPDCName: string;
　　var
　　  pDomain           : PWideChar;
　　  LibHandle         : THandle;
　　begin
　　  Result := '';
　　  LibHandle := LoadLibrary(NTlib);
　　  if LibHandle = 0 then
　　    raise Exception.Create('Unable to map library: ' + NTlib);
　　  try
　　    @NTNetGetDCName := GetProcAddress(Libhandle, 'NetGetDCName');
　　    @NTNetApiBufferFree := GetProcAddress(Libhandle, 'NetApiBufferFree');
　　    try
　　      if NTNetGetDCName(nil, nil, pDomain) = 0 then
　　        Result := WideCharToString(pDomain);
　　    finally
　　      NTNetApiBufferFree(pDomain);
　　    end;
　　  finally
　　    FreeLibrary(Libhandle);
　　  end;
　　end;

　　function GetDomainName: AnsiString;
　　  type
　　  WKSTA_INFO_100 = record
　　    wki100_platform_id: Integer;
　　    wki100_computername: PWideChar;
　　    wki100_langroup: PWideChar;
　　    wki100_ver_major: Integer;
　　    wki100_ver_minor: Integer;
　　  end;

　　  WKSTA_USER_INFO_1 = record
　　    wkui1_username: PChar;
　　    wkui1_logon_domain: PChar;
　　    wkui1_logon_server: PChar;
　　    wkui1_oth_domains: PChar;
　　  end;
　　  type
　　  //Win9X ANSI prototypes from RADMIN32.DLL and RLOCAL32.DLL

　　  TWin95_NetUserGetInfo = function(ServerName, UserName: PChar; Level: DWord; var
　　    BfrPtr: Pointer): Integer;
　　  stdcall;
　　  TWin95_NetApiBufferFree = function(BufPtr: Pointer): Integer;
　　  stdcall;
　　  TWin95_NetWkstaUserGetInfo = function(Reserved: PChar; Level: Integer; var
　　    BufPtr: Pointer): Integer;
　　  stdcall;

　　  //WinNT UNICODE equivalents from NETAPI32.DLL

　　  TWinNT_NetWkstaGetInfo = function(ServerName: PWideChar; level: Integer; var
　　    BufPtr: Pointer): Integer;
　　  stdcall;
　　  TWinNT_NetApiBufferFree = function(BufPtr: Pointer): Integer;
　　  stdcall;

　　var

　　  Win95_NetUserGetInfo: TWin95_NetUserGetInfo;
　　  Win95_NetWkstaUserGetInfo: TWin95_NetWkstaUserGetInfo;
　　  Win95_NetApiBufferFree: TWin95_NetApiBufferFree;

　　  WinNT_NetWkstaGetInfo: TWinNT_NetWkstaGetInfo;
　　  WinNT_NetApiBufferFree: TWinNT_NetApiBufferFree;

　　  WSNT: ^WKSTA_INFO_100;
　　  WS95: ^WKSTA_USER_INFO_1;

　　  EC: DWord;
　　  hNETAPI: THandle;
　　begin
　　try

　　  Result := '';

　　  if IsWinNT then
　　  begin
　　    hNETAPI := LoadLibrary('NETAPI32.DLL');
　　    if hNETAPI <> 0 then
　　    begin @WinNT_NetWkstaGetInfo := GetProcAddress(hNETAPI, 'NetWkstaGetInfo');
　　        @WinNT_NetApiBufferFree  := GetProcAddress(hNETAPI, 'NetApiBufferFree');

　　      EC := WinNT_NetWkstaGetInfo(nil, 100, Pointer(WSNT));
　　      if EC = 0 then
　　      begin
　　        Result := WideCharToString(WSNT^.wki100_langroup);
　　        WinNT_NetApiBufferFree(Pointer(WSNT));
　　      end;
　　    end;
　　  end
　　  else
　　  begin
　　    hNETAPI := LoadLibrary('RADMIN32.DLL');
　　    if hNETAPI <> 0 then
　　    begin @Win95_NetApiBufferFree := GetProcAddress(hNETAPI, 'NetApiBufferFree');
　　        @Win95_NetUserGetInfo := GetProcAddress(hNETAPI, 'NetUserGetInfoA');

　　      EC := Win95_NetWkstaUserGetInfo(nil, 1, Pointer(WS95));
　　      if EC = 0 then
　　      begin
　　        Result := WS95^.wkui1_logon_domain;
　　        Win95_NetApiBufferFree(Pointer(WS95));
　　      end;
　　    end;
　　  end;

　　finally
　　  if hNETAPI <> 0 then
　　    FreeLibrary(hNETAPI);
　　end;
　　end;

　　function AppendShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
　　var
　　  ShInfo: TSHARE_INFO_502;
　　  parm_err:PDWord;
　　  _FilePath,_NetName, _Remark : PWideChar ;
　　  _ServerName : Pchar ;
　　  LibHandle   : THandle;
　　begin
　　  LibHandle := LoadLibrary(NTlib);
　　  if LibHandle = 0 then
　　    raise Exception.Create('Unable to map library: ' + NTlib);
　　  try
　　    @NTNetShareAdd := GetProcAddress(Libhandle, 'NetShareAdd');
　　    GetMem(_ServerName,255) ; //分配內存
　　    GetMem(_FilePath,255);
　　    GetMem(_NetName,255);
　　    GetMem(_Remark,255);
　　    StringToWideChar(FilePath,_FilePath,255); //字符串轉換,一定要轉換正確
　　    StringToWideChar(NetName,_NetName,255);
　　    StringToWideChar(Remark,_Remark,255);
　　    strpcopy(_ServerName,ServerName);
　　    //開始創建結構
　　    with ShInfo do
　　    begin
　　      shi502_netname := _NetName;
　　      shi502_type := STYPE_DISKTREE ;
　　      shi502_remark := _Remark ;
　　      shi502_max_uses := $FFFFFFFF;
　　      shi502_current_uses := 10;
　　      shi502_path := _FilePath;
　　      shi502_passwd := nil;
　　      shi502_reserved := 0;
　　      shi502_security_descriptor := nil;
　　      shi502_permissions := Access_ALL;
　　    end;
　　    try
　　      Result := NTNetShareAdd(_ServerName, 502, @ShInfo, parm_err);
　　    finally // 別忘了釋放內存
　　      FreeMem(_ServerName,255);
　　      FreeMem(_FilePath,255);
　　      FreeMem(_NetName,255);
　　      FreeMem(_Remark,255);
　　    end;
　　  finally
　　    FreeLibrary(Libhandle);
　　  end;
　　end;

　　function DeleteShareResource(ServerName: string; NetName: string): Integer;
　　var
　　  _ServerName : Pchar ;
　　  LibHandle   : THandle;
　　begin
　　  LibHandle := LoadLibrary(NTlib);
　　  if LibHandle = 0 then
　　    raise Exception.Create('Unable to map library: ' + NTlib);
　　  try
　　    @NTNetShareDel := GetProcAddress(Libhandle, 'NetShareDel');
　　    GetMem(_ServerName,255) ; //分配內存
　　    strpcopy(_ServerName,ServerName);
　　    try
　　      Result := NTNetShareDel(_ServerName,  NetName,0);
　　    finally
　　      FreeMem(_ServerName,255);
　　    end;
　　  finally
　　    FreeLibrary(Libhandle);
　　  end;
　　end;

　　function AddShareResource (ServerName : PChar; FilePath : PChar;
　　                      NetName : PChar; Remark : PChar ) : Integer;
　　var
　　  MyShare : Share_Info50;
　　  PMyShare : ^Share_Info50;
　　  LibHandle   : THandle;
　　begin
　　  LibHandle := LoadLibrary(NTlib);
　　  if LibHandle = 0 then
　　    raise Exception.Create('Unable to map library: ' + MElib);
　　  try
　　    @MENetShareAdd := GetProcAddress(Libhandle, 'NetShareDel');
　　    strLcopy(MyShare.shi50_netname,NetName,13);
　　    MyShare.shi50_type := 0;
　　    MyShare.shi50_flags := 0;
　　    MyShare.shi50_remark := Remark;
　　    MyShare.shi50_path := FilePath;
　　    {MyShare.shi50_rw_passWord := nil ;
　　    MyShare.shi50_ro_passWord :=nil ;}
　　    PMyShare := @MyShare;
　　    Result := MENetShareAdd(ServerName,50,PMyShare,SizeOf(MyShare));
　　  finally
　　    FreeLibrary(Libhandle);
　　  end;
　　end;

　　function DelShareResource(ServerName: string; NetName: string): Integer;
　　var
　　  _ServerName : Pchar ;
　　  LibHandle   : THandle;
　　begin
　　  LibHandle := LoadLibrary(NTlib);
　　  if LibHandle = 0 then
　　    raise Exception.Create('Unable to map library: ' + MElib);
　　  try
　　    @NTNetShareDel := GetProcAddress(Libhandle, 'NetShareDel');
　　    GetMem(_ServerName,255) ; //分配內存
　　    strpcopy(_ServerName,ServerName);
　　    try
　　      Result := NTNetShareDel(_ServerName,  NetName,0);
　　    finally
　　      FreeMem(_ServerName,255);
　　    end;
　　  finally
　　    FreeLibrary(Libhandle);
　　  end;
　　end;