在WIN2000与WIN98中创建共享文件夹的方法

核心提示： 在去年写的‘使用SQLSERVER的扩展存储过程实现远程备份与恢复 （http://www.csdn.net/Develop/read_article.asp?id=21304）’一文中许多人都提到如何在程序中创建共享文件夹的问题，我当时因为工作忙，在WIN2000与WIN98中创建共享文件夹的方法，只看到了

    在去年写的‘使用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;