＋设为首页 ＋添加到收藏夹
如何取得局域网中的所有计算机名，局域网为对等网。
如何取得一边接在INTERNET上的本地计算机的IP地址
UPUP:)
有分相送如何用VB动态获取网络邻居的名称及其IP地址要所有邻居 http://www.csdn.net/Expert/icView1.asp?id=286028
参考一下这个
添加一个模块并设置工程的启动对象为Sub Main()
Option Explicit
Private Const RESOURCE_CONNECTED As Long = &H1&
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCE_REMEMBERED As Long = &H3&
Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCETYPE_PRINT As Long = &H2&
Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000
Private Const NO_ERROR = 0
Private Const ERROR_MORE_DATA = 234 L // dderror
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
Private Type NETRESOURCE_REAL
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
sLocalName As String
sRemoteName As String
sComment As String
sProvider As String
End Type
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Sub main()
Const MAX_RESOURCES = 256
Const NOT_A_CONTAINER = -1
Dim bFirstTime As Boolean
Dim lReturn As Long
Dim hEnum As Long
Dim lCount As Long
Dim lMin As Long
Dim lLength As Long
Dim l As Long
Dim lBufferSize As Long
Dim lLastIndex As Long
Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
Dim uNet() As NETRESOURCE_REAL
bFirstTime = True
Do
If bFirstTime Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
bFirstTime = False
Else
If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)
Else
lReturn = NOT_A_CONTAINER
hEnum = 0
End If
lLastIndex = lLastIndex + 1
End If
If lReturn = NO_ERROR Then
lCount = RESOURCE_ENUM_ALL
Do
lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
If lCount > 0 Then
ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL
For l = 0 To lCount - 1
Each Resource will appear here as uNet(i)
uNet(lMin + l).dwScope = uNetApi(l).dwScope
uNet(lMin + l).dwType = uNetApi(l).dwType
uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
If uNetApi(l).pLocalName Then
lLength = lstrlen(uNetApi(l).pLocalName)
uNet(lMin + l).sLocalName = Space$(lLength)
CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength
End If
If uNetApi(l).pRemoteName Then
lLength = lstrlen(uNetApi(l).pRemoteName)
uNet(lMin + l).sRemoteName = Space$(lLength)
CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength
End If
If uNetApi(l).pComment Then
lLength = lstrlen(uNetApi(l).pComment)
uNet(lMin + l).sComment = Space$(lLength)
CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength
End If
If uNetApi(l).pProvider Then
lLength = lstrlen(uNetApi(l).pProvider)
uNet(lMin + l).sProvider = Space$(lLength)
CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength
End If
Next l
End If
lMin = lMin + lCount
Loop While lReturn = ERROR_MORE_DATA
End If
If hEnum Then
l = WNetCloseEnum(hEnum)
End If
Loop While lLastIndex < lMin
If UBound(uNet) > 0 Then
For l = 0 To UBound(uNet)
Select Case uNet(l).dwDisplayType
Case RESOURCEDISPLAYTYPE_DIRECTORY&
Debug.Print "Directory...",
Case RESOURCEDISPLAYTYPE_DOMAIN
Debug.Print "Domain...",
Case RESOURCEDISPLAYTYPE_FILE
Debug.Print "File...",
Case RESOURCEDISPLAYTYPE_GENERIC
Debug.Print "Generic...",
Case RESOURCEDISPLAYTYPE_GROUP
Debug.Print "Group...",
Case RESOURCEDISPLAYTYPE_NETWORK&
Debug.Print "Network...",
Case RESOURCEDISPLAYTYPE_ROOT&
Debug.Print "Root...",
Case RESOURCEDISPLAYTYPE_SERVER
Debug.Print "Server...",
Case RESOURCEDISPLAYTYPE_SHARE
Debug.Print "Share...",
Case RESOURCEDISPLAYTYPE_SHAREADMIN&
Debug.Print "ShareAdmin...",
End Select
Debug.Print uNet(l).sRemoteName, uNet(l).sComment
Next l
End If
End Sub
//*在网络邻居中获取所有的工作组及计算机名*//
//*在win2000下其运行速度将变得奇慢，在下到要请教各位，有何良方。*//
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls ,winsock;
type
TNetResourceArray = ^TNetResource; //网络资源类型的数组
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
function GetIP(Sender: TObject; fcomputername:string) :string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//函数GetServerList列举出整个网络中的工作组名称，返回值为TRUE表示执行成功，
Function GetServerList( var List : TStringList ) : Boolean; //参数List中返回服务器的名称
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;
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum); //获取整个网络中的文件资源的句柄，lphEnum为返回名柄
If Res <> NO_ERROR Then
exit; //执行失败，退出
Count := $FFFFFFFF; //执行成功，开始获取整个网络中的网络类型信息
BufSize := 8192; //不限资源数目
GetMem(Buf, BufSize); //缓冲区大小设置为8K
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;
Res:= WNetCloseEnum(lphEnum); //WNetCloseEnum关闭一个列举句柄
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 := 1024*16; //缓冲区大小设置为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;
{function TForm1.GetIP(Sender: TObject;fcomputername:String):String;
var
ch:array[1..32] of Char;
I : Integer;
WSData:TWSAData;
MyHost:PHostEnt;
S:String;
host:string;
begin
host:= fcomputername;
if WSAstartup(2,wsdata)<>0 then S:=Winsock Error
else
if GetHostName(@ch[1],32)<>0 then S:=HostName Error
else begin
StrPCopy(@ch[1],host);
MyHost:=GetHostByName(@ch[1]);
if MyHost=nil then S:=IP Error
else begin
S:=;
for i:=1 to 4 do begin
S:=S+IntToStr(Ord(MyHost.h_addr^[i-1]));
if i<4 then S:=S+.;
end;
end;
end;
Result:=S;
end; }
function TForm1.GetIP(Sender: TObject; fcomputername:string) :string;
var
WSAData: TWSAData;
HostEnt: PHostEnt;
begin
HostEnt := nil;
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(fComputerName));
if HostEnt <> nil then
begin
with HostEnt^ do
result:= Format(%d.%d.%d.%d, [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSACleanup;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl,s2:TstringList;
i,j,k:integer;
temp:string;
begin
temp:=d:\computer.txt;
memo1.lines.Clear;
sl:=Tstringlist.create;
s2:=Tstringlist.create;
try
if GetServerList(sl) then
begin
for i:=0 to sl.count-1 do
begin
memo1.lines.Add (sl.Strings[i]+:);
try
winexec(pchar(command.com /C net view /workgroup:+sl.Strings[i]+ >+temp),sw_hide);
except
end;
k:=120;
repeat;
sleep(k);
k:=k+40;
until
fileexists(temp);
s2.LoadFromFile(temp);
for j:=1 to s2.count-1 do
begin
if pos(：,s2.Strings[j]) >0 then
memo1.lines.Add (s2.Strings[j]);
if pos(\\,s2.Strings[j]) >0 then
memo1.lines.Add ( +copy(s2.Strings[j],1,15)+ IP: + GetIP(Sender,trim(copy(s2.Strings[j],3,20))));
end;
end;
memo1.lines.Add(工作组个数：+inttostr(sl.count));
end
else
memo1.lines.Add(没有找到工作组！);
except
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.lines.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
memo1.lines.SaveToFile(LKnet.spl);
action:=cafree;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
IF fileexists(LKnet.spl) then
Memo1.Lines.LoadFromFile(LKnet.spl);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if pos(工作组个数, memo1.Text) =0 then
button1click(sender);
end;
end.
学习
如果速度确实得到提升，那就非常棒了
