Socket - transferindo arquivos

By Rafael Jeremias em 22 setembro 2006, 17:25 - testado no Delphi 2006

Server - Unit

unit MainUnit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  IdContext, IdCustomTCPServer, IdTCPServer, Dialogs, IdBaseComponent, IdComponent, Buttons;

type

  TForm1 = class(TForm)

    Server: TIdTCPServer;

    ativarBtn: TSpeedButton;

    procedure ServerExecute(AContext: TIdContext);

    procedure FormCreate(Sender: TObject);

    procedure ativarBtnClick(Sender: TObject);

  private

    ArqTmp           : TMemoryStream;

    TamanhoArquivo   : integer;

    RecebendoArquivo : boolean;

    function ligar   :boolean;

    procedure desligar;

  end;

var

  Form1: TForm1;

implementation

uses IdIOHandler;

{$R *.dfm}

procedure TForm1.ativarBtnClick(Sender: TObject);

begin

  ligar;

end;

procedure TForm1.desligar;

begin

  Server.Active  := false;

  ativarBtn.Down := false;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  desligar;

  RecebendoArquivo := false;

end;

function TForm1.ligar: boolean;

begin

  try

    Server.Active  := true;

    ativarBtn.Down := true;

    result         := true;

  finally

    result := false;

  end;

end;

procedure TForm1.ServerExecute(AContext: TIdContext);

Var

  TamBuffer : integer;

  pAux      : pointer;

begin

  if not RecebendoArquivo then

  begin

    TamanhoArquivo   := AContext.Connection.IOHandler.ReadInteger;

    RecebendoArquivo := TamanhoArquivo > 0;

    if ArqTmp = nil then

      ArqTmp := TMemoryStream.Create;

  end

  else

  begin

    AContext.Connection.IOHandler.InputBufferToStream(ArqTmp);

    if TamanhoArquivo = ArqTmp.Size then

    begin

      RecebendoArquivo := false;

      ArqTmp.SaveToFile('c:\recebe.rar');

      ShowMessage ('Transferencia completa');

      freeAndNil(ArqTmp);

    end;

  end;

end;

end.

Server - Form

object Form1: TForm1

  Left = 0

  Top = 0

  BorderStyle = bsDialog

  Caption = 'Server'

  ClientHeight = 33

  ClientWidth = 244

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object ativarBtn: TSpeedButton

    Left = 8

    Top = 3

    Width = 27

    Height = 25

    AllowAllUp = True

    GroupIndex = 1

    Glyph.Data = {

      76010000424D7601000000000000760000002800000020000000100000000100

      04000000000000010000C40E0000C40E00001000000000000000000000000000

      8000008000000080800080000000800080008080000080808000C0C0C0000000

      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00666666666666

      6666666666FFFFF6666666666000006666666666F777776FF666666005555500

      6666666776FF66776F6666055FF5555506666676677FF66676F660555FFF5555

      506667F66777FF6667F660555FFFF5555066676667777FF6676F055555FFFF55

      55067F66667777FF667F055555FFFFF555067F666F77777FF67F0555FFFFFFF5

      55067F667777777FF67F0555FFFFFF5555067F66777777FF667F05555FFFFFF5

      550676F66777777FF67660555FFFFFFF506667F667777777F7F6605555FFFFFF

      5066676F66777777676666055555555506666676FF66666F7666666005555500

      6666666776FFFF77666666666000006666666666677777666666}

    NumGlyphs = 2

    OnClick = ativarBtnClick

  end

  object Server: TIdTCPServer

    Bindings = <>

    DefaultPort = 8888

    MaxConnections = 99

    OnExecute = ServerExecute

    Left = 40

    Top = 4

  end

end

Client - Unit

unit mainUnit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, Buttons, StdCtrls, Mask, AEdit;

type

  TForm1 = class(TForm)

    servidorEdit: TAEdit;

    enviarBtn: TBitBtn;

    Dlg: TOpenDialog;

    Client: TIdTCPClient;

    procedure FormCreate(Sender: TObject);

    procedure enviarBtnClick(Sender: TObject);

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

  private

    fArqTmp : TMemoryStream;

    function ligar:boolean;

  public

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

uses

  mLib;

procedure TForm1.enviarBtnClick(Sender: TObject);

begin

  if not(ligar) then

    exit;

  if Dlg.Execute then

  begin

    fArqTmp.Clear; // Limpo o stream

    fArqTmp.LoadFromFile(Dlg.FileName); // Carrego

    Client.Socket.Write(fArqTmp.Size); // Envio o inteiro

    Client.Socket.Write(fArqTmp, fArqTmp.Size); // Envio o inteiro

    Client.Socket.WriteBufferFlush;

    Client.Disconnect;

  end;

end;

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

begin

  fArqTmp.free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  Client.Disconnect;

  fArqTmp := TMemoryStream.Create;

end;

function TForm1.ligar:boolean;

begin

  try

    mDlg.informaAbort(trim(servidorEdit.Text) = '', 'Informe o ip do servidor!', servidorEdit);

    Client.Disconnect;

    Client.Host := servidorEdit.Text;

    Client.Connect;

    mRot.Delay(1000);

    result := true;

  except

    result := false;

  end;

end;

end.

Client - Form

object Form1: TForm1

  Left = 0

  Top = 0

  BorderIcons = [biSystemMenu]

  BorderStyle = bsDialog

  Caption = 'Client'

  ClientHeight = 85

  ClientWidth = 214

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnClose = FormClose

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object servidorEdit: TAEdit

    Left = 8

    Top = 24

    Width = 197

    Height = 21

    TabOrder = 0

    Text = '192.168.50.7'

    EditLabel.Width = 40

    EditLabel.Height = 13

    EditLabel.Caption = 'Servidor'

    LabelSize = 0

  end

  object enviarBtn: TBitBtn

    Left = 112

    Top = 51

    Width = 94

    Height = 25

    Caption = 'Enviar'

    TabOrder = 1

    OnClick = enviarBtnClick

    Glyph.Data = {

      EE000000424DEE000000000000007600000028000000100000000F0000000100

      04000000000078000000C40E0000C40E00001000000000000000000000000000

      8000008000000080800080000000800080008080000080808000C0C0C0000000

      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00AAAAAAAAAAAA

      AAAAAAAAAAAAAAAAAAAAAAA0000000000000AAA0FFFF88FFFFF0AAA0FFFF898F

      FFF0A88788888998FFF09899899999998FF09899899999999FF09A99F9999999

      FFF0AAA0FFFF899FFFF0AAA0FFFF89FFFFF0AAA0FFFFFFFFFFF0AAA000000000

      0000AAA0CCCCCCCFCFC0AAA0000000000000}

  end

  object Dlg: TOpenDialog

    Left = 8

    Top = 40

  end

  object Client: TIdTCPClient

    ConnectTimeout = 0

    IPVersion = Id_IPv4

    Port = 8888

    ReadTimeout = -1

    Left = 40

    Top = 40

  end

end