In last year '' uses SQL Server expansion stored procedures to achieve remote backup and recovery (http://www.9cbs.net/develop/read_article.asp?id=21304) 'One article mention how to create in the program The problem of sharing folder, I was busy because I didn't see the message didn't respond in time, and I feel sorry for the inconvenience caused by the reader. In this article, I will list the code of how to create a shared folder in Win2000 and WIN98 (including related series of network functions, etc.) to comfort everyone.
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'; {shared Type} STYPE_DISKTREE = 0; STYPE_PRINTQ = 1; STYPE_DEVICE = 2; STYPE_IPC = 3; {access} ACCESS_READ = 0; ACCESS_WRITE = 1; ACCESS_CREATE = 2; Access_exec = 3; Access_Delete = 4; Access_all = 7;
type NET_API_STATUS = DWORD; // record type declarations, pay attention to the correct parameter type of correspondence, do not look the best to help the delphi, misleading 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_parssword: array [0..8] of char; end; // *********** ********************* Network function ***************** *** function iswinnt: boolean; // Judgment whether the NT system function getpdcname: string; // acquire the main domain controller name function getdomainname: Ansistring; // Get domain name // Establish, remove shared folder // for Win2000, WinNTFunction AppendshareSource (ServerName, Filepath, NetName, Remark: String): Integer; Function DE leteShareResource (ServerName: string; NetName: string): Integer; // for win98function 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; // establish a shared directory function NTNetShareDel: function (ServerName: Widestring; NetName: Widestring; Reserved: DWord): Integer; stdcall; // revoke the shared directory function MENetShareAdd: function (ServerName: PChar Sharelevel: smallint; buffer: pinter; size: word): integer; stdcall; menetsharedel: function (servername: pchar; netname: pchar; reserved: word): integer; stdcall; import): integer
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; 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_netapibufffrefree = function (bufptr: Pointer): integer; stdcall;
VAR
Win95_NetUsergetInfo: Twin95_NetUsergetInfo; WIN95_NETWKSTAUSERGETINFO: Twin95_NetWkstausetergetInfo; 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; Begintry
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_NetapibuffUfferfree (Pointer (WS95)); END; END;
Finally IF HNETAPI <> 0 THEN FREELIBRARY (HNETAPI); 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); // allocate memory GetMem (_FilePath, 255); GetMem (_NetName, 255); GetMem (_Remark, 255); StringToWideChar (FilePath, _FilePath, 255); // string conversion must be correctly converted StringToWideChar (NetName, _NetName, 255); StringToWideChar (Remark, _Remark , 255); strpcopy (_ServerName, ServerName); // start creating the structure 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 // Do not forget to release the memory FreeMem (_ServerName, 255); FreeMem (_FilePath, 255); Freemem (_NetName, 255); FreeMem (_Remark, 255); end; finally freelibrary; 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); // allocate memory 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;
