J
jackalan
Unregistered / Unconfirmed
GUEST, unregistred user!
正在作一个项目,服务器发消息通知客户机进行共享文件夹工作,该程序看似没有任何问题,但其实根本不能共享成功,但若单独使用该函数则一切OK,但把这个函数一加入主程序就挂了,什么用也没有,我要崩溃了,各位老大帮帮忙呀!不胜感激!!!!
************************原代码**************************
===========共享的单元============
unit ShareForNT;
interface
uses
Windows,Sysutils,ShlObj;
type TNTFunct = function(servername:Widestring; level: DWORD; Buf: PBYTE; parm_err: PDWORD ):Integer; stdcall;
type TNShareDel = function(ServerName:Widestring; NetName: Widestring; Reserved: DWord): Integer; StdCall;
type
//纪录类型声明,注意参数类型的正确对应,最好别看 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;
//删除共享
{function NetShareDel(ServerName:Widestring; NetName: Widestring;
Reserved: DWord): Integer; StdCall; }
const
{共享类型}
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 ;
//自己声明的函数,为了调用方便,参数就不用说明了吧!
function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
function DeleteShare(NetName: string):Integer;
implementation
//注意在 windows95/98/me 下面 dll 库是 SVRAPI.DLL ,而且参数类型也要随之改变的吆!
//function NetShareAdd; external 'netapi32.DLL' name 'NetShareAdd';
//function NetShareDel; external 'netapi32.DLL' name 'NetShareDel';
function DeleteShare(NetName: string):Integer;
var
hDll : THandle;
MyTNShareDel: TNShareDel;
_NetName,_ServerName : PWideChar;
begin
hDll := LoadLibrary('Netapi32.DLL');
if hDll > 32 then
begin
// NetShareAdd
//GetMem(_ServerName,255) ; //分配内存
GetMem(_NetName,255);
StringToWideChar(NetName,_NetName,255);
MyTNShareDel := GetProcAddress(hDll,'NetShareDel');
try
result := MyTNShareDel('',_NetName,0);
Finally // 别忘了释放内存
//FreeMem(_ServerName,255);
FreeMem(_NetName,255);
end;
end;
end;
function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
var
hDll : THandle;
ShInfo: TSHARE_INFO_502;
parm_errDWORD;
_FilePath,_NetName, _Remark : PWideChar;
_ServerName : Pchar ;
MyNTFunct: TNTFunct;
begin
hDll := LoadLibrary('Netapi32.DLL');
if hDll > 32 then
begin
// NetShareAdd
MyNTFunct := GetProcAddress(hDll,'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 := MyNTFunct(_ServerName,502,@ShInfo,parm_err);
Finally // 别忘了释放内存
FreeMem(_ServerName,255);
FreeMem(_FilePath,255);
FreeMem(_NetName,255);
FreeMem(_Remark,255);
end;
end;
end;
end.
************如果共享函数单独用一个BUTTON就没任何问题**************
procedure TFrmClient.Button1Click(Sender: TObject);
begin
ShareResource('','c:/1','test','');
end;
*****************************接受网络消息*************************
//方到任务处理中就出问题了,就好像没运行的一样
procedure TFrmClient.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
NowSocket := Socket;
listbox2.Items.Add(Socket.ReceiveText);//加入任务列表
end;
**********************任务处理(片断)*********************
if listbox2.Items.Count <= 0 then exit;
//网络传来的消息格式是:'SetShare| 项目名称|参数|共享路径'
if Leftbstr(StrCommand,9) = 'SetShare|' then
begin
//设定目录共享
Ri := ShareResource('','c:/1','test','');
//在TIMER或TFrmClient.ClientSocket1Read中都不行
if ri = 998 then
begin
NowSocket.SendText('|Put Share|Ok');
end
else
begin
showmessage('Fail');
end;
listbox2.Items.Delete(0);
end;
end;
end;
谢谢!请大家指教!
************************原代码**************************
===========共享的单元============
unit ShareForNT;
interface
uses
Windows,Sysutils,ShlObj;
type TNTFunct = function(servername:Widestring; level: DWORD; Buf: PBYTE; parm_err: PDWORD ):Integer; stdcall;
type TNShareDel = function(ServerName:Widestring; NetName: Widestring; Reserved: DWord): Integer; StdCall;
type
//纪录类型声明,注意参数类型的正确对应,最好别看 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;
//删除共享
{function NetShareDel(ServerName:Widestring; NetName: Widestring;
Reserved: DWord): Integer; StdCall; }
const
{共享类型}
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 ;
//自己声明的函数,为了调用方便,参数就不用说明了吧!
function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
function DeleteShare(NetName: string):Integer;
implementation
//注意在 windows95/98/me 下面 dll 库是 SVRAPI.DLL ,而且参数类型也要随之改变的吆!
//function NetShareAdd; external 'netapi32.DLL' name 'NetShareAdd';
//function NetShareDel; external 'netapi32.DLL' name 'NetShareDel';
function DeleteShare(NetName: string):Integer;
var
hDll : THandle;
MyTNShareDel: TNShareDel;
_NetName,_ServerName : PWideChar;
begin
hDll := LoadLibrary('Netapi32.DLL');
if hDll > 32 then
begin
// NetShareAdd
//GetMem(_ServerName,255) ; //分配内存
GetMem(_NetName,255);
StringToWideChar(NetName,_NetName,255);
MyTNShareDel := GetProcAddress(hDll,'NetShareDel');
try
result := MyTNShareDel('',_NetName,0);
Finally // 别忘了释放内存
//FreeMem(_ServerName,255);
FreeMem(_NetName,255);
end;
end;
end;
function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;
var
hDll : THandle;
ShInfo: TSHARE_INFO_502;
parm_errDWORD;
_FilePath,_NetName, _Remark : PWideChar;
_ServerName : Pchar ;
MyNTFunct: TNTFunct;
begin
hDll := LoadLibrary('Netapi32.DLL');
if hDll > 32 then
begin
// NetShareAdd
MyNTFunct := GetProcAddress(hDll,'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 := MyNTFunct(_ServerName,502,@ShInfo,parm_err);
Finally // 别忘了释放内存
FreeMem(_ServerName,255);
FreeMem(_FilePath,255);
FreeMem(_NetName,255);
FreeMem(_Remark,255);
end;
end;
end;
end.
************如果共享函数单独用一个BUTTON就没任何问题**************
procedure TFrmClient.Button1Click(Sender: TObject);
begin
ShareResource('','c:/1','test','');
end;
*****************************接受网络消息*************************
//方到任务处理中就出问题了,就好像没运行的一样
procedure TFrmClient.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
NowSocket := Socket;
listbox2.Items.Add(Socket.ReceiveText);//加入任务列表
end;
**********************任务处理(片断)*********************
if listbox2.Items.Count <= 0 then exit;
//网络传来的消息格式是:'SetShare| 项目名称|参数|共享路径'
if Leftbstr(StrCommand,9) = 'SetShare|' then
begin
//设定目录共享
Ri := ShareResource('','c:/1','test','');
//在TIMER或TFrmClient.ClientSocket1Read中都不行
if ri = 998 then
begin
NowSocket.SendText('|Put Share|Ok');
end
else
begin
showmessage('Fail');
end;
listbox2.Items.Delete(0);
end;
end;
end;
谢谢!请大家指教!