在WIN2000与98中创建共享文件夹
添加时间: 2006-2-26 9:48:18 作者: Delphi教程 阅读次数:57 来源: http://www.d9soft.com
在去年写的‘使用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;
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;
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
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);
//开始创建结构
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;
上一篇文章: 使用Delphi创建IIS虚拟目录 下一篇文章: Delphi 与FORTRAN语言的混合编程
相关文章: