1回顶部 在去年写的‘使用SQLSERVER的扩展存储过程实现远程备份与恢复一文中许多人都提到如何在程序中创建共享文件夹的问题,我当时因为工作忙,只看到了留言没有及时去回复,对读者造成的不便深感抱歉。在此文中,我就把如何在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; 2回顶部 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; 3回顶部 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; 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); 4回顶部 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; 5回顶部 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 6回顶部 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 hInfo: 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); 7回顶部 //开始创建结构 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) ; //分配内存 8回顶部 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; 9回顶部 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; |
正在阅读:在WIN2000与98中创建共享文件夹在WIN2000与98中创建共享文件夹
2004-03-18 14:45
出处:PConline
责任编辑:linjixiong