Fórum Rotina pronta para mostrar IP dinamico #322011

unit UMostraIP;

interface

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

type
  TfmMostraIP = class(TForm)
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    bbLerIP: TButton;
    Edit1: TEdit;
    bbCfg: TButton;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure bbLerIPClick(Sender: TObject);
    function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
    function WB_SaveHTMLCode(WebBrowser: TWebBrowser; const FileName: TFileName): Boolean;
    procedure bbCfgClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
  private
    { Private declarations }
    nSite, nCnt : integer;
    cEndIP, cIPLocal, cHost, cErr : string;
  public
    { Public declarations }
  end;

var
  fmMostraIP: TfmMostraIP;

implementation

{$R *.dfm}

uses UEnviaMail;

procedure TfmMostraIP.FormShow(Sender: TObject);
begin
   if not GetIPFromHost(cHost, cIPLocal, cErr) then
     MessageDlg(cErr, mtError, [mbOk], 0);

   nSite := 1;
   nCnt := 1;
   cEndIP := ´´;
   WebBrowser1.Navigate(´http://www.modemclub.com.br/cgi-bin/mostraip.cgi´);
end;

function TfmMostraIP.WB_SaveHTMLCode(WebBrowser: TWebBrowser; const FileName: TFileName): Boolean;
var
  ps: IPersistStreamInit;
  fs: TFileStream;
  sa: IStream;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  fs := TFileStream.Create(FileName, fmCreate);
  try
    sa := TStreamAdapter.Create(fs, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, True));
  finally
    fs.Free;
  end;
end;

function TfmMostraIP.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;

procedure TfmMostraIP.bbLerIPClick(Sender: TObject);
begin
   WB_SaveHTMLCode(Webbrowser1, ´endereço IP.txt´);

   Sleep(2000);

   Memo1.Lines.LoadFromFile(´endereço IP.txt´);

   WB_GetHTMLCode(Webbrowser1, Memo1.Lines);
   if nSite = 1 then    // alterna entre os 2 sites
   begin
      Edit1.Text := Copy(Memo1.Text, Pos(´face=Verdana><b>´, Memo1.Text)+16, 40);
      Edit1.Text := Copy(Edit1.Text, 1, Pos(´</b></font>´, Edit1.Text)-1);
   end
   else
   begin
      Edit1.Text := Copy(Memo1.Text, Pos(´<strong class="IP">´, Memo1.Text)+19, 40);
      Edit1.Text := Copy(Edit1.Text, 1, Pos(´</strong><br />´, Edit1.Text)-1);
   end;

   if cEndIP <> Edit1.Text then  // se IP diferente do anterior
   with fmEnviaMail do
   begin
      fmEnviaMail.MmDescricao.Lines.Clear;
      fmEnviaMail.MmDescricao.Lines.Add(fmMostraIP.Edit1.Text);
      fmEnviaMail.MmDescricao.Lines.Add(cIPLocal+´ ( ´+cHost+´ )´);
      fmEnviaMail.MmDescricao.Lines.Add(FormatDateTime(´"em "dd/mm/yyyy "às" hh:nn´, now));
      fmEnviaMail.MmDescricao.Lines.Add(WebBrowser1.LocationURL);

      fmEnviaMail.bbEnviarClick(Sender);   // envia e-mail
   end;

   cEndIP := Edit1.Text;
end;

procedure TfmMostraIP.bbCfgClick(Sender: TObject);
begin
   fmEnviaMail.ShowModal;
end;

procedure TfmMostraIP.Timer1Timer(Sender: TObject);
begin
   if (nCnt = 6) then
   begin
      nCnt := 1;
      bbLerIPClick(Sender);
      Exit;
   end;

   if nSite = 1 then
   begin
      WebBrowser1.Stop;
      WebBrowser1.Navigate(´www.meuip.com.br´);
      nSite := 2;
   end
   else
   begin
      WebBrowser1.Stop;
      WebBrowser1.Navigate(´http://www.modemclub.com.br/cgi-bin/mostraip.cgi´);
      nSite := 1;
   end;

   Inc(nCnt);
end;

function TfmMostraIP.GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
type
  Name = array[0..100] of Char; 
  PName = ^Name;
var 
  HEnt: pHostEnt; 
  HName: PName;
  WSAData: TWSAData; 
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := ´Winsock is not responding."´; 
    Exit; 
  end; 
  IPaddr := ´´; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + ´.´); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True;
  end
  else begin
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:=´WSANotInitialised´;
    WSAENETDOWN      :WSAErr:=´WSAENetDown´;
    WSAEINPROGRESS   :WSAErr:=´WSAEInProgress´;
   end;
  end;
  Dispose(HName);
  WSACleanup;
end;

end.

unit UEnviaMail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdPOP3;

type
  TfmEnviaMail = class(TForm)
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    OpenDialog1: TOpenDialog;
    bbAnexar: TButton;
    bbEnviar: TButton;
    ListBox1: TListBox;
    EdDestino: TEdit;
    EdAssunto: TEdit;
    MmDescricao: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    IdPOP31: TIdPOP3;
    Edit4: TEdit;
    Label7: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    procedure bbEnviarClick(Sender: TObject);
    procedure bbAnexarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmEnviaMail: TfmEnviaMail;

implementation

{$R *.dfm}

procedure TfmEnviaMail.bbEnviarClick(Sender: TObject);
var Anexo:Integer;
begin
   IdPOP31.Host := Edit4.Text;    // pop.mail.provedor.com.br
   IdPOP31.UserId := Edit2.Text;   // seuemail
   IdPOP31.Password := Edit3.Text;   // suasenha

   IdPOP31.Connect;

   IdSMTP1.Host := Edit1.Text;  // smtp.mail.provedor.com.br
   IdSMTP1.UserId := Edit2.Text;  // seuemail
   IdSMTP1.Password :=  Edit3.Text;   // suasenha

   IdMessage1.Recipients.EMailAddresses := EdDestino.Text; // destino
   IdMessage1.Subject := EdAssunto.Text;
   IdMessage1.Body := MmDescricao.Lines;
   IdMessage1.From.Address := Edit5.Text;   // seuemail@provedor.com.br
   IdMessage1.From.Name := Edit6.Text;   // Seu Nome

   for Anexo := 0 to ListBox1.Items.Count-1 do
      TIdAttachment.Create(IdMessage1.MessageParts,
      TFilename(ListBox1.Items.Strings[Anexo]));

   IdSMTP1.Connect;
   try
      IdSMTP1.Send(IdMessage1);
   finally
      IdPOP31.Disconnect;
      IdSMTP1.Disconnect;
   end;
//   Application.MessageBox(´O E-mail Foi Enviado Com Sucesso!´, ´Confirmação´, MB_ICONINFORMATION + MB_OK);
end;

procedure TfmEnviaMail.bbAnexarClick(Sender: TObject);
begin
   if OpenDialog1.Execute then
      ListBox1.Items.Add(OpenDialog1.FileName);
end;

end.