VPF::проблема в передачи файла через сокет

miha420

Дата 1.5.2011, 14:30 (ссылка)

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

Загрузка ...

Новичок

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

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

Сервер создает файл из 2-х файлов и передает его клиенту. А клиент должен из полученного файла получить 2 изначальных файла.
Вот здесь и появляется ошибка "Stream read error". После пересылки через сокет он перестает открываться, хотя другие файлы передаются не битыми.

Код сервера

Код


Procedure TForm1.AddToStream ( Source , Dest : TStream );
var
Size : Integer ;
begin
Source.position := 0 ;
// Сохраняем размер, помещая его в первый байт
Size := Source.Size ;
Dest.Write(Size,SizeOf(Integer));
Dest.CopyFrom(Source,Source.size);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Size: integer;
 P: ^Byte;
 begin
MS := TMemoryStream.Create; // Создаём буфер для файла
 MS.LoadFromFile('sa.sa'); // Загружаем файл в буфер
 // Посылаем информацию о файл (команда # название # размер)
 ServerSocket1.Socket.Connections[0].SendText('file#'+'sa.sa'+'#'+IntToStr(MS.Size)+'#');
 MS.Position := 0; // Переводим каретку в начало файла
 P := MS.Memory; // Загружаем в переменную "P" файл
 Size := ServerSocket1.Socket.Connections[0].SendBuf(P^, MS.Size); // Посылаем файл
 // Выводим прогресс
 ProgressBar1.Position := Size*100 div MS.Size;
 StatusBar1.SimpleText := 'Отправлено '+IntToStr(Size)+' из '+IntToStr(MS.Size)+' байт'
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 MS := TMemoryStream.Create; // Создаём буфер для файла
 MS2 := TMemoryStream.Create;
 MS2.LoadFromFile('18.jpg'); // Загружаем файл в буфер
 AddToStream(ms2,ms);
 mS2.LoadFromFile('19.jpg'); // Загружаем файл в буфер
 AddToStream(ms2,ms);
 ms.SaveTofile('sa.sa');
 ms2.Free;
 ms.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerSocket1.Open; // Открываем сокет
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ServerSocket1.Close; // Закрываем сокет
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Соединение установлено';
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Соединение не установлено';
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
if Socket.ReceiveText = 'end' then // Если клиент принял файл, то...
 begin
 StatusBar1.SimpleText := 'Клиент принял файл';
 MS.Free;ms2.Free; // Убиваем буфер
 end;
end;

Код клиента

Код


Procedure TForm1.GetFromStream ( Source , Dest : TStream ; Index : Integer  );
Var
  Size , I : Integer ;
begin
Source.Position := 0 ;
For i := 0 to index-1 do
   begin
     Source.Read(Size,SizeOf(Integer));
     Source.Position := Source.Position + Size ;
   end;
// Если марк¸р в файле равен размеру, то что-то пошло не так :(
if Source.position = Source.Size then
  Raise EAccessViolation.Create('Index Out Of Bounds') ;
// Получаем желаемый размер файла
Source.Read(Size,SizeOf(Integer));
// Очищаем буфер у Dest
Dest.Position := 0 ;
Dest.Size := 0 ;
Dest.CopyFrom(Source,Size);
end;

procedure TForm1.Writing(Text: string);
 begin
 if MS.Size < Size then // Если принято байт меньше размера файла, то...
 MS.Write(Text[1], Length(Text)); // Записываем в буфер
 // Выводим прогресс закачки файла
 ProgressBar1.Position := MS.Size*100 div Size;
 StatusBar1.SimpleText := 'Принято '+IntToStr(MS.Size)+' из '+IntToStr(Size);
 if MS.Size = Size then // Если файл принят, то...
 begin
 Receive := false; // Переводим клиента в нормальный режим
 MS.Position := 0; // Переводим каретку в начало буфера
 MS.SaveToFile(Name); // Сохраняем файл
 ClientSocket1.Socket.SendText('end'); // Посылаем команду "end", то есть файл принят
 MS.Free;ms2.Free; // Убиваем буфер
 StatusBar1.SimpleText := 'Файл принят';
 end;
 end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
//image1.Picture.LoadFromFile('18.jpg');
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
ms := TMemoryStream.Create ;
ms.LoadFromFile('sa.sa');
ms2 := TMemoryStream.Create ;
      GetFromStream(ms,ms2,0);
      ms2.SaveToFile('1.jpg');
      GetFromStream(ms,ms2,1);
      ms2.SaveToFile('2.jpg');
      ms2.Free;
      ms.Free;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Соединение установлено';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Соединение не установлено';
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  l: Integer;
  buf: PChar;
  src: TFileStream;
begin
//Записываем в l размер полученного блока
  l := Socket.ReceiveLength;
  //Заказываем память для буфера
  GetMem(buf,l+1);
  //Записываем в буфер полученный блок
  Socket.ReceiveBuf(buf^,l);
  //Открываем временный файл для записи
  src := TFileStream.Create('sa.sa',fmOpenReadWrite);
  //Ставим позицию в конец файла
  src.Seek(0,soFromEnd);
  //Записываем буфер в файл
  src.WriteBuffer(buf^,l);
  //Закрываем файл
  src.Free;
  //Освобождаем память
  FreeMem(buf);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientSocket1.Open; // Открываем сокет
 Receive := false; // Режим клиента - приём команд
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ClientSocket1.Close; // Закрываем сокет
end;

MetalFan

Дата 1.5.2011, 19:08 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Цитата(miha420 @ 1.5.2011, 14:30

)

Вот здесь и появляется ошибка "Stream read error".

В каком месте кода она возникает?

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

There are always someone smarter than you...

miha420

Дата 2.5.2011, 07:01 (ссылка)

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

Загрузка ...

Новичок

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

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

в коде клиента 19 строчка:

Dest.CopyFrom(Source,Size);

MetalFan

Дата 2.5.2011, 22:55 (ссылка)

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

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

miha420, Видимо size вылетает за размер потока.

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

There are always someone smarter than you...

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