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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 04.05.2019, 23:50   #11
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Найдите у себя в Delphi в настройках Undo Limit.



извиняюсь поторопился я там не заметил

Проверку сделать можно так

либо до 1-гига так
fileSize(FFile) = FileTrasfer_Size

либо для всех объемов вот эта функция

Код:
function SizeFilesEx(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;
проверку делаете так
SizeFilesEx(FFile) = FileTrasfer_Size
Извиняюсь еще раз)
Получился код
Код:
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));

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

      FileTrasfer_Receive := OpenFile(FFile, FileTrasfer_Name); // Переводим сервер в режим приёма файла
      Writing(RText);
    end;
  end;
end;
Writing(RText); не выполняется, судя по всему из за того что происходит ошибка в функции OpenFile
Код:
FileTrasfer_Receive := OpenFile(FFile, FileTrasfer_Name); // Переводим сервер в режим приёма файла
(я ее оборачивал в TRY except end и сработало исключение)Там точно все нормально? Я с трудом код этой функции понимаю )

Последний раз редактировалось niockasd; 04.05.2019 в 23:57.
niockasd вне форума Ответить с цитированием
Старый 05.05.2019, 11:33   #12
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

FileTrasfer_Name напишите что туда помещается, так как желательно туда путь указать и файл видимо OpenFile не может найти путь для сохранения поэтому возвращает false
Цитата:
Извиняюсь еще раз)
Получился код
Примерно так не меняя принцип в вашей функции я бы сделал по другому но для этого нужен проект

Код:
procedure Writing(Text: AnsiString);
begin
  if SizeFilesEx(FFile) < FileTrasfer_Size then // Если принято байт меньше размера файла, то...
     BlockWrite(FFile, Pointer(Text)^, Length(Text)); // Записываем буфер в файл

  if SizeFilesEx(FFile) = FileTrasfer_Size then  // Если файл принят, то...
  begin
    FileTrasfer_Receive := false; // Переводим клиента в нормальный режим

    Service.FileTransferSocketCleint.Socket.SendText('end');  // Посылаем команду "end", то есть файл принят
    CloseFile(FFile); // закрываем файл
  end;

  //что то пошло не так принял больше чем ждал
  if SizeFilesEx(FFile) >= FileTrasfer_Size then // Если файл принят, то...
  begin
    Service.FileTransferSocketCleint.Socket.SendText('end'); // Посылаем команду "end", то есть файл принят
    CloseFile(FFile); // закрываем файл
  end;
end;
Подробней об OpenFile функции и кое какие исправления в ней
Код:
function OpenFile(out AFile: File; const AFileName : UTF8String): longbool;
Var
 i: integer;
begin
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;
 end;

Последний раз редактировалось Aliens_wolfs; 05.05.2019 в 12:57.
Aliens_wolfs вне форума Ответить с цитированием
Старый 05.05.2019, 13:51   #13
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию

Спасибо) заработало.

Но размер пока получаю через FileSize (до 1 гб он я так понял ?)

SizeFilesEx string ждет, File не примет... Как его заставить file Полюбить ? ))))

Последний раз редактировалось niockasd; 05.05.2019 в 14:00.
niockasd вне форума Ответить с цитированием
Старый 05.05.2019, 14:01   #14
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
Но размер пока получаю через FileSize (до 1 гб он я так понял ?)
Примерно да может немного больше, но я для больших применял SizeFilesEx
FileSize с большими объемами мне в одном из моих проектов не помогло

Код:
procedure Writing(Text: AnsiString);
begin
  if SizeFilesEx(FileTrasfer_Name) < FileTrasfer_Size then // Если принято байт меньше размера файла, то...
     BlockWrite(FFile, Pointer(Text)^, Length(Text)); // Записываем буфер в файл

  if SizeFilesEx(FileTrasfer_Name) = FileTrasfer_Size then  // Если файл принят, то...
  begin
    FileTrasfer_Receive := false; // Переводим клиента в нормальный режим

    Service.FileTransferSocketCleint.Socket.SendText('end');  // Посылаем команду "end", то есть файл принят
    CloseFile(FFile); // закрываем файл
  end;
  //что то пошло не так принял больше чем ждал
  if SizeFilesEx(FileTrasfer_Name) >= FileTrasfer_Size then // Если файл принят, то...
  begin
    Service.FileTransferSocketCleint.Socket.SendText('end'); // Посылаем команду "end", то есть файл принят
    CloseFile(FFile); // закрываем файл
  end;
end;
Я там поторопившись ошибся нужно так SizeFilesEx(FileTrasfer_Name)

Последний раз редактировалось Aliens_wolfs; 05.05.2019 в 14:08.
Aliens_wolfs вне форума Ответить с цитированием
Старый 05.05.2019, 14:04   #15
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Код:
procedure Writing(Text: AnsiString);
begin
  if SizeFilesEx(FileTrasfer_Name) < FileTrasfer_Size then // Если принято байт меньше размера файла, то...
     BlockWrite(FFile, Pointer(Text)^, Length(Text)); // Записываем буфер в файл

  if SizeFilesEx(FileTrasfer_Name) = FileTrasfer_Size then  // Если файл принят, то...
  begin
    FileTrasfer_Receive := false; // Переводим клиента в нормальный режим

    Service.FileTransferSocketCleint.Socket.SendText('end');  // Посылаем команду "end", то есть файл принят
    CloseFile(FFile); // закрываем файл
  end;
//что то пошло не так принял больше чем ждал
if SizeFilesEx(FileTrasfer_Name) >= FileTrasfer_Size then // Если файл принят, то...
begin
Service.FileTransferSocketCleint.So cket.SendText('end'); // Посылаем команду "end", то есть файл принят
CloseFile(FFile); // закрываем файл
end;
end;

Я там ошибся нужно так SizeFilesEx(FileTrasfer_Name)
я пробовал FileTrasfer_Name скормить что то у меня не так пошло, файл не записывает с ней..

у меня еще тут ошибка была, я что то сначала выкинул строку эту
Код:
   function SizeFilesEx(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;
я так понял она все же нужна, выкидывать не стоит ее..
Где эта процедура описана ? FindClose(Handle) тоже не берет..
[dcc32 Error] MainUnit.pas(161): E2033 Types of actual and formal var parameters must be identical

Последний раз редактировалось niockasd; 05.05.2019 в 14:14.
niockasd вне форума Ответить с цитированием
Старый 05.05.2019, 14:12   #16
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

SizeFilesEx этой процедуры в модулях нет, она своя, из нее ничего нельзя выкидывать, поставьте ее перед процедурой OpenFile

в проекте должны быть подключены
uses
Windows, SysUtils, ..........

Последний раз редактировалось Aliens_wolfs; 05.05.2019 в 14:16.
Aliens_wolfs вне форума Ответить с цитированием
Старый 05.05.2019, 14:15   #17
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
SizeFilesEx этой процедуры в модулях нет, она своя, из нее ничего нельзя выкидывать, поставьте ее перед процедурой OpenFile
не не это я понял, я про ее код
Код:
  Windows.FindClose(Handle);
тут ошибка у меня
[dcc32 Error] MainUnit.pas(161): E2033 Types of actual and formal var parameters must be identical

SysUtils подключено.
niockasd вне форума Ответить с цитированием
Старый 05.05.2019, 14:17   #18
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуйте так
FindClose(Handle);
Aliens_wolfs вне форума Ответить с цитированием
Старый 05.05.2019, 14:19   #19
niockasd
Пользователь
 
Регистрация: 01.12.2015
Сообщений: 82
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Попробуйте так
FindClose(Handle);
пробовал) не в какую..
[dcc32 Error] MainUnit.pas(161): E2033 Types of actual and formal var parameters must be identical

если кликнуть по FindClose перебрасывает на sysutils все подключено, судя по всему хендл ей не нравится в качестве параметра...

Последний раз редактировалось niockasd; 05.05.2019 в 14:26.
niockasd вне форума Ответить с цитированием
Старый 05.05.2019, 14:25   #20
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Для вашего Delphi попробуйте так
Winapi.Windows.FindClose(Handle);

Если и так не выйдет то просто сделайте так в принципи тоже самое
CloseHandle(Handle);

Созданный Хендел всегда нужно закрывать

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


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
C# передача файлов в сети TaTT DoGG Помощь студентам 20 02.04.2017 15:53
Передача файлов по сети Shouldercannon Работа с сетью в Delphi 0 19.01.2016 15:30
передача файлов по сети SPD Общие вопросы Delphi 7 10.06.2011 00:24
Передача больших файлов чрез сокет D_E_N Работа с сетью в Delphi 0 18.01.2010 19:17
Передача файлов по сети SL1CK Работа с сетью в Delphi 3 05.12.2009 00:08