ربط جهازين و تبادل المعلومات في شبكة محليةباستخدام مكونات indy

كود :
unit chat1;

{

Chat application with Delphi source

http://delphi.about.com/library/weekly/aa101105a.htm

Full Delphi source to code to a simple Chat application.
Learn how UDP (User Datagram Protocol) broadcast can be
used to find partners with unknown IP addresses in the network.

Programming by Michael Schnell
Brought to you by Zarko Gajic

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdSocketHandle, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Edit2: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    Activated: Boolean;
    procedure SearchEvent(ResultIP, ResultName: String);
    procedure UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure UDPException(Sender: TObject);
  public
  end;

var
  Form1: TForm1;

implementation

uses UDP;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  UDPSearchForm.SearchEvent := SearchEvent;
  UDPSearchForm.Left := Left;
  UDPSearchForm.Top := Top;
  UDPSearchForm.AktIP := Edit1.Text;
  UDPSearchForm.SearchPartner;
end;

procedure TForm1.SearchEvent(ResultIP, ResultName: String);
begin
  Edit1.Text := ResultIP;
  Label1.Caption := ResultName;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  s, s2: String;
begin
  if Activated then exit;
  Memo1.Clear;
  Activated := true;
  UDPSearchForm.OnUDPRead := UDPRead;
  UDPSearchForm.OnException := UDPException;
  UDPSearchForm.Active := true;
  s := UDPSearchForm.LocalAddress;
  s2 := UDPSearchForm.WSGetHostByAddr(s);
  Memo1.Lines.Add('I''m (' + s + ') ' + s2);
end;

procedure TForm1.UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Buffer: Array [0..2047] of Byte;
  count: Integer;
  PeerIP: String;
  PeerPort: Integer;
  s, ss: String;
  i: Integer;
begin
  PeerIP := ABinding.PeerIP;
  PeerPort:= ABinding.PeerPort;
  count := AData.Size;
  if count > Length(Buffer) then begin
    exit;
  end;
  AData.Read(Buffer, count);
  if (Buffer[0] <> $00) and  (Buffer[0] <> $01) then begin  // not search
    Edit1.Text:= PeerIP;
  end;
  case Buffer[0] of
   $00: begin   // search request
    case count of
     4: begin
      case Buffer[1] of
       0: begin
        Buffer[0] := $01;
        UDPSearchForm.Host := PeerIP;
        UDPSearchForm.DoSend(Buffer, 4, Length(Buffer));
        Memo1.Lines.Add('Inquiry [' + UDPSearchForm.WSGetHostByAddr(PeerIP) + '(' + PeerIP + ')' +          ' Port: ' + IntToStr(PeerPort) +
          ']');
       end;
      end;
     end;
    end;
   end;
   $01: begin // Search Reply
    case count of
     4: begin
      case Buffer[1] of
       0: begin
        ss := UDPSearchForm.WSGetHostByAddr(PeerIP);
        s := '[' + ss + '(' + PeerIP + ')' +
          ' Client Port: ' + IntToStr(PeerPort) +
          ']';
        Memo1.Lines.Add('Inquiry Reply ' + s);
        if PeerIp = UDPSearchForm.LocalAddress then begin
          ss := '<myself>' + ss;
        end;
        UDPSearchForm.Add(PeerIP, ss);
       end;
      end;
     end;
    end;
   end;
   $10: begin // Text
    case Buffer[1] of
     0: begin
      s := '';
      for i := 4 to count-1 do begin
        s := s + char(Buffer[i]);
      end;
      Memo1.Lines.Add(PeerIP+'->' + s);
     end;
    end;
   end;
  end;
end;

procedure TForm1.UDPException(Sender: TObject);
begin
  //nothing
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  x: Array[0..100] of Byte;
  i: Integer;
begin
  UDPSearchForm.Host := Edit1.Text;
  UDPSearchForm.Active := true;
  x[0] := $10; // Text
  x[1] := 0;   // Type 0
  for i := 1 to Length(Edit2.Text) do begin
    x[i+3] := Byte(Edit2.Text[i]);
  end;
  UDPSearchForm.DoSend(x, 4+Length(Edit2.Text), length(x));
end;

end.

///////////////////////////////////////////////////////////////////

unit UDP;

interface

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

type
  TUDPSearchEvent = Procedure(ResultIP, ResultName: String) of Object;
  TUDPSearchForm = class(TForm)
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    IdUDPServer1: TIdUDPServer;
    IdUDPClient1: TIdUDPClient;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FLocalAddress: String;
    FActive: Boolean;
    FServerPort: Integer;
    FOnUDPRead: TUDPReadEvent;
    FHost: String;
    FOnException: TNotifyEvent;
    procedure SetActive(const Value: Boolean);
    procedure SetOnUDPRead(const Value: TUDPReadEvent);
    procedure SetHost(const Value: String);
    procedure ErrorDialog(Message: String; HelpContext: THelpContext);
    procedure SetOnException(const Value: TNotifyEvent);
  public
    AktIP: String;
    ReceiverForm2Event: TUDPSearchEvent;
    procedure SearchPartner;
    procedure Add(IP, Name: String);
    function WSGetHostByAddr(s: String) : String;
    function WSGetHostByName(s: String) : String;
    function ResolveHost(s: String) : String;
    function DoSend(var xt; Size, MaxSize: Integer): Integer;
    function PeerIP: String;
    property SearchEvent: TUDPSearchEvent read ReceiverForm2Event write ReceiverForm2Event;
    property LocalAddress : String read FLocalAddress;
    property Active: Boolean read FActive write SetActive;
    property Host: String read FHost write SetHost;
    property OnUDPRead: TUDPReadEvent read FOnUDPRead write SetOnUDPRead;
    property OnException: TNotifyEvent read FOnException write SetOnException;
  end;

var
  UDPSearchForm: TUDPSearchForm;

implementation

{$R *.dfm}
const
  UDPDefaultPort = 8760;

var
  MessageCount : Word;

procedure TUDPSearchForm.Add(IP, Name: String);
var
  s: String;
begin
   s := Name + '(' + IP + ')';
   RadioGroup1.Items.Add(s);
   Height := 50 + RadioGroup1.Items.Count * 13;
   if Name[1] = '<' then begin
     exit;
   end;
   if IP = AktIP then begin
     RadioGroup1.ItemIndex := RadioGroup1.Items.Count-1;
     exit
   end;
   if RadioGroup1.ItemIndex < 0 then begin
     RadioGroup1.ItemIndex := RadioGroup1.Items.Count-1;
     exit;
   end;
end;

procedure TUDPSearchForm.Button1Click(Sender: TObject);
var
  s, ResultIP, ResultName: String;
  p: Integer;
begin
  if RadioGroup1.Items.Count = 0 then begin
    Hide;
    Exit
  end;
  if RadioGroup1.ItemIndex < 0 then Exit;

  s := RadioGroup1.Items[RadioGroup1.ItemIndex];
  p := pos('(', s);
  ResultName := copy(s, 1, p-2);
  if p = 2 then exit;  // Error
  s := copy(s, p+1, High(Integer));
  p := pos(')', s);
  if p < 4 then exit;  // Error
  s := copy(s, 1, p-1);
  ResultIP := s;
  Hide;
  ReceiverForm2Event(ResultIP, ResultName);
end;

procedure TUDPSearchForm.SearchPartner;
var
  x: Array[0..3] of Byte;
begin
  RadioGroup1.Items.Clear;
  RadioGroup1.ItemIndex := -1;
  Height := 50+13;
  Top := Top;
  Left := left;
  Show;
  IdUDPClient1.Host := '255.255.255.255';
  IdUDPClient1.Active := true;
  IdUDPClient1.BroadcastEnabled := True;
  x[0] := $00; // Search Receivers
  x[1] := $00; // Search
  x[2] := MessageCount div $100;
  x[3] := MessageCount mod $100;
  inc(MessageCount);
  IdUDPClient1.Port := UDPDefaultPort;
  IdUDPClient1.SendBuffer(x, 4);
  IdUDPClient1.BroadcastEnabled := False;
end;

procedure TUDPSearchForm.FormCreate(Sender: TObject);
begin
  FLocalAddress := GStack.LocalAddress;
  IdUDPClient1.Port := UDPDefaultPort;
  IdUDPClient1.Binding.Port := UDPDefaultPort;     // Has no effect. why ?
  IdUDPServer1.DefaultPort := UDPDefaultPort;
end;

function TUDPSearchForm.WSGetHostByAddr(s: String): String;
begin
  Result := GStack.WSGetHostByAddr(s);
end;

function TUDPSearchForm.WSGetHostByName(s: String): String;
begin
  Result := GStack.WSGetHostByName(s);
end;

function TUDPSearchForm.ResolveHost(s: String): String;
begin
  Result := GStack.ResolveHost(s);
end;


function TUDPSearchForm.DoSend(var xt; Size, MaxSize: Integer): Integer;
var
  x: Array[0..3] of Byte absolute xt;
begin
  x[2] := MessageCount div $100;
  x[3] := MessageCount mod $100;
  inc(MessageCount);
  IdUDPClient1.SendBuffer(xt, Size);
  Result := Size;
end;

procedure TUDPSearchForm.ErrorDialog(Message: String; HelpContext: THelpContext);
begin
  MessageDlg(Message, mtError, [mbOK], HelpContext);
end;

procedure TUDPSearchForm.SetActive(const Value: Boolean);
begin
  FActive := Value;
  try
    IdUDPServer1.Active := Value;
   except
     on E: Exception do begin
       IdUDPServer1.Bindings.Clear;
       if assigned(FOnException) then FOnException(self);
       ErrorDialog(E.Message, E.HelpContext);
       Application.Terminate;
     end;  
  end;
  IdUDPServer1.BroadcastEnabled := true;
end;

procedure TUDPSearchForm.SetOnUDPRead(const Value: TUDPReadEvent);
begin
  FOnUDPRead := Value;
  IdUDPServer1.OnUDPRead := Value;
end;

procedure TUDPSearchForm.SetHost(const Value: String);
begin
  FHost := Value;
  IdUDPClient1.Host := Value;
end;


function TUDPSearchForm.PeerIP: String;
begin
   Result := IdUDPServer1.Binding.PeerIP;
end;

procedure TUDPSearchForm.SetOnException(const Value: TNotifyEvent);
begin
  FOnException := Value;
end;

end.