unit1.pas

IP notifier............check client and server section

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, OleCtrls, SHDocVw, ExtCtrls;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    WebBrowser1: TWebBrowser;
    Timer1: TTimer;
   
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
   
      //====================
    procedure ExtractIP;
    procedure FormCreate(Sender: TObject);
    procedure GetIPWebPage;
    procedure IPChanged;
    procedure Notify;
    procedure IPInterval(Sender: TObject);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);


  private
    { Private declarations }
      atime : integer;      { Interval between updates }
      webaddress : string;
      source : string;
      OldIP : string;
      NewIP : string;
      IPLastSent : string;
      start : integer;     { These last four vars }
      finish : integer;   {  are for Extracting IP }
      STag : string ;
      ETag : string ;        { from HTML source}

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

 procedure TForm1.FormCreate(Sender: TObject);

begin

 ClientSocket1.Address := '127.0.0.1'; // IP to recieve notifications
 ClientSocket1.Active := True;
 IPLastSent := 'None'  ;
 OldIP := '127.0.0.1' ;
 NewIP := '127.0.0.1';
 atime :=10 ;
 GetIPWebPage;
end;

  //=============================================================





  //================ Get IP  Web Page =============================
procedure TForm1.GetIPWebPage;


       var DOM : variant;
  begin
          webaddress := 'www.whatismyip.com';
          Webbrowser1.Navigate(webaddress);       {Loads Web site}

 //-----------------------------------------------------------------------
          DOM := WebBrowser1.Document;
  if      Webbrowser1.LocationURL <> '' then   {If Load web page ok}
                                                {Do what is below}
 begin

  Source :=  DOM.Body.OuterHTML; {Set Source as the HTML source}

  ExtractIP;                    {call procedure Extract Ip from source}

  //========================= If IP Statements =======================


  if    NewIP = OldIP then             { if IP has not changed }

  begin
       Label4.Caption := 'IP Unchanged at last check.' ;{Display IP not changed}
  end;
//-----------------------------------------------------------------------

  if       NewIP <> OldIP then             { if IP has changed then}

  begin    IPChanged; end;
//------------------------------------------------------------------

  if      NewIP <> IPLastSent then        { if IP is different from
                                       IPLastSent then notify}
  begin    notify; end
//-----------------------------------------------------------------------

   else begin                {If The Web page Couldn't be loaded then
                                            wait and try again }
     Timer1.enabled:=true;

  end;
  end;
  end;
  //======================  Extract IP From HTML Source  =============

  procedure TForm1.ExtractIP ;
  begin
     STag := 'Your IP Is ';
     Etag :=   '</H3>';
     start := Pos(STag, source);
     finish := Pos(ETag, source);

  if (start > 0) then
  begin
      start := start + Length(STag);
      NewIP := Copy(source, start, 15);  {Sets NewIP to the extracted IP}

  end;
  end;
 //======================   IP Update Interval ==========================
 procedure TForm1.IPInterval(Sender: TObject);

 begin
  if    atime>1 then    // updates IP every 10 seconds
  begin
         atime := atime - 1 ;
         label3.Caption := 'Updating in ' + (inttostr(atime)) +' seconds' ;
  end
  else begin
         atime :=5 ;
         label3.Caption := 'Updating Your IP' ;
         GetIPWebPage;
  end;
  end;
  //================ IP Has Changed =============================
  procedure TForm1.IPChanged ;

  begin
        Label4.Caption := 'IP Changed when last checked.' ; {Display IP changed}
        Label1.caption := 'Your IP is:';
        Label2.caption := NewIP;

          OldIP := NewIP ;

  end;

  //================ Notify  =============================
procedure TForm1.Notify;
 begin

 // memo1.lines.add (IPLastSent);

 try
     ClientSocket1.Address := '127.0.0.1';   {Try and connect to IP Displayer}
     ClientSocket1.Active := True;

  if IPLastSent <> NewIP then
  begin

  //memo1.lines.add ('notify sending IP');

      ClientSocket1.Socket.SendText('<IP>' + NewIP);end;
     except
     //  memo1.lines.add ('X in notify');
   end;
   end;
  //================ On Socket Error  =============================

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);

  begin
      //memo1.lines.add ('socket error');
      ErrorCode := 0;
  end;


 //================ On Read IP notifier sends back the IP it recieved =====

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);

   var
      Buf         : string;
      MsgLen      : integer;
      LenReceived : integer;

  begin
      MsgLen := Socket.ReceiveLength;
      SetLength( Buf, MsgLen );
      LenReceived := Socket.ReceiveBuf( Buf[1], MsgLen );
      Buf := Copy( Buf, 1, LenReceived );

  if Pos('<IP>', Buf) = 1 then
  begin
     Delete(Buf, 1, 4); {Delete the tag: <IP>}
     IPLastSent  := Buf;  end;
     //memo1.lines.add ('IP Notification Was Recieved');

  end;




     //====================  On connect =====================
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
  begin

// do nothing

  end;

   //====================  On disconnect =====================
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
  begin
 // do nothing
  end;


  end.