Delphi CAP 9 Desenvolvendo utilitários para Internet

8/2/2019 Delphi CAP 9 Desenvolvendo utilitrios para Internet

1/32

Desenvolvendo utilitrios para Internet 127

Captulo 9

Desenvolvendo utilitrios para Internet

Neste captulo, iremos desenvolver uma srie de utilitrios para Internet.

Portas Abertas: Seja Bem-Vindo

O primeiro utilitrio visa alertar aos amigos leitores sobre um grave problema:Portas Abertas.

Quantos de vocs trancam a porta de suas casas ao anoitecer, ou at mesmo luz do dia? Acredito que a maioria. Com o forteavano da Internet em todo o planeta, nos deparamos com o mesmo problema em nossos computadores:Portas Abertas.Nestecaptulo iremos desenvolver um aplicativo parascanneare apresentar as portas que esto abertas num determinado servidor.

Para facilitar a compreenso de todos, estou apresentando um exemplo muito simples, onde o usurio informa o Nome doServidor (ou endereo IP) e o intervalo de portas a serem scanneadas. Os leitores com conhecimentos mais avanados ouknow-how em Threads iro me crucificar por falta das benditas. Acontece que o principal objetivo deste exemplo demonstraro uso do componente TCPClient, e no do uso de Threads. Isso iria complicar um pouco a compreenso dos nossos amigosleitores. Aos amigos que se encaixam neste perfil, minhas sinceras desculpas. Bem, continuando, agora vem a parte boa: mo-na-massa.

Vamos iniciar um novo projeto no Delphi (grave a unitcomo un_scan.pas e o projeto comopscan.drp) e inserir os objetos queseguem:

OBJETO

pnTopo TPanel

Objeto Propriedade Valor

TPanel Align alTop

Caption

Name pnTopo

127


2/32

128 Delphi 7 Internet e Banco de Dados

Com o foco no objetopnTopo insira os seguintes objetos:

OBJETO

Label1 TLabel


TLabel Caption HOST

Left 16

Top 14

OBJETO

Label2 TLabel


TLabel Caption Porta Inicial

Left 16

Top 43

OBJETO

Label3 TLabel


TLabel Caption Porta Final

Left 232

Top 43

Agora vamos inserir os objetos de controle e interatividade com o usurio. Mantenha o foco no objeto pnTopo e insira osseguintes objetos:

OBJETO

NomeServidor TEdit


TEdit Name NomeServidor

Left 104

Top 10

Width 290

OBJETO

Inicio TSpinEdit [Samples]


TSpinEdit Name Inicio

Left 104

Top 40


3/32

Desenvolvendo utilitrios para Internet 129OBJETO

Fim TSpinEdit [Samples]


TSpinEdit Name Fim

Left 320Top 40

Neste ponto vamos inserir o boto para iniciar o processo descanner de portas.

OBJETO

btScan TButton


TButton Name btScan

Caption Scan

Left 416

Top 8

Com isso conclumos a primeira etapa do projeto.

Prosseguindo, vamos criar o mdulo de sada das informaes. Agora com o foco no formulrio e no mais no objetopnTopo,insira um objeto do tipo Tpanelalterando as seguintes propriedades:

OBJETO

pnDados TPanel


TPanel Align alClientName pnDados

Vamos inserir os objetos deste painel, como segue:

OBJETO

ListadePortas TMemo


TMemo Name ListadePortas

Height 180

Left 16Top 76

Width 500

Dentro deste mesmo painelpnDados, insira outro objeto do tipo TPanelalterando as propriedades que seguem:


4/32


OBJETO

PnProgresso TPanel


TPanel Name pnProgresso

CaptionHeight 65

Left 16

Top 8

Width 500

Amigos, sei que um pouco cansativo, mas estamos quase no final. Com o foco no objeto pnProgresso insira os seguintesobjetos:

OBJETO

btParar TButton


TButton Name btParar

Caption Parar

Left 400

Top 32

OBJETO

ProgressBar1 TProgressBar


TProgressBar Name ProgressBar1

Left 16

Top 8

Width 470

OBJETO

Label4 TLabel


TLabel Caption Scaneando Porta...

Left 16

Top 36


5/32

Desenvolvendo utilitrios para Internet 131OBJETO

porta TLabel


TLabel Caption 0

Left 112Top 36

Ufa!!! E para concluir a enorme lista de objetos, insira um do tipo TTCPClientque se encontra na seoInternet.

OBJETO

TCPClient1 TTCPClient [Internet]


TTCPClient Name TCPClient1

Finalmente vamos codificar o nosso projeto. Crie uma varivel global pertencente nossa classe Form1., com o nomeParar,do tipoInteger; veja:

var

Form1: TForm1;parar:integer; // variavel auxiliar

implementation

A varivel Pararser utilizada para finalizar o processo de Scanner das Portas. Neste ponto que poderamos criar umaThread, mas no vamos complicar.

S para aliviar um pouco a forte tenso, vamos dar uma olhadinha na interface do nosso projeto (figura 9.1):

Figura 9.1 Projeto Port Scanner


6/32


Vamos codificar o boto btScan, responsvel pelo ncleo do nosso projeto. No evento onClickdo objeto btScan, insira ocdigo que segue (para facilitar, numerei as linhas de programao, de forma que possamos analisar melhor o cdigo).

001002003004

005006007008009010011012013014015016017018019

020021022023024025026027028029

030031

032033034035036037038039

040041042

procedure TForm1.BtScanClick(Sender: TObject);var i:integer;begintry

ListadePortas.Clear; // Limpa a Lista de Portas

parar:=0; // 0 = continua, 1 = conclui

// Definies da barra de progresso

ProgressBar1.Max:=Fim.Value;ProgressBar1.Min:=Inicio.Value;

PainelProgresso.Visible:=True;TcpClient1.RemoteHost := NomeServidor.Text;

for i := Inicio.Value to Fim.Value dobeginif parar=1 then break; // finaliza o lao

ProgressBar1.Position:=i;porta.Caption:=inttostr(i);

Application.ProcessMessages;TcpClient1.RemotePort := inttostr(i);TcpClient1.Active:=true;

if TcpClient1.Connect thenListadePortas.Lines.Add('Porta ['+ inttostr(i) + ']

aberta');

TcpClient1.Disconnect; // disconeta porta

end; //for loopexcepton E:Exception dobegin

ListadePortas.Lines.Add('Erro: ' + E.Message);end; // end on do begin

end; //try block

ListadePortas.Lines.Add('Scaneamento das portas finalizado !');

PainelProgresso.Visible:=False;end;

Vamos ao detalhamento do cdigo:A linha 002 declara uma varivel i que ir auxiliar no lao de contagem das portas.

var i:integer;

Na linha 004 iniciamos uma proteo de erros da aplicao.


7/32

Desenvolvendo utilitrios para Internet 133try

A linha 005 limpa o contedo do objetoListaPortas.

ListadePortas.Clear

Na linha 007 inicializamos a varivelpararcom o valor 0, de forma que o sistema continue scanneando as portas at o limitesolicitado pelo usurio, ou atravs do pressionamento da tecla Parar, fazendo com que a varivel receba o valor 1.

parar:=0;

As linhas 011 e 012 configuram o objeto ProgressBar1 de maneira que o mesmo fique compatvel com as informaes portainicial e final. Com isso temos um progresso adequado.


A linha 014 torna visvel o objetoPainelProgresso.

PainelProgresso.Visible:=True;

A linha 015 configura o servidor remoto do objeto TcpClient1.

TcpClient1.RemoteHost := NomeServidor.Text;

A linha 017 inicia um loop baseado nas informaesPorta Inicial e Final.

for i := Inicio.Value to Fim.Value do

J na linha 019 nossa aplicao verifica se existe a obrigao de paralisar o loop. Esta informao vem do boto btParar.

if parar=1 then break;

A linha 021 posiciona a barra de progresso em relao ao andamento do loop.

ProgressBar1.Position:=i;

Na linha 022 apenas mostramos ao usurio atravs do objetoPorta, qualporta est sendoscanneada no momento.

porta.Caption:=inttostr(i);

A linha 024 solicita ao Windows que processe as informaes da aplicao, de maneira que a mesma no tenha o efeitocongelamento.

Application.ProcessMessages;

A linha 025 configura a porta que deve serscanneada, a 026 tenta ativar, e a 028 verifica se houve sucesso na ativao, e emcaso afirmativo, a linha 029 adiciona no objetoListadePortas a informao de que aPorta est aberta.

TcpClient1.RemotePort := inttostr(i);TcpClient1.Active:=true;

if TcpClient1.Connect thenListadePortas.Lines.Add('Porta ['+ inttostr(i) + '] aberta');

A linha 031 desconecta a porta independente do seu estado (aberta ou fechada).


8/32


TcpClient1.Disconnect;

A linha 032 finaliza o loop. As linhas 033, 034 e 035 tratam qualquer exceo ocorrida no bloco protegido (try...except...end).

end; //for loopexcept

on E:Exception dobeginListadePortas.Lines.Add('Erro: ' + E.Message);end; // end on do begin

end; //try block

Concluindo esta rotina, a linha 039 apresenta uma mensagem indicando o fim do scanneamento das portas e a 041 torna oobjetoPainelProgresso invisvel.

ListadePortas.Lines.Add('Scaneamento das portas finalizado !');

PainelProgresso.Visible:=False;

Para concluir o nosso projeto, devemos codificar o boto btPararcom o seguinte cdigo (no evento OnClick):

Parar:=1;

Amigos, agora s executar o aplicativo, informar o nome do servidor (caso seja seu prprio equipamento, digite localhost, nocampoNome do Servidor), e o intervalo de portas a serem scanneadas. A figura 9.2 ilustra nosso utilitrio scanneando umservidor.

Figura 9.2 Scanner em ao

IMPORTANTE

Embora seja possvel, no recomendo o uso deste aplicativo parascannearportasde servidores no-autorizados.

Normalmente utilizamos este tipo de aplicativo para vigiar nosso quintal e no odo vizinho.

Artigo originalmente publicado na Revista The Club, n 94


9/32

Desenvolvendo utilitrios para Internet 135Listagem 9.1

unit un_scan;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,IdTCPClient, Sockets, ComCtrls, ExtCtrls, Spin;

typeTForm1 = class(TForm)TcpClient1: TTcpClient;pnTopo: TPanel;BtScan: TButton;NomeServidor: TEdit;Label2: TLabel;Panel2: TPanel;ListadePortas: TMemo;PainelProgresso: TPanel;ProgressBar1: TProgressBar;Label1: TLabel;porta: TLabel;Inicio: TSpinEdit;Label3: TLabel;Label4: TLabel;Fim: TSpinEdit;btParar: TButton;procedure BtScanClick(Sender: TObject);procedure btPararClick(Sender: TObject);

private{ Private declarations }

public{ Public declarations }

end;

varForm1: TForm1;parar:integer; // variavel auxiliar

implementation

{$R *.dfm}

procedure TForm1.BtScanClick(Sender: TObject);var i:integer;begintry

ListadePortas.Clear; // Limpa a Lista de Portas

parar:=0; // 0 = continua, 1 = conclui

// Definies da barra de progresso



10/32


PainelProgresso.Visible:=True; // Visualiza painel progresso

TcpClient1.RemoteHost := NomeServidor.Text; // define o HOST

for i := Inicio.Value to Fim.Value dobegin

if parar=1 then break; // finaliza o lao

ProgressBar1.Position:=i; // atualiza ProgressBarporta.Caption:=inttostr(i); // atualiza Label Porta

Application.ProcessMessages; // solicita ao Windows prioridade noprocessamento da aplicao

TcpClient1.RemotePort := inttostr(i); // define porta a ser scaneada

TcpClient1.Active:=true; // tenta ativar a porta

if TcpClient1.Connect thenListadePortas.Lines.Add('Porta ['+ inttostr(i) + '] aberta');

TcpClient1.Disconnect; // disconecta porta

end; //for loopexcepton E:Exception do begin

ListadePortas.Lines.Add('Erro: ' + E.Message);end; // end on do begin

end; //try block

ListadePortas.Lines.Add('Scaneamento das portas finalizado!');

PainelProgresso.Visible:=False;end;

procedure TForm1.btPararClick(Sender: TObject);

begin Parar:=1;end;

end.

Ping

Neste tpicovamos desenvolver uma nova verso para o ping. Mas Facunte, o que ping? O utilitrio ping,encontrado namaioria dos sistemas operacionais, como Windows e Linux, utilizado para ouvir uma resposta de um determinado servidor,e medir o tempo da mesma. Esta resposta pode ser nula, quando no se consegue estabelecer uma comunicao com o servidor,ou terminal remoto. Normalmente os testes de pingso feitos emservidores de Internet, firewall, roteadores e servidores de

banco de dados. Vejamos um exemplo deste utilitrio rodando no sistema operacional Windows:


11/32


Figura 9.3 Ping sendo executado no Windows XP

Neste exemplo, executamos o utilitriopingno sistema operacional Windows XP, solicitando uma resposta do computadorServidor. Repare que o pingdispara um pacote de 32 bytes no endereo IP (200.173.173.142), relacionado ao Servidor, eouvequatro respostas num tempo menor que 1ms (um milesegundo). Com isso poderemos medir a eficincia no trfego dedados entre cliente/servidor, seja l qual for a sua origem (servidor de banco de dados, aparelho celular, servidor Internet,PDA, entre outros). Veja alguns exemplos ilustrativos do utilitrioPing (figuras 9.4, 9.5 e 9.6).

Figura 9.4 Ping disparado contra o Servidor com resultado satisfatrio

Figura 9.5 Ping disparado contra o Servidor sem resposta

Figura 9.6 Ping disparado contra o Servidor com resultado nada agradvel (lento)

Ping Servidor (32 bytes)

Estou aqui (1ms 32 bytes)


Mudo (sem resposta)


Estou aqui (estouro tempo)


12/32


Como vimos, existem trs possibilidades de resultado: satisfatrio, sem resposta e lento. Com isso podemos fazer testes deperformance em diversos tipos de servidores, e descobrir, em alguns casos, onde est o problema de lentido.

Bem, amigos, agora vem a parte boa: mo-na-massa.

Inicie um projeto do tipo CLX (Delphi 6 ou superior), pois poderemos executar nossa aplicao no Linux, compilando oprojeto no Kylix. Grave a unitcom o nome un_ping.pas e o projeto como ping.dpr. Insira o seguinte objeto, alterando suas

propriedades.

Objeto TPanel [Standard]Align alTop

Name pnEndereco

Com o foco no objetopnEndereco, insira os objetos que seguem, alterando suas respectivas propriedades:

Objeto TLabel[Standard]Caption EndereoLeft 12Top 20

Objeto TEdit [Standard]Left 72

Name edEnderecoTop 16Width 210

Objeto TBitBtn [additional]Caption PingLeft 296

Name btPingTop 16Width 75

Agora com o foco no formulrio, insira outro objeto do tipo TPanele altere as propriedades que seguem:

Objeto TPanel [Standard]Align AlClient

Name PnResultado

Com o foco no objetopnResultado insira um objeto do tipo TMemo e altere as seguintes propriedades:

Objeto TMemo [standard]Height 160Left 16

Name mmResultadoLines (deixe em branco)Top 16

Width 500

Com isso teremos um formulrio parecido com afigura 9.7.


13/32


Figura 9.7 Aplicao Ping em tempo de projeto

Neste ponto iremos inserir o nosso objeto chave: TidICMPClient. Muita hora nesta calma, ou melhor, muita calma nestahora, amigos, no mais um imposto do governo, apenas o nosso componente chave.

Facunte, que nome complicado de componente! O que quer dizer ICMP? ICMP quer dizerInternet Control Message Protocol,ou Protocolo Internet de Controle de Mensagens. Este protocolo normalmente utilizado pelos utilitrios que iremosdesenvolver, e basicamente serve para enviar mensagens a servidores remotos.

Ok, ento vamos inserir o nosso objeto TidICMPClient, e alterar as seguintes propriedades:

Objeto TPanel [Standard]Name NossoICMPReceiveTimeout 10000

Perceba que alteramos a propriedade ReceiveTimeout. Esta propriedade indica o tempo mximo em milessegundos para umaresposta do servidor, gerando um timeoutquando ultrapassado este tempo.

Vamos codificar o boto btPing, inserindo o cdigo que segue no evento OnClick:

var

i: integer;begin

btPing.Enabled:=False;try

NossoICMP.Host := edEndereco.Text;for i := 1 to 4 dobegin

NossoICMP.Ping;Application.ProcessMessages;

end;finally

btPing.Enabled := True;end;

end;

Vamos analisar o cdigo. Primeiro, estamos declarando uma varivel do tipo integerpara nos auxiliar no lao doping.

var

i: integer;

Em seguida desabilitamos o boto btPing, impedindo o usurio de clicar vrias vezes e causar um efeito redundante.

btPing.Enabled:=False;


14/32


No prximo ponto, protegemos o cdigo com try para que eventuais erros sejam ignorados em nossa aplicao.

try

Em seguida configuramos a propriedadeHostdo nosso objetoNossoICMPde acordo com a informao do usurio extrada doobjeto edEndereco.

NossoICMP.Host := edEndereco.Text;

Finalmente iniciamos o lao, executando o comandoPing4 vezes (padro), e solicitando ao S.O. uma atualizao da aplicao.

for i := 1 to 4 dobegin

NossoICMP.Ping;Application.ProcessMessages;

end;

E para concluir esta parte do cdigo, finalizamos o bloco protegido, habilitando novamente o boto btPing.

finally


Agora, iremos codificar o evento OnReply do objetoNossoICMP. Este evento responsvel pelas informaes de resposta.

Coloque o cdigo a seguir no evento OnReply:

var

sTime:string;begin

if (AReplyStatus.MsRoundTripTime = 0) thensTime := '


15/32

Desenvolvendo utilitrios para Internet 141Esta uma declarao padro para o evento OnReply do objetoNossoICMP. Com relao propriedade MsRoundTripTime,ela representa o tempo em milessegundos do resultado de retorno do pacote. Caso o resultado seja 0, ento atribumos o valor < 1 nossa varivelsTime, seno, atribumos o valor = .

Prosseguindo com a nossa anlise, agora vem o ponto forte da nossa aplicao: a linha de resultado.

mmResultado.Lines.Add(Format('%d bytes de %s: sequencia#=%d tempo-de-vida(ttl)=%d

tempo%s%d ms',[AReplyStatus.BytesReceived,AReplyStatus.FromIpAddress,AReplyStatus.SequenceId,AReplyStatus.TimeToLive,sTime,AReplyStatus.MsRoundTripTime]));

Percebam que estamos adicionando contedo ao nosso objeto mmResultado:

mmResultado.Lines.Add

Estamos nos aproveitando da funo Format para facilitar a composio da linha de resultado. Para quem no conhece afuno Format, sugiro uma breve visita no Help do Delphi, onde sempre encontramos ricas informaes. Vejamos ossignificados das propriedades da constante AReplyStatus.

BytesReceived = bytes recebidosFromIpAddress = endereo do HostSequenceId = nmero da sequnciaTimeToLive = Tempo de vida do pacote

Agora vamos executar o nosso projeto e ver o resultado. Afigura 9.8 ilustra o nosso projeto em execuo.

Figura 9.8 Projeto Ping em execuo


16/32


Misso Cumprida

Ao final deste tpico, espero ter esclarecido a todos a utilidade do Ping, bem como tertransmitido com clareza as funcionalidades do objeto TidICMPClient.

Artigo originalmente publicado na Revista Clube Delph, n 33

Listagem 9.2 unit un_ping

unit un_ping;

interface

usesSysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,QStdCtrls, QExtCtrls, QButtons, IdBaseComponent, IdComponent, IdRawBase,IdRawClient, IdIcmpClient;

typeTForm1 = class(TForm)pnEndereco: TPanel;PnResultado: TPanel;edEndereco: TEdit;btPing: TBitBtn;Label1: TLabel;mmResultado: TMemo;NossoICMP: TIdIcmpClient;procedure btPingClick(Sender: TObject);procedure NossoICMPReply(ASender: TComponent;const AReplyStatus: TReplyStatus);

private

{ Private declarations }public{ Public declarations }

end;

varForm1: TForm1;

implementation

{$R *.xfm}

procedure TForm1.btPingClick(Sender: TObject);vari: integer;

beginbtPing.Enabled:=False;tryNossoICMP.Host := edEndereco.Text;for i := 1 to 4 dobeginNossoICMP.Ping;


17/32

Desenvolvendo utilitrios para Internet 143Application.ProcessMessages;

end;finally


end;

procedure TForm1.NossoICMPReply(ASender: TComponent;const AReplyStatus: TReplyStatus);

varsTime:string;

beginif (AReplyStatus.MsRoundTripTime = 0) thensTime := '


18/32


Figura 9.9 Simulao do Trace Route

Com o trace routepoderemos descobrir falhas ou lentido de resposta em todos os servidores envolvidos no processo de envioe recebimento de pacotes. Normalmente falamos que o site X est extremamente lento. Nem sempre o prprio site, pode serum dos servidores envolvidos (conhecido como hope) no processo.

Nosso utilitrio uma adaptao de um programa de demonstrao que vem no pacote da INDY Components. Vamos iniciar odesenvolvimento do nosso utilitrio.

Atravs das opesFile/New...CLX Application, crie uma nova aplicao. Grave a unitcom o nome un_tracert.pas e o projetocomo tracert.dpr. Insira os objetos que seguem alterando suas respectivas propriedades.


Name pnTopoHeight 155

Cliente (Brasil)

tempo de resposta: 2ms

Provedor de Acesso


BackBone Embratel


Servidor Final: Japo


19/32

Desenvolvendo utilitrios para Internet 145Com o foco no objetopnTopo, insira os objetos que seguem, alterando suas respectivas propriedades:


Name pnDadosHeight 60

Ainda com o foco noPnTopo,insira um objeto do tipo TMemo, e altere as seguintes propriedades.

Objeto TListBox [Standard]Align alClient

Name lbLog

Agora com o foco no objetoPnDados, insira os objetos que seguem, alterando suas respectivas propriedades:

Objeto TLabel[Standard]Caption Host DestinoLeft 12Top 8

Objeto TLabel[Standard]Caption Mximo HopesLeft 12Top 40

Objeto TEdit [Standard]Left 110

Name edTargetText (deixar em branco)Top 5Width 280

Objeto TSpindEdit [Common Controls]

Left 110Name seMaxHopsTop 32Value 50Width 65

Objeto TButton [Standard]Caption ExecutaLeft 184

Name btExecutaTop 32Width 75


20/32


Objeto TButton [Standard]Caption CancelaLeft 270

Name btCancelaTop 32Width 75

Agora com o foco no Formulrio, insira outro componente do tipo TPanelalterando as seguintes propriedades.

Objeto TPanel [Standard]Align AlClient

Name PnInfo

Com o foco no objetopnInfo insira um componente do tipo TListView, alterando as seguintes propriedades.

Objeto TListView [Common Controls]Align alClientColumns insira trs colunas como ilustra afigura 9.10

Name LvTraceViewStyle vsReport

Figura 9.10 Columns.items do listview1

Insira os objetos que seguem, alterando as respectivas propriedades.

Objeto idICMPClient [Indy Clients]Name idICMPClient

Objeto idAntiFreeze [Indy Misc]Name idAntiFreeze

Afigura 9.11 ilustra nosso formulrio.


21/32


Figura 9.11 Formulrio do projeto Tracert

Para facilitar a organizao das nossasprocedures e aes, vamos utilizar o componenteActionList. Insira um objeto do tipoTActionListe atravs do duplo-clique insira as seguintes aes (figura 9.12).

:Figura 9.12 Aes do projeto

Agora vamos codificar nosso projeto. Na seo private insira o cdigo que segue.

bResolved: Boolean;ResolvedHost: String;Stopped: Boolean;

function PingHost(Host: string; TTL: Integer): boolean;function FindItem(TTL: Integer; Add: boolean): TListItem;

Nesta seo, definimos algumas variveis e funes com o objetivo de auxiliar em alguns processos.

bResolved: Boolean;ResolvedHost: String;Stopped: Boolean;


22/32


bResolved para atribuirtrue oufalse na operao depingResolvedHost para atribuir o host (hope) em operaoStopped atribui o valortruepara informar a paralisao das operaes.


Na clusula uses insira as seguintes Units.

uses idStack, IdException;

Agora vamos codificar as aes: No evento OnExecute daAction acGO, insira o cdigo que segue:

tryStopped := false;acGo.Enabled := false;acStop.enabled := true;acResolve.execute;if bResolved and not stopped thenbeginacPing.execute;if not stopped then

acTrace.Execute;end;acGo.Enabled := true;acStop.enabled := false;

finally{ ok }

end; { try/finnaly }

Nesta rotina estamos atribuindo as definies iniciais do nosso projeto, e executando as rotinas de pinge trace. No eventoOnExecute daActionacResolve, insira o cdigo que segue:

bResolved := false;lbLog.Items.Append(Format('resolvendo %s', [edTarget.text]));try

Application.ProcessMessages;ResolvedHost := gStack.WSGetHostByName(edTarget.text);bResolved := true;lbLog.Items.Append(format('%s resolvido %s',[edTarget.text, ResolvedHost]));

excepton e: EIdSocketError dolbLog.Items.text := lbLog.Items.text + e.message;

end;

Neste cdigo estamos resolvendo um host(hope), ou melhor, verificando informaes e possibilidade de contato com o host.Repare que estamos utilizando a funo WSGetHostByName, da unit IdStack,para mapear e resolvero host.

ResolvedHost := gStack.WSGetHostByName(edTarget.text);

Se a operao for bem sucedida, adicionamos no lbLogo resultado; caso contrrio, a mensagem de erro.Operao bem sucedida

lbLog.Items.Append(format('%s resolvido %s',[edTarget.text, ResolvedHost]));


23/32

Desenvolvendo utilitrios para Internet 149Erro.

excepton e: EIdSocketError dolbLog.Items.text := lbLog.Items.text + e.message;

No evento OnExecute daAction acPing, insira o seguinte cdigo.

PingHost(ResolvedHost, seMaxHops.value);Application.ProcessMessages;

Aqui estamos executando a chamada da funo PingHost (ser criada posteriormente), com o host atual, e o mximo dehopes. No evento OnExecute daAction acTrace, insira o cdigo que segue.

varTTL: Integer;Reached: boolean;aItem: TListItem;

beginTTL := 0;reached := false;lvTrace.Items.Clear;

repeatinc(TTL);IdIcmpClient.Host := ResolvedHost;IdIcmpClient.TTL := TTL;IdIcmpClient.ReceiveTimeout := 5000;IdIcmpClient.Ping;aItem := FindItem(TTL, True);aItem.SubItems.Clear;case IdIcmpClient.ReplyStatus.ReplyStatusType ofrsEcho:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Reached in : %d ms',

[IdIcmpClient.ReplyStatus.MsRoundTripTime]));

reached := true;end;rsError:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append('Unknown error.');

end;rsTimeOut:beginaItem.SubItems.Append('?.?.?.?');aItem.SubItems.Append('Timed out.');

end;rsErrorUnreachable:begin

aItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Destination network unreachable',[IdIcmpClient.ReplyStatus.MsRoundTripTime]));

break;end;rsErrorTTLExceeded:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);


24/32


aItem.SubItems.Append(format('TTL=%d',[IdIcmpClient.ReplyStatus.TimeToLive]));

end;end; // caseApplication.ProcessMessages;

until reached or (TTL > seMaxHops.value) or Stopped;

Este cdigo um pouco mais complexo, mas vamos analisar passo a passo. Inicialmente, estamos definindo algumas variveisauxiliares.

TTL define o hope atual.Reached define se o TTL atual foi resolvidoaItem objeto do tipo TListItempara ser adicionado em nossoLvTrace.

varTTL: Integer;Reached: boolean;aItem: TListItem;

Em seguida temos a atribuio inicial das variveis.

TTL := 0;

reached := false;lvTrace.Items.Clear;

O bloco que segue inicia um lao, at que uma das trs situaes (resolvido reached = true, TTL > hopes, ou solicitao decancelamento) seja verdadeira. Incrementamos o TTL, e atribumos ao objeto idICMPClientalgumas configuraes, comoHoste TTL. Executamos o mtodopingdo idICMPClient, e em seguida preparamos o objeto aItempara receber a informaodo resultado da operao.

repeatinc(TTL);IdIcmpClient.Host := ResolvedHost;IdIcmpClient.TTL := TTL;IdIcmpClient.ReceiveTimeout := 5000;IdIcmpClient.Ping;

aItem := FindItem(TTL, True);aItem.SubItems.Clear;

Os prximos blocos tratam os diversos tipos de resultado do mtodoping. O bloco que segue trata o tipo de resposta (rsEcho)e adiciona um subitem ao objeto aItem.

case IdIcmpClient.ReplyStatus.ReplyStatusType ofrsEcho:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Reached in : %d ms',

[IdIcmpClient.ReplyStatus.MsRoundTripTime]));reached := true;

end;

O bloco seguinte recebe um tipo de resposta de erro (rsError) e tambm adiciona um subitem ao objeto aItem.

rsError:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append('Unknown error.');

end;


25/32

Desenvolvendo utilitrios para Internet 151O prximo bloco trata o TimeOutexcedido (rsTimeOut), definido como 5000 milesegundos.

rsTimeOut:

beginaItem.SubItems.Append('?.?.?.?');aItem.SubItems.Append('Timed out.');

end;

Em seguida, temos o tratamento de uma operao no resolvida (rsErrorUnreachable).

rsErrorUnreachable:

beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Destination network unreachable',

[IdIcmpClient.ReplyStatus.MsRoundTripTime]));break;

end;

E por fim, temos o tratamento de erro (rsErrorTTLExceeded), onde excedido o nmero mximo de tentativas.

rsErrorTTLExceeded:

begin

aItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('TTL=%d',

[IdIcmpClient.ReplyStatus.TimeToLive]));end;

end; // caseApplication.ProcessMessages;


um cdigo realmente complexo, mas estudando com calma e ateno, entenderemos cada mtodo implementado.

Agora no evento OnExecute daAction acStop, insira o cdigo que segue.

Stopped := true;

acStop.enabled := false;

Com isso estamos solicitando uma parada nas operaes.

Agora vamos atribuir as Actions acGO e acStop, ao objeto btExecuta e btCancela, respectivamente. Para tanto, bastaselecionar aAction desejada do objeto em questo. Para finalizar nosso projeto, devemos criar as rotinas que seguem.


Primeiro vamos criar a rotina PingHost. Insira o cdigo que segue em nossa unit.

function Tform1.PingHost(Host: string; TTL: Integer): Boolean;begin

result := false;IdIcmpClient.Host := Host;IdIcmpClient.TTL := TTL;IdIcmpClient.ReceiveTimeout := 5000;IdIcmpClient.Ping;case IdIcmpClient.ReplyStatus.ReplyStatusType ofrsEcho:begin


26/32


lbLog.Items.Append(format('resposta do host %s in %d milesegundos',[IdIcmpClient.ReplyStatus.FromIpAddress,IdIcmpClient.ReplyStatus.MsRoundTripTime]));

result := true;end;rsError:lbLog.Items.Append('Erro desconhecido');

rsTimeOut:lbLog.Items.Append('Timed out.');

rsErrorUnreachable:lbLog.Items.Append(format('Host %s no resolvido',[IdIcmpClient.ReplyStatus.FromIpAddress]));

rsErrorTTLExceeded:lbLog.Items.Append(format('Hope %d %s: TTL expirou',[IdIcmpClient.TTL,idIcmpClient.ReplyStatus.FromIpAddress]));

end; // caseend;

Repare que muito parecida com aAction acTrace, s que neste caso, estamos resumindo o resultado das operaes em nossoobjeto lbLog. Agora vamos criar a rotina FindItem. Insira o cdigo que segue em nossa unit.

function Tform1.FindItem(TTL: Integer; Add: boolean): TListItem;vari: Integer;

beginresult := nil;// Find the TTL itemif lvTrace.Items.Count < TTL Thenbeginfor i := 0 to lvTrace.Items.Count - 1 dobeginif StrToIntDef(lvTrace.Items[i].Caption, -1) = TTL thenbeginresult := lvTrace.Items[i];Break;

end;end;

end;if not assigned( result ) thenbegin// Not found, add itresult := lvTrace.Items.Add;result.Caption := IntToStr(TTL);

end;end;

O objetivo desta funo retornar informaes adicionadas no objeto lvTrace,baseada na TTL atual, e utilizada pelaActionacTrace.

Agora vamos gravar e compilar nossa aplicao. Afigura 9.13 ilustra nossa aplicao sendo executada.


27/32


Figura 9.13 Tracert em ao

Listagem 9.3 un_tracert.pas

unit un_tracert;

interface

uses

SysUtils, Types, Classes, Variants, QTypes, QGraphics, QControls, QForms,QDialogs, QStdCtrls, QExtCtrls, QComCtrls, QActnList, IdComponent,IdRawBase, IdRawClient, IdIcmpClient, IdBaseComponent, IdAntiFreezeBase,IdAntiFreeze;

typeTForm1 = class(TForm)pnTopo: TPanel;pnInfo: TPanel;pnDados: TPanel;Label1: TLabel;edTarget: TEdit;Label2: TLabel;

seMaxHops: TSpinEdit;btExecuta: TButton;btCancela: TButton;lvTrace: TListView;ActionList1: TActionList;acGo: TAction;acResolve: TAction;


28/32


acPing: TAction;acTrace: TAction;acStop: TAction;IdAntiFreeze1: TIdAntiFreeze;IdIcmpClient: TIdIcmpClient;lbLog: TListBox;procedure acGoExecute(Sender: TObject);procedure acResolveExecute(Sender: TObject);procedure acPingExecute(Sender: TObject);procedure acTraceExecute(Sender: TObject);procedure acStopExecute(Sender: TObject);

private{ Private declarations }bResolved: Boolean;ResolvedHost: String;Stopped: Boolean;function PingHost(Host: string; TTL: Integer): boolean;function FindItem(TTL: Integer; Add: boolean): TListItem;

public{ Public declarations }

end;

varForm1: TForm1;

implementation

uses idStack, IdException;{$R *.xfm}

procedure TForm1.acGoExecute(Sender: TObject);begintry

Stopped := false;acGo.Enabled := false;

acStop.enabled := true;acResolve.execute;if bResolved and not stopped thenbeginacPing.execute;if not stopped thenacTrace.Execute;

end;acGo.Enabled := true;acStop.enabled := false;

finally{ ok }

end; { try/finally }

end;

procedure TForm1.acResolveExecute(Sender: TObject);beginbResolved := false;lbLog.Items.Append(Format('resolvendo %s',[edTarget.text]));


29/32

Desenvolvendo utilitrios para Internet 155try

Application.ProcessMessages;ResolvedHost := gStack.WSGetHostByName(edTarget.text);bResolved := true;

lbLog.Items.Append(format('%s resolvido %s',[edTarget.text, ResolvedHost]));excepton e: EIdSocketError dolbLog.Items.text := lbLog.Items.text + e.message;

end;

end;

procedure TForm1.acPingExecute(Sender: TObject);beginPingHost(ResolvedHost, seMaxHops.value);Application.ProcessMessages;

end;

procedure TForm1.acTraceExecute(Sender: TObject);varTTL: Integer;

Reached: boolean;aItem: TListItem;

beginTTL := 0;reached := false;lvTrace.Items.Clear;repeatinc(TTL);IdIcmpClient.Host := ResolvedHost;IdIcmpClient.TTL := TTL;IdIcmpClient.ReceiveTimeout := 5000;IdIcmpClient.Ping;aItem := FindItem(TTL, True);aItem.SubItems.Clear;

case IdIcmpClient.ReplyStatus.ReplyStatusType ofrsEcho:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Reached in : %d ms',

[IdIcmpClient.ReplyStatus.MsRoundTripTime]));reached := true;

end;rsError:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append('Unknown error.');

end;rsTimeOut:beginaItem.SubItems.Append('?.?.?.?');aItem.SubItems.Append('Timed out.');

end;rsErrorUnreachable:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('Destination network unreachable',


30/32


[IdIcmpClient.ReplyStatus.MsRoundTripTime]));break;

end;rsErrorTTLExceeded:beginaItem.SubItems.Append(IdIcmpClient.ReplyStatus.FromIpAddress);aItem.SubItems.Append(format('TTL=%d',

[IdIcmpClient.ReplyStatus.TimeToLive]));end;

end; // caseApplication.ProcessMessages;


end;

procedure TForm1.acStopExecute(Sender: TObject);beginStopped := true;acStop.enabled := false;

end;

function TForm1.PingHost(Host: string; TTL: Integer): Boolean;

beginresult := false;IdIcmpClient.Host := Host;IdIcmpClient.TTL := TTL;IdIcmpClient.ReceiveTimeout := 5000;IdIcmpClient.Ping;case IdIcmpClient.ReplyStatus.ReplyStatusType ofrsEcho:beginlbLog.Items.Append(format('response from host %s in %d millisec.',

[IdIcmpClient.ReplyStatus.FromIpAddress,IdIcmpClient.ReplyStatus.MsRoundTripTime]));

result := true;end;rsError:lbLog.Items.Append('Unknown error.');

rsTimeOut:lbLog.Items.Append('Timed out.');

rsErrorUnreachable:lbLog.Items.Append(format('Host %s reports destination network unreachable.',

[IdIcmpClient.ReplyStatus.FromIpAddress]));

rsErrorTTLExceeded:lbLog.Items.Append(format('Hope %d %s: TTL expired.',

[IdIcmpClient.TTL,IdIcmpClient.ReplyStatus.FromIpAddress]));

end; // caseend;


31/32

Desenvolvendo utilitrios para Internet 157function TForm1.FindItem(TTL: Integer; Add: boolean): TListItem;vari: Integer;

beginresult := nil;// Find the TTL itemif lvTrace.Items.Count < TTL Thenbeginfor i := 0 to lvTrace.Items.Count - 1 dobeginif StrToIntDef(lvTrace.Items[i].Caption, -1) = TTL thenbeginresult := lvTrace.Items[i];Break;

end;end;

end;if not assigned( result ) thenbegin// Not found, add itresult := lvTrace.Items.Add;result.Caption := IntToStr(TTL);

end;end;

end.


32/32


Anotaes de Dvidas

Preciso Revisar

Anotaes Gerais

?

Delphi CAP 9 Desenvolvendo utilitários para Internet

Documents

Transcript of Delphi CAP 9 Desenvolvendo utilitários para Internet