[Crabber]

Возникли проблемы при передаче файлов jpg, bmp, mp3, exe от сервера клиенту. Сервер успешно принимает только текстовые файлы. При попытке принять мультимедийные и исполняемые файлы клиент выводит ошибки с несуразным бредом, в следствии чего принятый файл не пригоден для использования. Хотя размер файла при этом не отличается от размера файла который был передан сервером. Может кто подскажет каким образом можно реализовать передачу jpg, bmp, mp3, exe файлов с помощью данных компонетнов?

Тип сервера: stNonBlocking

Код сервера (отправка файла):

Код:

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   ms: TMemoryStream;
begin
  {Если от клиента пришла комманда серверу}
  client_msg:= Socket.ReceiveText;

  if client_msg = 'send' then
  begin
    ms:= TMemoryStream.Create;
  try
    ms.LoadFromFile('D:\1.exe');
    ms.Position:= 0;
    // Добавляем длину данных, чтобы клиент знал, сколько данных будет
    // передано. Добавляем #0 , чтобы можно было определить, где
    // заканчивается информация о размере.
    Socket.SendText(IntToStr(ms.Size) + #0);
    // Посылаем его
    Socket.SendStream(ms);
  except
      // освободить поток, если что-то не так.
      ms.Free;
  end;
end;

Код клиента (приём файла):

Код:

procedure TForm1.Button2Click(Sender: TObject);
begin
// Отправляем команду на сервер для начала передачи файла
ClientSocket1.Socket.SendText('send');
end;


procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s, sl: String;
  Data: TMemoryStream;
  DataSize: Integer;
  Reciving: boolean;
begin
    s:= Socket.ReceiveText;
    if not Reciving then
    begin
      // получаем длину потока данных.
      SetLength(sl, StrLen(PChar(s))+1);
      StrLCopy(@sl[1], PChar(s), Length(sl)-1);
      DataSize:= StrToInt(sl);
      Data:= TMemoryStream.Create;
      Delete(s, 1, Length(sl));
      Reciving:= True;
    end;
    try
      Data.Write(s[1], length(s));
    if Data.Size = DataSize then
      begin
        Data.Position:= 0;
        Data.SaveToFile('C:\123.exe');
        Data.Free;
        Reciving:= False;
      end;
  except
     Data.Free;
  end;
end;

[Bargest]

Мне кажется, что прикол в том, что вы через String приём делаете, а строки и нулевые символы (которых в нетекстовых форматах уйма) - понятия несовместимые.

[Crabber]

Кто нибудь может реализовать приём бинарных файлов через сокеты?

[NumLock]

один из вариантов:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
    FPipeRead: THandle;
    FPipeWrite: THandle;
    FDataLen: DWORD;
    FDataRead: DWORD;
    FFileStream: TFileStream;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreatePipe(FPipeRead, FPipeWrite, nil, $8000);
  FDataLen:=0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(FPipeWrite);
  CloseHandle(FPipeRead);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientSocket1.Open;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add('Client Connect');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FileStream: TFileStream;
  len: DWORD;
begin
  FileStream:=TFileStream.Create(Edit1.Text, fmOpenRead);
  try
    len:=FileStream.Size;
    ClientSocket1.Socket.SendBuf(len, SizeOf(len));
    ClientSocket1.Socket.SendStream(FileStream);
  except
    FileStream.Free;
  end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Len: Integer;
  Buffer: PChar;
  dummy: Cardinal;
begin
  Len:=Socket.ReceiveLength;
  Buffer:=GetMemory(Len);
  try
    Len:=Socket.ReceiveBuf(Buffer^, Len);
    WriteFile(FPipeWrite, Buffer^, Len, dummy, nil);
  finally
    FreeMemory(Buffer);
  end;
  while True do
  begin
    Len:=GetFileSize(FPipeRead, nil);
    if Len=0 then Break;
    if FDataLen=0 then
    begin
      if Len<SizeOf(DWORD) then Break;
      ReadFile(FPipeRead, FDataLen, SizeOf(DWORD), dummy, nil);
      FDataRead:=0;
      FFileStream:=TFileStream.Create(Edit2.Text, fmCreate);
    end else
    begin
      Buffer:=GetMemory(Len);
      try
        ReadFile(FPipeRead, Buffer^, Len, dummy, nil);
        FFileStream.Write(Buffer^, Len);
        Inc(FDataRead, Len);
        if FDataRead=FDataLen then
        begin
          FFileStream.Free;
          FDataLen:=0;
          Memo1.Lines.Add('Ok');
        end;
      finally
        FreeMemory(Buffer);
      end;
    end;
  end;
end;

end.

!!!Проверки и очистки ресурсов при дисконнекте нет!!!

[Crabber]

Спасибо, отличная реализация! Всё работает так-как и нужно было.

[NumLock]

Crabber, да, забыл совсем предупредить: это только пример механизма (отправка размера данных-сами данные) получения двоичных данных по сокету. он не учитывает множественное подключение к серверу нескольких клиентов. в данном примере при подключении еще клиентов и отправки ими данных сервер в итоге получит "кашу". пример для работы с несколькими клиентами (на этом же механизме) я уже выкладывал ранее.