DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: 19137911446
今日帖子: 9
在线用户: 31
导航: 论坛 -> 文档资料 斑竹:liumazi,ruralboy  
作者:
男 blueapple (blueapple1120) ★☆☆☆☆ -
盒子活跃会员
2003/9/30 18:07:48
标题:
显示计算机的名称(VB) 浏览:2221
加入我的收藏
楼主: 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

Sub Main()
GetWindowsDirectory_test
End Sub 

----------------------------------------------
Blueapple
作者:
男 hongama (hongama) ★☆☆☆☆ -
盒子活跃会员
2004/3/26 10:29:37
1楼: VB的哦!
给个delphi的--》
unit fwqxz_s; 

interface 

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

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; 

end.

----------------------------------------------
-
作者:
男 bren (冰人) ★☆☆☆☆ -
普通会员
2004/4/21 18:30:28
2楼: api呀!呵呵!
----------------------------------------------
---------------------------
||||知已知彼,百战不殆!|||||
---------------------------
努力学习,天天向上!
                          -----------冰人吻语
                          IP:xxx.xxx.xxx.xxx
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行89.84375毫秒 RSS