天天看點
傳回

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;
 
/// //////////////////////////////////////////////////////////////////////////
/// ////////////////////////////////////////////////////////////
/// //////////////////////////////////////////////
/// /////////// 代碼實作部門////////////
 
{ =================================================================
  功 能: 檢測機器是否登入網絡
  參 數: 無
  傳回值: 成功: True 失敗: False
  備 注:
  版 本:
  1.0 2002/10/03 09:55:00
  ================================================================= }
function IsLogonNet: Boolean;
begin
  Result := False;
  if GetSystemMetrics(SM_NETWORK) <> 0 then
    Result := True;
end;
 
{ =================================================================
  功 能: 傳回本機的區域網路Ip位址
  參 數: 無
  傳回值: 成功: True, 并填充LocalIp 失敗: False
  備 注:
  版 本:
  1.0 2002/10/02 21:05:00
  ================================================================= }
function GetLocalIP(var LocalIp: string): Boolean;
 
var
  HostEnt: PHostEnt;
  IP: String;
  Addr: Pchar;
  Buffer: array [0 .. 63] of Char;
  WSData: TWSADATA;
begin
  Result := False;
  try
    WSAStartUp(2, WSData);
    GetHostName(Buffer, SizeOf(Buffer));
    // Buffer:='ZhiDa16';
    HostEnt := GetHostByName(Buffer);
    if HostEnt = nil then
      exit;
    Addr := HostEnt^.h_addr_list^;
    IP := Format('%d.%d.%d.%d', [Byte(Addr[0]), Byte(Addr[1]), Byte(Addr[2]),
      Byte(Addr[3])]);
    LocalIp := IP;
    Result := True;
  finally
    WSACleanup;
  end;
end;
 
{ =================================================================
  功 能: 通過Ip傳回機器名
  參 數:
  IpAddr: 想要得到名字的Ip
  傳回值: 成功: 機器名 失敗: ''
  備 注:
  inet_addr function converts a string containing an Internet
  Protocol dotted address into an in_addr.
  版 本:
  1.0 2002/10/02 22:09:00
  ================================================================= }
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
  備 注:
  版 本:
  1.0 2002/10/02 22:44:00
  ================================================================= }
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;
  備 注: 該函數還有問題
  版 本:
  1.0 2002/10/02 21:05:00
  ================================================================= }
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.
  版 本:
  1.0 2002/10/03 07:30:00
  ================================================================= }
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;
  備 注:
  版 本:
  1.0 2002/10/03 08:00:00
  ================================================================= }
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;
上一篇: Delphi資料類型轉換 【轉】Delphi資料類型轉換
下一篇: delphi中Case文法的使用方法