⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 cvery_608119760.rar
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TNetResourceArray = ^TNetResource;  //网络资源类型的数组
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    StaticText1: TStaticText;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    GroupBox3: TGroupBox;
    btnRun: TButton;
    btnExit: TButton;
    procedure btnRunClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    Function GetUsers(GroupName:string;var List:TStringList):Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation
{$R *.DFM}

Function TfrmMain.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
       List.Add(Temp^.lpRemoteName);
       Inc(Temp);
     End;
 End;
 Res := WNetCloseEnum(lphEnum);//关闭一次列举
If Res <> NO_ERROR Then exit;//执行失败
  Result:=True;
  FreeMem(Buf);
end;

procedure TfrmMain.btnRunClick(Sender: TObject);
var
  List:TstringList;
  i:integer;
begin
try
  List:=TstringList.Create;
  if GetUsers(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;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
memo1.Lines.Clear ;
end;


procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  frmMain.Close;
end;
end.


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -