会员: 密码:  免费注册 | 忘记密码 | 会员登录 网页功能: 加入收藏 设为首页 网站搜索  
技术文档 > Delphi
通过程序获得局域网内的全部机器名
发表日期:2003-05-28 00:00:00作者: 出处:  

type

 PnetResourceArr = ^TNetResource;

implementation

procedure GetServerList(List:TStrings);

Type

 {$H+}

 PMyRec = ^MyRec;

 MyRec = Record

      dwScope   : Integer;

      dwType    : Integer;

      dwDisplayType : Integer;

      dwUsage   : Integer;

      LocalName  : String;

      RemoteName  : String;

      Comment   : String;

      Provider   : String;

     End;

 {H-}

Var

 NetResource : TNetResource;

 TempRec  : PMyRec;

 Buf    : Pointer;

 Count,

 BufSize,

 Res    : DWORD;

 lphEnum  : THandle;

 p     : PNetResourceArr;

 i,

 j     : SmallInt;

 NetworkTypeList : TList;

begin

// Result := False;

 NetworkTypeList := TList.Create;

 List.BeginUpdate;

 List.Clear;

 GetMem(Buf, 8192);

 Try

  Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum);

  If Res <> 0 Then Raise Exception(Res);

  Count := $FFFFFFFF;

  BufSize := 8192;

  Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

  If Res = ERROR_NO_MORE_ITEMS Then Exit;

  If (Res <> 0) Then Raise Exception(Res);

  P := PNetResourceArr(Buf);

  For I := 0 To Count - 1 Do

  Begin

   New(TempRec);

   TempRec^.dwScope := P^.dwScope;

   TempRec^.dwType := P^.dwType ;

   TempRec^.dwDisplayType := P^.dwDisplayType ;

   TempRec^.dwUsage := P^.dwUsage ;

   TempRec^.LocalName := StrPas(P^.lpLocalName);

   TempRec^.RemoteName := StrPas(P^.lpRemoteName);

   TempRec^.Comment := StrPas(P^.lpComment);

   TempRec^.Provider := StrPas(P^.lpProvider);

   NetworkTypeList.Add(TempRec);

   Inc(P);

  End;

  Res := WNetCloseEnum(lphEnum);

  If Res <> 0 Then Raise Exception(Res);

  For J := 0 To NetworkTypeList.Count-1 Do

  Begin

   TempRec := NetworkTypeList.Items[J];

   NetResource := TNetResource(TempRec^);

   Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

   If Res <> 0 Then Raise Exception(Res);

   While true Do

   Begin

    Count := $FFFFFFFF;

    BufSize := 8192;

    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If Res = ERROR_NO_MORE_ITEMS Then Break;

    If (Res <> 0) Then Raise Exception(Res);

    P := PNetResourceArr(Buf);

    For I := 0 To Count - 1 Do

    Begin

     List.Add(P^.lpRemoteName);

     Inc(P);

    End;

   End;

  End;

  Res := WNetCloseEnum(lphEnum);

  If Res <> 0 Then Raise Exception(Res);

  //Result := True;

  Finally

   FreeMem(Buf);

   NetworkTypeList.Destroy;

 End;

 List.EndUpdate;

end;

procedure GetUserList(fServer:string;List:TStrings);

Var

 NetResource : TNetResource;

 Buf    : Pointer;

 Count,

 BufSize,

 Res    : DWord;

 Ind    : Integer;

 lphEnum  : THandle;

 Temp    : PNetResourceArr;

Begin

 List.Clear;

 GetMem(Buf, 8192);

 Try

  FillChar(NetResource, SizeOf(NetResource), 0);

  NetResource.lpRemoteName := @fServer[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 <> 0 Then Exit;

  While True Do

  Begin

   Count := $FFFFFFFF;

   BufSize := 8192;

   Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

   If Res = ERROR_NO_MORE_ITEMS Then Exit;

   If (Res <> 0) then Exit;

   Temp := PNetResourceArr(Buf);

   For Ind := 0 to Count - 1 do

   Begin

    List.Add(Temp^.lpRemoteName + 2); { Add all the network usernames to List StringList }

    Inc(Temp);

   End;

  End;

  Res := WNetCloseEnum(lphEnum);

  If Res <> 0 Then Raise Exception(Res);

//  Result := True;

 Finally

  FreeMem(Buf);

 End;

End;

这程序是网上来的,我整理了一个,就变成现在这样了。

procedure oncreate;

begin GetServerList(Listbox1.Items);end;

procedure Listbox1.Onclick

begin

 GetUserList(Listbox1.Items[Listbox1.ItemIndex],Listbox2.Items);

end;

**************************************

获得网上邻居列表的程序

程序如下:

var

i : Integer;

ErrCode : Integer;

NetRes : Array[0..1023] of TNetResource;

EnumHandle : Thandle;

EnumEntries : Dword;

BufferSize : Dword;

ComputerIP,ComputerName:String;

begin

//try

With NetRes[0] do begin

 dwScope :=RESOURCE_GLOBALNET;

 dwType :=RESOURCETYPE_ANY;

 dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;

 dwUsage :=RESOURCEUSAGE_CONNECTABLE;

 lpLocalName :=NIL;

 lpRemoteName :=NIL;

 lpComment :=NIL;

 lpProvider :=NIL;

 end;

{ get net root }

ErrCode:=WNetOpenEnum(

RESOURCE_GLOBALNET,

RESOURCETYPE_ANY,

RESOURCEUSAGE_CONTAINER,

@NetRes[0],

EnumHandle

);

If ErrCode=NO_ERROR then begin

 EnumEntries:=1;

 BufferSize:=SizeOf(NetRes);

 ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);

 WNetCloseEnum(EnumHandle);

 ErrCode:=WNetOpenEnum(

 RESOURCE_GLOBALNET,

 RESOURCETYPE_ANY,

 RESOURCEUSAGE_CONNECTABLE,

 @NetRes[0],

 EnumHandle

 );

 EnumEntries:=1024;

 BufferSize:=SizeOf(NetRes);

 ErrCode:=WNetEnumResource(

 EnumHandle,

 EnumEntries,

 @NetRes,

 BufferSize

 );

 for i:=0 to 1023 do

   if NetRes[i].lpRemoteName='' then Exit

   else begin

    ComputerName:=Copy(NetRes[i].lpRemoteName,3,Length(NetRes[i].lpRemoteName)-2);

    ComputerIP:=GetIP(ComputerName);

    ShowMessage('计算机名' + NetRes[i].lpRemoteName + chr(13)

    + '计算机说明:' + NetRes[i].lpComment + chr(13)

    + 'IP地址:' + ComputerIP);

 end;

 end;

*************

请问怎样获取所有能访问的网上邻居中的计算机名称列表?

通过Windows Shell API

用SHGetSpecialFolderLocation获得Neighborhood的PIDL,然后将一个IShellFolder接

口绑定到这个PIDL,再然后就可以用这个接口的EnumObjects函数枚举其中的对象了。

因我不会Delphi,所以不知道用Delphi应该具体如何做,下面一段C++代码列出了"我

的电脑"下的所有项目(我的计算机没有安装网络邻居,所以用这个代替,方法应该是

一样的)

#include <stdio.h>

#include <iostream.h>

#include <comdef.h>

#include <windows.h>

#include <shellapi.h>

#include <shlobj.h>

#include <shlguid.h>

#include <shlwapi.h>

void _inline error(){ cerr<<"ERROR!"<<endl; _exit(1); }

void main(int argc, char* argv[])

{

IMallocPtr pMalloc;

IShellFolderPtr pShellFolder,pFolder;

LPITEMIDLIST pidl;

IEnumIDListPtr pEnum;

HRESULT hr;

STRRET Name;

ULONG celtFetched;

SHGetMalloc(&pMalloc);

if (!SUCCEEDED(SHGetDesktopFolder(&pShellFolder)))

 error();

if (!SUCCEEDED(SHGetSpecialFolderLocation(NULL,CSIDL_DRIVES,&pidl)))

 error();

pShellFolder->BindToObject(pidl,NULL,IID_IShellFolder,(LPVOID*)&pFolder);

hr=pFolder->EnumObjects(NULL,SHCONTF_FOLDERS|SHCONTF_NONFOLDERS|

 SHCONTF_INCLUDEHIDDEN,&pEnum);

while ((hr = pEnum->Next (1, &pidl, &celtFetched)) != S_FALSE &&

celtFetched == 1)

{

 hr = pFolder->GetDisplayNameOf (pidl, SHGDN_NORMAL , &Name);

 if (FAILED (hr))

 {

  error();

  break;

 }

 printf("%s\n",Name.cStr);

}

if (!pidl)

 pMalloc->Free(pidl);

}

**************

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 StdCtrls, ComCtrls, ImgList, ExtCtrls, ToolWin;

type

 TForm1 = class(TForm)

  ImageList1: TImageList;

  ToolBar1: TToolBar;

  ToolButton1: TToolButton;

  Panel1: TPanel;

  ResourceTree: TTreeView;

  Splitter1: TSplitter;

  ResourceList: TListView;

  Panel2: TPanel;

  lbScope: TLabel;

  lbType: TLabel;

  lbDisplayType: TLabel;

  lbUsage: TLabel;

  lbLocalName: TLabel;

  lbRemoteName: TLabel;

  lbComment: TLabel;

  lbProvider: TLabel;

  ToolButton2: TToolButton;

  procedure Button1Click(Sender: TObject);

  procedure ResourceTreeChange(Sender: TObject; Node: TTreeNode);

  procedure ToolButton2Click(Sender: TObject);

 private

  { Private declarations }

 public

  { Public declarations }

  function AddTreeItem(nr:NETRESOURCE;node:TTreeNode):TTreeNode;

  function EnumNetWorkResource(lpnr:PNetResource;node:TTreeNode):Boolean;

  procedure ConnectResource(pnr:PNetResource);

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

function GetLastErrorText:string;

var

  dwSize:DWORD;

  lpszTemp:LPSTR;

begin

   dwSize:=512;

   lpszTemp:=nil;

   try

    GetMem(lpszTemp,dwSize);

    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,

    nil,GetLastError,LANG_NEUTRAL,lpszTemp,dwSize,nil);

   finally

      Result:=StrPas(lpszTemp);

      FreeMem(lpszTemp);

   end;

end;

function TForm1.EnumNetWorkResource(lpnr:PNetResource;node:TTreeNode):Boolean;

var

nr:NetResource;

hEnum:THandle;

lpnrLocal: PNETRESOURCE;

cbBuffer:DWORD;

cEntries,dwEnumResult:DWORD;

i:Integer;

LocalNode:TTreeNode;

begin

Result:=False;

cbBuffer:=163840;

cEntries:=$ffffffff;

lpnrLocal:=nil;

if(WNetOpenEnum(RESOURCE_GLOBALNET,

RESOURCETYPE_ANY,

  0,

  lpnr,

  hEnum)<>NO_ERROR)then

  begin

  ShowMessage('Open enum error,node='+lpnr^.lpRemoteName);

  ShowMessage(GetLastErrorText);

  Result:=False;

  Exit;

  end;

try

  repeat

lpnrLocal:=PNetResource(GlobalAlloc(GPTR,cbBuffer));

  dwEnumResult:=WNetEnumResource(hEnum,

    cEntries,

      lpnrLocal,

      cbBuffer);

    if(dwEnumResult=NO_ERROR)then

    begin

      for i:=0 to cEntries-1 do

      begin

        nr:=(PNetResource(PChar(lpnrLocal)+sizeOf(NetResource)*i))^;

        LocalNode:=AddTreeItem(nr,node);

        if(RESOURCEUSAGE_CONTAINER=

        nr.dwUsage and RESOURCEUSAGE_CONTAINER)then

          begin

          if(not EnumNetWorkResource(@nr,LocalNode))then

          begin

          ShowMessage('Error enum,Parent='+lpnr^.lpRemoteName);

ShowMessage(GetLastErrorText);

            end;

          end;

        end;

      end;

  until (dwEnumResult=ERROR_NO_MORE_ITEMS);

  if(dwEnumResult=ERROR_NO_MORE_ITEMS)then

  Result:=True;

Except

GlobalFree(Cardinal(lpnrLocal));

WNetCloseEnum(hEnum);

  Raise;

  end;

GlobalFree(Cardinal(lpnrLocal));

WNetCloseEnum(hEnum);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumNetWorkResource(nil,ResourceTree.Items[0]);

end;

function TForm1.AddTreeItem(nr: NETRESOURCE; node: TTreeNode): TTreeNode;

var

pnr:PNetResource;

begin

GetMem(pnr,SizeOf(NetResource));

pnr^:=nr;

Result:=ResourceTree.Items.AddChildObject(node,nr.lpRemoteName,pnr);

if(nr.dwUsage=RESOURCEUSAGE_CONTAINER)then

Result.ImageIndex:=0

else Result.ImageIndex:=1;

end;

procedure TForm1.ResourceTreeChange(Sender: TObject; Node: TTreeNode);

var

pnr:PNetResource;

begin

pnr:=PNetResource(Node.Data);

if(pnr=nil)then Exit;

case pnr^.dwScope of

RESOURCE_CONNECTED:

  lbScope.Caption:='Connetted';

  RESOURCE_GLOBALNET:

  lbScope.Caption:='GlobalNet';

  RESOURCE_REMEMBERED:

  lbScope.Caption:='Remembered';

  else

  lbScope.Caption:='else scope:'+IntToStr(pnr^.dwScope);

  end;

case pnr^.dwType of

RESOURCETYPE_DISK:

  lbType.Caption:='Disk';

  RESOURCETYPE_PRINT:

  lbType.Caption:='Printer';

  else

  lbType.Caption:=IntToStr(pnr^.dwType);

  end;

case pnr^.dwDisplayType of

RESOURCEDISPLAYTYPE_DOMAIN:

  lbDisplayType.Caption:='Domain';

  RESOURCEDISPLAYTYPE_GENERIC:

  lbDisplayType.Caption:='Generic';

  RESOURCEDISPLAYTYPE_SERVER:

  lbDisplayType.Caption:='Server';

  RESOURCEDISPLAYTYPE_SHARE:

  lbDisplayType.Caption:='Shared';

  else

  lbDisplayType.Caption:='else type:'+IntToStr(pnr^.dwDisplayType);

  end;

case pnr^.dwUsage of

RESOURCEUSAGE_CONTAINER:

  lbUsage.Caption:='Container';

  RESOURCEUSAGE_CONNECTABLE:

  lbUsage.Caption:='Connectable';

  else

  lbUsage.Caption:='else Usage:'+IntToStr(pnr^.dwUsage);

  end;

lbLocalName.Caption:=pnr^.lpLocalName;

lbRemoteName.Caption:=pnr^.lpRemoteName;

lbComment.Caption:=pnr^.lpComment;

lbProvider.Caption:=pnr^.lpProvider;

//ConnectResource(pnr);

end;

procedure TForm1.ConnectResource(pnr: PNetResource);

begin

if((pnr^.dwUsage and RESOURCEUSAGE_CONNECTABLE)

=RESOURCEUSAGE_CONNECTABLE)then

  begin

{  if(WNetAddConnection2(pnr^,PChar(''),'wuwei',0)<>NO_ERROR)then

  ShowMessage(GetLastErrorText);}

if(WNetAddConnection(pnr^.lpRemoteName,'','h:')<>NO_ERROR)then

  ShowMessage(GetLastErrorText);

  end;

end;

procedure TForm1.ToolButton2Click(Sender: TObject);

var

p:PNetResource;

begin

p:=PNetResource(ResourceTree.Selected.Data);

ConnectResource(p);

end;

end.

*******

查询局域网中NT服务器的计算机名

You should use API function

NET_API_STATUS NetServerEnum(

 LPWSTR servername,  

 DWORD level,     

 LPBYTE *bufptr,    

 DWORD prefmaxlen,   

 LPDWORD entriesread, 

 LPDWORD totalentries, 

 DWORD servertype,   

 LPWSTR domain,    

 LPDWORD resume_handle 

);

返回顶部】 【打印本页】 【关闭窗口

关于我们 / 给我留言 / 版权举报 / 意见建议 / 网站编程QQ群   
Copyright ©2003- 2024 Lihuasoft.net webmaster(at)lihuasoft.net 加载时间 0.00405