获取网上邻居所有计算机名,网上有很多,但都不能正常运行。

zhuxiaojun 2001-11-03 10:32:13
...全文
85 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
zfmich 2001-11-03
  • 打赏
  • 举报
回复
借花献佛,我已经测试过,没问题。

//列举出整个网络中的工作组名称,返回值为TRUE表示执行成功,
//参数List中返回服务器(工作组)的名称
Function GetServerList( var List : TStringList ) : Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
NetResource : TNetResource;
Buf : Pointer;
Count,BufSize,Res : DWORD;
lphEnum : THandle;
p : TNetResourceArray;
i,j : SmallInt;
NetworkTypeList : TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;

//获取整个网络中的文件资源的句柄,lphEnum为返回名柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,Nil,lphEnum);
If Res <> NO_ERROR Then exit;//Raise Exception(Res);//执行失败

//获取整个网络中的网络类型信息
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf,BufSize);//申请内存,用于获取工作组信息

Res := WNetEnumResource(lphEnum,Count,Pointer(Buf),BufSize);
If ( Res = ERROR_NO_MORE_ITEMS )//资源列举完毕
or (Res <> NO_ERROR )//执行失败
Then Exit;

P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do//记录各个网络类型的信息
Begin
NetworkTypeList.Add(p);
Inc(P);
End;

//WNetCloseEnum关闭一个列举句柄
Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then exit;

For J := 0 To NetworkTypeList.Count-1 Do //列出各个网络类型中的所有工作组名称
Begin//列出一个网络类型中的所有工作组名称
NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息

//获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
Res := WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@NetResource,lphEnum);
If Res <> NO_ERROR Then break;//执行失败

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 ) //资源列举完毕
or (Res <> NO_ERROR) //执行失败
then break;

P := TNetResourceArray(Buf);
For I := 0 To Count - 1 Do//列举各个工作组的信息
Begin
List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
Inc(P);
End;

End;

Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then break;//执行失败

End;

Result := True;
FreeMem(Buf);

NetworkTypeList.Destroy;

End;


//列举出指定工作组GroupName中的计算机名称,返回值为TRUE表示执行成功,
//参数List中返回计算机名称
Function GetUsers( GroupName : string; var List : TStringList ) : Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
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 := @GroupName[1];//指定工作组名称
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息

//获取指定工作组的网络资源句柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@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
//获取工作组的计算机名称,+2表示删除"\\",如\\wangfajun=>wangfajun
List.Add(Temp^.lpRemoteName + 2);
Inc(Temp);
End;
End;

Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then exit;//执行失败

Result := True;
FreeMem(Buf);
End;
cobi 2001-11-03
  • 打赏
  • 举报
回复
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
WinSock, StdCtrls, tools, ExtCtrls, Buttons, IniFiles, ComCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
edStart: TEdit;
edEnd: TEdit;
plMemo: TPanel;
Panel3: TPanel;
lbCount: TLabel;
btnGetHostName: TButton;
BitBtn1: TBitBtn;
Timer1: TTimer;
Label1: TLabel;
lbUsedTime: TLabel;
Memo1: TMemo;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
btnPing: TButton;
ProgressBar: TProgressBar;
procedure btnGetHostNameClick(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnPingClick(Sender: TObject);
procedure Memo1DblClick(Sender: TObject);
private
{ Private declarations }
sysDir: string;
CountOfThreads: integer;
IpStartLastSection,IpEndLastSection: integer;
procedure MyMsgHasGetName(var msg: TMessage); message MYMSG_HASGETNAME;
procedure MyMsgResultOfPing(var msg: TMessage); message MYMSG_RESULTOFPING;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.DFM}

procedure TForm1.btnGetHostNameClick(Sender: TObject);
var
i: integer;
IpHeader,sIP: string;
//p: PHostEnt;
begin
if GetIPHeader(edStart.Text) <> GetIPHeader(edEnd.Text) then
showMessage(' Error ');
IpHeader := GetIPHeader(edStart.Text);
IpStartLastSection := GetIPLastSection(edStart.Text);
IpEndLastSection := GetIPLastSection(edEnd.Text);
if (IpStartLastSection = 0)or(IpEndLastSection = 0)
or(IpStartLastSection > IpEndLastSection) then
exit;

lbUsedTime.Caption := '0';
timer1.Enabled := true;
for i := IpStartLastSection to IpEndLastSection do
begin
sIP := IpHeader + inttostr(i);
with TThreadGetComputerName.Create(handle,sIP,false) do;
//FreeOnTerminate := true;
inc(CountOfThreads);
end;
end;

procedure TForm1.MyMsgHasGetName(var msg: TMessage);
var
sIP: string;
p: PHostEnt;
i: integer;
begin
if msg.WParam <> 0 then
begin
sIP := string(pchar(msg.WParam));
if length(sIP) < 20 then
for i:=length(sIP) to 20 do
sIP := sIP + ' ';
end
else exit;
if msg.LParam <> 0 then
begin
p := PHostEnt(msg.LParam);
Memo1.Lines.Add('IP: ' + sIP + ' Computer Name: ' + p^.h_name);
end
else
begin
Memo1.Lines.Add('IP: ' + sIP + ' Computer Name: ' + '=Unknown=');
end;
Application.ProcessMessages;
dec(CountOfThreads);
if CountOfThreads = 0 then Timer1.Enabled := false;
end;

procedure TForm1.MyMsgResultOfPing(var msg: TMessage);
var
ResultStr: string;
begin
ResultStr := string(PChar(msg.lParam));
Memo1.Lines.Add(ResultStr);
dec(CountOfThreads);
ProgressBar.Position := ProgressBar.Position + 1;
Application.ProcessMessages;
if CountOfThreads = 0 then Timer1.Enabled := false;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
lbCount.Caption := inttostr(Memo1.Lines.Count);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if CountOfThreads = 0 then
timer1.Enabled := false
else
lbUsedTime.Caption := inttostr((strtoint(lbUsedTime.Caption))+1);
Application.ProcessMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
strStart,strEnd: string;
begin
plMemo.Align := alClient;
CountOfThreads := 0;
SetLength(sysDir,255);
GetSystemDirectory(pChar(sysDir),255);
sysDir := PChar(sysDir);
if (length(sysDir) = 0) then exit;
if copy(sysDir,length(sysDir),1) <> '\' then
sysDir := sysDir + '\';
IniFile:=TIniFile.Create(sysDir + 'RSetup.ini');
try
strStart := IniFile.ReadString('RANGE','START','');
strEnd := IniFile.ReadString('RANGE','END','');
if (strStart <> '')and(strEnd <> '') then
begin
edStart.Text := strStart;
edEnd.Text := strEnd;
end;
finally
IniFile.Free;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
IniFile: TIniFile;
begin
if sysDir = '' then exit;
IniFile:=TIniFile.Create(sysDir + 'RSetup.ini');
try
IniFile.WriteString('RANGE','START',edStart.Text);
IniFile.WriteString('RANGE','END',edEnd.Text);
finally
IniFile.Free;
end;
end;

procedure TForm1.btnPingClick(Sender: TObject);
var
i: integer;
IpHeader,sIP: string;
WSAData: TWSAData;
hICMPdll: HMODULE;
hICMP: THandle;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
begin
if GetIPHeader(edStart.Text) <> GetIPHeader(edEnd.Text) then
showMessage(' Error ');
IpHeader := GetIPHeader(edStart.Text);
IpStartLastSection := GetIPLastSection(edStart.Text);
IpEndLastSection := GetIPLastSection(edEnd.Text);
if (IpStartLastSection = 0)or(IpEndLastSection = 0)
or(IpStartLastSection > IpEndLastSection) then
exit;
ProgressBar.Position := 0;
ProgressBar.Max := IpEndLastSection - IpStartLastSection + 1;
WSAStartup(2,WSAData);
try
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll,'IcmpCreateFile');
@ICMPCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
@ICMPSendEcho := GetProcAddress(hICMPdll,'IcmpSendEcho');
hICMP := IcmpCreateFile;
Memo1.Lines.Add('---目的地址--- ------字节数-----返回时间(毫秒)');

lbUsedTime.Caption := '0';
timer1.Enabled := true;
for i := IpStartLastSection to IpEndLastSection do
begin
sIP := IpHeader + inttostr(i);
with TThreadPing.Create(handle,sIP,true,
hICMP,
IcmpCreateFile,
IcmpCloseHandle,
IcmpSendEcho) do
begin
inc(CountOfThreads);
Application.ProcessMessages;
Resume;
end;
while(CountOfThreads > 20)and(Not Application.Terminated) do
Application.ProcessMessages;
end;
while(CountOfThreads <> 0)and(Not Application.Terminated) do
Application.ProcessMessages;
finally
WSACleanup;
end;

end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
Memo1.Clear;
Memo1Change(sender);
end;

end.


unit tools;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
WinSock;
const
MYMSG_HASGETNAME = WM_USER + 111;
MYMSG_RESULTOFPING = WM_USER + 112;

type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: byte;
TOS: byte;
Flags: byte;
OptionsSize: byte;
OptionsData: PChar;
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = Packed record
Address: dword;
Status: dword;
RTT: dword;
DataSize: word;
Reserved: word;
Data: pointer;
Options: TIPOptionInformation;
end;

TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): boolean; stdcall;
TIcmpSendEcho = function(Icmphandle: Thandle;
DestinationAddress: dword;
RequestData: pointer;
RequestSize: word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: pointer;
ReplySize: dword;
Timeout: dword): dword; stdcall;


type
TThreadGetComputerName = class(TThread)
private
fOwnerHandle: hWnd;
fsIP: string;
protected
procedure Execute; override;
public
constructor Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean);
end;

TThreadPing = class(TThread)
private
fOwnerHandle: hWnd;
fsIP: string;
fhICMP: THandle;
fIcmpCreateFile: TIcmpCreateFile;
fIcmpCloseHandle: TIcmpCloseHandle;
fIcmpSendEcho: TIcmpSendEcho;
protected
procedure Execute; override;
public
constructor Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean;
hICMP: THandle;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho);
end;


function GetIPHeader(sIP: string): string;
function GetIPLastSection(sIP: string): byte;
function wpGetUserNameByIP(sIP: string): PHostEnt;

function winPing(sIP: string;
hICMP: THandle;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho): string;

implementation

function GetIPHeader(sIP: string): string;
var
tmpIp: string;
begin
result := '';
tmpIp := sIP;
while copy(tmpIp,length(tmpIp),1) <> '.' do
delete(tmpIp,length(tmpIp),1);
result := tmpIp;
end;

function GetIPLastSection(sIP: string): byte;
var
tmpIp: string;
resultStr: string;
begin
resultStr := '';
tmpIp := sIP;
while copy(tmpIp,length(tmpIp),1) <> '.' do
begin
resultStr := copy(tmpIp,length(tmpIp),1) + resultStr;
delete(tmpIp,length(tmpIp),1);
end;
if StrToInt(resultStr) > 255 then
result := 0
else
result := StrToInt(resultStr);
end;

function wpGetUserNameByIP(sIP: string): PHostEnt;
var
WSAData: TWSAData;
p: PHostEnt;
InetAddr: dword;
begin
WSAStartup(2,WSAData);
InetAddr := inet_addr(PChar(sIP));
try
try
p := GetHostByAddr(@InetAddr,length(sIP),PF_Inet);
finally
WSACleanup;
end;
except
ShowMessage('Can not Get the COMPUTER NAME which IP = ' + sIP +', Abort');
end;
result := p;
end;

function winPing(sIP: string;
hICMP: THandle;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho): string;
var
IPOpt: TIPOptionInformation; //the option information which send with echo packet
FIPAddress: dword;
pReqData,pRevData: PChar;
pIPE: PIcmpEchoReply; //ICMP Echo reply cache
FSize: dword;
MyString: string;
FTimeOut: dword;
BufferSize: dword;
i: integer;
begin
Result := PChar(sIP) + 'No acknowledgement';
if sIP = '' then exit;
FIPAddress := inet_addr(pchar(sIP));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^,SizeOf(pIPE^),0);
pIPE^.Data := pRevData;
MyString := '------Hello,This is My Echo-------';
pReqData := PChar(MyString);
FillChar(IPOpt,Sizeof(IPOpt),0);
IPOpt.TTL := 64;
FTimeout := 4000;
IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),
@IPOpt,pIPE,BufferSize,FTimeout);
try
try
if length(sIP) < 20 then
for i:=length(sIP) to 20 do
sIP := sIP + ' ';
Result := sIP + 'No acknowledgement';
if pIPE^.Options.TTL <> 0 then
if pReqData^ = pIPE^.Options.OptionsData^ then
begin
Result := sIP + '--------'
+IntToStr(pIPE^.DataSize)
+ '----------------'
+ inttostr(pIPE^.RTT);
end;
except
Result := sIP + ' No answer ';
end;
finally
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;

constructor TThreadGetComputerName.Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean);
begin
fsIP := sIP;
fOwnerHandle := OwnerHandle;
inherited Create(CreateSuspended);
Self.FreeOnTerminate := true;
end;

procedure TThreadGetComputerName.Execute;
var
p: PHostEnt;
sIP: string;
begin
sIP := fsIP;
p := wpGetUserNameByIP(sIP);
SendMessage(fOwnerHandle,MYMSG_HASGETNAME,integer(@sIP[1]),integer(p));
end;

constructor TThreadPing.Create(OwnerHandle: hWnd; sIP: string; CreateSuspended: Boolean;
hICMP: THandle;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho);
begin
fsIP := sIP;
fOwnerHandle := OwnerHandle;
fhICMP := hICMP;
fIcmpCreateFile := IcmpCreateFile;
fIcmpCloseHandle := IcmpCloseHandle;
fIcmpSendEcho := IcmpSendEcho;
inherited Create(CreateSuspended);
Self.FreeOnTerminate := true;
end;

procedure TThreadPing.Execute;
var
sIP,ResultStr: string;
begin
sIP := fsIP;
ResultStr := winPing(sIP,
fhICMP,
fIcmpCreateFile,
fIcmpCloseHandle,
fIcmpSendEcho);
SendMessage(fOwnerHandle,MYMSG_RESULTOFPING,integer(@sIP[1]),
integer(@ResultStr[1]));
end;

end.
可用的程序,两个单元

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧