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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 19.11.2017, 21:01   #1
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию Срочно! Помощь с Delphi Indy и передачей больших файлов

Добрый день! Работаю с вк апи. Делаю многопоточную загрузку видео. Проблема вот в чём. Когда код был вне потока, писало OutOfMemory при попытке создания FileStream. В общем, большие файлы не грузятся. Очень срочно нужна помощь, желательно код. Свой представляю ниже(работа потока);

procedure ThreadSEND.Execute;
const
CRLF = #13#10;
var
HTTP: THTTPsend;
Video: TFileStream;
Bound, Field: String;
begin
HTTP := THTTPsend.Create;
HTTP.TargetHost := host;
HTTP.UserAgent :=
'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/61.0.3163.100 Safari/537.36';
Bound := '-----' + IntToHex(Random(65535), 8) + '_boundary';
HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
Field := '--' + Bound + CRLF;
Field := Field +
'Content-Disposition: form-data; name="video_file"; filename="' + fn + '"' +
CRLF + 'Content-Type: ' + 'video/mp4' + CRLF + CRLF;
WriteStrToStream(HTTP.Document, Field);
try
try
Video := TFileStream.Create(fn, fmOpenRead);
HTTP.Document.CopyFrom(Video, 0);
WriteStrToStream(HTTP.Document, CRLF);
Field := '--' + Bound + CRLF +
'Content-Disposition: form-data; name="video_file"' + CRLF + CRLF +
'post' + CRLF;
WriteStrToStream(HTTP.Document, Field);
Field := '--' + Bound + '--' + CRLF;
WriteStrToStream(HTTP.Document, Field);
HTTP.HTTPMethod('POST', url);
if HTTP.ResultString = 'OK' then
Synchronize(Sync)
else
Synchronize(Async);
except
Synchronize(MemoryEXP);
Video.Free;
HTTP.Clear;
HTTP.Free;
end;
finally
HTTP.Clear;
HTTP.Free;
Video.Free;
end;
Synchronize(Finality);
end;

Пытался найти что-то по передаче частями, но не знаю, как это реализовать используя данный код и вообще Delphi + Indy в принципе. И будет ли сервер вк принимать постепенную загрузку такую.

Последний раз редактировалось LikanGT; 19.11.2017 в 21:02. Причина: Добавление информации
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 08:40   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Походу TFileStream весь файл в память грузит здесь нужно попробовать сразу с диска через AssignFile

Можно попробовать сделать так

Код:
var
PositionFile: integer;
fStream: File;

//Определяем размер большого файла
function SizeFiles(const FileName : String): Int64;
var
  Handle   : THandle;
  FindData : TWin32FindData;
begin
FillChar(FindData, SizeOf(TWin32FindData), 0);
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      Int64Rec(Result).Lo := FindData.nFileSizeLow;
      Int64Rec(Result).Hi := FindData.nFileSizeHigh;
      Exit;
    end;
  end;
  Result := -1;
end;

//Открываем файл
function OpenFiles(Const FileName: string): Integer;
begin
Result:=0;
  {$I-}
   if not FileExists(FileName) then
   exit;
   AssignFile(fStream, FileName);
   FileMode := fmOpenRead;
   Reset(fStream, 1);
   {$I+}
   //ошибка открытия файла то выходим
  if IOResult <> 0 then
  begin
  CloseFile(fStream);
  Showmessage(SysErrorMessage(GetLastError));
  exit;
  end;
    //Определяем размер всего файла
  fSize:= SizeFiles(TFileRec(fStream).Name);
  if fSize = 0 then
   CloseFile(fStream);
end;

//Закрываем файл
function CloseFiles(): boolean;
Begin
  Result:= false;
  if TFileRec(fStream).Handle > 0 then
  begin
   CloseFile(fStream);
   FillChar(TFileRec(fStream), SizeOf(TFileRec(fStream)), 0);
   fSize:= 0;
  Result:= true;
  end;
End;

//Читаем из файла
function ReadFiles(Var Buffer; iSize: integer=0; iSeek: integer=0): Integer;
var
RealSize: integer;
begin
Result:=0;
 if TFileRec(fStream).Handle > 0 then
 begin
  //Сравниваем размеры всего файла и позиции
  RealSize:= fSize - iSeek;
  if RealSize <= 0 then
   begin
  CloseFiles();
  exit;
 end;
  //Сравниваем размеры всего файла и наш размер
  if iSize > fSize then
  iSeek:= 0;
  //переходим на нужную позицию
  seek(fStream, iSeek);
 //Читаем файл и записываем в буфер данные
 BlockRead(fStream, Buffer, iSize, Result);
 end;
end;

В потоке вашем объявите процедуру которая будет отправлять из файла куски по 1024бит можете больше сделать

Код:
procedure ThreadSEND.HttpOnstatus(Sender: TObject; Reason: THookSocketReason; const Value: String);
    var
    Docum: TMemoryStream;
   Buf: array [0..1023] of AnsiChar;
   Len: integer;
    begin
  //чистим буфер
 FillChar(addr(Buf)^, SizeOf(Buf), 0);
 Len:= ReadFiles(addr(Buf)^, SizeOf(Buf), PositionFile);
 if (len > 0)then
 begin
  Inc(PositionFile, Len);
  if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).SendBuffer(Pointer(@Buf), Len);
 end
 else
 if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).CloseSocket;
end;
Применяем вышеуказанные функции.
В вашем коде что написали уберите или закомментируйте Video := TFileStream.Create(fn, fmOpenRead); и HTTP.Document.CopyFrom(Video, 0);

Ну а далее напишите так перед HTTP.HTTPMethod('POST', url);
Код:
PositionFile:= 0;
OpenFiles(fn);
HTTP.Sock.OnStatus:= HttpOnstatus;
HTTP.HTTPMethod('POST', url);
CloseFiles();

Последний раз редактировалось Aliens_wolfs; 20.11.2017 в 15:43.
Aliens_wolfs вне форума Ответить с цитированием
Старый 20.11.2017, 15:56   #3
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Походу TFileStream весь файл в память грузит здесь нужно попробовать сразу с диска через AssignFile

Можно попробовать сделать так

Код:
var
PositionFile: integer;
fStream: File;

//Определяем размер большого файла
function SizeFiles(const FileName : String): Int64;
var
  Handle   : THandle;
  FindData : TWin32FindData;
begin
FillChar(FindData, SizeOf(TWin32FindData), 0);
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      Int64Rec(Result).Lo := FindData.nFileSizeLow;
      Int64Rec(Result).Hi := FindData.nFileSizeHigh;
      Exit;
    end;
  end;
  Result := -1;
end;

//Открываем файл
function OpenFiles(Const FileName: string): Integer;
begin
Result:=0;
  {$I-}
   if not FileExists(FileName) then
   exit;
   AssignFile(fStream, FileName);
   FileMode := fmOpenRead;
   Reset(fStream, 1);
   {$I+}
   //ошибка открытия файла то выходим
  if IOResult <> 0 then
  begin
  CloseFile(fStream);
  Showmessage(SysErrorMessage(GetLastError));
  exit;
  end;
    //Определяем размер всего файла
  fSize:= SizeFiles(TFileRec(fStream).Name);
  if fSize = 0 then
   CloseFile(fStream);
end;

//Закрываем файл
function CloseFiles(): boolean;
Begin
  Result:= false;
  if TFileRec(fStream).Handle > 0 then
  begin
   CloseFile(fStream);
   FillChar(TFileRec(fStream), SizeOf(TFileRec(fStream)), 0);
   fSize:= 0;
  Result:= true;
  end;
End;

//Читаем из файла
function ReadFiles(Var Buffer; iSize: integer=0; iSeek: integer=0): Integer;
var
RealSize: integer;
begin
Result:=0;
 if TFileRec(fStream).Handle > 0 then
 begin
  //Сравниваем размеры всего файла и позиции
  RealSize:= fSize - iSeek;
  if RealSize <= 0 then
   begin
  CloseFiles();
  exit;
 end;
  //Сравниваем размеры всего файла и наш размер
  if iSize > fSize then
  iSeek:= 0;
  //переходим на нужную позицию
  seek(fStream, iSeek);
 //Читаем файл и записываем в буфер данные
 BlockRead(fStream, Buffer, iSize, Result);
 end;
end;

В потоке вашем объявите процедуру которая будет отправлять из файла куски по 1024бит можете больше сделать

Код:
procedure ThreadSEND.HttpOnstatus(Sender: TObject; Reason: THookSocketReason; const Value: String);
    var
    Docum: TMemoryStream;
   Buf: array [0..1023] of AnsiChar;
   Len: integer;
    begin
  //чистим буфер
 FillChar(addr(Buf)^, SizeOf(Buf), 0);
 Len:= ReadFiles(addr(Buf)^, SizeOf(Buf), PositionFile);
 if (len > 0)then
 begin
  Inc(PositionFile, Len);
  if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).SendBuffer(Pointer(@Buf), Len);
 end
 else
 if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).CloseSocket;
end;
Применяем вышеуказанные функции.
В вашем коде что написали уберите или закомментируйте Video := TFileStream.Create(fn, fmOpenRead); и HTTP.Document.CopyFrom(Video, 0);

Ну а далее напишите так перед HTTP.HTTPMethod('POST', url);
Код:
PositionFile:= 0;
OpenFiles(fn);
HTTP.Sock.OnStatus:= HttpOnstatus;
HTTP.HTTPMethod('POST', url);
CloseFiles();
Извиняюсь за глупый вопрос, первый вар с двумя переменными в какой раздел вписывать? Это глобальные переменные? И, как я понимаю, вместе с ними еще должна быть fSize: Int64?
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 16:19   #4
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Вроде всё добавил. Прога крешнулась, убрал try except из потоков вроде как процесс идет, но в диспетчере сеть по 0 занята.
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 16:42   #5
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Вот что получилось по коду. Может опять что не так делаю.
Код:
type
  ThreadSEND = class(TThread)
  private
    url, fn, name, host: string;
  public
    PositionFile: integer;
    fStream: File;
    fSize: Int64;
    constructor Create(ur: string; f: string; na: string; ho: string);
    destructor Destroy; override;
    procedure Threadfree;
    procedure Sync;
    procedure Async;
    procedure Finality;
    procedure MemoryExp;
    procedure Execute; override;
    function OpenFiles(Const FileName: string): Integer;
    function CloseFiles(): boolean;
    function SizeFiles(const FileName : String): Int64;
    function ReadFiles(Var Buffer; iSize: integer=0; iSeek: integer=0): Integer;
    procedure HttpOnStatus(Sender: TObject; Reason: THookSocketReason; const Value: String);
  end;
Код:
function ThreadSEND.ReadFiles(Var Buffer; iSize: integer=0; iSeek: integer=0): Integer;
var
RealSize: integer;
begin
Result:=0;
 if TFileRec(fStream).Handle > 0 then
 begin
  //Сравниваем размеры всего файла и позиции
  RealSize:= fSize - iSeek;
  if RealSize <= 0 then
   begin
  CloseFiles();
  exit;
 end;
  //Сравниваем размеры всего файла и наш размер
  if iSize > fSize then
  iSeek:= 0;
  //переходим на нужную позицию
  seek(fStream, iSeek);
 //Читаем файл и записываем в буфер данные
 BlockRead(fStream, Buffer, iSize, Result);
 end;
end;
function ThreadSEND.CloseFiles: boolean;
begin
  Result:= false;
  if TFileRec(fStream).Handle > 0 then
  begin
   CloseFile(fStream);
   FillChar(TFileRec(fStream), SizeOf(TFileRec(fStream)), 0);
   fSize:= 0;
  Result:= true;
  end;
end;
function ThreadSEND.SizeFiles(const FileName: String): Int64;
var
  Handle   : THandle;
  FindData : TWin32FindData;
begin
FillChar(FindData, SizeOf(TWin32FindData), 0);
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      Int64Rec(Result).Lo := FindData.nFileSizeLow;
      Int64Rec(Result).Hi := FindData.nFileSizeHigh;
      Exit;
    end;
  end;
  Result := -1;
end;
procedure ThreadSEND.HttpOnStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: String);
var
Docum: TMemoryStream;
Buf: array [0..1023] of AnsiChar;
Len: integer;
begin
  //чистим буфер
 FillChar(addr(Buf)^, SizeOf(Buf), 0);
 Len:= ReadFiles(addr(Buf)^, SizeOf(Buf), PositionFile);
 if (len > 0)then
 begin
  Inc(PositionFile, Len);
  if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).SendBuffer(Pointer(@Buf), Len);
 end
 else
 if (TTCPBlockSocket(Sender) <> nil) then
  TTCPBlockSocket(Sender).CloseSocket;
end;
Код:
procedure ThreadSEND.Execute;
const
CRLF = #13#10;
var
HTTP: THTTPsend;
Bound, Field: String;
begin
HTTP := THTTPsend.Create;
HTTP.TargetHost := host;
HTTP.UserAgent :=
'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/61.0.3163.100 Safari/537.36';
Bound := '-----' + IntToHex(Random(65535), 8) + '_boundary';
HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
Field := '--' + Bound + CRLF;
Field := Field +
'Content-Disposition: form-data; name="video_file"; filename="' + fn + '"' +
CRLF + 'Content-Type: ' + 'video/mp4' + CRLF + CRLF;
WriteStrToStream(HTTP.Document, Field);
WriteStrToStream(HTTP.Document, CRLF);
Field := '--' + Bound + CRLF +
'Content-Disposition: form-data; name="video_file"' + CRLF + CRLF +
'post' + CRLF;
WriteStrToStream(HTTP.Document, Field);
Field := '--' + Bound + '--' + CRLF;
WriteStrToStream(HTTP.Document, Field);
PositionFile:= 0;
OpenFiles(fn);
HTTP.Sock.OnStatus:= HttpOnstatus;
HTTP.HTTPMethod('POST', url);
CloseFiles();
Synchronize(Sync);
HTTP.Clear;
HTTP.Free;
Synchronize(Finality);
end;
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 17:15   #6
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

А сколько у вас файл для передачи весит?
Aliens_wolfs вне форума Ответить с цитированием
Старый 20.11.2017, 17:28   #7
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Пробовал 50 мб, 500 мб и 10 мб
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 17:29   #8
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
А сколько у вас файл для передачи весит?
дело в том, что нужно, чтоб любые отправлял.
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 17:58   #9
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
А сколько у вас файл для передачи весит?
Вынес всё в отдельное событие по кнопке. При комплие пишет
[dcc32 Error] main.pas(886): E2009 Incompatible types: 'method pointer and regular procedure'
на строчке
HTTP.Sock.OnStatus:= HttpOnstatus;
LikanGT вне форума Ответить с цитированием
Старый 20.11.2017, 18:11   #10
LikanGT
Пользователь
 
Регистрация: 19.11.2017
Сообщений: 18
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
А сколько у вас файл для передачи весит?
С этой ошибкой разобрался. Нужно было для формы сделать процедуру онстатус. Но всё же походу не работает
LikanGT вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Delphi срочно помощь dasf51 Фриланс 8 07.09.2017 12:53
Срочно! Помощь с циклами в Delphi Raikerock Помощь студентам 3 14.09.2014 09:27
Нужна помощь с пакетной передачей anghela Помощь студентам 18 01.12.2013 13:08
ПРоблема с передачей и сохранением файлов с помощью indi компонентов albatros Работа с сетью в Delphi 4 18.02.2009 22:39
Нужна помощь с передачей даных в процедуру programer_tang Общие вопросы Delphi 5 28.08.2008 10:14