unit1.pas

可以获得外网和内网的iP的代码

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls;

type
  TDealType = (GuoNei,GuoWai);
  (*
     嘿嘿，帮朋友写的一个获取公网IP线程。
     在创建线程前，可以判断本机是否联网等。
     感觉用Timer控制没有线程稳定
     具体的要求根据自身情况添加。
     如有疑问可以联系本人。
     [e-mail]
  *)
  TGetIPThread = class(TThread)
  private
      FLabInfo : TLabel;
      FStop : Boolean;
      FIdHTTP : TIdHTTP;
      FDealType : TDealType;
      FIP : String;
      procedure DrawInfoCaption;
      procedure GetIP;
  protected
      procedure Execute; override;
  public
      constructor Create(LabInfo : TLabel;
      IdHttp : TIdHTTP;
      DealType : TDealType;
      const ThreadPriority: TThreadPriority = tpNormal);
      procedure Stop;
  end;
  TMainFrm = class(TForm)
    IdHTTP1: TIdHTTP;
    GetBtn: TButton;
    Label1: TLabel;
    StopBtn: TButton;
    Label2: TLabel;
    InfoLabGuoNei: TLabel;
    InfoLabGuoWai: TLabel;
    IdHTTP2: TIdHTTP;
    procedure GetBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure ThreadDone(Sender : TObject);
  public
    { Public declarations }
    GetIPThreadGuoNei , GetIPThreadGuoWai : TGetIPThread;
  end;
var
  MainFrm: TMainFrm;

implementation

{$R *.dfm}

function GetLocalIP(FIdHTTP : TIdHTTP;DealType : TDealType) : string;
var
   IPSTR , IPSTR1 : String;
   iPos : Integer;
begin
    Result := '';
    Case DealType Of
        GuoNei : Begin
                     IPSTR := FIdHTTP.Get('http://www.ip138.com') ;
                     iPos := Pos('您的IP地址是',IPSTR);
                     if iPos <> 0 then
                     IPSTR1 := Copy(IPSTR,iPos+12,20);
                     iPos := Pos('：',IPSTR1);
                     if iPos <> 0 Then
                     Result := Trim(Copy(IPSTR1,iPos+2,15));
                 End;
        GuoWai : Begin
                     IPSTR := FIdHTTP.Get('http://vbnet.mvps.org/resources/tools/getpublicip.shtml');
                     iPos := Pos('var',IPSTR);
                     if iPos <> 0 Then
                     IPSTR1 := Trim(Copy(IPSTR,iPos+3,30));
                     iPos := Pos('ip',IPSTR1);
                     if iPos <> 0 Then
                     Result := Trim(Copy(IPSTR1,iPos + 6,15));
                 End;
    End;
end;
procedure TMainFrm.GetBtnClick(Sender: TObject);
begin
    GetIPThreadGuoNei := TGetIPThread.Create(InfoLabGuoNei,IdHttp1,GuoNei);
    GetIPThreadGuoWai := TGetIPThread.Create(InfoLabGuoWai,IdHttp2,GuoWai);
    GetIPThreadGuoNei.OnTerminate := ThreadDone;
    GetIPthreadGuoWai.OnTerminate := ThreadDone;
end;

{ TGetIPThread }

constructor TGetIPThread.Create(LabInfo : TLabel;
      IdHttp : TIdHTTP;
      DealType : TDealType;
      const ThreadPriority: TThreadPriority = tpNormal);
begin
   Inherited Create(False);
   FLabInfo := LabInfo;
   Priority := ThreadPriority;
   FIdHttp := IdHttp;
   FDealType := DealType;
end;

procedure TGetIPThread.DrawInfoCaption;
begin
   FLabInfo.Caption := FIP;
end;

procedure TGetIPThread.Execute;
begin
   While Not FStop Do
   GetIP;
end;

procedure TGetIPThread.GetIP;
begin
   FIP := GetLocalIP(FIdHTTP,FDealType);
   Sleep(1000);
   Synchronize(DrawInfoCaption);
end;

procedure TGetIPThread.Stop;
begin
    FStop := True;
end;

procedure TMainFrm.ThreadDone(Sender : TObject);
begin
   if Sender is TGetIPThread then
      with Sender as TGetIPThread do
      Begin
          GetIPThreadGuoNei := nil;
          GetIPThreadGuoWai := nil;
      End;
end;

procedure TMainFrm.StopBtnClick(Sender: TObject);
begin
    If Assigned(GetIPThreadGuoWai) Then
    GetIPThreadGuoWai.Stop;
    If Assigned(GetIPThreadGuoNei) Then
    GetIPThreadGuoNei.Stop;
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    StopBtnClick(Nil);
end;

end.