可用net shar通过重定向来实现: unit recon;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}function CreateDOSProcessRedirected(const CommandLine, InputFile, OutputFile, ErrMsg :string):boolean;constROUTINE_ID = '[function: CreateDOSProcessRedirected ]';varOldCursor : TCursor;pCommandLine : array[0..MAX_PATH] of char;pInputFile,pOutPutFile : array[0..MAX_PATH] of char;StartupInfo : TStartupInfo;ProcessInfo : TProcessInformation;SecAtrrs : TSecurityAttributes;hAppProcess,hAppThread,hInputFile,hOutputFile : THandle;beginResult := False;{ Check for InputFile existence }if not FileExists(InputFile)thenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'Input file * %s *' + #10 +'does not exist' + #10 + #10 +ErrMsg, [InputFile]);{ Save the cursor }OldCursor := Screen.Cursor;Screen.Cursor := crHourglass;{ Copy the parameter Pascal strings to null terminatedstrings }StrPCopy(pCommandLine, CommandLine);StrPCopy(pInputFile, InputFile);StrPCopy(pOutPutFile, OutputFile);TRY{ Prepare SecAtrrs structure for the CreateFile calls.This SecAttrs structure is needed in this case becausewe want the returned handle can be inherited by childprocess. This is true when running under WinNT.As for Win95, the documentation is quite ambiguous }FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);SecAtrrs.nLength := SizeOf(SecAtrrs);SecAtrrs.lpSecurityDescriptor := nil;SecAtrrs.bInheritHandle := True;{ Create the appropriate handle for the input file }hInputFile := CreateFile(pInputFile,{pointer to name of the file }GENERIC_READ or GENERIC_WRITE, {access (read-write) mode }FILE_SHARE_READ or FILE_SHARE_WRITE, {share mode }@SecAtrrs, {pointer to security attributes }OPEN_ALWAYS,{how to create }FILE_ATTRIBUTE_NORMALor FILE_FLAG_WRITE_THROUGH, { file attributes }0 ); {andle to file with attributes to copy }{ Is hInputFile a valid handle? }if hInputFile = INVALID_HANDLE_VALUEthenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'WinApi function CreateFile returned an' + 'invalid handle value' + #10 +'for the input file * %s *' + #10 + #10 +ErrMsg, [InputFile]);{ Create the appropriate handle for the output file }hOutputFile := CreateFile(pOutPutFile,{pointer to name of the file }GENERIC_READ or GENERIC_WRITE,{access (read-write) mode }FILE_SHARE_READ or FILE_SHARE_WRITE,{share mode }@SecAtrrs,{pointer to security attributes }CREATE_ALWAYS, { how to create }FILE_ATTRIBUTE_NORMALor FILE_FLAG_WRITE_THROUGH,{file attributes }0 );{handle to file with attributes to copy }{ Is hOutputFile a valid handle? }if hOutputFile = INVALID_HANDLE_VALUEthenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'WinApi function CreateFile returned an' +'invalid handle value' + #10 +'for the output file * %s *' + #10 + #10 +ErrMsg, [OutputFile]);{ Prepare StartupInfo structure }FillChar(StartupInfo, SizeOf(StartupInfo), #0);StartupInfo.cb := SizeOf(StartupInfo);StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;StartupInfo.wShowWindow := SW_HIDE;StartupInfo.hStdOutput := hOutputFile;StartupInfo.hStdInput := hInputFile;{ Create the app }Result := CreateProcess(nil, { pointer to name of executable module }pCommandLine, { pointer to command line string }nil, { pointer to process security attributes }nil, { pointer to thread security attributes }True, { handle inheritance flag }HIGH_PRIORITY_CLASS, { creation flags }nil, { pointer to new environment block }nil, { pointer to current directory name }StartupInfo, { pointer to STARTUPINFO }ProcessInfo); { pointer to PROCESS_INF }{ wait for the app to finish its job and take the handles to free them later }if ResultthenbeginWaitforSingleObject(ProcessInfo.hProcess, INFINITE);hAppProcess := ProcessInfo.hProcess;hAppThread := ProcessInfo.hThread;endelseraise Exception.Create(ROUTINE_ID + #10 + #10 +'Function failure' + #10 + #10 +ErrMsg);FINALLY{ Close the handles.Kernel objects, like the process and the files we created in this case, are maintained by a usage count. So, for cleaning up purposes, we have to close the handles to inform the system that we don't need the objects anymore }if hOutputFile <> 0 then CloseHandle(hOutputFile);if hInputFile <> 0 then CloseHandle(hInputFile);if hAppThread <> 0 then CloseHandle(hAppThread);if hAppProcess <> 0 then CloseHandle(hAppProcess);{ Restore the old cursor }Screen.Cursor:= OldCursor;END;end; { CreateDOSProcessRedirected } procedure TForm1.Button1Click(Sender: TObject); var t:tstringlist; begin t:=tstringlist.create; t.SaveToFile('e:\temp\ttt1.txt'); CreateDOSProcessRedirected('net share','e:\temp\ttt1.txt','e:\temp\ttt2.txt',''); t.LoadFromFile('e:\temp\ttt2.txt'); deletefile( 'e:\temp\ttt1.txt'); deletefile( 'e:\temp\ttt2.txt');memo1.Lines:=t; //可对t处理后再显示winexec('net share e:\share /delete',sw_hide); //删除共享 end;end.
//删除共享 function NetShareDel(ServerName:Widestring; NetName: Widestring; Reserved: DWord): Integer; StdCall;
获得本机已经设置成共享的目录名称 Function GetUserResource( UserName : string ; var List : TStringList ) : Boolean; Var NetResource : TNetResource; Buf : Pointer; Count,BufSize,Res : DWord; Ind : Integer; lphEnum : THandle; Temp : TNetResourceArray; Begin Result := False; List.Clear; FillChar(NetResource, SizeOf(NetResource), 0); //初始化网络层次信息 NetResource.lpRemoteName := @UserName[1]; //指定计算机名称 Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum); //获取指定计算机的网络资源句柄 If Res <> NO_ERROR Then exit; //执行失败 While True Do //列举指定工作组的网络资源 Begin Count := $FFFFFFFF; //不限资源数目 BufSize := 8192; //缓冲区大小设置为8K GetMem(Buf, BufSize); //申请内存,用于获取工作组信息 Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize); //获取指定计算机的网络资源名称 If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕 If (Res <> NO_ERROR) then Exit; //执行失败 Temp := TNetResourceArray(Buf); For Ind := 0 to Count - 1 do Begin List.Add(Temp^.lpRemoteName); Inc(Temp); End; End; Res := WNetCloseEnum(lphEnum); //关闭一次列举 If Res <> NO_ERROR Then exit; //执行失败 Result := True; FreeMem(Buf); End; procedure TForm1.Button1Click(Sender: TObject); var List:TstringList; i:integer; begin try List:=TstringList.Create; if GetUserResource(edit1.text,List) then if List.count=0 then //指定计算机下没有找到共享资源 begin memo1.Lines.Add (edit1.text+'下没有找到共享资源!'); end else memo1.Lines.Add (edit1.text+'下的所有共享资源如下:'); for i:=0 to List.Count-1 do begin Memo1.lines.Add (List.strings[i]); end; finally List:=TstringList.Create; //如有异常则释放分配的资源 end; end;
To aiirii:您好,谢谢您以上的代码。由于我是才学Delphi编程不久,上面的代码有些地方我还是看不懂。我试了一下,编译的时候有错误。我用的是Delphi6。其中的 TNetResource和TNetResourceArray, 我查了帮助,没找到。是不是Delphi6里面没有这两个类?另外,你的那个程序是针对网络环境的,涉及到网络方面的编程,我真的不懂,很茫然。我只是想得到自己本机的共享信息。您能否把程序简化一下,改成只是针对本机的?谢谢!
To liangqingzhi(老之): 您好,您上面推荐的http://www.piecust.jsol.net/jinjohn/program/delphi/wtj/network/net0009.htm 我已经仔细的看过了,基本上读懂了,真是受益匪浅。不过还是有一个细节上的问题,请解释一下,谢谢:代码中有这样一段:TNetResource(NetworkTypeList.Items[J]^)NetworkTypeList.Items[J]^指的是NetworkTypeList.Items[J]所指向的内存块的内容,这已经是TNetResource类型的了,那这里的TNetResource是什么意思呢?
unit recon;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}function CreateDOSProcessRedirected(const CommandLine, InputFile,
OutputFile, ErrMsg :string):boolean;constROUTINE_ID = '[function: CreateDOSProcessRedirected ]';varOldCursor : TCursor;pCommandLine : array[0..MAX_PATH] of char;pInputFile,pOutPutFile : array[0..MAX_PATH] of char;StartupInfo : TStartupInfo;ProcessInfo : TProcessInformation;SecAtrrs : TSecurityAttributes;hAppProcess,hAppThread,hInputFile,hOutputFile : THandle;beginResult := False;{ Check for InputFile existence }if not FileExists(InputFile)thenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'Input file * %s *' + #10 +'does not exist' + #10 + #10 +ErrMsg, [InputFile]);{ Save the cursor }OldCursor := Screen.Cursor;Screen.Cursor := crHourglass;{ Copy the parameter Pascal strings to null terminatedstrings }StrPCopy(pCommandLine, CommandLine);StrPCopy(pInputFile, InputFile);StrPCopy(pOutPutFile, OutputFile);TRY{ Prepare SecAtrrs structure for the CreateFile calls.This SecAttrs structure is needed in this case becausewe want the returned handle can be inherited by childprocess. This is true when running under WinNT.As for Win95, the documentation is quite ambiguous }FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);SecAtrrs.nLength := SizeOf(SecAtrrs);SecAtrrs.lpSecurityDescriptor := nil;SecAtrrs.bInheritHandle := True;{ Create the appropriate handle for the input file }hInputFile := CreateFile(pInputFile,{pointer to name of the file }GENERIC_READ or GENERIC_WRITE, {access (read-write) mode }FILE_SHARE_READ or FILE_SHARE_WRITE, {share mode }@SecAtrrs, {pointer to security attributes }OPEN_ALWAYS,{how to create }FILE_ATTRIBUTE_NORMALor FILE_FLAG_WRITE_THROUGH, { file attributes }0 ); {andle to file with attributes to copy }{ Is hInputFile a valid handle? }if hInputFile = INVALID_HANDLE_VALUEthenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'WinApi function CreateFile returned an' + 'invalid handle value' + #10 +'for the input file * %s *' + #10 + #10 +ErrMsg, [InputFile]);{ Create the appropriate handle for the output file }hOutputFile := CreateFile(pOutPutFile,{pointer to name of the file }GENERIC_READ or GENERIC_WRITE,{access (read-write) mode }FILE_SHARE_READ or FILE_SHARE_WRITE,{share mode }@SecAtrrs,{pointer to security attributes }CREATE_ALWAYS, { how to create }FILE_ATTRIBUTE_NORMALor FILE_FLAG_WRITE_THROUGH,{file attributes }0 );{handle to file with attributes to copy }{ Is hOutputFile a valid handle? }if hOutputFile = INVALID_HANDLE_VALUEthenraise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +'WinApi function CreateFile returned an' +'invalid handle value' + #10 +'for the output file * %s *' + #10 + #10 +ErrMsg, [OutputFile]);{ Prepare StartupInfo structure }FillChar(StartupInfo, SizeOf(StartupInfo), #0);StartupInfo.cb := SizeOf(StartupInfo);StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;StartupInfo.wShowWindow := SW_HIDE;StartupInfo.hStdOutput := hOutputFile;StartupInfo.hStdInput := hInputFile;{ Create the app }Result := CreateProcess(nil, { pointer to name of executable module }pCommandLine, { pointer to command line string }nil, { pointer to process security attributes }nil, { pointer to thread security attributes }True, { handle inheritance flag }HIGH_PRIORITY_CLASS, { creation flags }nil, { pointer to new environment block }nil, { pointer to current directory name }StartupInfo, { pointer to STARTUPINFO }ProcessInfo); { pointer to PROCESS_INF }{ wait for the app to finish its job and take the handles to free them later }if ResultthenbeginWaitforSingleObject(ProcessInfo.hProcess, INFINITE);hAppProcess := ProcessInfo.hProcess;hAppThread := ProcessInfo.hThread;endelseraise Exception.Create(ROUTINE_ID + #10 + #10 +'Function failure' + #10 + #10 +ErrMsg);FINALLY{ Close the handles.Kernel objects, like the process and the files we created in this case, are maintained by a usage count. So, for cleaning up purposes, we have to close the handles to inform the system that we don't need the objects anymore }if hOutputFile <> 0 then CloseHandle(hOutputFile);if hInputFile <> 0 then CloseHandle(hInputFile);if hAppThread <> 0 then CloseHandle(hAppThread);if hAppProcess <> 0 then CloseHandle(hAppProcess);{ Restore the old cursor }Screen.Cursor:= OldCursor;END;end; { CreateDOSProcessRedirected }
procedure TForm1.Button1Click(Sender: TObject);
var
t:tstringlist;
begin
t:=tstringlist.create;
t.SaveToFile('e:\temp\ttt1.txt');
CreateDOSProcessRedirected('net share','e:\temp\ttt1.txt','e:\temp\ttt2.txt','');
t.LoadFromFile('e:\temp\ttt2.txt');
deletefile( 'e:\temp\ttt1.txt');
deletefile( 'e:\temp\ttt2.txt');memo1.Lines:=t; //可对t处理后再显示winexec('net share e:\share /delete',sw_hide); //删除共享
end;end.
function NetShareDel(ServerName:Widestring; NetName: Widestring;
Reserved: DWord): Integer; StdCall;
Function GetUserResource( UserName : string ; var List : TStringList ) : Boolean;
Var
NetResource : TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWord;
Ind : Integer;
lphEnum : THandle;
Temp : TNetResourceArray;
Begin
Result := False;
List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0); //初始化网络层次信息
NetResource.lpRemoteName := @UserName[1]; //指定计算机名称
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
//获取指定计算机的网络资源句柄
If Res <> NO_ERROR Then exit; //执行失败
While True Do //列举指定工作组的网络资源
Begin
Count := $FFFFFFFF; //不限资源数目
BufSize := 8192; //缓冲区大小设置为8K
GetMem(Buf, BufSize); //申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
//获取指定计算机的网络资源名称
If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕
If (Res <> NO_ERROR) then Exit; //执行失败
Temp := TNetResourceArray(Buf);
For Ind := 0 to Count - 1 do
Begin
List.Add(Temp^.lpRemoteName);
Inc(Temp);
End;
End;
Res := WNetCloseEnum(lphEnum); //关闭一次列举
If Res <> NO_ERROR Then exit; //执行失败
Result := True;
FreeMem(Buf);
End;
procedure TForm1.Button1Click(Sender: TObject);
var
List:TstringList;
i:integer;
begin
try
List:=TstringList.Create;
if GetUserResource(edit1.text,List) then
if List.count=0 then //指定计算机下没有找到共享资源
begin
memo1.Lines.Add (edit1.text+'下没有找到共享资源!');
end
else
memo1.Lines.Add (edit1.text+'下的所有共享资源如下:');
for i:=0 to List.Count-1 do
begin
Memo1.lines.Add (List.strings[i]);
end;
finally
List:=TstringList.Create; //如有异常则释放分配的资源
end;
end;
转贴地址:
http://www.piecust.jsol.net/jinjohn/program/delphi/wtj/network/net0009.htm
1、找不到TNetResource的帮助,我很想全面了解一下TNetResource,请问在哪里可以找到?
2、我记得在使用类的对象之前都要Create一下,而上面的代码中在使用NetResource之前并没有Create,请问这是怎么回事?
DWORD dwScope;
DWORD dwType;
DWORD dwDisplayType;
DWORD dwUsage;
LPTSTR lpLocalName;
LPTSTR lpRemoteName;
LPTSTR lpComment;
LPTSTR lpProvider;
} NETRESOURCE;
您好,您上面推荐的http://www.piecust.jsol.net/jinjohn/program/delphi/wtj/network/net0009.htm
我已经仔细的看过了,基本上读懂了,真是受益匪浅。不过还是有一个细节上的问题,请解释一下,谢谢:代码中有这样一段:TNetResource(NetworkTypeList.Items[J]^)NetworkTypeList.Items[J]^指的是NetworkTypeList.Items[J]所指向的内存块的内容,这已经是TNetResource类型的了,那这里的TNetResource是什么意思呢?