Delphi 獲取Computer，Ip，工作組，MAC

delphi 獲取本機IP地址和MAC地址
unit NetFunc;

interface

uses

SysUtils, Windows, dialogs, winsock, Classes, ComObj, WinInet, Variants;

//錯誤信息常量

const

C_Err_GetLocalIp = '獲取本地ip失敗';

C_Err_GetNameByIpAddr = '獲取主機名失敗';

C_Err_GetSQLServerList = '獲取SQLServer服務器失敗';

C_Err_GetUserResource = '獲取共享資失敗';

C_Err_GetGroupList = '獲取所有工作組失敗';

C_Err_GetGroupUsers = '獲取工作組中所有計算機失敗';

C_Err_GetNetList = '獲取所有網絡類型失敗';

C_Err_CheckNet = '網絡不通';

C_Err_CheckAttachNet = '未登入網絡';

C_Err_InternetConnected ='沒有上網';

 

C_Txt_CheckNetSuccess = '網絡暢通';

C_Txt_CheckAttachNetSuccess = '已登入網絡';

C_Txt_InternetConnected ='上網了';

 

//檢測機器是否登入網絡

function IsLogonNet: Boolean;

//得到本機的局域網Ip地址

function GetLocalIP(var LocalIp:string): Boolean;

//通過Ip返回機器名

function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;

//獲取網絡中SQLServer列表

function GetSQLServerList(var List: Tstringlist): Boolean;

//獲取網絡中的所有網絡類型

function GetNetList(var List: Tstringlist): Boolean;

//獲取網絡中的工作組

function GetGroupList(var List: TStringList): Boolean;

//獲取工作組中所有計算機

function GetUsers(GroupName: string; var List: TStringList): Boolean;

//獲取網絡中的資源

function GetUserResource(IpAddr: string; var List: TStringList): Boolean; 

//映射網絡驅動器

function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean; 

//檢測網絡狀態

function CheckNet(IpAddr:string): Boolean; 

//判斷Ip協議有沒有安裝 這個函數有問題

function IsIPInstalled : boolean;

//檢測機器是否上網

function InternetConnected: Boolean;

//關閉網絡連接

function NetCloseAll:boolean;

////////////// 代碼實現部門////////////

implementation

 

//判斷網絡是否連接

 uses

WinInet;

procedure TForm1.Button1Click(Sender: TObject);

begin 

   if InternetGetConnectedState(nil, 0) then

     ShowMessage('已連接');

end;

 

//功 能: 檢測機器是否登入網絡

function IsLogonNet: Boolean;

begin

  Result := False;

  if GetSystemMetrics(SM_NETWORK) <> 0 then

  Result := True;

end;

{=================================================================

功 能: 返回本機的局域網Ip地址

返回值: 成功: True, 並填充LocalIp 失敗: False}

procedure TMainFrom.Button3Click(Sender: TObject);
var
  ip: string;
begin
  ip := idipwatch1.LocalIP;
  Edit2.Text := ip;
end;

{=================================================================

功 能: 通過Ip返回機器名

參 數:

IpAddr: 想要得到名字的Ip

返回值: 成功: 機器名 失敗: ''

備 注:

inet_addr function converts a string containing an Internet

Protocol dotted address into an in_addr.

}

function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;

var

  SockAddrIn: TSockAddrIn;

  HostEnt: PHostEnt;

  WSAData: TWSAData;

begin

  Result := False;

  if IpAddr = '' then exit;

  try

    WSAStartup(2, WSAData);

    SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));

    HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);

    if HostEnt <> nil then

    MacName := StrPas(Hostent^.h_name);

    Result := True;

  finally

    WSACleanup;

  end;

end;

 

{=================================================================

功 能: 返回網絡中SQLServer列表

參 數:

List: 需要填充的List

返回值: 成功: True,並填充List 失敗 False

=================================================================}

function GetSQLServerList(var List: Tstringlist): boolean;

var

  i: integer;

  //sRetValue: String;

  SQLServer: Variant;

  ServerList: Variant;

begin

  //Result := False;

  List.Clear;

  try

    SQLServer := CreateOleObject('SQLDMO.Application');

    ServerList := SQLServer.ListAvailableSQLServers;

    for i := 1 to Serverlist.Count do

    list.Add (Serverlist.item(i));

    Result := True;

  Finally

    SQLServer := NULL;

    ServerList := NULL;

  end;

end;

 

{=================================================================

功 能: 判斷IP協議有沒有安裝

參 數: 無

返回值: 成功: True 失敗: False;

備 注: 該函數還有問題

=================================================================}

function IsIPInstalled : boolean;

var

  WSData: TWSAData;

  ProtoEnt: PProtoEnt;

begin

  Result := True;

  try

    if WSAStartup(2,WSData) = 0 then

    begin

      ProtoEnt := GetProtoByName('IP');

      if ProtoEnt = nil then

      Result := False

    end;

  finally

    WSACleanup;

  end;

end;

{=================================================================

功 能: 返回網絡中的共享資源

參 數:

IpAddr: 機器Ip

List: 需要填充的List

返回值: 成功: True,並填充List 失敗: False;

備 注:

WNetOpenEnum function starts an enumeration of network

resources or existing connections.

WNetEnumResource function continues a network-resource

enumeration started by the WNetOpenEnum function.

=================================================================}

function GetUserResource(IpAddr: string; var List: TStringList): Boolean;

type

  TNetResourceArray = ^TNetResource;//網絡類型的數組

Var

  i: Integer;

  Buf: Pointer;

  Temp: TNetResourceArray;

  lphEnum: THandle;

  NetResource: TNetResource;

  Count,BufSize,Res: DWord;

Begin

  Result := False;

  List.Clear;

  if copy(Ipaddr,0,2) <> '//' then

    IpAddr := '//'+IpAddr; //填充Ip地址信息

  FillChar(NetResource, SizeOf(NetResource), 0);//初始化網絡層次信息

  NetResource.lpRemoteName := @IpAddr[1];//指定計算機名稱

  //獲取指定計算機的網絡資源句柄

  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,

  RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);

  Buf:=nil;

  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 i := 0 to Count - 1 do

    begin

      //獲取指定計算機中的共享資源名稱，+2表示刪除"//"，

      //如//192.168.0.1 => 192.168.0.1

      List.Add(Temp^.lpRemoteName + 2);

      Inc(Temp);

    end;

  end;

  Res := WNetCloseEnum(lphEnum);//關閉一次列舉

  if Res <> NO_ERROR then exit;//執行失敗

    Result := True;

    FreeMem(Buf);

End;

 

{=================================================================

功 能: 返回網絡中的工作組

參 數:

List: 需要填充的List

返回值: 成功: True,並填充List 失敗: False;

=================================================================}

function GetGroupList( 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;

  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;

 

//獲取網卡MAC地址
function GetMacAddress: string;
var
  lib:Cardinal;
  Func: function(GUID:PGUID):Longint; stdcall;
  GUID1,GUID2:TGUID;
begin
  Result := '';
  Lib := Loadlibrary('rpcrt4.dll');
  if Lib <> 0 then
  begin
    if Win32Platform <> VER_PLATFORM_WIN32_NT then
      @Func := GetProcAddress(lib,'UuidCreate')
    else @Func := GetProcAddress(lib,'UuidCreateSequential') ;
    if Assigned(Func) then
    begin
      if (Func(@GUID1) = 0) and
        (Func(@GUID2) = 0) and
        (GUID1.D4[2] = GUID2.D4[2]) and
 (GUID1.D4[3] = GUID2.D4[3]) and
 (GUID1.D4[4] = GUID2.D4[4]) and
 (GUID1.D4[5] = GUID2.D4[5]) and
 (GUID1.D4[6] = GUID2.D4[6]) and
 (GUID1.D4[7] = GUID2.D4[7]) then
      begin
 result := IntToHex(GUID1.D4[2], 2) +
      IntToHex(GUID1.D4[3], 2) +
   IntToHex(GUID1.D4[4], 2) +
   IntToHex(GUID1.D4[5], 2) +
   IntToHex(GUID1.D4[6], 2) +
   IntToHex(GUID1.D4[7], 2) ;
      end;
    end;
    FreeLibrary(Lib);
  end;
end;

 

//GetComputerName
procedure TMainFrom.Button2Click(Sender: TObject);
var
  arr: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  d: DWORD;
begin
  d := SizeOf(arr);
  GetComputerName(arr,d);
  Edit1.Text := arr;
end;

 

 

end.