What is my home ip?

[Asri]

Önemli Not: Bu makale, programın networkdeki bilgisayarlarda sağlıklı çalışmadığının
tespit edilmesi üzerine yeniden düzenlenmiştir. Network yapısı nedeniyle internet
bağlantısının kesildiğinin geç öğrenilmesi ve adsl modemlerinde hızlı bir şekilde
bağlantıyı yenilemelerinden dolayı sağlıklı çalışmamaktaydı. Bu bug giderildi ve programa
internet bağlantısının kontrol edilmesi yerine eski ip ve yeni ip kontrolü ile daha sağlıklı
bir kontrol eklenmiştir.

*Bugfix -Startup da çalıştığında inidosyası bulunamadı hatası
hata : if not fileexists('.\ipsender.ini') then
çözüm: if not fileexists(prgdizini+'ipsender.ini') then

Programı deneyip sağlıklı sonuç alamayan arkadaşlardan özür dilerim.
Lütfen karşılaştığınız problemleri ve varsa çözümlerini bildirin ki başkalarıda sorun yaşamasın.


------------------------------------------------0--------------------------------------------------------
Diyelimki bir şirkete çalışıyorsunuz ve evinizde de adsl var. Bilgisayarınız sürekli açık ve aynı zamanda
habire download yapıyor. İş yerinden evinizdeki bilg. ulaşmak ve gerektiğinde ordan dosya alıp dosya vermek yada
evdeki bilgisayarı istediğiniz gibi kullanmak istiyorsunuz. Gerekli programları yüklediğiniz var sayarak size gerekli olan
IP adresinizi nasıl öğreneceğini anlatmak istiyorum. Aslında adsl de ip nizin zırt pırt değişmemesi gerekiyor
ama burası Türkiye Ben şirkette 15 dk. 3 defa değiştiğini biliyorum

Neyse bıraklım üstesinden gelemeyeceğimiz problemleri.

Evinizde bir PC niz var ve sürekli internete bağlı. IP si değiştiğinde belirttiğiniz mail adreslerine
ip bilgisini göndermesini istiyorsanız aşağıdaki işlemleri yapın.

Ben bu programı kendim için yazmıştım ama yazdıkça şunu da ekliyim bunu da ekliiyim diyince bu hale geldi.
Bu programı bir çok şubesi olan firmalarda da kullanbilirsiniz. Şubelerdeki ip ler statik değil ise size sürekli
raporlanıcaktır.isterseniz şirketteki farklı kişilere de aynı anda göndertebilirisniz.

SMTP adresini varlığını kontrol edecek bir kod bulamadım. Bu yüzden smtp adresi hatalı
girildiği takdirde program hata verecektir.

iyi çalışmalar.

Size mail yolu ile konusu aşağıdaki gibi bir mail gelicek. xxx olan yerlerde ip adresi olucak.

Merkez -->MAKINE_ADI KULLANICI_ADI XXX.XXX.XXX.XXX -->27.11.2004 15:11:45

----------------- ipsender.ini dosyasının içeriği ----------------
[Ayarlar]
KimdenMail=ipsender@ipsender.com
KimdenAdi=ipsender
Kime=alici@aliciadresi.com
Konu=Ip Sender -->
SmtpAdresi=stmp.smtpadresi.com
SmtpPort=25
MailGondersin=evet
FormGorunsun=evet
SurekliCalis=hayır
SonIP=xxx.xxx.xxx.xxx
BeklemeSuresi=60000
Alici_Mail_1=birinci_kisi@sirketiniz.com
Alici_Mail_2=ikinci@sirketiniz.com
Alici_Mail_3=ucuncu_kisi@sirketiniz.com
----------------- ipsender.ini dosyasının içeriği ----------------

Alici_Mail_x= x sayısı 999 kadar eklenebilir
BeklemeSUresi=x x sayısı her 1 saniye için 1000 girilmelidir.

Yeni bir proje açın. Forma aşağıdaki nesneleri yerleştirin
1 tane tlabel1
1 tane tlabel2
1 tane tmemo1
1 tane tidMessage
1 tane tidHTTP
1 tane tisSMTP
1 tane tPopupMenu
1 tane ttimer1
1 tane ttimer2
1 tane twebbrowser


bu nesneleri yerleştirdikten sonra Uses kısmındakileri karşılaştırıp eksik olanları ekleyin.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils,Classes,Controls, Forms,
  dialogs,StdCtrls, IdComponent, wininet,IdSMTP, IdMessage,inifiles, ExtCtrls,
  ComCtrls,ShellApi,IdHTTP, Menus, IdMessageClient,
  winsock,IdBaseComponent, IdTCPConnection, IdTCPClient,registry, IdUDPBase,
  IdUDPClient, IdDNSResolver,IdIPWatch, OleCtrls, SHDocVw,activex;


type
  TForm1 = class(TForm)
    IdMessage: TIdMessage;
    IdSMTP: TIdSMTP;
    Timer1: TTimer;
    Gster1: TMenuItem;
    k1: TMenuItem;
    Label1: TLabel;
    IdHTTP1: TIdHTTP;
    Label2: TLabel;
    menu: TPopupMenu;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure k1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Gster1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
    TrayIcon : TNotifyIconData;
    Procedure FormuGizle(Sender: TObject);
    Procedure FormuGoster;
    Procedure MenuyuGoster;

  public
    function SendMail(FileToSend: String): String;
    procedure ayaroku;
    procedure ayarkaydet;
    procedure guncelle;
    procedure sureklicalis_kayit;
    procedure sureklicalis_kaldir;
    function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
    Function inidenoku(
     TheIniFile            : String;
     IniSection            : String;
     StringName            : String;
     DefaultString         : String): String;
    Function iniyeyaz(
     TheIniFile            : String;
     IniSection            : String;
     StringName            : String;
     defaultstring         : String): String;

  end;

var
  Form1: TForm1;
  ipisi,inidosya:string;
  gorunsun,aktifx,fromadresx,fromnamex,toadresx,konux,
  smtpx,smtpportx:string;
  c,u: array[0..127] of Char;
  adres,sonip,sureklicalis,aranan,s,user,computer: string;
  parametre:olevariant;
  beklemesuresi,i,yer:integer;
  reg: TRegistry;
  liste:tstringlist;
  gonder,ilk,sayfageldi:boolean;
  sz: dword;

implementation

{$R *.dfm}

Kod: Tümünü seç

//ini dosyası için program çalıştığı dizini tespit eder
function prgdizini: string;
begin
  Result := ExtractFilePath(Application.ExeName);
  if Result[Length(Result)] <> '\' then
   Result := Result + '\';
end;

Kod: Tümünü seç

//ini dosyasından parametreleri okumak için
Function tform1.inidenoku(
  TheIniFile            : String;
  IniSection            : String;
  StringName            : String;
  DefaultString         : String): String;
Var
  TheIni                : TIniFile;
Begin
  TheIni                  := TIniFile.Create(TheIniFile);
  Try
    Result :=
      TheIni.ReadString(
        IniSection,
        StringName,
        DefaultString);
    If Result = '' Then
    Begin
      Result := DefaultString;
    End;
  Finally
    TheIni.Free;
  End;
End;

Kod: Tümünü seç

//ini dosyasına parametreleri yazmak için
Function tform1.iniyeyaz(
  TheIniFile            : String;
  IniSection            : String;
  StringName            : String;
  defaultstring         : String): String;
Var
  TheIni                : TIniFile;
Begin
  TheIni                  := TIniFile.Create(TheIniFile);
  Try
    TheIni.writeString(
        IniSection,
        StringName,
        defaultstring);
  Finally
    TheIni.Free;
  End;
End;

Kod: Tümünü seç

//ini dosyasına parametreleri kaydeder. 
//ini dosyası yok ise default değerleri kullanarak oluşturur.
procedure tform1.ayarkaydet;
begin
   iniyeyaz(inidosya,'Ayarlar','KimdenMail','ipsender@ipsender.com');
   iniyeyaz(inidosya,'Ayarlar','KimdenAdi','ipsender');
   iniyeyaz(inidosya,'Ayarlar','Kime','alici@aliciadresi.com');
   iniyeyaz(inidosya,'Ayarlar','Konu','Ip Sender -->');
   iniyeyaz(inidosya,'Ayarlar','SmtpAdresi','smpt.aliciadresi.com');
   iniyeyaz(inidosya,'Ayarlar','SmtpPort','25');
   iniyeyaz(inidosya,'Ayarlar','MailGondersin','evet');
   iniyeyaz(inidosya,'Ayarlar','FormGorunsun','evet');
   iniyeyaz(inidosya,'Ayarlar','SurekliCalis','hayir');
   iniyeyaz(inidosya,'Ayarlar','SonIP','xxx.xxx.xxx.xxx');
   iniyeyaz(inidosya,'Ayarlar','BeklemeSuresi','20000');

   for i:=1 to 2 do begin
    iniyeyaz(inidosya,'Ayarlar','Alici_Mail_'+inttostr(i),'');
   end;

end;

Kod: Tümünü seç

//ini dosyasından ayarları okumak için.
//ini dosyası bulunamazsa ayarkaydet ile dosya oluşturulur.
procedure tform1.ayaroku;
begin
  if not fileexists(prgdizini+'ipsender.ini') then
  begin
    ayarkaydet;
    showmessage('ipsender.ini '+'dosyasında gerekli ayarlari yapiniz.');
    form1.Close;
  end;
  inidosya:=prgdizini+'ipsender.ini';
  fromadresx:=inidenoku(inidosya,'Ayarlar','KimdenMail','ipsender@benimip.com');
  fromnamex:=inidenoku(inidosya,'Ayarlar','KimdenAdi','ipsender');
  toadresx:=inidenoku(inidosya,'Ayarlar','Kime','ip_bekleyen@ip-bekleyen.com');
  konux:=inidenoku(inidosya,'Ayarlar','Konu','Ip Sender -->');
  smtpx:=inidenoku(inidosya,'Ayarlar','SmtpAdresi','mail.akyurek.com.tr');
  smtpportx:=inidenoku(inidosya,'Ayarlar','SmtpPort','25');
  aktifx:=inidenoku(inidosya,'Ayarlar','MailGondersin','evet');
  gorunsun:=inidenoku(inidosya,'Ayarlar','FormGorunsun','evet');
  sureklicalis:=inidenoku(inidosya,'Ayarlar','SurekliCalis','hayir');
  sonip:=inidenoku(inidosya,'Ayarlar','SonIP','xxx.xxx.xxx.xxx');
  beklemesuresi:=strtoint(inidenoku(inidosya,'Ayarlar','BeklemeSuresi','20000'));


  for i:=1 to 999 do begin
      s:=inidenoku(inidosya,'Ayarlar','Alici_Mail_'+inttostr(i),'');
      if s<>'' then liste.Add(s);
  end;

  if sureklicalis='evet' then sureklicalis_kayit
                         else sureklicalis_kaldir;
end;

Kod: Tümünü seç

//form kapatıldığında systemtray den icon'ı kaldırır.
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if gorunsun='evet' then
   Shell_NotifyIcon(NIM_DELETE,@TrayIcon); // System Tray'deki iconu sil
end;

Kod: Tümünü seç

//Form kapatıldığında programı sonlandırır.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Application.Terminate; // Uygulamayı bitir
end;

Kod: Tümünü seç

//popupmenu deki çıkış seçildiğinde program sonlandırılır. 
procedure TForm1.k1Click(Sender: TObject);
begin
 Application.Terminate; // Uygulamayı bitir
end;

Kod: Tümünü seç

//Form'u systemtray'a geçirmek için
Procedure TForm1.FormuGizle(Sender: TObject);
Begin

    if gorunsun='evet' then
  begin
Shell_NotifyIcon(NIM_ADD,@TrayIcon); // System Tray'e yeni bir Icon ekle
  Form1.Visible:=False;                // Formu gizle
end;

End;

Kod: Tümünü seç

//systemtray daki icon'ı menu göstermek için
Procedure TForm1.MenuyuGoster;
Var
  FareninKonumu : TPoint;
Begin
  if gorunsun='evet' then
  begin

  GetCursorPos(FareninKonumu);                 // Mouse'un pozisyonunu öğren
  menu.Popup(FareninKonumu.X,FareninKonumu.Y); // PopUp menüyü o pozisyona aç
  PostMessage(Self.Handle,WM_NULL,0,0);        // Systeme Herhangibir Mesaj Gönderme
end;

End;

Kod: Tümünü seç

//systemtray da sağ tuş ile göster tıklandığında formu göstermek için
Procedure TForm1.FormuGoster;
Begin
  if gorunsun='evet' then
  begin

  Form1.Visible:=True; // Formu göster
  Application.BringToFront;               // Formu öne al
  Application.Restore;                    // Uygulamayı tekrar başlat
  Shell_NotifyIcon(NIM_DELETE,@TrayIcon); // System Tray'deki iconu sil
 end;
End;

Kod: Tümünü seç

//mouse systemtray daki icon'ın üzerine geldiğinde
// sol tuşa basıldığında form gösterilir, sağ tuşa basıldığında popupmenu çıkar.
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if gorunsun='evet' then
  begin
 
 // $201 Sol Tuş Basıldı
  // $204 Sağ Tuş Basıldı
  If (x=$201) Then FormuGoster
              Else If (x=$204) Then begin
                     MenuyuGoster;
              end;
 end;
end;

Kod: Tümünü seç

//popupmenu de göster tıklandığında çalışan kodlar.
procedure TForm1.Gster1Click(Sender: TObject);
begin
  if gorunsun='evet' then formugoster;
end;

Kod: Tümünü seç

//ip adresi web sayfasından okunduğunda okunanın ip olup olmadığı için
function checkIP(zvIPAddressID: string): boolean;
var
  ipLengthOfGroup, ipPosition, ipNoOfGroups: integer;
  ipGroupNum, Code: integer;
begin
  checkip := False;
  ipNoOfGroups := 0;
  ipLengthOfGroup := 0;
  for ipPosition := 1 to Length(zvIPAddressID) do
    case Ord(zvIPAddressID[ipPosition]) of
      48..57:
        begin
          inc(ipLengthOfGroup);
          if (ipLengthOfGroup > 3) then exit;
        end;
      46:
        begin
          inc(ipNoOfGroups);
          Val(Copy(zvIPAddressID, ipPosition - ipLengthOfGroup, ipLengthOfGroup), ipGroupNum, Code);
          if ((ipNoOfGroups > 3) or (ipLengthOfGroup = 0)) or (ipGroupNum > 255) then exit;
          ipLengthOfGroup := 0;
        end;
      else
        exit;
    end;
  Val(Copy(zvIPAddressID, ipPosition - ipLengthOfGroup, ipLengthOfGroup), ipGroupNum, Code);
  checkip := (ipNoOfGroups = 3) and (ipLengthOfGroup > 0) and (ipGroupNum < 256);
end;

Kod: Tümünü seç

//ini dosyasında süreklicalis evet ise programı startup'a ekler.
procedure tform1.sureklicalis_kayit;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false);
  reg.WriteString('ipsender',Application.ExeName);
  reg.CloseKey;
  reg.free;
end;

Kod: Tümünü seç

//ini dosyasında süreklicalis hayır ise programı startup'dan siler.
procedure tform1.sureklicalis_kaldir;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false);
  if reg.ValueExists('ipsender') then reg.DeleteValue('ipsender');
  reg.CloseKey;
  reg.free;
end;

Kod: Tümünü seç

//ip değişmiş ise listedeki maillere ip bilgisini gönderir.
function Tform1.SendMail(FileToSend: String): String;
var
  MailMsg        : TidMessage;
  MailFile       : TidAttachment;
begin
  idsmtp.Host:=smtpx;
  MailMsg := TidMessage.Create(idSMTP);
  MailMsg.From.Address :=fromadresx;
  MailMsg.From.Name    := fromnamex;
  MailMsg.Recipients.Add;
  MailMsg.Recipients.Items[0].Address :=toadresx;

  sz := SizeOf(u);GetUserName(u, sz);

  sz := SizeOf(c);GetComputerName(c, sz);

  user := u;
  computer := c;

  MailMsg.Subject:= konux+computer+'  '+user+' '+s+' -->'+FormatDateTime('dd.mm.yyyy hh:nn:ss',now);

  // server a bağlanıyor
  try
    idSMTP.Connect();
  except
    on E : Exception do
       Exit;
  end;

  // gönderiyor
  try
    idSMTP.Send(MailMsg);
  except
    on E: Exception do
        Exit;
  end;

  // işlem bitince hafızayı temizliyor.
  idSMTP.Disconnect;
  MailMsg.Free;
end;

Kod: Tümünü seç

//ip bilgisinin okunacağı web sayfasından okuma bilgisinin tamamlandığını anlamak için
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
    sayfageldi:=true;
end;

Kod: Tümünü seç

//ip bilgisinin alınması için websayfası içeriğinin text formatına dönüştürülmesi
function tform1.WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, True));
    if Result then ACode.Add(ss.Datastring);
  finally
    ss.Free;
  end;
end;

Kod: Tümünü seç

//Form oluşturulduğunda ilk ayarların yapılması için
procedure TForm1.FormCreate(Sender: TObject);
begin
  ilk:=true;
  memo1.Visible:=false;
  webbrowser1.visible:=false;
  timer2.Enabled:=false;

  liste:=tstringlist.Create;
  liste.Sorted:=true;
  liste.Duplicates:=dupignore;
  liste.Sort;

  inidosya:=prgdizini+'ipsender.ini';
  ayaroku;

  if gorunsun='hayır' then application.ShowMainForm:=false;
  gonder:=true;

  // TrayIcon'ın parametreleri aşağıda ayarlanıyor.
  if gorunsun='evet' then
  begin

  With TrayIcon Do
    Begin
      cbsize           := SizeOf(TrayIcon);
      wnd              := Self.Handle;
      hicon            := Application.Icon.Handle;
      uID              := 0;
      sztip            := 'Ip Sender Coded by Aser';
      uflags           := NIF_ICON Or NIF_TIP Or NIF_MESSAGE;
      uCallBackMessage := WM_MOUSEMOVE;
    End;
  Application.OnMinimize:=FormuGizle; // Form minimize edilince çalışacak procedure
 end;
end;

Kod: Tümünü seç

//Text halindeki websayfası bilgisinden ip nin ayıklanması için
procedure tform1.guncelle;
begin
  aranan:='Internet Connection';
  yer:=pos(aranan,memo1.Text);

  yer:=yer+length(aranan);
  s:=copy(memo1.Text,yer,100);

  s:=copy(s,1,pos('-',s)-1);
  ipisi:=trim(s);
  if not checkip(ipisi) then ipisi:='0.0.0.0';
  memo1.Clear;
end;

Kod: Tümünü seç

//ip kontrol zamanı geldiğinde devreye giren timer nesnesi
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  adres:='http://www.showmyip.com';
  sayfageldi:=false;
  parametre:= navNoHistory or navNoReadFromCache or navNoWriteToCache;
  webbrowser1.Navigate(adres,parametre);
  timer2.Enabled:=true;
  if ilk then
  begin
      timer1.Interval:=beklemesuresi;
        if gorunsun='evet' then formugizle(sender);
      ilk:=false;
  end;
end;

Kod: Tümünü seç

//Websayfası içeriğinin gelmesini bekleyen timer nesnesi.
procedure TForm1.Timer2Timer(Sender: TObject);
begin
 timer1.Enabled:=false;
 if sayfageldi then
 begin
    WB_GetHTMLCode(Webbrowser1, memo1.Lines);
    guncelle;
    label1.Caption:='İnternete bağlısınız';
    label2.Caption:=ipisi;

    if (ipisi<>sonip) and (ipisi<>'0.0.0.0') and gonder then
    begin
      sonip:=ipisi;
      iniyeyaz(inidosya,'Ayarlar','SonIP',sonip);
      if aktifx='evet' then
      begin
         for i:=0 to liste.Count-1 do
         begin
           toadresx:=liste.Strings[i];
           sendmail('gonder');
         end;
      end;
      gonder:=false;
    end;

    if ipisi='0.0.0.0' then
    begin
      label1.Caption:='İnternete bağlı değilsiniz';
      label2.Caption:='0.0.0.0';
      gonder:=true;
    end;
    timer2.Enabled:=false;
    timer1.Enabled:=true;
 end;

end;

end.

ipsender.dfm dosyasının içeriği aşağıdadır.

Kod: Tümünü seç

object Form1: TForm1
  Left = 335
  Top = 100
  AutoScroll = False
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = 'Ip Sender Coded by Aser'
  ClientHeight = 77
  ClientWidth = 253
  Color = clBtnFace
  Constraints.MinHeight = 50
  Constraints.MinWidth = 130
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Scaled = False
  OnClose = FormClose
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnMouseMove = FormMouseMove
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 26
    Top = 13
    Width = 146
    Height = 19
    Caption = #304'nternet ba'#287'lant'#305'n'#305'z'
    Color = clMenu
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -17
    Font.Name = 'Times New Roman'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
    Transparent = True
  end
  object Label2: TLabel
    Left = 26
    Top = 29
    Width = 5
    Height = 23
    Color = clMenu
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -20
    Font.Name = 'Times New Roman'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
    Transparent = True
  end
  object WebBrowser1: TWebBrowser
    Left = 16
    Top = 80
    Width = 137
    Height = 41
    TabOrder = 0
    OnDocumentComplete = WebBrowser1DocumentComplete
    ControlData = {
      4C000000290E00003D0400000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object Memo1: TMemo
    Left = 16
    Top = 32
    Width = 121
    Height = 33
    TabOrder = 1
    Visible = False
  end
  object IdMessage: TIdMessage
    AttachmentEncoding = 'MIME'
    BccList = <>
    CCList = <>
    Encoding = meMIME
    Recipients = <>
    ReplyTo = <>
    Left = 144
    Top = 32
  end
  object IdSMTP: TIdSMTP
    MaxLineAction = maException
    ReadTimeout = 0
    Port = 25
    AuthenticationType = atNone
    Left = 208
    Top = 32
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 176
    Top = 32
  end
  object IdHTTP1: TIdHTTP
    MaxLineAction = maException
    ReadTimeout = 0
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.ContentRangeEnd = 0
    Request.ContentRangeStart = 0
    Request.ContentType = 'text/html'
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 120
    Top = 32
  end
  object menu: TPopupMenu
    Left = 208
    object Gster1: TMenuItem
      Caption = '&G'#246'ster'
      OnClick = Gster1Click
    end
    object k1: TMenuItem
      Caption = '&'#199#305'k'#305#351
      OnClick = k1Click
    end
  end
  object Timer2: TTimer
    OnTimer = Timer2Timer
    Left = 176
  end
end

[mege]

bende aynısının tıpkısı nedenle birtane yapmıştım bu programdan
biraz daha basit çünki ayar mayar yapamıyorsunuz hepsi koda gömülü. ayrıca whatismyip yerine kendi sitemdeki php scriptten alıyor ip mi.
vatana millete hayırlı olsun bende senin mesajın altına ekleyeyim. programı jedi komponnetleri ve delphi forum ile 5 dakkada yapmıştım, dağınıklıktan anlıcaksınız zaten

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,IdHTTP, ExtCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdMessage,
  IdAntiFreezeBase, IdAntiFreeze, JvBalloonHint, JvComponent, JvTrayIcon,
  Menus,WinSock;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    IdAntiFreeze1: TIdAntiFreeze;
    JvTrayIcon1: TJvTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Kapat1: TMenuItem;
    N2: TMenuItem;
    Ayarlar1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Kapat1Click(Sender: TObject);
    procedure Ayarlar1Click(Sender: TObject);
    procedure JvTrayIcon1Click(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LastIP:string;
  LastLocalIP:string;
implementation

{$R *.dfm}

function GetLocalIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  i: Integer;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(PChar(''));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do
  begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
  WSACleanup;
end;


Function GetIPFromNet(url:string):string;
Var Browser: TIdHTTP;
begin
  Result:= '';
  Browser := TIdHTTP.Create(nil);
  try
    Result := Browser.Get(url);
  finally
    Browser.Free;
  end;
end;

procedure mailat;
var SMTP :TIdSMTP;
    IdMsgSend : TIdMessage;
begin
  try
   SMTP := TIdSMTP.Create(nil);
   IdMsgSend := TIdMessage.Create(nil);
   with IdMsgSend do
      begin
         Body.Clear;
         Body.Add('IPin v0.00.00');
         Body.Add('Date : '+datetostr(now));
         Body.Add('Time : '+timetostr(now));
         Body.Add('IP   : ' + LastIP);
         Body.Add('Local IP : '+LastLocalIP);
         From.Text                 := 'seninmail@HotPOP.com';
         ReplyTo.EMailAddresses    := 'seninmail@HotPOP.com';
         Recipients.EMailAddresses := 'seninmail@hotmail.com'; { To: header }
         Subject                   := 'Time : '+timetostr(now)+' : '+LastIP; { Subject: header }
         {CCList.EMailAddresses := edtCC.Text; {CC}
         {BccList.EMailAddresses := edtBCC.Text; {BBC}
      end;


   SMTP.AuthenticationType := atLogin; {Simple Login}
   SMTP.Username := 'seninmail@HotPOP.com';
   SMTP.Password := 'seninmailsifren'; // şifreenn 

   {General setup}
   SMTP.Host := 'smtp.hotpop.com';
   SMTP.Port := 25;

   {now we send the message}
   SMTP.Connect;
   try
      SMTP.Send(IdMsgSend);
   finally
      SMTP.Disconnect;
   end;
  finally
   SMTP.Free;
   IdMsgSend.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LastIP:='';
LastLocalIP:='';
Timer1Timer(Sender);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var tmpLastIP,tmpLastLocalIP:string;
begin
JvTrayIcon1.HideApplication;
tmpLastIP := GetIpFromNet('http://members.lycos.co.uk/seninsiten/ip.php');
tmpLastLocalIP:= GetLocalIP;
if ((LastIP <> tmpLastIP) and (tmpLastIP<>'')) or
   ((LastLocalIP <> tmpLastLocalIP) and (tmpLastLocalIP<>''))   then
 begin
  LastIP := tmpLastIP;
  LastLocalIP := tmpLastLocalIP;

  memo1.Lines.Add('');
  memo1.Lines.Add('Time : '+timetostr(now));
  memo1.Lines.Add('...Local IP : '+LastLocalIP);
  memo1.Lines.Add('...Net IP   : '+copy(LastIP,1,20));
  JvTrayIcon1.BalloonHint('IPin ','Time : '+timetostr(now)+#13+'Local IP: '+LastLocalIP+#13+'IP: '+copy(LastIP,1,20));
    mailat;  
 end;

end;

procedure TForm1.Kapat1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Ayarlar1Click(Sender: TObject);
begin
JvTrayIcon1.ShowApplication;
JvTrayIcon1.Active := TRUE;
end;

procedure TForm1.JvTrayIcon1Click(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
JvTrayIcon1.BalloonHint('IPin ','Time : '+timetostr(now)+#13+'Local IP: '+LastLocalIP+#13+'IP: '+copy(LastIP,1,20));
end;

end.

dfm:

Kod: Tümünü seç

object Form1: TForm1
  Left = 419
  Top = 120
  BorderIcons = [biMinimize]
  BorderStyle = bsDialog
  Caption = 'IP Sender'
  ClientHeight = 147
  ClientWidth = 274
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 274
    Height = 147
    Align = alClient
    Lines.Strings = (
      'Bu .. program mege tarafından yazılmıştır'
      '.')
    ReadOnly = True
    TabOrder = 0
  end
  object Timer1: TTimer
    Interval = 60000
    OnTimer = Timer1Timer
    Left = 304
    Top = 16
  end
  object IdAntiFreeze1: TIdAntiFreeze
    Left = 312
    Top = 56
  end
  object JvTrayIcon1: TJvTrayIcon
    Active = True
    IconIndex = 0
    PopupMenu = PopupMenu1
    Visibility = [tvAutoHide, tvAutoHideIcon, tvRestoreDbClick, tvMinimizeDbClick]
    OnClick = JvTrayIcon1Click
    Left = 104
    Top = 48
  end
  object PopupMenu1: TPopupMenu
    Left = 144
    Top = 48
    object Ayarlar1: TMenuItem
      Caption = 'Aç...'
      OnClick = Ayarlar1Click
    end
    object N1: TMenuItem
      Caption = '-'
    end
    object Kapat1: TMenuItem
      Caption = 'Kapat'
      OnClick = Kapat1Click
    end
    object N2: TMenuItem
      Caption = '-'
    end
  end
end

ip.php

Kod: Tümünü seç

<?
        function fetchip()
       {
          $client_ip = $_SERVER['HTTP_CLIENT_IP'];
          $x_forwarded_for = $_SERVER['HTTP_X_FORWARDED_FOR'];
          $remote_addr = $_SERVER['REMOTE_ADDR'];

          if (!empty ($client_ip) )
         {
            $ip_expl = explode('.',$client_ip);
            $referer = explode('.',$remote_addr);
           
         if($referer[0] != $ip_expl[0])
          {
              $ip=array_reverse($ip_expl);
              $return=implode('.',$ip);
             }
         else
          {
              $return = $client_ip;
             }
           }
       elseif (!empty($x_forwarded_for) )
        {
            if(strstr($x_forwarded_for,','))
          {
              $ip_expl = explode(',',$x_forwarded_for);
              $return = end($ip_expl);
              }
         else
           {
               $return = $x_forwarded_for;
               }
          }
        else
        {
            $return = $remote_addr;
          }
        unset ($client_ip,$x_forwarded_for,$remote_addr,$ip_expl);
        return $return;
       }
       $ip=fetchip();
      echo $ip;
?>

[Asri]

@mege arkadaşım eklediğin kod için teşekkür ederim.

çok aramama rağmen localden gerçek ip yi öğrenemedim. Bende http://www.showmyip.com yi kullanmak zorunda kaldım.

selamlar, saygılar.