取得网上邻居中的工作组及计算机名:
procedure GetDomainList(TV:TTreeView);
var
a : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : THandle;
EnumEntries : DWord;
BufferSize : DWord;
s : string;
itm : TTreeNode;
begin
{ Start here }
try
With NetRes[0] do begin
dwScope :=RESOURCE_GLOBALNET;
dwType :=RESOURCETYPE_ANY;
dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
dwUsage :=RESOURCEUSAGE_CONTAINER;
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_CONTAINER,
@NetRes[0],
EnumHandle
);
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(
EnumHandle,
EnumEntries,
@NetRes[0],
BufferSize
);
IF ErrCode=No_Error then with TV do try
a:=0;
Items.BeginUpDate;
Items.Clear;
Itm:=Items.Add(TV.Selected,string(NetRes[0].lpProvider));
Itm.ImageIndex:=0;
Itm.SelectedIndex:=0;
{ get domains }
下面的一个单元定义了一个组件. TNetworkBrowser, 可以枚举hierachical树上所有的网络资源. 实际上浏览是要花费很长时间的,这您可以通过在WINDOWS资源管理器中打开"整个网络" 来比较一下. 如果你设置SCOPE属性 为nsContext , 你就可以看到和网络邻居中一样的机器列表.
unit NetBrwsr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TNetScope = (nsConnected, nsGlobal, nsRemembered, nsContext);
TNetResourceType = (nrAny, nrDisk, nrPrint);
TNetDisplay = (ndDomain, ndGeneric, ndServer, ndShare, ndFile, ndGroup,
ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
TNetUsage = set of (nuConnectable, nuContainer);
TNetworkItems = class;
TNetworkItem = class
private
FScope: TNetScope;
FResourceType: TNetResourceType;
FDisplay: TNetDisplay;
FUsage: TNetUsage;
FLocalName: string;
FRemoteName: string;
FComment: string;
FProvider: string;
FSubItems: TNetworkItems;
public
constructor Create;
destructor Destroy; override;
property Scope: TNetScope read FScope;
property ResourceType: TNetResourceType read FResourceType;
property Display: TNetDisplay read FDisplay;
property Usage: TNetUsage read FUsage;
property LocalName: string read FLocalName;
property RemoteName: string read FRemoteName;
property Comment: string read FComment;
property Provider: string read FProvider;
property SubItems: TNetworkItems read FSubItems;
end;
TNetworkItems = class
private
FList: TList;
procedure SetItem(Index: Integer; Value: TNetworkItem);
function GetItem(Index: Integer): TNetworkItem;
function GetCount: Integer;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(Item: TNetworkItem);
procedure Delete(Index: Integer);
property Items[Index: Integer]: TNetworkItem read GetItem write
SetItem; default;
property Count: Integer read GetCount;
end;
TNetworkBrowser = class(TComponent)
private
FItems: TNetworkItems;
FScope: TNetScope;
FResourceType: TNetResourceType;
FUsage: TNetUsage;
FActive: Boolean;
procedure Refresh;
procedure SetActive(Value: Boolean);
procedure SetScope(Value: TNetScope);
procedure SetResourceType(Value: TNetResourceType);
procedure SetUsage(Value: TNetUsage);
procedure EnumerateNet(NetItems: TNetworkItems; lpnr: PNetResource);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Open;
procedure Close;
property Items: TNetworkItems read FItems;
published
property Scope: TNetScope read FScope write SetScope default nsGlobal;
property ResourceType: TNetResourceType read FResourceType
write SetResourceType default nrAny;
property Usage: TNetUsage read FUsage write SetUsage default [];
property Active: Boolean read FActive write SetActive default False;
end;
implementation
type
PNetResourceArray = ^TNetResourceArray;TNetResourceArray = array[0..0] of TNetResource;
{ TNetworkItem }
constructor TNetworkItem.Create;
begin
inherited;
FSubItems := TNetworkItems.Create;
end;
destructor TNetworkItem.Destroy;
begin
if FSubItems <> nil then
FSubItems.Free;
inherited;
end;
{ TNetworkItems }
constructor TNetworkItems.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TNetworkItems.Destroy;
begin
Clear;
if FList <> nil then
FList.Free;
inherited;
end;
procedure TNetworkItems.SetItem(Index: Integer; Value: TNetworkItem);
begin
if (FList.Items[Index] <> nil) and (FList.Items[Index] <> Value) then
TNetworkItem(FList.Items[Index]).Free;
FList.Items[Index] := Value;
end;
function TNetworkItems.GetItem(Index: Integer): TNetworkItem;
begin
Result := TNetworkItem(FList.Items[Index]);
end;
procedure TNetworkItems.Clear;
begin
while Count > 0 do
Delete(0);
end;
procedure TNetworkItems.Add(Item: TNetworkItem);
begin
FList.Add(Item);
end;
procedure TNetworkItems.Delete(Index: Integer);
begin
if FList.Items[Index] <> nil then
TNetworkItem(FList.Items[Index]).Free;
FList.Delete(Index);
end;
function TNetworkItems.GetCount: Integer;
begin
if FList <> nil then
Result := FList.Count
else
Result := 0;
end;

解决方案 »

  1.   

    { TNetworkBrowser }
    constructor TNetworkBrowser.Create(AOwner: TComponent);
    begin
    inherited Create(AOwner);
    FItems := TNetworkItems.Create;
    FScope := nsGlobal;
    FResourceType := nrAny;
    FUsage := [];
    end;
    destructor TNetworkBrowser.Destroy;
    begin
    if FItems <> nil then
    FItems.Free;
    inherited;
    end;
    procedure TNetworkBrowser.EnumerateNet(NetItems: TNetworkItems; lpnr:
    PNetResource);
    var
    dwResult, dwResultEnum: Integer;
    hEnum: THandle;
    cbBuffer, cEntries, i: Integer;
    nrArray: PNetResourceArray;
    NewItem: TNetworkItem;
    dwScope, dwType, dwUsage: Integer;
    begin
    cbBuffer := 16384;
    cEntries := $FFFFFFFF;
    case FScope of
    nsConnected: dwScope := RESOURCE_CONNECTED;
    nsGlobal: dwScope := RESOURCE_GLOBALNET;
    nsRemembered: dwScope := RESOURCE_REMEMBERED;
    nsContext: dwScope := RESOURCE_CONTEXT;
    else
    dwScope := RESOURCE_GLOBALNET;
    end;
    case FResourceType of
    nrAny: dwType := RESOURCETYPE_ANY;
    nrDisk: dwType := RESOURCETYPE_DISK;
    nrPrint: dwType := RESOURCETYPE_PRINT;
    else
    dwType := RESOURCETYPE_ANY;
    end;
    dwUsage := 0;
    if nuConnectable in FUsage then
    dwUsage := dwUsage or RESOURCEUSAGE_CONNECTABLE;
    if nuContainer in FUsage then
    dwUsage := dwUsage or RESOURCEUSAGE_CONTAINER;
    dwResult := WNetOpenEnum(dwScope, dwType, dwUsage, lpnr, hEnum);
    if dwResult <> NO_ERROR then Exit;
    GetMem(nrArray, cbBuffer);
    repeat
    dwResultEnum := WNetEnumResource(hEnum, cEntries, nrArray, cbBuffer);
    if dwResultEnum = NO_ERROR then
    for i := 0 to cEntries-1 do
    begin
    NewItem := TNetworkItem.Create;
    case nrArray[i].dwScope of
    RESOURCE_CONNECTED: NewItem.FScope := nsConnected;
    RESOURCE_GLOBALNET: NewItem.FScope := nsGlobal;
    RESOURCE_REMEMBERED: NewItem.FScope := nsRemembered;
    RESOURCE_CONTEXT: NewItem.FScope := nsContext;
    else
    NewItem.FScope := nsGlobal;
    end;
    case nrArray[i].dwType of
    RESOURCETYPE_ANY: NewItem.FResourceType := nrAny;
    RESOURCETYPE_DISK: NewItem.FResourceType := nrDisk;
    RESOURCETYPE_PRINT: NewItem.FResourceType := nrPrint;
    else
    NewItem.FResourceType := nrAny;
    end;
    case nrArray[i].dwDisplayType of
    RESOURCEDISPLAYTYPE_GENERIC: NewItem.FDisplay := ndGeneric;
    RESOURCEDISPLAYTYPE_DOMAIN: NewItem.FDisplay := ndDomain;
    RESOURCEDISPLAYTYPE_SERVER: NewItem.FDisplay := ndServer;
    RESOURCEDISPLAYTYPE_SHARE: NewItem.FDisplay := ndShare;
    RESOURCEDISPLAYTYPE_FILE: NewItem.FDisplay := ndFile;
    RESOURCEDISPLAYTYPE_GROUP: NewItem.FDisplay := ndGroup;
    RESOURCEDISPLAYTYPE_NETWORK: NewItem.FDisplay := ndNetwork;
    RESOURCEDISPLAYTYPE_ROOT: NewItem.FDisplay := ndRoot;
    RESOURCEDISPLAYTYPE_SHAREADMIN: NewItem.FDisplay :=
    ndShareAdmin;
    RESOURCEDISPLAYTYPE_DIRECTORY: NewItem.FDisplay :=
    ndDirectory;
    RESOURCEDISPLAYTYPE_TREE: NewItem.FDisplay := ndTree;
    RESOURCEDISPLAYTYPE_NDSCONTAINER: NewItem.FDisplay :=
    ndNDSContainer;
    else
    NewItem.FDisplay := ndGeneric;
    end;
    NewItem.FUsage := [];
    if nrArray[i].dwUsage and RESOURCEUSAGE_CONNECTABLE <> 0 then
    Include(NewItem.FUsage, nuConnectable);
    if nrArray[i].dwUsage and RESOURCEUSAGE_CONTAINER <> 0 then
    Include(NewItem.FUsage, nuContainer);
    NewItem.FLocalName := StrPas(nrArray[i].lpLocalName);
    NewItem.FRemoteName := StrPas(nrArray[i].lpRemoteName);
    NewItem.FComment := StrPas(nrArray[i].lpComment);
    NewItem.FProvider := StrPas(nrArray[i].lpProvider);
    NetItems.Add(NewItem);
    // if container, call recursively
    if (nuContainer in NewItem.FUsage) and (FScope <> nsContext) then
    EnumerateNet(NewItem.FSubItems, @nrArray[i])
    end;
    until dwResultEnum = ERROR_NO_MORE_ITEMS;
    FreeMem(nrArray);
    WNetCloseEnum(hEnum);
    end;
    procedure TNetworkBrowser.Refresh;
    begin
    FItems.Clear;
    if FActive then
    EnumerateNet(FItems, nil);
    end;
    procedure TNetworkBrowser.SetActive(Value: Boolean);
    begin
    if Value <> FActive then
    begin
    FActive := Value;
    Refresh;
    end;
    end;
    procedure TNetworkBrowser.SetScope(Value: TNetScope);
    begin
    if Value <> FScope then
    begin
    FScope := Value;
    Refresh;
    end;
    end;
    procedure TNetworkBrowser.SetResourceType(Value: TNetResourceType);
    begin
    if Value <> FResourceType then
    begin
    FResourceType := Value;
    Refresh;
    end;
    end;
    procedure TNetworkBrowser.SetUsage(Value: TNetUsage);
    begin
    if Value <> FUsage then
    begin
    FUsage := Value;
    Refresh;
    end;
    end;
    procedure TNetworkBrowser.Open;
    begin
    Active := True;
    end;
    procedure TNetworkBrowser.Close;
    begin
    Active := False;
    end;
    end.
      

  2.   

    function GetNetWorkgroup : string;
    var
      Reg : TRegistry;
    begin
      Reg := TRegistry.create;
      Result := '(n/a)';
      with Reg do
      try
         RootKey := HKEY_LOCAL_MACHINE;
         if OpenKey('System\CurrentControlSet\Services\VxD\VNETSUP', 
            false) then
            Result := ReadString('Workgroup');
      finally
         CloseKey;
         free;
      end;
    end;
      

  3.   

    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, DB, ADODB, DBTables;
    type
        TNetResourceArray = ^TNetResource;//网络类型的数组type
      TForm1 = class(TForm)
        Button1: TButton;
        ListBox1: TListBox;
        Label1: TLabel;
        Label2: TLabel;
        ListBox2: TListBox;
        Button2: TButton;
        ADOConnection1: TADOConnection;
        Button3: TButton;
        Edit1: TEdit;
        Button4: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    Function GetServerList( var List : TStringList ) : Boolean;
    Function GetUsers( GroupName : string; var List :TStringList ) : Boolean;
    var
      Form1: TForm1;
    implementation{$R *.dfm}//列举出整个网络中的工作组名称,返回值为TRUE表示执行成功,
    //参数List中返回服务器(工作组)的名称
    Function GetServerList( var List : TStringList ) : Boolean;
    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;procedure TForm1.Button1Click(Sender: TObject);
    var ls: TStringList;
    begin
        ls:= TStringList.Create();
        GetServerList(ls);
        listbox1.Items:=ls;
    end;//列举出指定工作组GroupName中的计算机名称,返回值为TRUE表示执行成功,
    //参数List中返回计算机名称
    Function GetUsers( GroupName: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 := @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;procedure TForm1.Button2Click(Sender: TObject);
    var ls:tstringlist;
    begin
        if listbox1.ItemIndex >0 then
        begin
            ls:=tstringlist.Create;
            GetUsers(listbox1.Items.Strings[listbox1.itemindex],ls);
            listbox2.Items:=ls;
        end;
    end;procedure TForm1.Button3Click(Sender: TObject);
    begin
        //showmessage(ADOConnection1.Provider);
        ADOConnection1.Provider:='MSDASQL';
        //ADOConnection1.connectionstring:='Provider=SQLOLEDB.1;Password=sql;Persist Security Info=True;User ID=sa;Data Source='+Quotedstr(edit1.text);
        //ADOConnection1.connectionstring:='Password=sql;Persist Security Info=True;User ID=sa;Data Source='+Quotedstr(listbox2.Items.Strings[listbox2.itemindex]);
        ADOConnection1.connectionstring:='Provider=SQLOLEDB.1;Password=sql;Persist Security Info=True;User ID=sa;Data Source='+Quotedstr(listbox2.Items.Strings[listbox2.itemindex]);
        try
            with ADOConnection1 do
            begin
                Open;
            end;
            showmessage('Ok!');
            ADOConnection1.Close;
        except
            on E:exception do
            begin
                showmessage('Error');
                showmessage(e.Message);
            end;
                {try
                dt:=strtodate(text);
                sender.value:=text;
                f:=true;
            except
                on Econverterror do
                begin
                    application.MessageBox('日期输入错误!','请注意',mb_ok+MB_ICONEXCLAMATION);
                    which_date.Text:= '    -  -  ';
                    f:=false;
                end;}end;end;procedure TForm1.Button4Click(Sender: TObject);
    begin
        showmessage(ADOConnection1.Version);
    end;end.