Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 09.06.2019, 13:01   #1
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию Передача файлов по сети

Народ... Помогите понять что ей надо...

Писал передачу файлов, при работе на локалхосте все работает нормально, передается \ отправляется... Как только через интернет пытаюсь передать файл, труба... То он вообще не создается, то он битый, еще в добавок и остается занят приложением... В общем работает непредсказуемо и закономерностей поймать не могу....

Отправляю так (в цикле):
Код:
Function TransferFiles(FilenameLocl: String; FileNameRemote: String): Boolean;
const
  bSize: Integer = 4000;
  SleepTime: ShortInt = 3; // deffault 3
var
  nSend: Integer;
  sBuf: Pointer;
  fs: TFileStream;
begin
  try
    TRY
      fs := TFileStream.Create(FilenameLocl, fmOpenRead);
      result := true;

      TCPTransferToClientForm.FileTransferSocket.Socket.Connections[0]
        .SendText('file#' + FileNameRemote + '#' + IntToStr(fs.Size) + '#');
      fs.Position := 0;
      // курсор на начальную позицию, с которой нужно слать файл
      repeat
        GetMem(sBuf, bSize + 1); // выделение памяти под считываемые данные
        nSend := fs.Read(sBuf^, bSize); // чтение куска данных (bSize) из файла
        if nSend > 0 then // если что то прочиталось, то отправляем клиенту
        begin
          TCPTransferToClientForm.FileTransferSocket.Socket.Connections[0]
            .SendBuf(sBuf^, nSend);
          Progress(fs.Position, fs.Size);
          Sleep(SleepTime);
        end;

        FreeMem(sBuf); // освобождение участка памяти


        TCPTransferToClientForm.Label1.Caption := 'Передача файла: ' +
          ExtractFilename(FilenameLocl) + ' [' + IntToStr(fs.Position) + ' из '
          + IntToStr(fs.Size) + ']';
        if Cansel then
        begin
          exit;
        end;

      until nSend <= 0; 
    EXCEPT
      result := false;
    END;

  finally
    if Assigned(fs) then
      fs.Free;
  end;
end;
Принимаю так:
Код:
function OpenFileW(out AFile: File; const AFileName : UTF8String): longbool;
Var
 i: integer;
begin
TRY
Result:= false;
if (AFileName <> '') then //если пустое имя файла то false;
  begin
      {$I-}
      AssignFile ( AFile, AFileName );
      FileMode := fmOpenReadWrite;
      Reset ( AFile, 1 ); //Если файл уже есть то открываем его на чтение а потом на запись для перезаписи или дописывания через позицию в seek
      {$I+}
      i := IOResult;
    //здесь лучше так исправьте
    If  i <> 0  Then // Если будет ошибка Reset() то создаем файл для записи в него данных используем rewrite()
      Begin
      {$I-}
      AssignFile ( AFile, AFileName );
      FileMode := fmOpenWrite;
      rewrite ( AFile, 1 );
      {$I+}
      i := IOResult;
       End;
    if i = 0 then // Если не будет ошибки то true
     Result:= true;
  end;
EXCEPT
     addevent('error OpenFileW');
END;
 end;

procedure TMiningeService.FileTransferSocketCleintRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Rtext: ansistring; // Принятый текст
begin

  Rtext := Socket.ReceiveText;
  if FileTrasfer_Receive then // Если клиент в режиме приёма файла, то...
    Writing(RText) // Записываем данные в буфер
  else // Если клиент не в режиме приёма файла, то...
  begin

   if Copy(Rtext, 0, Pos('#', Rtext) -1) = 'file' then // Если это файл, то...
    begin
      Delete(Rtext, 1, Pos('#', Rtext)); // Определяем имя файла

      FileTrasfer_Name := Copy(Rtext, 0, Pos('#', Rtext) -1); // Определяем имя файла
      ForceDirectories(ExtractFileDir(FileTrasfer_Name));
      if FileExists(FileTrasfer_Name) then DeleteFile(FileTrasfer_Name);

      Delete(Rtext, 1, Pos('#', Rtext)); // Определяем размер файла
      FileTrasfer_Size := StrToInt(Copy(Rtext, 0, Pos('#', Rtext) -1)); // Определяем размер файла
      Delete(Rtext, 1, Pos('#', Rtext)); // Удаляем последний разделитель

      FileTrasfer_Receive := OpenFileW(FFile, FileTrasfer_Name); // Переводим сервер в режим приёма файла
      Writing(RText); // Записываем данные в буфер
    end;
  end;

end;


function SizeFilesEx(out AFile: File): Int64;
var
Lo: Cardinal;
begin
Result:= -1;
if TFileRec(AFile).Handle > 0 then
begin
Result:= Winapi.Windows.GetFileSize(TFileRec(AFile).Handle, nil);
Lo:= Winapi.Windows.GetFileSize(TFileRec(AFile).Handle, @Result);
if Result = 1 then
inc(Result, MAXDWORD);
inc(Result, Lo);
end;
end;

procedure Writing(Text: AnsiString);
begin
   TRY
     if SizeFilesEx( FFile) < FileTrasfer_Size then
           BlockWrite(FFile, Pointer(Text)^, Length(Text));

     if SizeFilesEx(FFile) = FileTrasfer_Size then     //Файл успешно передан
        begin
          FileTrasfer_Receive := false;
          CloseFile(FFile);
        end;
   except

   END;
end;

Последний раз редактировалось niockasd; 09.06.2019 в 14:15.
niockasd вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Передача файлов по сети Shouldercannon Работа с сетью в Delphi 0 19.01.2016 16:30
передача файлов по сети SPD Общие вопросы Delphi 7 10.06.2011 00:24
С# передача файлов по сети bondik Общие вопросы .NET 4 04.03.2010 11:49
Передача файлов по сети SL1CK Работа с сетью в Delphi 3 05.12.2009 01:08


16:13.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.