Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.06.2019, 08:31   #1
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию [Delphi] Передача файлов

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

Отправляю так (в цикле):
Код:

Код:
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;
Оплата по договоренности, минимум 500 р.
Связь telegram: @Vasily675468
niockasd вне форума Ответить с цитированием
Старый 20.06.2019, 09:38   #2
WorldMaster
Старожил
 
Аватар для WorldMaster
 
Регистрация: 25.08.2011
Сообщений: 2,841
По умолчанию

Через интернет?? а ip какие у машин?
Skype - wmaster_s E-Mail - WorldMasters@gmail.com
Работаем по 3 критериям - быстро, качественно, недорого. Заказчик выбирает любые два.
WorldMaster вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
передача файлов Вадим2011 C# (си шарп) 0 09.04.2011 23:21
VB передача файлов. Soutch_park Помощь студентам 0 16.01.2011 20:11
[Delphi 7] TIdFTP передача файлов на FTP сервер. Через проки или нет? tozter Работа с сетью в Delphi 0 21.12.2010 00:51
Передача файлов Delphi 2009 KoBRaAndrey Общие вопросы Delphi 2 08.11.2009 02:03
Передача файлов по UDP GAGARIN-NEW Работа с сетью в Delphi 3 15.11.2007 22:45