VPF::Передача файлов через сокет - Форум программистов

Cameron

Дата 29.9.2005, 14:39 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 28.9.2005

Репутация: нет
Всего: нет

Вот программа передачи файлов через сокеты но она передаёт не больше 8 кб помогите сделать так что бы передавать любой обьём.

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    ClientSocket1: TClientSocket;
    ServerSocket1: TServerSocket;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
  buffer1:^integer;
  buffer2:^integer;
  Output:TmemoryStream;
  InPut:TmemoryStream;
  Size:Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
serversocket1.Port:=1001;
serversocket1.Active:=true;
serversocket1.Open;
memo1.Lines.Add('Ñåðâåð Àêòèâåí');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
clientsocket1.Port:=1001;
clientsocket1.Address:='192.168.0.2';
clientsocket1.Active:=true;
memo1.Lines.Add('Êëèåíò àêòâåí');
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
clientsocket1.Open;
memo1.Lines.Add('Êëèåíò ïîäêëþ÷èëñÿ');
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Ñåðâåð: êëèåíò ïîäêëþ÷èëñÿ');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText('send');
memo1.Lines.Add('Çàïðîñ îòïðàâëåí send');
end;



procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
input:=tmemorystream.Create;
input.Position:=0;
size:=socket.ReceiveLength;
getmem(buffer2, size);
socket.ReceiveBuf(buffer2^,size);
input.Write(buffer2^, size);
freemem(buffer2);
begin
input.Position:=0;
memo1.Lines.Add(inttostr(socket.ReceiveLength));
input.SaveToFile('d:\1.jpg');
memo1.Lines.Add('Ôàéë ïðèíÿò');
end;
end;


procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
begin

begin
Output:=Tmemorystream.Create;
output.Position:=0;
image1.Picture.Graphic.SaveToStream(output);
i:=output.Size;
memo1.Lines.add(inttostr(i));
getmem(buffer1,i);
output.Position:=0;
begin
output.Read(buffer1^,i);
serversocket1.Socket.Connections[0].SendBuf(buffer1^,i);
freemem(buffer1);
end;
memo1.Lines.Add('Ôàéë îòïðàâëåí');
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add(socket.ReceiveText);
end;

end.

Это сообщение отредактировал(а) Snowy - 4.10.2005, 11:14

Dubinsky

Дата 3.10.2005, 17:38 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 252
Регистрация: 1.6.2005

Репутация: нет
Всего: нет

та же проблема , но я знаю её причину ... когда шлём файл то он делится на пакеты по 8 кб и приходит кусками - клеить надо его ...

Rodman

Дата 20.9.2006, 18:41 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122

А каким образом ее склеить???

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

Демо

Дата 20.9.2006, 19:11 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 3
Всего: 50

Код


procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s: String;
begin
  while Socket.ReceiveLength>0 do s := s+socket.ReceiveText;
  memo1.Lines.Add(socket.ReceiveText);
end;

2.
Каким-то образом нужно определять, что файл передан полностью.
Если сразу после передачи клиент отключается, то проблем нет. В обработчике OnDisconnect определяем, что файл передан.
Если же такой вариант не подходит, необходимо в начале передачи(перед началом передачи данных файла) передать размер файла.
Сервер должен получить этот размер и при приеме считать длину принятых данных.

Добавлено @ 19:15
Вот примерчик - с одним участником разбирались.

Клиент:

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    CS: TClientSocket;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    Stop:boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 CS.Port:=666;
 CS.Host:='127.0.0.1';
 CS.Open;
end;

procedure TForm1.Button2Click(Sender: TObject);
 begin
 Stop:=True;
 end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  DC:HDC;
  BMP:TBitmap;
  SBMP:TMemoryStream;
  Len: Int64;
 
begin
  if Timer1.Tag=1 then Exit;
  Timer1.Tag := 1;
  SBMP:=TMemoryStream.Create;
  BMP:=TBitmap.Create;
  DC:=GetDC(0);
  BMP.Height:=0;
  BMP.Width:=0;
  BMP.Height:=500;
  BMP.Width:=500;
  BitBlt(BMP.Canvas.Handle,0,0,BMP.Width,BMP.Height,DC,0,0,SrcCopy);
  BMP.SaveToStream(SBMP);
  BMP.Free;
  Len := SBMP.Size;
  CS.Socket.SendBuf(Len,SizeOf(Int64));
  SBMP.Position:=0;
  CS.Socket.SendStream(SBMP);
end;

procedure TForm1.CSRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.ReceiveText;
  Timer1.Tag := 0;
end;

end.

Сервер:

Код


unit Unit1;

interface

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

type

  TState=(stNone,stData);
  TForm1 = class(TForm)
    Image1: TImage;
    SS: TServerSocket;
    procedure FormCreate(Sender: TObject);
    procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    SBMP:TMemoryStream;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  State: TState=stNone;
  Msg:string;
  Len: Int64;
  CountReceived: Int64;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 SS.Port:=666;
 SS.Open;
end;

procedure TForm1.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  Msg:= Msg+Socket.ReceiveText;

  while Msg<>'' do
  begin
    case State of
      stNone:
        begin
          if Length(Msg)<SizeOf(Int64) then Exit;
          State := stData;
          Move(Msg[1],Len,SizeOf(int64));
          Delete(Msg,1,SizeOf(int64));
          CountReceived := 0;
          SBMP:=TMemoryStream.Create;
        end;
      stData:
        begin
          CountReceived := CountReceived+SBMP.Write(Msg[1],Length(Msg));
          Msg := '';
          if CountReceived=Len then
          begin
            State := stNone;
            SBMP.Position:=0;
            Image1.Picture.Bitmap.Height:=100;
            Image1.Picture.Bitmap.Width:=100;
            Image1.Picture.Bitmap.LoadFromStream(SBMP);
            SBMP.Free;
            Socket.SendText('o');
          end;
        end;
    end;
  end;
end;

end.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »