Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Sub GetComputerName_test() Dim Name As String, Length As Long Length = 255 Name = String(Length, 0) GetComputerName Name, Length Name = Left(Name, Length) MsgBox "此电脑的名称:=" & Name, , "GetComputerName" End Sub
Sub Main() GetComputerName_test End Sub 读取 Windows 的所在目录 [返回] Public Const MAX_PATH = 260 Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Sub GetWindowsDirectory_test() Dim S As String, Length As Long S = String(MAX_PATH, 0) Length = GetWindowsDirectory(S, MAX_PATH) S = Left(S, InStr(S, Chr(0)) - 1) MsgBox "Windows 路径=" & S, , "GetWindowsDirectory" End Sub
type Tfwqxz = class(TForm) Panel1: TPanel; UserList: TListBox; BitBtn1: TBitBtn; BitBtn2: TBitBtn; procedure FormShow(Sender: TObject); Function GetServerList( var List : TStringList ) : Boolean; Function GetUsers( GroupName : string; var List : TStringList ) : Boolean; procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;
var fwqxz: Tfwqxz;
implementation
uses main_s;
{$R *.DFM}
procedure Tfwqxz.FormShow(Sender: TObject); var list1,list2:TStringList; i,j:Integer; begin i:=1; list1:= TStringList.Create; list2:= TStringList.Create; if GetServerList(list1) then begin showmessage('执行成功'); for i:=0 to list1.Count-1 do begin if getusers(list1.Strings[i],list2) then begin for j:=0 to list2.Count-1 do UserList.Items.Add(list2.Strings[j]); end; end; end; list1.Destroy; list2.Destroy; end;
Function Tfwqxz.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;
Function Tfwqxz.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;
procedure Tfwqxz.BitBtn1Click(Sender: TObject); begin main.Edit1.Text:=UserList.Items.Strings[UserList.itemIndex]; fwqxz.Close; end;
procedure Tfwqxz.BitBtn2Click(Sender: TObject); begin fwqxz.Close; end;
procedure Tfwqxz.FormCreate(Sender: TObject); var list1,list2:TStringList; i,j:Integer; begin i:=1; list1:= TStringList.Create; list2:= TStringList.Create; if GetServerList(list1) then begin for i:=0 to list1.Count-1 do begin if getusers(list1.Strings[i],list2) then begin for j:=0 to list2.Count-1 do UserList.Items.Add(list2.Strings[j]); end; end; end; list1.Destroy; list2.Destroy; end;