1. Opis ogólny Indy.
1.1. Gniazda.
1.2. Protokoły.
1.3. Typy połączeń gniazdowych.
2. Wybrane komponenty Indy w praktyce.
2.1. TCP.
2.1.1. Prosty przykład odpowiedzi (PING).
2.2. UDP.
2.3. Obsługa poczty – wysyłanie (SMTP) i odbieranie (POP3).
2.3.1. SMTP.
2.3.2. POP3.
2.4. HTTP.
2.4.1. Zapis strony do pliku na dysku lokalnym.
2.4.2. Niestandardowy serwer HTTP.
2.4.3. Prosty serwer HTTP.
2.5. FTP.
2.5.1. Klient FTP.
2.5.2. Serwer FTP.
2.6. IdThreadComponent
2.6.1. Przykład użycia w powiązaniu z pakietem TCP.
2.6.2. Przykład użycia w powiązaniu z pakietem UDP.
2.6.3. Przykład użycia w powiązaniu z pakietem FTP.
2.7. PING - komponent IdIcmpClient (Internet Control Message Protocol)
2.7.1. IdIcmpClient - -przykład sprawdzający dostępność adresów IP w całym segmencie
2.8. Komponent IdIPWatch
2.9. Komponent IdConnectionIntercept
1. Opis ogólny
Komponenty Internet Direct obsługują programowanie gniazdowe niskiego poziomu oraz większość powszechnie znanych protokołów internetowych. Borland, w celu zastąpienia "przestarzałych" komponentów: TCPClient czy TcpServer, zaproponował stosowanie odpowiednich komponentów Indy. Dostarcza kolekcję internetowych otwartych komponentów, które poprzednio nazywane były WinShoes (termin pochodzi od WinSock - nazwy biblioteki gniazdowej Windows).

W palecie Delphi wyróżnić możemy następujące zakładki zawierające odpowiednie składniki INDY:
  • Indy Clients
  • Indy Servers
  • Indy I/O Handles
  • Indy Intercepts
  • Indy Misc


Komponenty Indy rozpoznawane są po przedrostku "Id". Pakiet INDY zawiera ponad 100 komponentów zawierających aplikacje klient-serwer TCP/IP dla rozmaitych komponentów, zawiera składniki związane z bezpieczeństwem oraz kodowaniem.

Internet Direct (Indy) stworzone zostało przez grupę kierowaną przez Chada Howera (jest również dostępne w Kyliksie). Najnowsze wersje otwartych komponentów Indy znaleźć można pod adresem internetowym www.nevrona.com/indy. Są to darmowe komponenty uzupełnione wieloma przykładami oraz plikami pomocy. Indy w wersji 8 rozpowszechniane było wraz z Delphi 6, w wersji 9 dostępne jest od Delphi 7. W Delphi 2005 podczas instalacji możliwy jest wybór przez użytkownika instalowanej wersji Indy (9 lub 10).

Info Połączenia nieblokujące - polegają na odczytywaniu danych z gniazd oraz zapisywaniu do nich w sposób asynchroniczny, co nie powoduje blokowania realizacji innych fragmentów kodu aplikacji sieciowej. Alternatywnym podejściem jest użycie połączenia blokującego, przy którym aplikacja czeka, aż odczyt lub zapis zostanie zakończony i dopiero wówczas przechodzi do wykonania następnej linii kodu.


Komponenty Indy stosują połączenia blokujące co daje możliwość uproszczenia logiki programu. Operacje gniazdowe wykonywane z poziomu Indy, powinny być wykonywane za pomocą wątku albo komponentu IdAntiFreeze stanowiącego prostszą alternatywę. Serwery Indy wykorzystują architekturę wielowątkową którą sterować można za pomącą komponentów IdThreadMgrDefault oraz IdThreadMgrPool. Komponent IdThreadMgrDefault jest domyślnym komponentem, drugi obsługuje odpytywanie (ang. pooling) wątków.

1.1 Gniazda
Sercem Internetu jest Transmision Control Protokol/Internet Protokol (TCP/IP). Jest to zestaw dwóch oddzielnych protokołów zapewniających połączenie przez prywatną sieć intranetową czy internet.

Info Protokół TCP odpowiada za usługi transportowe wysokiego poziomu. Jest on zorientowany połączeniowo, czyli umożliwia zestawienie połączenia w którym efektywnie i niezawodnie przesyłane są dane. Połączenie to charakteryzuje się możliwością sterowania przepływem, potwierdzania odbioru, zachowania kolejności danych, kontroli błędów i przeprowadzania retransmisji. TCP organizuje również dwukierunkową współpracę między warstwą IP, a warstwami wyższymi, uwzględniając przy tym wszystkie aspekty priorytetów i bezpieczeństwa. Musi prawidłowo obsłużyć niespodziewane zakończenie aplikacji, do której właśnie wędruje datagram, musi również bezpiecznie izolować warstwy wyższe - w szczególności aplikacje użytkownika - od skutków awarii w warstwie protokołu IP. Protokół IP odpowiada za: definiowanie oraz wybór marszruty datagramów (czyli porcji danych przesyłanych w sieci) oraz określanie schematu adresowania.


Każde połączenie odbywa się przez port. Port jest reprezentowany przez 16 bitową liczbę. Adres IP jest 32 bitową liczbą składającą się z czterech składników zwanych oktetami oddzielonych kropkami (np.: 127.0.0.1 jest adresem localhost’u i można go wykorzystywać przy testowaniu działania komponentów klient-serwer przy braku połączenia z internetem).

Info Adresy IP wraz z portami TCP określają połączenia internetowe lub gniazda. Różne aplikacje działające na tym samym zestawie komputerowym nie mogą używać tego samego gniazda (czyli tego samego portu).


Niektóre porty TCP zostały zarezerwowane dla określonych protokołów i usług wysokiego poziomu.

ProtokółPort
HTTP (Hypertext Transfer Protokol)80
FTP (File Transfer Protokol)21
SMTP (Simple Mail Transfer Protokol)25 (lub 587)
POP3 (Post Office Protokol)110
Telnet23


Lista portów wraz z opisem dostępna jest na stronie www.iana.org/assignments/port-numbers

1.2. Protokoły

Info Protokół stanowi zbiór zasad, które przestrzegane będą przez aplikacje typu klient i serwer, ustalający przepływ danych. Protokoły niskiego poziomu, w skład których wchodzą TCP/IP, implementowane są przez system operacyjny. W skład protokołów wysokiego poziomu wchodzą HTTP, FTP czy SMTP i są one zdefiniowane na stronie www.ietf.org firmy Internet Engineering Task Force. Protokoły przesyłania są na wyższym poziomie niż protokoły transmisji, ponieważ abstrahują od mechanizmu transportu zapewnionego przez TCP/IP. Dzięki tej właściwości protokoły nie są zależne od systemu operacyjnego czy sprzętu, są również niezależne od fizycznej sieci.


1.3. Typy połączeń gniazdowych
  1. Połączenia klienta – inicjowane są przez klienta i łączą jego lokalne gniazdo ze zdalnym gniazdem serwera. Gniazda klienta określają serwer z którym się chcą połączyć poprzez podanie jego nazwy lub adresu IP wraz z portem.

  2. Połączenia nasłuchujące – są biernymi gniazdami serwera oczekującymi klienta. Po zgłoszeniu klienta żądania serwer tworzy nowe gniazdo przeznaczone do określonego połączenia, a następnie powraca do nasłuchiwania.

  3. Połączenia serwera – są połączeniami aktywowanymi przez serwer po zaakceptowaniu żądania ze strony klienta.


2. Komponenty INDY w praktyce.

2.1 TCP

Info Protokół TCP (Transmision Control Protokol) jest protokołem połączeniowym, umożliwia zestawienie połączenia w którym efektywnie i niezawodnie przesyłane są dane. Zestawione połączenie charakteryzuje się możliwością sterowania przepływem, potwierdzania odbioru, zachowania kolejności danych, kontrolowania błędów oraz przeprowadzania retransmisji. Protokół TCP organizuje dwukierunkową współpracę między warstwą IP, a warstwami wyższymi Do jego cech zaliczyć można również prawidłową obsługę niespodziewanie zakończonych aplikacji otrzymujących datagram oraz bezpieczne izolowanie warstwy wyższej przed skutkami awarii w warstwie prokołu IP.
Protokół IP (Internet Protokol) jest podstawowym protokołem warstwy internetu i odpowiada on za przesyłanie pakietów zwanych datagramami. Jest to protokół bezpołączeniowy, datagramy przesyłane są przez sieć bez kontroli poprawności ich dostarczenia. Wewnątrz datagramu IP umieszczane są segmenty TCP oraz pakiety UDP w celu dalszego ich przesłania.


Protokół TCP w odniesieniu do IP posiada rozszerzone możliwości, do których zaliczyć można:
  • strumienie – sformatowane dane są transportowane w postaci strumieni bitów zorganizaowancyh w bajty lub obiekty ośmio bitowe,
  • buffer flow control – czyli kontrola zajętości bufora zapobiegająca przepełnianiom buforów powiązanych ze strumieniem danych. Wolniejszy proces ma zapenioną możliwość nadążania z odbieraniem oraz przetwarzaniem danych,
  • detekcja i korekcja błędów transmisji – w przypadku wystąpienia błędu w transmisji następuje powiadomienie o tym fakcie obu stron, a następnie w celu zaradzeniu na wystąpienie błędu następuje powtórna transmisja brakujących pakietów,
  • połączenie full-duplex – umożliwiające jednoczesną transmisję w obu kierunkach.
Dodatkowo używane są okna pozwalające zwiększyć wydajność transmisji poprzez dopuszczenie do transmisji kilku pakietów jednocześnie. Technologia TCP pozwala utrzymać wiele jednoczesnych połączeń pomiędzy różnymi aplikacjami. W celu rozróżnienia połączeń używane są numery portów. Numery IP wraz z numerami portów budują tzw.: końcówki.

Protokół tworzący internet (TCP/IP) opisywany jest w dwojaki sposób:
  • za pomocą siedmiowarstwowego modelu ISO/OSI,
  • uproszczonego modelu czterowarstwowego.


Warstwy TCP


Warstwy z modelu uproszczonego pokrywają się z odpowienimi funkcjami z modelu ISO/OSI. Najważniejszymi są warstwy: sieciowa oraz transportowa, drugoplanowymi są natomiast warstwy: dostępu do sieci i aplikacji. Wspominając o warstwach nadmienić należy, iż najniższą warstwą w hierarchi architektury protokołu TCP/IP jest warstwa dostępu do sieci. Na jej poziomie dodaje się nagłówki oraz zakończenie do datagramów IP. W wyniku czego uzyskuje się tzw. „ramki”, które są następnie przesyłane w sieci.

W skład protokołu TCP/IP wchodzą:
  1. protokoły transferu danych:
    • IP (Internet Protocol),
    • TCP (Transmission Control Protocol),
    • UDP (User Datagram Protocol),
  2. protokoły kontroli poprawności połączeń:
    • ICMP (Internet Control Message Protocol),
  3. protokoły zarzadzani siecią:
    • SNMP (Simple Network Management Protocol),
  4. protokoły zdalnego włączania się do sieci:
    • TELNET (Network Terminal Protocol),
  5. protokoły przesyłania plików:
    • FTP (File Transfer Protocol).


W skład połączenia uzyskanego za pomocą TCP zaliczyć można:
  • wysłanie bitu SYNC/ACK od strony próbującej nawiązać połączenie,
  • odpowiedź w postaci SYNC/ACK potweirdzające nawiązanie połączenia,
  • zamknięcie połączenia za pomocą pakietu FIN.


Do największych zalet protokołów TCP/IP zaliczyć można:
  • niezależność od specyfikacji sprzętowo-programowej systemów,
  • możliwość integracji wielu różnych rodzajów sieci,
  • wspólny schemat adresacji,
  • istnienie standardowych protokołów warstw wyższych.


W skład najbardziej znanych protokołów warstwy palikacjikorzystających z protokołu TCP należą:
  • Telnet (Network Terminal Protokol) pozwalający na rozpoczęcie sesji poprzez sieć dla usług terminalowych,
  • FTP (File Transfer Protokol) umożliwiający przesyłanie plików,
  • TFTP (Trivial File Transfer Protokol), który stanowi uproszczoną wersję protokołu FTP i wykorzystywany jest przy prostych usługach transferu plików,
  • SMTP (Simple Mail Transfer Protokol) umożliwiający na wymianę poczty elektronicznej,
  • HTTP (Hyper Text Transfer Protokol) udostępniający w sieci strony zapiasane na serwerach WWW (World Wide Web).


Delphi umożliwia zestawić prostą komunikację dwóch programów przez gniazdo w obszarze sieci poprzez zastosowanie komponentów IdTCPClient oraz IdTCPServer. Pierwszym krokiem zmierzającym do uzyskania w/w komunikacji jest ustalenie wspólnego portu zarówno dla aplikacji klient jak i serwer. 

//aplikacja typu klient
IdTCPClient1.Port :=3500;

//aplikacja typu serwer
IdTCPServer1.DefaultPort := 3500;


Krokiem drugim jest zdefiniowanie adresu IP serwera po stronie klienta: 

//Adres IP 127.0.0.1 jak opisano powyżej umożliwia uzyskanie testowego połączenia.
IdTCPClient1.Host := ‘127.0.0.1’;


Krokiem trzecim jest włączenie aplikacji typu serwer w tryb nasłuchiwania 

IdTCPServer1.Active := true;


Tak przygotowana aplikacja klienta i serwera jest już przygotowana do nawiązania połączenia. Nawiazanie połaczenia ze strony klienta następuje w momencie wykonania polecenia: 

IdTCPClient1.Connect;


Info Za pomocą kolekcji Bindings można nawiązywać połączenia z wieloma adresami IP oraz portami.


Komponent IdTCPServer umożliwia w odpowiednim zdarzeniu obsłużyć przychodzące połączenie ze strony klienta, co możemy wykorzystać na przykład do utworzenia logu zdarzeń. 

procedure Tform1.IdTCPServer1Connect(Athread: TidPeerThread);
begin
  Memo1.lines.add(‘Połączenie od: ‘ + Athread.Connection.Socked.Binding.PeerIP);
end;


Przeważnie po ustanowieniu połączenia następuje komunikacja pomiędzy aplikacją typu klient i serwer. Oparta on może być na łańcuchach tekstowych. Gniazda, zarówno serwera jak i klienta, dysponują metodami odczytu i zapisu przeznaczonymi do przesyłania danych.

Po stronie klienta wysłanie ciągów znaków tekstowych odbywa się poprzez zastosowanie polecenia: IdTCPClient1.Write.

Rozbudowując zdarzenie OnClick przycisku Button uzyskujemy: 

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Edit1.Text <> '' then
  begin
    //nawiązanie połączenia
    if not IdTCPClient1.Connected then
    begin
      try
        IdTCPClient1.Connect(-1);
      except
        on exception do
        begin
          Showmessage('Nie można nawiązać połaczenia z serwerem: '
          + IdTCPClient1.Host);
        end;
      end;    
    end;
    //rozłączenie
    if IdTCPClient1.Connected then
    begin
      //wysyłanie wiadomości
      IdTCPClient1.Write(Edit1.Text);
      IdTCPClient1.Disconnect;
    end;
  end;
end;


Po stronie serwera należy rozbudować zdarzenie OnConnect: 

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  Memo1.Lines.Add('Połączenie od: '  + AThread.Connection.Socket.Binding.PeerIP);
  Memo1.Lines.Add('Otrzymany tekst: ' + Athread.Connection.AllData);
end;


Cały kod programu: 

unit Main_Unit1;

interface

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

type
  TForm1=class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //wyczyszczenie komponentów Edit1 i Memo1
  Edit1.Clear;
  Memo1.Clear;

  //ustawienie portów
  IdTCPServer1.DefaultPort := 3500;
  IdTCPClient1.Port := 3500;

  //ustawienie adresu IP po stronie klienta
  IdTCPClient1.Host := '127.0.0.1';

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  //aktywacja serwera
  If not IdTCPServer1.Active then
  begin
    IdTCPServer1.Active := true;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Edit1.Text <> '' then
  begin
    //nawiązanie połączenia
    if not IdTCPClient1.Connected then
    begin
      try
        IdTCPClient1.Connect(-1);
      except
        on exception do
        begin
          Showmessage('Nie można nawiązać połaczenia z serwerem: '
          + IdTCPClient1.Host);
        end;
      end;
    end;
    //rozłączenie
    if IdTCPClient1.Connected then
    begin
      IdTCPClient1.Write(Edit1.Text);
      IdTCPClient1.Disconnect;
    end;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  Memo1.Lines.Add('Połączenie od: ' 
  + AThread.Connection.Socket.Binding.PeerIP);
  Memo1.Lines.Add('Otrzymany tekst: ' 
  + Athread.Connection.AllData);
end;

end.


Inne sposoby wymiany informacji pomiędzy IdTCPServer a IdTCPClient:
  • poprzez zdefiniowanie właściwości po stronie serwera (ustawienie rozkazu tekstowego, kodu numerycznego, wyniku tekstowego):


object IdTCPServer1 : TIdTCPServer
  CommandHandlers=<
    Item
      Command=‘test’
      Name=‘TidCommandHandler0’
      ParseParams=False
      ReplyMormal.NumericCode=100
      ReplyNormal.Text.Stringd=(‘Witam – Serwer INDY’)
      ReplyNormal.TextCode=‘100’
    end


Poniższy kod wykonuje klient: 

procedure Tform1.Button1Click(Sender: TObject);
begin
  IdTCPClient1.SendCmd(‘test’);
  Showmessage(IdTCPClient1.LastCmdResult.TextCode 
  + ‘ : ‘ + IdTCPClient1.LastCmdTResult.Text.Text);
end;


  • poprzez obsługę zdarzenia OnCommand:


//Serwer
procedure Tform1.IdTCPServer1TidCommandHandler1Command (Asender: TIdCommand);
begin
  Asender.Thread.Connection.Writeln(‘Odpowiedź serwera’);
end;

//Klient
procedure Tform1.ButtonClick(Sender: TObject);
begin
  IdTCPClient1.WriteLn(‘execute’);
  Showmessage(IdTCPClient1.ReadLn);
end;


2.1.1. Prosty przykład odpowiedzi (PING)

Budowę naszego programu rozpoczynamy od dodania do formy komponentów: IdTCPClient oraz IdTCPServer, można dołaczyć również IdAntiFreeze. Następnie dodajemy dwa przyciski Button, pole Edit oraz Memo. W procedurze obsługi zdarzenia OnCreate (procedura FormCreate) dodajemy czyszczenie pola Edit oraz Memo: 

procedure TForm1.FormCreate(Sender: TObject);
begin
  //czyszczenie pola Edit1
  Edit1.Text := '';
  //czyszczenie komponentu Memo1
  Memo1.Clear;
end;


Następnie w procedurze obsługi zdarzenia OnClick jednego z przycisków (w naszym przypadku Button2) dodajemy kod aktywujący serwer oraz definiujący jego port: 

procedure TForm1.Button2Click(Sender: TObject);
begin
  //zdefiniowanie standardowego portu serwera
  IdTCPServer1.DefaultPort := 6000;
  if not IdTCPServer1.Active then
  begin
    //aktywacja sewera
    IdTCPServer1.Active := true;
    //ukrycie przycisku Button2
    Button2.Visible := false;
  end;
end;


Musimy również wyłaczyć serwer przy zamknięciu aplikacji. Kod dezaktywacji serwera umieszczamy w procedurze obsługi zdarzenia OnClose formy programu: 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //sprawdzamy czy serwer pracuje
  if IdTCPServer1.Active then
  begin
    //dezaktywacja serwera
    IdTCPServer1.Active := false;
  end;
end;


Całość kodu poświęconą częsci dla serwera kończymy obsługując zdarzenie OnExecute komponentu IdTCPServer: 

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  LLine: string;  //nowa zmienna typu string
begin
  Sleep(1000);  //odczekanie 1 sekundy
  LLine := AThread.Connection.ReadLn;  //odczytanie wysłanej informacji przez klienta
                                      //i przypisanie jej do zmiennej typu string
  //sprawdzenie wartości otrzymanej i przypisanej do zmiennej
  if LLine = 'PING' then
  begin
    //przesłanie odpowiedzi do klienta
    AThread.Connection.WriteLn('250');
  end;
end;


Cześć związaną z obdsługą serwera oraz rozpoczęciem i zakończeniem aplikacji mamy za sobą. Teraz musimy zbudować cześć związaną z obsługą klienta TCP/IP. Cały kod obsługujący klienta naszej aplikacji umieścimy w obsłudze zdarzenia OnClick drugiego przycisku (w naszym przypadku Button1): 

procedure TForm1.Button1Click(Sender: TObject);
begin
  //sprawdzenie wartości przetrzymywanej w polu Edit
  If Edit1.Text <> '' then
  begin
    //podstawienie adresu IP z pola Edit 
    IdTCPClient1.Host := Edit1.Text;
    //ustawienie numeru portu klienta
    IdTCPClient1.Port := 6000;
    //ustawienie czasu na odpowiedź
    IdTCPClient1.ReadTimeout := 5;
  end;
  //sprawdzenie czy klient nawiązał już połączenie
  if (not IdTCPClient1.Connected) and (IdTCPClient1.Host <> ‘’) then
  begin
    //ustanowienie połączenia
    IdTCPClient1.Connect(-1);
  end;
  //wykonywanie pętli dopóki połączenie jest ustanowione
  while IdTCPClient1.Connected do
  begin
    //wysyłanie tekstu “PING” na serwer 
    IdTCPClient1.WriteLn('PING');
    //odebranie tekstu przesłanego przez serwer i dodanie do Memo1
    Memo1.Lines.Add(IdTCPClient1.ReadLn('', 3000));
    //jeżeli minął czas odpowiedzi wyświetlenie informacji i zakończenie działania pętli 
    if IdTCPClient1.ReadLnTimedOut then
    begin
      //wyświetlenie informacji
      MessageDlg('Timeout!', mtInformation, [mbOk], 0);
      //zakończenie działania pętli
      Exit;
    end;
  end;
end;


Cały kod programu: 

unit indy_ping_unit;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    IdTCPClient1: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    Button2: TButton;
    IdTCPServer1: TIdTCPServer;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '';
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  If Edit1.Text <> '' then
  begin
    IdTCPClient1.Host := Edit1.Text;
    IdTCPClient1.Port := 6000;
    IdTCPClient1.ReadTimeout := 5;
  end;
  if (not IdTCPClient1.Connected) and (IdTCPClient1.Host <> '') then
  begin
    IdTCPClient1.Connect(-1);
  end;
  while IdTCPClient1.Connected do
  begin
    IdTCPClient1.WriteLn('PING');
    Memo1.Lines.Add(IdTCPClient1.ReadLn('', 3000));
    if IdTCPClient1.ReadLnTimedOut then
    begin
      MessageDlg('Timeout!', mtInformation, [mbOk], 0);
      Exit;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := 6000;
  if not IdTCPServer1.Active then
  begin
    IdTCPServer1.Active := true;
    Button2.Visible := false;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if IdTCPServer1.Active then
  begin
    IdTCPServer1.Active := false;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  LLine: string;
begin
  Sleep(1000);
  LLine := AThread.Connection.ReadLn;
  if LLine = 'PING' then
  begin
    AThread.Connection.WriteLn('250');
  end;
end;

end.


Z uwagi na połączenie części klienta i serwera w jednym programie szybko można sprawdzić działanie poprzez próbę zestawienia połączenia z adresem 127.0.0.1 (łączymy się z serwerem na naszej stacji roboczej).

2.2. UDP

User Datagram Protocol (UDP) działa w sposób bezpołączeniowy. Zapewnia więc tak samo zawodny sposób dostarczania pakietów co protokół IP. W protokole tym nie uwzględniono jakiejkolwiek kontroli transmisji czy korekcji błędów, konsekwencją czego pakiety UDP mogą zostać zagubione, zduplikowane albo też przybyć w nieprawidłowej kolejności. Dzięki wykorzystaniu mniejszych nagłówków niż ma to miejsce w przypadku TCP pozwala na lepsze wykorzystanie przepustowości łączy i dzięki temu na szybsze przetwarzanie pakietów.

Info UDP jest wykorzystywane głównie w przypadkach, gdy kontrola transmisji jest zapewniona przez protokoły wyższych warstw.


W skład najbardziej znanych protokołów warstwy aplikacji korzystających z protokołu UDP zaliczyć można:
  • DNS (Domain Name Service) służący do zamiany adresów IP na nazwy,
  • RIP (Routing Information Protokol) służący do wymiany informacji związanych z aktualizacją reguł doboru tras w węzłach sieci,
  • NFS (Network File System) umożliwiający współdzielenie plików przez wiele komputerów połączonych w sieci.


W celu skorzystania z User Datagram Protocol w Delphi poprzez INDY należy zastosować IdUDPClient oraz IdUDPServer. Struktura programu jest podobna jak w przypadku pakietu TCP (komponentów IdTCPClient oraz IdTCPServer).

Kod źródłowy programu korzystającego z protokołu UDP poprzez INDY przedstawia poniższy przykład: 

unit udp_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  StdCtrls, IdSocketHandle, IdTCPServer;

type
  TForm1=class(TForm)
    IdUDPClient1: TIdUDPClient;
    IdUDPServer1: TIdUDPServer;
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure IdUDPServer1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Clear;
  Memo1.Clear;
  IdUDPClient1.Port := 36000;
  IdUDPServer1.DefaultPort := 36000;
  IdUDPServer1.Active := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdUDPClient1.Host := '127.0.0.1';
  IdUDPClient1.Send(Edit1.Text);
end;

procedure TForm1.IdUDPServer1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  Memo1.Lines.Add(AStatusText);
end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  sText: string;
begin
  //do uses dodać: IdSocketHandle
  Memo1.Lines.Add(ABinding.PeerIP);
  AData.Position := 0;
  SetLength(sText, AData.Size);
  AData.ReadBuffer(sText[1], AData.Size);
  Memo1.Lines.Add(sText)
end;

end.


Procedurę odczytu można również zbudować korzystając ze strumieni: 

procedure IdUDPServerUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle); 
var 
  Text: string; 
  StrStream: TStringStream; 
begin 
  StrStream := TStringStream.Create(''); 
  try 
    StrStream.CopyFrom(AData, AData.Size);  
    Text := StrStream.DataString; 
  finally 
    StrStream.Free; 
  end; 
end;


2.3. Obsługa poczty - wysyłanie (SMTP) i odbieranie (POP3)

W celu używania protokołów pocztowych w Delphi za pomocą pakietu INDY niezbędne jest umieszczenie komponentu komunikatów (IdMessage) w naszej aplikacji. Wysyłanie poczty nastąpi po jego wypełnieniu i użyciu komponentu IdSMTP. Odbiór wiadomości pocztowej umożliwia komponent IdPOP3, który zwraca obiekt IdMessage.

2.3.1 SMTP

Info SMTP - Simple Mail Transfer Protocol. Protokół ten jest głównie używany do przenoszenia poczty elektronicznej. Standardowo serwery SMTP oczekują na przychodzącą pocztę na porcie 25. Odebraną pocztę kopiują do odpowiednich skrzynek pocztowych. Jeśli wiadomość nie może zostać dostarczona, nadawcy zostaje zwrócony komunikat błędu zawierający początkowy fragment wiadomości.


Przykładowy kod źródłowy wysyłania wiadomości pocztowej: 

procedure Tform1.wyslij();
begin
  //czyszczenie zawartości komponentu IdMessage
  IdMessage1.Clear;
  //ustawienie adresu IP/nazwy serwera
  IdSMTP1.Host :=Edit1.Text;
  //ustawienie nazwy użytkownika
  IdSMTP1.Username := Edit2.Text;
  //ustawienie hasła użytkownika
  IdSMTP1.Password := Edit3.Text;
  //ustawienie trybu authentifikacji
  IdSMTP1.AuthenticationType := atLogin;

  //nawiązanie połączenia w przypadku jego braku
  if not IdSMTP1.Connected then
  begin
    try
      StatusBar1.SimpleText := 'Zestawianie połączenia z serwerem ...';
      //nawiązywanie połączenia
      IdSMTP1.Connect(-1);
      StatusBar1.SimpleText := 'Połączony ...';
    except
      on exception do
      begin
        StatusBar1.SimpleText :='BŁĄD !!! Wysyłanie poczty !!! Połączenie z serwerem '
                                                  + IdSMTP1.Host + ' niepowiodło się !!!';
      end;
    end;
  end;

  //jeżeli połączenie jest zestawione – wysyłanie wiadomości
  if IdSMTP1.Connected then
  begin
     //dodanie informacji od kogo
     IdMessage1.From.Text := Edit4.Text;
     //dodanie tematu
     IdMessage1.Subject :=Edit5.Text;
     //dodanie adresu odbiorcy
     IdMessage1.Recipients.Add.Text :=Edit6.Text;
     //dodanie załącznika do wiadomości
     TidAttachment.create(IdMessage1.MessageParts, ExtractFilePath(ParamStr(0)) 
                                        + 'zalacznik.txt');
     StatusBar1.SimpleText := 'Wysyłanie wiadomości ...';
     Try
       //wysyłanie wiadomości
       IdSMTP1.Send(IdMessage1);
       StatusBar1.SimpleText := 'Wiadomość wysłana.';
       //czyszczenie komponentu IdMessage
       IdMessage1.Clear;
     except
       on exception do
       begin
         showmessage('Błąd przy wysyłaniu wiadomości !!!');
         StatusBar1.SimpleText := 'Błąd przy wysyłaniu wiadomości !!!';
         //czyszczenie komponentu IdMessage
         IdMessage1.Clear;
       end;
     end;
  end;
end;


2.3.2 POP3.

Info POP3 - (Post Office Protocol) służy do przenoszenia poczty elektronicznej z serwera pocztowego na komputer użytkownika. Protokół oparty jest na architekturze klient-serwer, w której pocztę odbiera serwer pocztowy. Serwer przechowuje wiadomość aż do momentu, gdy użytkownik się zaloguje i ją pobierze.


Przykładowy kod źródłowy odbioru wiadomości pocztowej: 

procedure Tform1.obierz ();
var
  il_wiad : integer;     //ilość wiadomości
  il_zal : integer;      //ilość załączników
  zal_nazwa : string;    //nazwa załącznika
begin
  //czyszczenie komponentu IdMessage
  IdMessage1.Clear;
  //ustawienie adresu IP/nazwy serwera
  IdPOP31.Host := Edit1.Text;
  //ustawienie nazwy użytkownika
  IdPOP31.Username := Edit2.Text;
  //ustawienie hasła użytkownika
  IdPOP31.Password := Edit3.Text;

  //nawiązanie połączenia w przypadku jego braku
  If not IdPOP31.Connected then
  begin
    try
      statusbar1.SimpleText := 'Odbieranie poczty - zestawianie połączenia!!!';
      //zestawianie połączenia
      IdPOP31.Connect(-1);
      statusbar1.SimpleText := 'Odbieranie poczty - połączony!!!';
    except
      on exception do
      begin
        statusbar1.SimpleText := 'Odbieranie poczty - błąd połączenia!!!';
      end;
    end;
  end;

  //odebranie wiadomości w przypadku pomyślnego nawiązania połączenia
  if IdPOP31.Connected then
  begin
    //sprawdzenie ilości wiadomości na serwerze
    il_wiad := IdPOP31.CheckMessages;
    statusbar1.SimpleText := il_wiad;

    while il_wiad > 0 do
    begin
      //czyszczenie komponentu IdMessage
      IdMessage1.Clear;
      //odbiór wiadomości z serwera, wypełnienie komponentu IdMessage
      IdPOP31.Retrieve(il_wiad, IdMessage1);
      //sprawdzenie ilości załączników w wiadomości
      il_zal := IdMessage1.MessageParts.Count - 1;
      Showmessage('Odbieranie wiadomości: ' + inttostr(il_wiad) + ' Od: ' 
                   + IdMessage1.From.Text + ' Temat: ' 
				   + IdMessage1.Subject + ‘ Załączników: ‘ 
                   + inttostr(il_zal);
      while il_zal > 0 do
      begin
        if (IdMessage1.MessageParts.Items[il_zal] is TIdAttachment) then
        begin
          zal_nazwa := TIdAttachment(IdMessage1.MessageParts.Items[il_zal]).Filename;  
          TIdAttachment(IdMessage1.MessageParts.Items[il_zal]).SaveToFile
                                  (ExtractFilePath(ParamStr(0)) + zal_nazwa);
        end;
        il_zal := il_zal – 1;
      end;
      //kasowanie wiadomości na serwerze
      IdPOP31.Delete(il_wiad);
      il_wiad := il_wiad – 1;
    end;
  end;
end;


2.4. HTTP

Protokół HTTP (Hyper-Text Transfer Protokol) jest kolejnym (poza protokołami obsługi wiadomości) z najbardziej popularnych. Po stronie klienta następuje czytanie plików, serwery natomiast generują i udostępniają strony HTML. Strony internetowe generowane są w sposób statyczny, jak i dynamiczny (np.; w odpowiedzi na wykonywane czynności użytkownika). Na podstawie wpisanego w przeglądarce adresu następuje wyszukanie (lokalizacja) adresu IP serwera i dane przesyłane są do przeglądarki użytkownika.
W przypadku gdy protokół HTTP nie zapewnia wystarczającego poziomu bezpieczeństwa wykorzystuje się jego rozbudowaną wersję: HTTPS. Rozbudowana wersja HTTPS umożliwia szyfrowanie danych pomiędzy klientem a serwerem i nosi ono nazwę SSL (Secure Socket Layer).

Zaimplementowanie w kodzie źródłowym Delphi protokołu HTTP jest możliwe dzięki kontrolce TIdHTTP (zakładka Indy Clients).

Połączenie.
Zachowując się intuicyjnie, możemy w łatwy sposób nawiązać połączenie z serwerem poprzez wpisanie w metodzie Connect komponentu TIdHTTP adresu serwera wraz z portem. 

IdHTTP.connect(‘www.google.pl’, 80);


Status.
W celu sprawdzenia statusu połączenia stosujemy zdarzenie OnStatus. Pozwala ono wychwycić na jakim etapie działa komponent TIdHTTP. Parametr AStatus zwraca informacje o stanie połączenia w formie danych:
  • hsResolving – szukanie hosta,
  • hsConnecting – próba połączenia,
  • hsConnected – połączony,
  • hsDisconnecting – rozłączenie,
  • hsDisconnected – rozłączony.


procedure TForm1.IdHTTPStatus(ASender: TObject; AStatus: TIdStatus; AStatusText: string );
begin
  Memo1.Lines.Add(AStatusText);
  case AStatus of
    hsResolving: Memo1.Lines.Add(‘Wyszukiwanie hosta …’);
    hsConnecting: Memo1.Lines.Add(‘Łączenie z hostem …’);
    hsConnecting: Memo1.Lines.Add(‘Połączenie zestawione.’);
    hsDisconnecting: Memo1.Lines.Add(‘Rozłączanie …’);
    hsDisconnected: Memo1.Lines.Add(‘Rozłączono !’);
  end;
end;


Metoda Post.
Istotą metody Post jest przekazywanie danych w nagłówku HTTP do przeglądarki. Dane są przekazywane w postaci: nazwa_pola=wartosc_pol&nazwapola2=wartosc_pola2. Poszczególne elementy oddzielone są od siebie znakiem &, natomiast nazwa pola oddzielona jest od wartości znakiem równości („=”).

Wykorzystanie metody Post komponentu TIdHTTP sprowadza się do podania dwóch parametrów typu TStringStream (strumienie). Pierwszy z parametrów zawiera dane przesyłane do skryptu (wartość wejściowa), drugi parametr zawiera dane zwrócone przez skrypt (wartość wyjściowa).
Używając metody Post musimy podać jeszcze adres strony, do której przekazany zostanie nagłówek oraz treść IdHTTP.

Sposób użycia metody Post: 

IdHTTP.Post(‘http://adres.www/index.php’, Stream_in, Stream_out);


Metoda Get.
Podobnie jak w przypadku metody Post poszczególne pola oddzielone są od siebie znakiem &. Podstawową różnicą jest natomiast sposób ich przekazywania. Dane dołączane są do adresu strony, wygląda to następująco:
„http://www.google.pl/search?pole1=wartosc1&pole2=wartosc2”.
Metodą Get sugeruje się przekazywanie niewielkiej ilości danych.

Pobieranie kodu HTML polega na użyciu metody Get komponentu TIdHTTP. W wyniku działania metody Get kod HTML zostanie zwrócony w postaci tekstu (String). 

var
  html_tekst : string;
begin
  html_tekst := IdHTTP.Get(‘http://www.google.pl/’);
end;


2.4.1. Zapis strony do pliku na dysku lokalnym

Zastosowanie metody Get w korelacji ze strumieniem (String; TStream) pozwoli na zapisanie strony www do pliku. 

var
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  try
    Edit1.Text := 'http://4programmers.net/Delphi/Indy';
    IdHTTP1.Get(Edit1.Text, ms);
    ms.SaveToFile(ExtractFilePath(ParamStr(0)) + FormatDateTime('yyyy-mm-dd', date) 
                             + '_' + FormatDateTime('hh_nn_ss_zzz', Time) + '_test.html');
  finally
    ms.Free;
  end;
end;


Funkcje formatowania daty (FormatDateTime) użyte zostały ze względu na możliwy do wystąpienia błąd w przypadku istnienia pliku „*test.html” na dysku. Oczywiście można użyć poleceń języka związanych z kasowaniem plików.

Tak zapisany plik można otworzyć za pośrednictwem przeglądarki internetowej używając polecenia ShellExecute: 

var
  ms: TMemoryStream;
  plik_nazwa : string;
begin
  ms := TMemoryStream.Create;
  try
    Edit1.Text := 'http://4programmers.net/Delphi/Indy';
    IdHTTP1.Get(Edit1.Text, ms);
    plik_nazwa := ExtractFilePath(ParamStr(0)) + FormatDateTime('yyyy-mm-dd', date) 
                           + '_' + FormatDateTime('hh_nn_ss_zzz', Time) + '_test.html';
    ms.SaveToFile(plik_nazwa);
  finally
    ms.Free;
  end;

  //OTWARCIE ZAPISANEGO PLIKU !!!
  if fileexists(plik_nazwa) then
  begin
    ShellExecute(Handle, 'open',Pchar(plik_nazwa), nil, nil, SW_SHOWNORMAL);  
  end;
end;


2.4.2. Niestandardowy serwer HTTP.

Budowę niestandardowego serwera HTTP opartego na INDY należy zacząć umieszczając na formie komponent TIdHTTPServer z palety Indy Servers. Po umieszczeniu komponentu niezbędne jest obsłużenie aktywacji i dezaktywacji komponentu. W celach testowych dobrze jest również dodać pole edycyjne przeznaczone na numer portu.

Włączenie serwera: 

IdHTTP.Server1.Active := true;


Wyłączenie serwera: 

IdHTTP.Server1.Active :=false;


Ustawienie domyślnego portu na którym będzie pracował serwer (ustawienie portu należy przeprowadzać przed uruchomieniem serwera): 

IdHTTPServer1.DefaultPort := 80;


Zmieniając domyślne ustawienia portu serwera możliwe jest używanie kilku serwerów w jednym czasie.

Po uruchomieniu serwera metodą Active należy obsłużyć zdarzenie OnCommandGet odpowiedzialne za zwrócenie strony wraz z informacjami dodatkowymi: 

procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  html_result : string;
begin
  //procedura zwraca stronę www
  //logowanie
  RichEdit1.Lines.Add(ARequestInfo.Document);




end;


A oto kod źródłowy najważniejszych procedur naszego niestandardowego serwera: 

//WŁĄCZENIE SERWERA
procedure TForm1.Button1Click(Sender: TObject);
var
  //do uses dodać: idSocketHandle
  Binding : TIdSocketHandle;
begin
  //włączenie serwera
  if not IdHTTPServer1.Active then
  begin
    IdHTTPServer1.DefaultPort := 80;
    IdHTTPServer1.Bindings.Clear;
    Binding := IdHTTPServer1.Bindings.Add;
    Binding.Port := StrToIntDef(inttostr(IdHTTPServer1.DefaultPort), 80);
    Binding.IP := '127.0.0.1';
    try
      IdHTTPServer1.Active := true;
    except
      on e: exception do
      begin
        ShowMessage(format('Exception %s in Activate. Error is:"%s".', [e.ClassName,
                                e.Message]));
      end;
    end;
  end;
  if IdHTTPServer1.Active then
  begin
    Showmessage('HTTP Serwer właczony!.' + #13 + 'Nasłuchiwanie na porcie: ' 
	+ inttostr(IdHTTPServer1.DefaultPort));
  end;
end;

//WYŁĄCZENIE SERWERA
procedure TForm1.Button2Click(Sender: TObject);
begin
  //wyłaczenie serwera
  if IdHTTPServer1.Active then
  begin
    IdHTTPServer1.Active := false;
  end;
  if not IdHTTPServer1.Active then
  begin
    Showmessage('HTTP Serwer wyłączony!.');
  end;
end;

//OBSŁUGA ZDARZENIA ONCOMMANDGET
procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  html_result : string;
begin
  //procedura zwraca stronę www
  //logowanie – pokazanie w RichEdit nazwy wyświetlanej strony
  RichEdit1.Lines.Add(ARequestInfo.Document);
  //budowa i wyświetlenie HTML’u w przeglądarce internetowej

end;


W wynik podania w adresie przeglądarki http://localhost/test?user=tete zobaczymy efekt działania serwera (można również użyć polecenia z numerem portu: http://localhost:80/test?user=tete) jak na poniższym przykładzie:



Powyższy przykład pokazuje tworzenie statycznej strony www. Jednakże możliwe jest również tworzenie stron dynamicznych dzięki komponentom serii Producer znajdujących się na karcie Internet palety komponentów Delphi.

Komponenty serii Producer:
  • PageProducer – umożliwia modyfikację pliku HTML, w którym umieszczone zostały specjalne znaczniki. W czasie działania programu PageProducer zamienia znaczniki na właściwy kod. Dzięki takiej metodzie istnieje łatwy sposób modyfikacji wybranych fragmentów kodu HTML. Specjalne znaczniki, o których mowa, przetwarzane są w zdarzeniu OnTag komponentu PageProducer. Podstawowym formatem znaczniku specjalnego jest <#nazwaznacznikaspecjalnego>.
  • DataSetPageProducer – dzięki niemu możliwe jest automatyczne zastępowanie znaczników nazwami pól ze źródła bazy danych.
  • DataSetTableProducer – umożliwia on wyświetlać w formie tabeli dane otrzymywane z zapytania lub zbioru danych.
  • QueryTableProducer i SQLQueryTableProducer – przeznaczeniem jest budowanie zapytań z parametrami na podstawie wprowadzonych danych w formularzu.


Odbiegając nieco od tematu artykułu zauważyć można, iż komponenty z serii Producer zostały specjalne dodane w Delphi do obsługi baz danych.

2.4.3. Prosty serwer HTTP.

Podobnie jak w przypadku niestandardowego serwera HTTP na formie umieszczamy komponent TIdHTTPServer z palety Indy Servers. Dodajemy do formy pola TEdit (przeznaczone na adres serwera, port serwera, katalog dokumentu głównego index.html), przycisk TButton (przeznaczony do włączenia/wyłączenia serwera) oraz TMemo (który spełanić będzie funkcję prostego logu zdarzeń).

Do słowa uses dodajemy ponadto: idSocketHandle, IdGlobal, IdThreadMgr, IdThreadMgrDefault, syncobjs, IdThreadMgrPool, ExtCtrls, IdIntercept, IdIOHandlerSocket.

W momencie tworzenia formy obsługujemy zdarzenie OnCreate: 

procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Clear;
  Edit_adres.Text := '127.0.0.1';
  Edit_port.Text := '8080';
  Edit_kat.Text := 'C:\';
  if IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Wyłącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP włączony, nasłuchiwanie na porcie: ' + Edit_port.Text);
  end;
  if not IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Włącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP wyłączony!!!');
  end;
end;


Włączenie i wyłączenie serwera obsługujemy poprzez zdarzenie OnClick przycisku Button: 

procedure TForm1.Button1Click(Sender: TObject);
var
  //do słowa uses dodać: idSocketHandle
  Binding : TIdSocketHandle;
  i : integer;
begin
  i := 0;
  if not IdHTTPServer1.Active then
  begin
    IdHTTPServer1.Bindings.Clear;
    Binding := IdHTTPServer1.Bindings.Add;
    Binding.Port := StrToIntDef(edit_port.text, 80);
    Binding.IP := Edit_adres.text;
  end;
  if not DirectoryExists(edit_kat.text) then
  begin
    ShowMessage(Format('Web root katalog (%s) nieznaleziony.',[edit_kat.text]));
  end;
  if (DirectoryExists(edit_kat.text)) and (not IdHTTPServer1.Active) and (i=0) then
  begin
    try
      IdHTTPServer1.Active := true;
      ShowMessage(format('Nasłuchiwanie za połączeniem HTTP na 
                              %s:%d.',[IdHTTPServer1.Bindings[0].IP, 
                              IdHTTPServer1.Bindings[0].Port]));
    except
      on e: exception do
      begin
        ShowMessage(format('Wyjątek %s przy aktywacji. Błąd:"%s".', [e.ClassName, 
                                e.Message]));
      end;
    end;
    i := 1;
  end;
  if (DirectoryExists(edit_kat.text)) and (IdHTTPServer1.Active) and (i=0) then
  begin
    IdHTTPServer1.Active := false;
    ShowMessage(format('Nasłuchiwanie za połączeniem HTTP na %s:%d 
                            zakończone.',[IdHTTPServer1.Bindings[0].IP, 
                            IdHTTPServer1.Bindings[0].Port]));
  end;
  if IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Wyłącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP włączony, nasłuchiwanie na porcie: ' + Edit_port.Text);
  end;
  if not IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Włącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP wyłączony!!!');
  end;
end;


Najważniejszą procedurą wysyłająca stronę jest procedura obsługująca zdarzenie OnCommandGet komponentu IdHTTPServer: 

procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LocalDoc: string;
  ByteSent: Cardinal;
  ResultFile: TFileStream;
begin
  {
    Wywołanie serwera: http://127.0.0.1:8080/
  }
  LocalDoc := ExpandFilename(edit_kat.text + 'index.html');
  if FileExists(LocalDoc) then
  begin
    if AnsiSameText(Copy(LocalDoc, 1, Length(edit_kat.text)), edit_kat.Text) then
    begin
      if AnsiSameText(ARequestInfo.Command, 'HEAD') then
      begin
        ResultFile := TFileStream.create(LocalDoc, fmOpenRead	or fmShareDenyWrite);
        try
          AResponseInfo.ResponseNo := 200;
          AResponseInfo.ContentType := GetMIMEType(LocalDoc);
          AResponseInfo.ContentLength := ResultFile.Size;
        finally
          ResultFile.Free;
        end;
      end else
      begin
        ByteSent := IdHTTPServer1.ServeFile(AThread, AResponseInfo, LocalDoc);
      end;
    end;
  end;
end;


oraz funkcja: 

function TForm1.GetMIMEType(sFile: TFileName): String;
begin
  result := MIMEMap.GetFileMIMEType(sFile);
end;


Cały kod źródłowy serwera zamieszczony jest poniżej: 

unit http_serwer_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  IdCustomHTTPServer, IdHTTPServer,
  //dodane do uses
  idSocketHandle, IdGlobal, IdThreadMgr, IdThreadMgrDefault,
  syncobjs, IdThreadMgrPool, ExtCtrls, IdIntercept,
  IdIOHandlerSocket;
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit_adres: TEdit;
    Edit_port: TEdit;
    Edit_kat: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Label4: TLabel;
    IdHTTPServer1: TIdHTTPServer;
    procedure IdHTTPServer1CommandGet(AThread: TIdPeerThread;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function GetMIMEType(sFile: TFileName): String;
  public
    { Public declarations }
    MIMEMap: TIdMIMETable;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Clear;
  Edit_adres.Text := '127.0.0.1';
  Edit_port.Text := '8080';
  Edit_kat.Text := 'C:\';
  if IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Wyłącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP włączony, nasłuchiwanie na porcie: ' + Edit_port.Text);
  end;
  if not IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Włącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP wyłączony!!!');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  //do słowa uses dodać: idSocketHandle
  Binding : TIdSocketHandle;
  i : integer;
begin
  i := 0;

  if not IdHTTPServer1.Active then
  begin
    IdHTTPServer1.Bindings.Clear;
    Binding := IdHTTPServer1.Bindings.Add;
    Binding.Port := StrToIntDef(edit_port.text, 80);
    Binding.IP := Edit_adres.text;
  end;

  if not DirectoryExists(edit_kat.text) then
  begin
    ShowMessage(Format('Web root katalog (%s) nieznaleziony.',[edit_kat.text]));
  end;

  if (DirectoryExists(edit_kat.text)) and (not IdHTTPServer1.Active) and (i=0) then
  begin
    try
      IdHTTPServer1.Active := true;
      ShowMessage(format('Nasłuchiwanie za połączeniem HTTP na 
                              %s:%d.',[IdHTTPServer1.Bindings[0].IP, 
                              IdHTTPServer1.Bindings[0].Port]));
    except
      on e: exception do
      begin
        ShowMessage(format('Wyjątek %s przy aktywacji. Błąd:"%s".', [e.ClassName, 
                                e.Message]));
      end;
    end;
    i := 1;
  end;

  if (DirectoryExists(edit_kat.text)) and (IdHTTPServer1.Active) and (i=0) then
  begin
    IdHTTPServer1.Active := false;
    ShowMessage(format('Nasłuchiwanie za połączeniem HTTP na %s:%d  
                             zakończone.',[IdHTTPServer1.Bindings[0].IP, 
                             IdHTTPServer1.Bindings[0].Port]));
  end;

  if IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Wyłącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP włączony, nasłuchiwanie na porcie: ' + Edit_port.Text);
  end;
  if not IdHTTPServer1.Active then
  begin
    Button1.Caption := 'Włącz serwer HTTP';
    memo1.Lines.Add('Serwer HTTP wyłączony!!!');
  end;

end;

procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LocalDoc: string;
  ByteSent: Cardinal;
  ResultFile: TFileStream;
begin
  {
    Wywołanie serwera: http://127.0.0.1:8080/
  }
  LocalDoc := ExpandFilename(edit_kat.text + 'index.html');
  if FileExists(LocalDoc) then
  begin
    if AnsiSameText(Copy(LocalDoc, 1, Length(edit_kat.text)), edit_kat.Text) then
    begin
      if AnsiSameText(ARequestInfo.Command, 'HEAD') then
      begin
        ResultFile := TFileStream.create(LocalDoc, fmOpenRead	or fmShareDenyWrite);
        try
          AResponseInfo.ResponseNo := 200;
          AResponseInfo.ContentType := GetMIMEType(LocalDoc);
          AResponseInfo.ContentLength := ResultFile.Size;
        finally
          ResultFile.Free;
        end;
      end else
      begin
        ByteSent := IdHTTPServer1.ServeFile(AThread, AResponseInfo, LocalDoc);
      end;
    end;
  end;
end;

function TForm1.GetMIMEType(sFile: TFileName): String;
begin
  result := MIMEMap.GetFileMIMEType(sFile);
end;

end.


2.5. FTP.

Info FTP (File Transfer Protocol) – protokół ten działa na zasadzie klient-serwer. Zdefiniowany jest jako jedna z usług sieciowych w warstwowym modelu TCP/IP, który opisujące funkcje sieci komputerowych. Protokół ten określa sposób przesyłania plików pomiędzy dwoma komputerami. Połączenie z serwerem FTP następuje na zasadzie autoryzacji użytkownika, a dostęp do poszczególnych plików i katalogów uzależniony jest od posiadanych uprawnień logującego się użytkownika.


W celu zbudowania aplikacji typu klient niezbędne jest umieszczenie na formie projektu komponentu IdFTP z panelu Indy Client. Przy budowie aplikacji typu serwer na formie należy umieścić komponent IdFTPServer z panelu Indy Servers.

2.5.1. Klient FTP.

Pierwszą rzeczą jaką możemy zrobić (nie musimy) jest ustalenie portu na jakim ma pracować klient FTP (standardowo jest to port numer 21). Zmianę portu umożliwia nam metoda Port komponentu IdFTP: 

IdFTP1.Port := '21';


Następnym krokiem przed nawiązaniem połączenia jest zdefiniowanie adresu serwera, nazwy użytkownika oraz jego hasła: 

IdFTP1.Username := 'anonymous';
IdFTP1.Password := 'haslo';
IdFTP1.Host := '127.0.0.1';


Info Serwery FTP przeznaczone do użytku publicznego pozwalają przeważnie na uzyskanie anonimowego dostępu do określonych zasobów osobom, które posługują się identyfikatorem 'anonymous'.


Mając ustalone powyższe parametry możemy nawiązać połączenie metoda Connect. 

if not IdFTP1.Connected then
begin
  IdFTP1.Connect();
end;


W celu rozłączenia z serwerem FTP należy użyć metody Disconnect. 

if IdFTP1.Connected then
begin
  IdFTP1.Disconnect;
end;


Zbudowanie programu na powyższych zasadach tworzyć może jedynie zarys stosowanych metod w aplikacji typu klient. Każdy klient FTP umożliwia dokonywanie pewnych czynności zarówno po stronie serwera jak i na dysku lokalnym. Należy zatem obsłużyć między innymi metody wysyłania i odbierania plików/katalogów, tworzenia nowych katalogów na serwerze, zmiany trybu przesyłania danych (tekstowo/binarnie). Niezbędne jest również dodanie elementów wizualnych, których zadaniem będzie prezentacja danych w formie okienkowej.

Metoda Put obsługuje wysyłanie danych na serwer. 

var
  localfile, remotefile : string
begin
  IdFTP1.Put(LocalFile, RemoteFile);
end;


Gdzie:
  • localfile – pełna ścieżka wraz z nazwą pliku na dysku lokalnym,
  • remotefile – nazwa pliku wysyłanego na serwer.

Metoda Get obsługuje pobieranie pliku z serwera. 

var
  localfile, remotefile : string
begin
  IdFTP1.get(RemoteFile, LocalFile);
end;


Gdzie:
  • remotefile – nazwa pliku pobieranego z serwera,
  • localfile – pełna ścieżka wraz z nazwą pliku zapisywana na dysku lokalnym.

Tworzenie nowych katalogów na serwerze obsługuje metoda MakeDir 

var
  nowy_kat : string;
begin
  IdFTP1.MakeDir(nowy_kat);
end;


Zmianę katalogu na serwerze obsługuje metoda ChangeDir. 

var
  kat_zdalny : string;
begin
  IdFTP1.ChangeDir(kat_zdalny);
end;


Metodę zmiany katalogów na serwerze jak również na dysku lokalnym dobrze jest zaimplementować w obsłudze zdarzenia elementów wizualnych (takich jak np.: ListView).

Zmianę trybu przesyłania danych obsługuje metoda TransferType. W celu zautomatyzowania wyboru można dodać obsługę metody do elementu TRadioGroup. Do słowa uses należy dodać: IdFTPCommon. 

case RadioGroup1.ItemIndex of
   0: IdFTP1.TransferType := ftAscii;
   1: IdFTP1.TransferType := ftBinary;
end;


2.5.2. Serwer FTP.

W skład najważniejszych elementów serwera FTP wchodzić musi obsługa zdarzeń:
  • OnAfterUserLogin – w obsłudze zdarzenia ustawia się parametry startowe,
  • OnUserLogin – w obsłudze zdarzenia dokonujemy kontroli poprawności logującego się użytkownika,
  • OnStoreFile – w obsłudze zdarzenia definiujemy zachowanie serwera w przypadku odbierania pliku od klienta,
  • On RetrieveFile – w obsłudze zdarzenia definiujemy zachowanie serwera w przypadku żądania pobrania pliku przez klienta,
  • OnChangeDirectory – w obsłudze zdarzenia definiujemy zachowanie serwera w przypadku otrzymania żądania zmiany katalogu przez klienta,
  • OnListDirectory – w obsłudze zdarzenia definiujemy zachowanie serwera w przypadku otrzymania żądania ze strony klienta podania struktury plików i katalogów,
  • OnMakeDirectory – jak nazwa wskazuje zdarzenie obsługuje żądanie utworzenia katalogu na serwerze.


Zdarzenie OnAfterLogin: 

procedure TForm1.IdFTPServer1AfterUserLogin(ASender: TIdFTPServerThread);
begin
  //ustawiamy katalog domowy podczas logowania
  ASender.HomeDir :=  '\';
  ASender.CurrentDir := '\';
end;


Zdarzenie OnUserLogin: 

procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
  const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
  //sprawdzenie użytkownika
  AAuthenticated := ((AUsername = 'anonymous') and (APassword = 'haslo'));
  if AAuthenticated = true then
  begin
    //funkcje po rozpoznaniu użytkownika
  end;
end;


Zdarzenie OnStoreFile: 

procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
  const AFileName: string; AAppend: Boolean; var VStream: TStream);
var
  appdir : string;
begin
  appdir := sc_programu:=ExtractFilePath(ParamStr(0));
  //zmienną appdir można zdefiniować jako public 
  //oraz w obsłudze zdarzenia OnAfterLogin podstawić wartość jak powyżej

  //odbieranie pliku
  if not Aappend then
  begin
    //odbieranie pliku - nowy plik
    VStream := TFileStream.Create(AppDir + AFilename,fmCreate);
  end;
  if Aappend then
  begin
    //odbieranie pliku - nadpisywanie istniejącego
    VStream := TFileStream.Create(AppDir + AFilename,fmOpenWrite);
  end;
end;


Zdarzenie On RetrieveFile: 

procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
  const AFileName: string; var VStream: TStream);
var
  appdir : string;
begin
  appdir := sc_programu:=ExtractFilePath(ParamStr(0));
  //zmienną appdir można zdefiniować jako public 
  //oraz w obsłudze zdarzenia OnAfterLogin podstawić wartość jak powyżej

  //wysyłanie pliku
  VStream := TFileStream.Create(AppDir + AFilename,fmOpenRead);
  Application.ProcessMessages;
end;


Zdarzenie OnChangeDirectory: 

procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: string);
begin
  //zmiana katalogu
  Asender.CurrentDir := VDirectory;
end;


Zdarzenie OnListDirectory (zmienne appdir i change_dir typu string do zdefiniowania jako public w innych częściach kodu źródłowego programu): 

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
  const APath: string; ADirectoryListing: TIdFTPListItems);
var
 LFTPItem :TIdFTPListItem;
 SR : TSearchRec;
 SRI : Integer;
begin
  //przesłanie zawartości katalogu do klienta
  SRI := FindFirst(AppDir + change_dir + '*.*', faAnyFile - faHidden - faSysFile, SR);
  While SRI = 0 do
  begin
    LFTPItem := ADirectoryListing.Add;
    LFTPItem.FileName := SR.Name;
    LFTPItem.Size := SR.Size;
    LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);

    Application.ProcessMessages;

    if SR.Attr = faDirectory then
     LFTPItem.ItemType   := ditDirectory
    else
     LFTPItem.ItemType   := ditFile;
    SRI := FindNext(SR);
  end;
  FindClose(SR);
  SetCurrentDir(AppDir + '..');
end;


Zdarzenie OnMakeDirectory: 

procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: string);
begin
  //tworzenie katalogu
  if not ForceDirectories(Appdir + VDirectory) then
  begin
    //można dodać komunikat błędu na serwerze
    Memo1.Lines.Add('Błąd tworzenia katalogu: ' + Appdir + VDirectory);
  end;
end;


2.6. IdThreadComponent

Jednym z prostrzych sposobów zbudowania aplikacji nieblokującej działania podczas wykonywania poleceń INDY jest wykorzystanie komponentu IdThreadComponent. Dzięki niemu usykamy efekt wątkowości. Ogólny sposób użycia prezentuje poniższy schemat: 


procedure TForm1.btnConnect1Click(Sender: TObject);
begin
  //uruchomienie wątku
  IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent1Run(Sender: TIdThreadComponent);
begin
  //wykonywany kod w wątku
  {
  …np.: funkcje pobierania, wysyłania pliku IdFTP1.Get czy IdFTP1Put(),
  }

  //zatrzymanie wątku po wykonaniu kodu
  IdThreadComponent1.Stop;
end;





2.6.1. Przykład użycia w powiązaniu z pakietem TCP






procedure T Form1.Button1Click(Sender: TObject);
begin
  //wątek dla wysyłania wiadomości ...
  IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
begin
  IdTCPClient1.Host :=label1.Caption;
  if (richedit1.Lines.Text <> '') and (label1.Caption <> '') then
  begin
    if not IdTCPClient1.Connected then
    begin
      try
        IdTCPClient1.Connect(60);
        if IdTCPClient1.Connected then
        begin
          IdTCPClient1.Write(richedit1.Lines.Text);
          IdTCPClient1.Disconnect;
        end;
      except
        on exception do
        begin
            Memo1.Lines.Add('Wysłanie wiadomości do: ' 
                                         + label1.Caption + ' nie jest możliwe !!!');
        end;
    end;
  end;
  //zatrzymanie wątku
  IdThreadComponent1.Stop;
end;






W przypadku wystąpienia wyjątku zastosowano zapis stosownej informacji do kontrolki Memo, nie jest zalecane stosowanie okien powiadomień 
(np.: Showmessage() w połączeniu wątkiem.





2.6.2. Przykład użycia w powiązaniu z pakietem UDP






procedure T Form1.Button1Click(Sender: TObject);
begin
  //wątek dla wysyłania wiadomości ...
  IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
begin
  Id UDPClient1.Host :=label1.Caption;
  if (richedit1.Lines.Text <> '') and (label1.Caption <> '') then
  begin
    try
      IdUDPClient1. Send(richedit1.Lines.Text);
    except
      on exception do
      begin
          Memo1.Lines.Add('Wysłanie wiadomości do: ' 
                                         + label1.Caption + ' nie jest możliwe !!!');
    end;
  end;
  //zatrzymanie wątku
  IdThreadComponent1.Stop;
end;






Wykorzystanie wątku za pomocą komponentu ThreadComponent w odniesieniu do pakietu UDP jest  analogiczne jak w przypadku TCP, 
podobne rozwiązania stosuje się w odniesieniu do innych komponentów INDY.





2.6.3. Przykład użycia w powiązaniu z pakietem FTP




Wysyłanie pliku (IdFTP1.Put()):





procedure TForm1.Button1Click(Sender: TObject);
begin
  //uruchomienie wątku
 IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
var
  kontrolka : Integer;
  File_lokalny : String;
  localfile : string;
  remotefile : string;
begin

  label1.Visible := true;
  label1.Caption := '';

  Kontrolka:=ListView1.SelCount;
  try
    // jezeli puste pole to index = 0, jezeli pozycja wybrana to index = 1
    if kontrolka <> 0 then
    begin
      File_lokalny := ListView1.Selected.Caption;
      if directoryexists(Edit_kat_lokalny.Text + File_lokalny + '\') then
      begin
        Memo1.Lines.Add('Przesyłanie katalogu nie jest możliwe !!!');
      end;
      if fileexists(Edit_kat_lokalny.Text + File_lokalny) then
      begin
        if IdFTP1.Connected then
        begin
          IdFTP1.TransferType := ftBinary;
          localfile := Edit_kat_lokalny.Text + File_lokalny;
          remotefile := File_lokalny;

          label1.Caption := 'Wysyłanie ...';

          IdFTP1.Put(LocalFile, RemoteFile);

        end;
      end;
    end;
  except
    on exception do
    begin
      Memo1.Lines.Add('Błąd podczas wysyłania pliku !!!'
      + #13 + 'Nie można nawiązać połączenia FTP !!!'
      + #13 + 'Adres: ' + IdFTP1.Host + ' nieodpowiada.');
    end;
  end;

  label1.Caption := '';
  label1.Visible := false;

  //zatrzymanie wątku
  IdThreadComponent1.Stop;

end;






Pobieranie pliku (IdFTP1.Get()):





procedure TForm1.Button1Click(Sender: TObject);
begin
  //uruchomienie wątku
  IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent3Run(Sender: TIdCustomThreadComponent);
var
  kontrolka : Integer;
  File_zdalny : String;
  test : string;
  localfile : string;
  remotefile : string;
begin

  label1.Visible := true;
  label1.Caption := '';

  Kontrolka:=ListView1.SelCount;
  try
    // jezeli puste pole to index = 0, jezeli pozycja wybrana to index = 1
    if kontrolka <> 0 then
    begin
      File_zdalny := ListView1.Selected.Caption;
      test := ListView1.Selected.SubItems[0];
      if test = 'Dir' then
      begin
        showmessage('Pobranie katalogu nie jest możliwe !!!');
      end;
      if test <> 'Dir' then
      begin
        if IdFTP1.Connected then
        begin
          IdFTP1.TransferType := ftBinary;
          localfile := Edit_kat_lokalny.Text + File_zdalny;
          remotefile := File_zdalny;
          if fileexists(Edit_kat_lokalny.Text + File_zdalny) then
          begin
            Memo1.Lines.Add('Pobieranie przerwane !!!' 
            + #13 + 'Pobierany plik istnieje już na dysku lokalnym !!!');
          end;
          if not fileexists(Edit_kat_lokalny.Text + File_zdalny) then
          begin

            label1.Caption := 'Pobieranie ...';

            IdFTP1.get(RemoteFile, LocalFile);

          end;
        end;
      end;
    end;
  except
    on exception do
    begin
      Memo1.Lines.Add('Błąd podczas pobierania pliku !!!'
      + #13 + 'Nie można nawiązać połączenia FTP !!!'
      + #13 + 'Adres: ' + IdFTP1.Host + ' nieodpowiada.');
    end;
  end;

  label1.Caption := '';
  label1.Visible := true;

  //zatrzymanie wątku
  IdThreadComponent1.Stop;

end;






Odwołanie się do komórki ListView1 i sprawdzenie czy nie zawiera ona tekstu „Dir” oznaczającego katalog musi być poprzedzona wypełnieniem 
kontrolki ListView1 w momencie łączenia z serwerem. Przykładowy sposób pobrania danych z serwera oraz wypełnienia odpowiednimi wartościami 
kontrolki ListView1 przedstawia poniższy kod:




    

  • wywołanie połączenia:
    • 







procedure TForm1.Button1Click(Sender: TObject);
begin
  //uruchomienie wątku
  IdThreadComponent1.Start;
end;

procedure TForm1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
var
  kontrolka : integer;
begin
  inherited;
  kontrolka := 0;

  label1.Visible := true;
  label1.Caption := '';

  if (Edit_adres.Text = '') then
  begin
    Memo1.Lines.Add('Podaj adres IP adresata w sieci TCP/IP !!!');
  end;
  if Edit_adres.Text = '127.0.0.1' then
  begin
    Memo1.Lines.Add('Połączenie z adresem 127.0.0.1 nie jest obsługiwane !!!');
  end;
  try
    if (Edit_adres.Text <> '') and (Edit_adres.Text <> '127.0.0.1') and (kontrolka = 0) then
    begin

      IdFTP1.Username := 'test';  //nazwa użytkownika
      IdFTP1.Password := 'testowe';   //hasło użytkownika
      IdFTP1.Host := Edit_adres.Text;   //adres serwera
      if not IdFTP1.Connected then
      begin
        label1.Caption := 'Łączenie ...';

        IdFTP1.Connect();

        if IdFTP1.Connected then
        begin

          ListView1.Clear;  //wyczyszczenie kontrolki ListView1

          //ustawienie głównego katalogu wystawianego przez serwer
          Form1.kat_zdalny := IdFTP1.RetrieveCurrentDir;
          Form1.kat_zdalny_bezwzgledny := IdFTP1.RetrieveCurrentDir;
          edit_kat_zdalny.Text :=Form1.kat_zdalny;

          //wywołanie procedury wypełeniącej LsitView1
          ListView1();

          kontrolka := 1;
        end;
      end;
    end;
  except
    on exception do
    begin
      //Wypisanie na kontrolce ListView1 informacji o niepowodzeniu połączenia
      ListView1.Canvas.Font.Size := 10;
      ListView1.Canvas.Font.Color := clRed;
      ListView1.Canvas.TextOut(15, 30, 'Nie można nawiązać połączenia');
      ListView1.Canvas.TextOut(15, 50, 'z adresem: ' + IdFTP1.Host);
    end;
  end;

  //zatrzymanie wątka
  IdThreadComponent1.Stop;

  Label1.Visible := false;

end;







    

  • wypełnienie ListView1:
    • 







procedure TForm1.ListView1 ();
Var
  LS: TStringList;
  ind : integer;
  List_zdalny : TListItem;
  test_kat : string;
  plik_nazwa : string;
  plik_wielk : string;
  plik_data : string;
begin
  LS := TStringList.Create;
  try
    IdFTP1.ChangeDir(Form1.kat_zdalny);
    IdFTP1.TransferType := ftASCII;

    ListBox1.Items.Clear;
    IdFTP1.List(LS);
    LS.Sort;
    LS.Capacity;
    ListBox1.Items.Assign(LS);
    ind := 0;
    ListBox1.Selected[ind] := true;
    ListView_zdalny.Clear;
    while ind + 1 <= LS.Count  do // rob dopoki liczba zbalezionych plikow nie wyjdzie 
                                                    //poza zakres indeksu
    begin
      test_kat := copy(ListBox1.Items.Strings[ind], 24, 5);
      plik_nazwa := copy(ListBox1.Items.Strings[ind], 40,    
                             length(ListBox1.Items.ValueFromIndex[ind]));
      plik_wielk := copy(ListBox1.Items.Strings[ind], 28, 10);
      while pos(' ', plik_wielk) > 0 do
      begin
        delete(plik_wielk, 1, pos(' ', plik_wielk));
      end;

      plik_data := copy(ListBox1.Items.Strings[ind], 1, 23);

      //jeżeli główna ścieżka
      if Form1.kat_zdalny = '\' then
      begin
        //jeżeli katalog
        if (test_kat = '<DIR>') and (plik_nazwa <> '.') and (plik_nazwa <> '..') then
        begin
          List_zdalny := ListView1.Items.Add; // stworzenie nowej pozycji
          List_zdalny.Caption := '[' + plik_nazwa + ']';
          List_zdalny.SubItems.Add('Dir');
        end;
        //jeżeli plik
        if test_kat <> '<DIR>' then
        begin
          List_zdalny := ListView1.Items.Add; // stworzenie nowej pozycji
          List_zdalny.Caption := plik_nazwa;
          List_zdalny.SubItems.Add(plik_wielk);
          List_zdalny.SubItems.Add(plik_data);
        end;
      end;

      //jeżeli ścieżka podrzędna
      if Form1.kat_zdalny <> '\' then
      begin
        //jeżeli katalog
        if (test_kat = '<DIR>') and (plik_nazwa <> '.') then
        begin
          List_zdalny := ListView1.Items.Add; // stworzenie nowej pozycji
          List_zdalny.Caption := '[' + plik_nazwa + ']';
          List_zdalny.SubItems.Add('Dir');
        end;
        //jeżeli plik
        if test_kat <> '<DIR>' then
        begin
          List_zdalny := ListView1.Items.Add; // stworzenie nowej pozycji
          List_zdalny.Caption := plik_nazwa;
          List_zdalny.SubItems.Add(plik_wielk);
          List_zdalny.SubItems.Add(plik_data);
        end;
      end;

      ind := ind +1;
      if ind + 1 > LS.Count then
      begin
         break;
      end;
      ListBox1.Selected[ind] := true;
    end;
  finally
    LS.Free;
  end;
end;








2.7. PING - komponent IdIcmpClient (Internet Control Message Protocol)







Info


ICMP (Internet Control Message Protokol) jest drugim protokołem (podstawowym jest IP) warstwy Internetu i jest on ścicśle związany 
z protkołwem IP.Jego zadaniem jest przesyłanie komunikatów o nieprawidłowościach w pracy sieci. Pozwala on przesyłać wiadomości 
sterujące, które dotyczyć mogą: przepływu, testowania połączeń, wskazywania alternatywnych połączeń oraz wykrywania niedostępnych użytkowników.










Zastosowanie komponentu IdIcmpClient umożliwia pozyskać informacje zwiazane z funkcjonowaniem urządzeń w sieci np.: router’ów, stacji 
roboczych. Przesłanie polecenia ping i odebranie informacji umożliwia dokonać w/w kontroli. Za pomocą kontrolki IdIcmpClient pozyskać 
można również dodatkowe informacje związane z ilością przesyłanych bajtów, czasem życia, czasem oczekiwania na odpowiedź. 
Sposób użycia komponentu jest stosunkowo prosty. W aplikacji pisanej w Delphi należy umieścić na formie pole Edit (posłuży do 
wprowadzania adresu IP), przycisku Button (uruchomi wysyłanie pinga), komponentu Memo (zapisywane będą do komponentu informacje 
zwrotne). Ostatnim komponentem jaki umieszczamy na formie jest IdIcmpClient. 



W obsłudze zdarzenia OnCreate formy dodajemy:





procedure TForm1.FormCreate(Sender: TObject);
begin
  //wyczyszczenie pola Edit
  Edit1.Text := '';
  //wyczyszczenie komponentu Memo
  Memo1.Clear;
end;






W obsłudze zdarzenia OnClick przycisku Button dodajemy:





procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
begin
  //ustawiamy czas oczekiwania
  IdIcmpClient1.ReceiveTimeout := 1000;
  //wyłączamy dostępność przycisku button
  button1.Enabled := False;
  try
    //ustawiamy adres IP 
    IdIcmpClient1.Host := Edit1.Text;
    //wykonujemy pętlę 20 razy
    for i := 1 to 20 do begin
      //wysyłamy polecenie Ping
      IdIcmpClient1.Ping;
      //pozwalamy odetchnąć systemowi – obsłużyć komunikaty Windows
      Application.ProcessMessages;
      //dodatkowo można wykonać opóźnienie – w tym przypadku 1 sekundy
      sleep(1000);
    end;
  finally
    //finalizując włączamy dostępność przycisku button
    button1.Enabled := True;
  end;
end;






W obsłudze zdarzenia OnReply komponentu IdIcmpClient dodajemy:





procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;  //nowa zmienna typu string
begin
  //sprawdzanie błedów odpowiedzi ping'a (AReplyStatus.MsgType?)
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'  //ustawienie wartości zmiennej dla wartości mniejszych niż 1
  else
    sTime := '=';  //ustawienie wartości zmiennej

  //wypełnienie komponentu Memo odpowiednio: ilością przesłanych bajtów, 
  //kolejnym numerem ID, czasem życia, zmienną sTime, czasem oczekiwania na odpowiedź
  Memo1.Lines.Add(Format('%d bytes from %s: Sequence ID=%d TTL=%d Time%s%d ms',
    [AReplyStatus.BytesReceived,
    AReplyStatus.FromIpAddress,
    AReplyStatus.SequenceId,
    AReplyStatus.TimeToLive,
    sTime,
    AReplyStatus.MsRoundTripTime]));
end;






Cały kod programu:





unit icmp_clent_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient,
  StdCtrls;

type
  TForm1 = class(TForm)
    IdIcmpClient1: TIdIcmpClient;
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '';
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
begin
  IdIcmpClient1.ReceiveTimeout := 1000;
  button1.Enabled := False;
  try
    IdIcmpClient1.Host := Edit1.Text;
    for i := 1 to 20 do begin
      IdIcmpClient1.Ping;
      Application.ProcessMessages;
      sleep(1000);
    end;
  finally
    button1.Enabled := True;
  end;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
begin
  //sprawdzanie błedów odpowiedzi ping'a (AReplyStatus.MsgType?)
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';

  Memo1.Lines.Add(Format('%d bytes from %s: Sequence ID=%d TTL=%d Time%s%d ms',
    [AReplyStatus.BytesReceived,
    AReplyStatus.FromIpAddress,
    AReplyStatus.SequenceId,
    AReplyStatus.TimeToLive,
    sTime,
    AReplyStatus.MsRoundTripTime]));
end;

end. 








2.7.1. IdIcmpClient - przykład sprawdzający dostępność adresów IP w całym segmencie






unit ping_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdRawBase, IdRawClient, IdIcmpClient, IdBaseComponent, IdComponent,
  IdIPWatch, StdCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    RichEdit1: TRichEdit;
    IdIPWatch1: TIdIPWatch;
    IdIcmpClient1: TIdIcmpClient;
    lbl_local_ip: TLabel;
    lbl_numer_ip: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Button2: TButton;
    Edit4: TEdit;
    PopupMenu1: TPopupMenu;
    zapiszlog1: TMenuItem;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button3: TButton;
    Edit5: TEdit;
    Label5: TLabel;
    wyczyzawarto1: TMenuItem;
    CheckBox1: TCheckBox;
    procedure wyczyzawarto1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure zapiszlog1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    sc_programu : string;
    host, segment1, segment2, segment3, segment4 : string;
    operacja : integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //pobranie ścieżki dostępu do pliku exe naszej aplikacji
  sc_programu:=ExtractFilePath(ParamStr(0));
  //wyłaczenie historii komponentu IdIPWatch
  IdIPWatch1.HistoryEnabled := false;
   //ustawienie ścieżki dostępu do pliku z historią wraz z jego nazwą
  IdIPWatch1.HistoryFilename := sc_programu + 'iphist.dat';
  //pobranie adresu IP stacji roboczej
  lbl_local_ip.Caption := IdIPWatch1.LocalIP;
  lbl_numer_ip.Caption := '';

  Edit1.Text := IdIPWatch1.LocalIP;
  Edit2.Text := '1';
  Edit3.Text := '254';
  Edit4.Text := '2';
  Edit5.Text := '1000';

  //zwolnienie komponentu IdIPWatch
  IdIPWatch1.Free;

  RichEdit1.Clear;
  RichEdit1.PlainText := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j : integer;
begin
  if Edit1.Text <> '' then
  begin
    host := Edit1.Text;
    operacja := 1;

    segment1 := copy(host, 1, (Pos('.', host)) - 1);
    delete(host, 1, (Pos('.', host)));
    segment2 := copy(host, 1, (Pos('.', host)) - 1);
    delete(host, 1, (Pos('.', host)));
    segment3 := copy(host, 1, (Pos('.', host)) - 1);
    delete(host, 1, (Pos('.', host)));
    segment4 := host;

    //Showmessage('Segment: ' + segment1 + '-' + segment2 + '-' + segment3);
    Richedit1.SelAttributes.Color := clRed;
    Richedit1.SelAttributes.style := [fsBold];
    RichEdit1.Lines.Add('Start ... segment: ' + segment1 + '-' + segment2 + '-' 
	+ segment3);
    Button1.Enabled := false;
    IdIcmpClient1.ReceiveTimeout := strtoint(Edit5.Text);
    for j:=strtoint(Edit2.Text) to strtoint(Edit3.Text) do
    begin
      if operacja = 0 then
      begin
        break;
      end;
      for i:= 1 to strtoint(edit4.Text) do
      begin
        if operacja = 0 then
        begin
          break;
        end;
        IdIcmpClient1.Host := segment1 + '.' + segment2 + '.' + segment3 + '.' 
		+ inttostr(j);
        lbl_numer_ip.Caption := 'Sprawdzam: ' + IdIcmpClient1.Host;
        Application.ProcessMessages;
        try
          IdIcmpClient1.Ping;
        Except
          //
        end;
        Application.ProcessMessages;
        sleep(100);
      end;
    end;
    Button1.Enabled := true;
    Richedit1.SelAttributes.Color := clRed;
    Richedit1.SelAttributes.style := [fsBold];
    RichEdit1.Lines.Add('... stop !');
  end;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime : string;
begin
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'  //ustawienie wartości zmiennej dla wartości mniejszych niż 1
  else
    sTime := '=';  //ustawienie wartości zmiennej
  if (AReplyStatus.MsRoundTripTime >= 1000) and (not CheckBox1.Checked) then
  begin
    Richedit1.SelAttributes.Color := clBlack;
    Richedit1.SelAttributes.style := [];
    RichEdit1.Lines.Add(IdIcmpClient1.Host + ' - time out (' +  
                                      inttostr(AReplyStatus.MsRoundTripTime) + ')');
  end;
  if (AReplyStatus.MsRoundTripTime < 1000) then
  begin
    Richedit1.SelAttributes.Color := clNavy;
    Richedit1.SelAttributes.style := [fsBold];
    RichEdit1.Lines.Add(Format('%d bytes from %s: Sequence ID=%d TTL=%d Time%s%d ms',
      [AReplyStatus.BytesReceived,
      AReplyStatus.FromIpAddress,
      AReplyStatus.SequenceId,
      AReplyStatus.TimeToLive,
      sTime,
      AReplyStatus.MsRoundTripTime]));
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  operacja := 0;
end;

procedure TForm1.zapiszlog1Click(Sender: TObject);
begin
  RichEdit1.Lines.SaveToFile(sc_programu + segment1 + '-' + segment2 + '-' + segment3 
                                               + '.txt');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  operacja := 0;
  Application.ProcessMessages;
  lbl_numer_ip.Caption := 'Kończenie działania programu ...';
  Application.ProcessMessages;
  close;
end;

procedure TForm1.wyczyzawarto1Click(Sender: TObject);
begin
  RichEdit1.Clear;
end;

end.








2.8. Komponent IdIPWatch




Komponent IdIPWatch pozwala w prosty sposób pobrać adres IP zestawu na którym uruchamiamy naszą aplikację. Po umieszczeniu na formie komponentu 
IdIPWatch należy obsłużyć np.: zdarzenie OnCreate formy dodając w niej funkcje obsługi koponentu IdIPWatch jak przedstawia poniższy przykład:





var
  sc_programu : string;  //nowa zmienna typu string
  local_ip : string;  //nowa zmienna typu string
begin
  //pobranie ścieżki dostępu do pliku exe naszej aplikacji
  sc_programu:=ExtractFilePath(ParamStr(0));
  //wyłaczenie historii komponentu IdIPWatch
  IdIPWatch1.HistoryEnabled := false;
   //ustawienie ścieżki dostępu do pliku z historią wraz z jego nazwą
  IdIPWatch1.HistoryFilename := sc_programu + 'iphist.dat';
  //pobranie adresu IP stacji roboczej
  local_ip := IdIPWatch1.LocalIP;
  //zwolnienie komponentu IdIPWatch
  IdIPWatch1.Free; 
end;








2.9. Komponent IdConnectionIntercept 




W/w komponent pozwala nam uzyskać wiecej informacji na temat zestawionego połączenia a zwłaszcza podczas transmisji (pakiety przychodzące oraz 
wychodzące). Na poniższym przykładzie widzimy prostą metodę jego zastosowania:



Przychodzące:





procedure Tklient_ftp_form.IdConnectionIntercept1Receive(
  ASender: TIdConnectionIntercept; AStream: TStream);
var
  Text: string;
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create('');
  try
    StrStream.CopyFrom(AStream, AStream.Size);
    Text := Trim(StrStream.DataString);
    log_intercept := Text;
    RichEdit1.Lines.Add('<<- ' + Text);
  finally
    StrStream.Free;
  end;
end;






Wychodzące:





procedure Tklient_ftp_form.IdConnectionIntercept1Send(
  ASender: TIdConnectionIntercept; AStream: TStream);
var
  Text: string;
  StrStream: TStringStream;
begin
  StrStream := TStringStream.Create('');
  try
    StrStream.CopyFrom(AStream, AStream.Size);
    Text := Trim(StrStream.DataString);
    if pos('PASS', Text) > 0 then
    begin
      RichEdit1.Lines.Add('->> Password ...');
    end;
    if pos('PASS', Text) = 0 then
    begin
      RichEdit1.Lines.Add('->> ' + Text);
    end;
  finally
    StrStream.Free;
  end;
end;