Форум программистов [Powered by Invision Power Board]

Код



сервер

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ScktComp, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    ServerSocket1: TServerSocket;
    Panel1: TPanel;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Edit2: TEdit;
    procedure N3Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
// Procedure SendFileBySocket(filename: string);

    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.N3Click(Sender: TObject);
begin
ServerSocket1.Active:=true;
memo1.Lines.Add('open');
end;


procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var
  s:string;
  begin
  s:=Socket.ReceiveText;
  memo1.Lines.Add(s);
end;

end.


КЛИЕНТ

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, ComCtrls, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    ClientSocket1: TClientSocket;
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    Comands1: TMenuItem;
    Activetrue1: TMenuItem;
    send1: TMenuItem;
    procedure Activetrue1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure send1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Reciving: boolean;
  DataSize: integer;
  Data: TMemoryStream; 
implementation

{$R *.dfm}


procedure TForm1.Activetrue1Click(Sender: TObject);
begin
ClientSocket1.Active:=true;
end;


procedure TForm1.send1Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText('Are you ready');
end;

Код


unit Unit1;

interface

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

const
  CR=#13;
  LF=#10;

type

  TForm1 = class(TForm)
    ss: TServerSocket;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure ssClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ssClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ssClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ssListen(Sender: TObject; Socket: TCustomWinSocket);
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    FList: TStringlist;
  public
    procedure Disp(const s: String; Sock: Pointer);
    procedure DelFromList(Sock: Pointer);
    procedure AddBuf(Sock: Pointer; const Str: String);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
begin
  ss.Port := 9999;
  ss.Open;
end;

procedure TForm1.Disp(const s: String; Sock: Pointer);
begin
  Memo1.Lines.Add(FormatDateTime('hh:nn:ss ',now)+'Socket:'+IntToStr(Integer(Sock))+' '+s);
end;

procedure TForm1.ssClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Disp('Client Connect',Socket);
  FList.AddObject('',Socket)
end;

procedure TForm1.ssClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Disp('Client Disconnect',Socket);
  DelFromList(Socket);
end;

procedure TForm1.ssClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  Disp('Error:'+SysErrorMessage(ErrorCode),Socket);
  ErrorCode := 0;
  Socket.Close;
  DelFromList(Socket);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FList := TStringList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FList.Free;
end;

procedure TForm1.ssListen(Sender: TObject; Socket: TCustomWinSocket);
begin
  Disp('Server listen',Socket);
end;

procedure TForm1.DelFromList(Sock: Pointer);
var
  i: Integer;
begin
  for i := 0 to FList.Count-1 do
  begin
    if FList.Objects[i]=Sock then
    begin
      FList.Delete(i);
      Exit;
    end;
  end;
end;

procedure TForm1.AddBuf(Sock: Pointer; const Str: String);
var
  i: Integer;
  pz: Integer;
  s: String;
begin
  for i := 0 to FList.Count-1 do
  begin
    if FList.Objects[i]=Sock then
    begin
      FList[i] := FList[i]+Str;
      pz := Pos(CR,FList[i]);

      while pz>0 do
      begin
        s := FList[i];
        s := Copy(FList[i],1,pz-1);
        Disp('Received:'+s,Sock);
        Disp('Echo:'+s,Sock);
        TCustomWinSocket(Sock).SendText(s+CR+LF);
        FList[i] := Copy(FList[i],pz+1,Length(Flist[i])-pz);
        pz := Pos(CR,FList[i]);
      end;
    end;
  end;
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  s: String;
begin
  while Socket.ReceiveLength>0do
  begin
    s := Socket.ReceiveText;
    AddBuf(Socket,s);
  end;
end;

end.

Код



procedure TForm1.N2Click(Sender: TObject);

  begin
    {отправка файла через сокет}
    ClientSocket1.Socket.SendStream(TFileStream.Create(edit1.Text, fmOpenRead or fmShareDenyWrite));

end;

Цитата(Marlin @ 10.3.2006, 06:57

)

проблема в том, как мне отобразить прогресс отправки.