functions.pas

能够获取外网ip的delphi程序

unit Functions;

interface

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

function CheckInternetOnline: boolean;  //检查互联网是否在线
function IsIP(S: string): boolean; //判断录入的字符串是否为IP
function GetLocalIP: string; //获取本机IP地址
function GetTheInternetLocalIP: string; //获取外网IP地址


implementation

uses
  GetInternetLocalIP,WinInet,Winsock;
  
//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

function CheckInternetOnline: boolean;  //检查互联网是否在线
var
  ConnectState: DWORD;
  StateSize: DWORD;
begin
  ConnectState := 0;
  StateSize := SizeOf(ConnectState);
  Result := false;
  //Use WinInet.pas;
  if InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ConnectState, StateSize) then
    Result := (ConnectState and INTERNET_STATE_DISCONNECTED) <> 2;
  if Result then
    Result := InternetCheckConnection('http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=6&ar=msnhome', 1, 0);
end;

//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
function IsIP(S: string): boolean; //判断录入的字符串是否为IP
var
  S1, S2, S3, S4, sTemp: string;
  K, I: integer;
begin
  S1 := '';
  S2 := '';
  S3 := '';
  S4 := '';
  K := 0;
  Result := false;
  S := Trim(S);
  if Length(S) < 7 then exit; //最小的IP长度也是7位0.0.0.0
  for I := 0 to Length(S) do
    if S[I] = '.' then
      Inc(K);
  if K <> 3 then
  begin
    Result := false;
    exit;
  end
  else
  begin
    sTemp := S;
    for I := Length(sTemp) downto 1 do
      if sTemp[I] = '.' then
        Delete(sTemp, I, 1);
    for I := Length(sTemp) downto 1 do
      if not (sTemp[I] in ['0'..'9']) then
      begin
        Result := false;
        exit;
      end;
    K := Pos('.', S);
    S1 := Copy(S, 1, K - 1);
    Delete(S, 1, K);
    K := Pos('.', S);
    S2 := Copy(S, 1, K - 1);
    Delete(S, 1, K);
    K := Pos('.', S);
    S3 := Copy(S, 1, K - 1);
    Delete(S, 1, K);
    S4 := S;
    Result := (StrToInt(S1) >= 0) and (StrToInt(S1) <= 255) and
      (StrToInt(S2) >= 0) and (StrToInt(S2) <= 255) and
      (StrToInt(S3) >= 0) and (StrToInt(S3) <= 255) and
      (StrToInt(S4) >= 0) and (StrToInt(S4) <= 255);
  end;
end;
//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

function GetLocalIP: string; //获取本机IP地址
type
  TaPInAddr = array[0..255] of PInAddr; //Use Winsock.pas
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  i: integer;
  GInitData: TWSADATA;
begin
  wsastartup($101, GInitData);
  result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if not assigned(phe) then
    exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  i := 0;
  while pptr^[I] <> nil do
  begin
    result := Result + StrPas(inet_ntoa(pptr^[I]^)) + ',';
    inc(i);
  end;
  Delete(Result, Length(Result), 1);
  wsacleanup;
end;
//HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

function GetTheInternetLocalIP: string; //获取外网IP地址
begin
  Result := '';
  //Use GetInternetLocalIP.pas
  if not Assigned(GetInternetLocalIPForm) then
    if CheckInternetOnline then
    try
      Application.CreateForm(TGetInternetLocalIPForm, GetInternetLocalIPForm);
      while GetInternetLocalIPForm.TheInternetLocalIP = 'E' do Application.ProcessMessages;
      Result := GetInternetLocalIPForm.TheInternetLocalIP;
      if not IsIP(Result) then 
        Result := '';
    finally
      FreeAndNil(GetInternetLocalIPForm);
    end;
end;

end.