Sockets - usando os sockets do Delphi

{ Sockets completo

Instalando os compoentes no Delphi 7

Para isso vá no menu Component | Install Packages... 

Na janela que ira surgir clique no botão Add... e procure pelo arquivo dclsockets70.bpl. 

De OK e pronto! Os componentes irão aparecer na palleta Internet. 

Agora vamos direto ao Assunto

  TserverSocket – Este componente como o nome já diz é o SERVIDOR. 

  Ele será responsável por receber as conexões. De quem? Dos TClientSocket! 

  É importante perceber este conceito em que cada TclientSocket conecta a um e somente um servidor. 

  Sempre que você quiser fazer uma comunicação usara no mínimo um Server e um Client 

  (Vamos passar a chamá-los assim OK?) Um outro detalhe super importante é que no caso do servidor ele 

  recebe um integer de conexões.

  TclientSocket – Este componente como o nome já diz é o CLIENTE. 

  É com ele que conectamos aos servidores. Pense nele como a janela do seu browser.

  Com ele podemos nos conectar em qualquer servidor. Mas para isso temos que fazer alguns 

  ajustes que veremos a seguir. Por enquanto é importante pegar o conceito de que cada Client se 

  liga somente e diretamente a um Server e o Server poder receber vários Clients. De cara pode 

  surgir a seguinte duvida: Ora, se o client está ligado no servidor como faço para ele falar 

  com outro client ??? Não tem saída meu caro! Sempre vai passar pelo servidor, não há mágica,

  o que vai acontecer que iremos informar ao servidor o destinatário final da mensagem quando

  o servidor receber e “perceber” que a mensagem deve se entregue a outro Client, ele irá enviar

  uma mensagem ao Client correspondente. Isso é o protocolo de comunicação, ele é pessoal e 

  cada um vai implementar como achar melhor.

  http://www.activedelphi.com.br/modules.php?op=modload&name=News&file=article&sid=249&mode=thread&order=0&thold=0

}

--- Form SERVER

object ServidorForm: TServidorForm

  Left = 564

  Top = 108

  BorderStyle = bsDialog

  Caption = 'SERVER - [Agente]'

  ClientHeight = 462

  ClientWidth = 320

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  Position = poScreenCenter

  OnClose = FormClose

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object Memo1: TMemo

    Left = 8

    Top = 8

    Width = 305

    Height = 445

    Color = clBlack

    Font.Charset = DEFAULT_CHARSET

    Font.Color = clYellow

    Font.Height = -11

    Font.Name = 'MS Sans Serif'

    Font.Style = []

    ParentFont = False

    ScrollBars = ssVertical

    TabOrder = 0

  end

  object ServidorSocket: TServerSocket

    Active = False

    Port = 2200

    ServerType = stNonBlocking

    OnClientConnect = ServidorSocketClientConnect

    OnClientDisconnect = ServidorSocketClientDisconnect

    OnClientRead = ServidorSocketClientRead

    Left = 52

    Top = 32

  end

end

--- Unit SERVER

unit ServidorUnit;

interface

uses Forms, Classes, Controls, StdCtrls, mLib, ScktComp, SysUtils;

type

  TServidorForm = class(TForm)

    Memo1: TMemo;

    ServidorSocket: TServerSocket;

    procedure ServidorSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);

    procedure FormCreate(Sender: TObject);

    procedure ServidorSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);

    procedure ServidorSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    function LocalizaCliente(Cli: Pointer): Integer;

  public

    IDConexoes: TList;

  end;

var

  ServidorForm: TServidorForm;

implementation

{$R *.dfm}

procedure TServidorForm.ServidorSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);

var

  Msg     : String;

  IDCli, I: Integer;

  L       : TStringList;

begin

  Msg := socket.ReceiveText;

  // comando que solicita a data/hora do servidor

  if Msg = 'DataHora' then

  Begin

    IDCli := LocalizaCliente(Socket.Data);

    if IDCli >= 0 then

      ServidorSocket.Socket.Connections[IDCli].SendText(mStr.FormataHora(Now));

  end;

  // comando Lista pastas

  if mStr.Separa(Msg, ';', 1) = 'ListaPasta' then

  Begin

    IDCli := LocalizaCliente(Socket.Data);

    if IDCli >= 0 then

    begin

      L := TStringList.Create;

      mFile.GetFiles(L, mStr.Separa(Msg, ';', 2));

      for I := 0 to L.Count-1 do

        ServidorSocket.Socket.Connections[IDCli].SendText(L[I] + '¿');

      L.Free;

    end;

  end;

  Memo1.Lines.Add('Recebi de ' + Socket.LocalAddress + ' o comando ' + Msg);

end;

procedure TServidorForm.FormCreate(Sender: TObject);

begin

  IDConexoes := TList.Create;

  IDConexoes.Clear;

  // ativa o servidor

  ServidorSocket.Active := True;

end;

procedure TServidorForm.ServidorSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);

var

  IDsocket: ^Byte;

begin

 // adiciona o client na lista

 New(IDSocket);

 Socket.Data := IDSocket;

 IDConexoes.Add(Socket.data);

 Memo1.Lines.Add('Frente conectou -> ' + Socket.LocalAddress);

end;

procedure TServidorForm.ServidorSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);

begin

  Memo1.Lines.Add('Frente desconectou -> ' + Socket.LocalAddress);

  // remove o client da lista

  IDConexoes.Remove(Socket.Data);

  Dispose(Socket.Data);

end;

function TServidorForm.LocalizaCliente(Cli: Pointer): Integer;

begin

  Result := IDConexoes.IndexOf(Cli);

end;

procedure TServidorForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  IDConexoes.Free;

end;

end.

================================================================================

Form CLIENT

object Form1: TForm1

  Left = 337

  Top = 103

  BorderStyle = bsDialog

  Caption = 'CLIENT - [Frente]'

  ClientHeight = 479

  ClientWidth = 473

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object ServidorEdit: TAEdit

    Left = 12

    Top = 24

    Height = 21

    TabOrder = 0

    Text = '127.0.0.1'

    EditLabel.Width = 82

    EditLabel.Height = 13

    EditLabel.Caption = 'Servidor [Agente]'

    LabelSize = 0

  end

  object EnviarBtn: TButton

    Left = 12

    Top = 148

    Width = 75

    Height = 25

    Caption = 'Enviar'

    TabOrder = 1

    OnClick = EnviarBtnClick

  end

  object Desconectar: TButton

    Left = 12

    Top = 184

    Width = 75

    Height = 25

    Caption = 'Desconectar'

    TabOrder = 2

    OnClick = DesconectarClick

  end

  object Memo1: TMemo

    Left = 148

    Top = 8

    Width = 321

    Height = 465

    Color = clBlack

    Font.Charset = DEFAULT_CHARSET

    Font.Color = clLime

    Font.Height = -11

    Font.Name = 'MS Sans Serif'

    Font.Style = []

    ParentFont = False

    ScrollBars = ssVertical

    TabOrder = 3

  end

  object ComandoEdit: TACombo

    Left = 12

    Top = 68

    Width = 121

    Height = 21

    CharCase = ecNormal

    Items.Strings = (

      'DataHora'

      'ListaPasta')

    TabOrder = 4

    EditLabel.Width = 45

    EditLabel.Height = 13

    EditLabel.Caption = 'Comando'

  end

  object ParametrosEdit: TAEdit

    Left = 12

    Top = 116

    Height = 21

    TabOrder = 5

    Text = 'C:\*.*'

    EditLabel.Width = 53

    EditLabel.Height = 13

    EditLabel.Caption = 'Parametros'

    LabelSize = 0

  end

  object ClienteSocket: TClientSocket

    Active = False

    ClientType = ctNonBlocking

    Host = '127.0.0.1'

    Port = 2200

    OnDisconnect = ClienteSocketDisconnect

    OnRead = ClienteSocketRead

    OnError = ClienteSocketError

    Left = 224

    Top = 84

  end

end

--- Unit CLIENT

unit ClienteUnit;

interface

uses Forms, mLib, Controls, StdCtrls, ACombo, Classes, Mask, AEdit,

  ScktComp;

type

  TForm1 = class(TForm)

    ServidorEdit: TAEdit;

    EnviarBtn: TButton;

    Desconectar: TButton;

    Memo1: TMemo;

    ComandoEdit: TACombo;

    ParametrosEdit: TAEdit;

    ClienteSocket: TClientSocket;

    procedure EnviarBtnClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure ClienteSocketRead(Sender: TObject; Socket: TCustomWinSocket);

    procedure ClienteSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);

    procedure ClienteSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);

    procedure DesconectarClick(Sender: TObject);

  private

  public

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.EnviarBtnClick(Sender: TObject);

var

  Comando: string;

begin

  if not ClienteSocket.Active then

  begin

    ClienteSocket.Host   := ServidorEdit.Text;

    ClienteSocket.Active := True;

    mRot.Delay(1000);

  end;

  Comando := ComandoEdit.Text;

  if not ParametrosEdit.Vazio then Comando := Comando + ';' + ParametrosEdit.Text;

  ClienteSocket.Socket.SendText(Comando);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  ComandoEdit.ItemIndex := 0;

end;

procedure TForm1.ClienteSocketRead(Sender: TObject; Socket: TCustomWinSocket);

var

  S: string;

  I: Integer;

begin

  S := ClienteSocket.Socket.ReceiveText;

  if Pos('¿', S) > 0 then

  begin

    for I := 1 to mStr.Ocorre(S, '¿') do

      Memo1.Lines.Add(mStr.Separa(S, '¿', I));

  end

  else

    Memo1.Lines.Add(S);

end;

procedure TForm1.ClienteSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);

begin

  ErrorCode := 0; // abafa erros!?

end;

procedure TForm1.ClienteSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);

begin

  Memo1.Lines.Add('desconectou');

end;

procedure TForm1.DesconectarClick(Sender: TObject);

begin

  ClienteSocket.Active := False;

end;

end.