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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 22.08.2013, 14:56   #1
_CyberHedgehog_
Пользователь
 
Регистрация: 25.01.2012
Сообщений: 12
Печаль IdCMDTCP и передача zip архива

Добрый день. Реализовываю передачу zip архива с клиента на сервер. Использую IdCmdTCPServer и IdCmdTCPClient. Примерно, что есть сейчас:

1) Сервер шлёт клиенту команду 'yeswritefile':

Код:
procedure TForm1.Button1Click(Sender: TObject);
var i,l1:integer;
begin
if combobox1.ItemIndex<>-1 then
begin
 timer1.Enabled:=false;
 for i:=1 to stringgrid1.rowcount do
  if stringgrid1.Cells[1,i]=combobox1.Items[combobox1.itemindex] then l1:=i;
   tmplist:=idcmdtcpserver1.Contexts.LockList;
    tIdContext(tmpList[strtoint(stringgrid1.cells[0,l1])]).Connection.SendCmd('yeswritefile');
     idcmdtcpserver1.Contexts.unlockList;
end else
begin
  showmessage('Нет выбранного запроса!');
end;
end;
2) клиент получает уведомление от сервера и передаёт файл:

Код:
procedure TForm2.IdCmdTCPClient1CommandHandlers1Command(ASender: TIdCommand);
var f:tfilestream;
begin
 f:=tfilestream.Create(fn,fmopenread);
 try
 idcmdtcpclient1.Socket.WriteLn('200');                 \\необходимость данной строки спорная
 asender.Context.Connection.SendCmd('iwriteit');
 asender.Context.connection.IOHandler.WriteBufferOpen;
 ASender.Context.Connection.IOHandler.write(f);
 asender.Context.connection.IOHandler.WriteBufferClose;
 except
 f.Free;
 showmessage('Error!');
 end;
 if f<>nil then f.free;
end;
3) сервер же, получив команду iwriteit должен принять файл, однако зависает:

Код:
procedure TForm1.IdCmdTCPServer1CommandHandlers4Command(ASender: TIdCommand);
var f:tfilestream;
begin
 f:=tfilestream.Create('e:\slanm\server\receive'+FormatDateTime('yyyy.mm.dd hh.nn.ss.zzz', Now)+'.zip',fmcreate);
 showmessage('ok111');  \\для проверки
 asender.Context.Connection.iohandler.ReadStream(f);
 f.Free;

 memo1.Lines.Add(datetostr(now)+' '+timetostr(now)+', были приняты данные от клиента.');
end;
Не могу понять в чем дело. При тестировании сервера с помощью telnet клиента, выяснил, что сервер отправляет команду yeswritefile и виснет. Кажется он ждёт от telnet клиента reply(200), однако при отправке этого ответа ничего не происходит.
Путём экспериментов выяснил, что если отправить reply ровно через 20 секунд после зависания сервера, то в большинстве случаев он продолжает свою работу и можно отправлять команду iwriteit с клиента. Но почему именно 20 секунд, почему не всегда 20, а пару раз было 31, и как с этим работать на клиенте? Sleep(20 000) оказался неэффективен.
_CyberHedgehog_ вне форума Ответить с цитированием
Старый 22.08.2013, 15:04   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Вопрос не в тему: Может стоит использовать IdFTP для таких передач?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 22.08.2013, 15:08   #3
_CyberHedgehog_
Пользователь
 
Регистрация: 25.01.2012
Сообщений: 12
По умолчанию

Может и стоит, но уже готово больше половины проекта и именно с IdCmdTcp. Разбираться в работе IdFTP и начинать всё заново сейчас просто нет времени.
_CyberHedgehog_ вне форума Ответить с цитированием
Старый 22.08.2013, 15:44   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Хм... Ну тады звиняйте. Сказать нечего. Я избегал работать с IdTCP напрямую.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 22.08.2013, 20:06   #5
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

а так
Код:
procedure TForm1.Button1Click(Sender: TObject);
var i,l1:integer;
Context:tIdContext;
begin
if combobox1.ItemIndex<>-1 then
begin
 timer1.Enabled:=false;
 for i:=1 to stringgrid1.rowcount do
  if stringgrid1.Cells[1,i]=combobox1.Items[combobox1.itemindex] then l1:=i;
   tmplist:=idcmdtcpserver1.Contexts.LockList;
  Context:=tIdContext(tmpList[strtoint(stringgrid1.cells[0,l1])]);
     idcmdtcpserver1.Contexts.unlockList;
    Context.Connection.SendCmd('yeswritefile');
end else
begin
  showmessage('Нет выбранного запроса!');
end;
end;
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 23.08.2013, 13:14   #6
_CyberHedgehog_
Пользователь
 
Регистрация: 25.01.2012
Сообщений: 12
Злость

Slym, я пробовал. Но нет. Решение иное. Не знаю, что не так с sendcmd в TidContext, но стоило заменить

Код:
tIdContext(tmpList[strtoint(stringgrid1.cells[0,l1])]).Connection.SendCmd('yeswritefile');
на

Код:
TIdContext((tmpList[strtoint(stringgrid1.cells[0,l1])]).Connection.IOHandler.Writeln('yeswritefile');
, как сервер перестал виснуть.
Но полной работоспособности проекта я так и не достиг.
Что есть теперь:
1) Сервер получает уведомление от клиента, просит пользователя нажать на кнопку "Принять". Пользователь нажимает:

Код:
procedure TForm1.Button1Click(Sender: TObject);  \\нажатие кнопки 'принять' на сервере
var i,l1:integer;
begin
{if combobox1.ItemIndex<>-1 then
begin    }
 timer1.Enabled:=false;
 memo1.lines.Add('-1');
 for i:=1 to stringgrid1.rowcount do
   if stringgrid1.Cells[1,i]=combobox1.Items[combobox1.itemindex] then l1:=i;
 memo1.lines.Add('0');
 try
    tmplist:=idcmdtcpserver1.Contexts.LockList;
    memo1.lines.add('1');
    tIdContext(tmpList[strtoint(stringgrid1.cells[0,l1])]).Connection.IOHandler.WriteLn('yeswritefile');
    memo1.lines.Add('2');
 finally
   idcmdtcpserver1.Contexts.unlockList;
 end;
{end else
begin
  showmessage('Нет выбранного запроса!');
end;   }
end;
2) Клиент получает команду "yeswritefile", обрабатывает её и отправляет файловый поток:

Код:
procedure TForm2.IdCmdTCPClient1CommandHandlers1Command(ASender: TIdCommand);  \\получение 'yeswritefile' клиентом
var f:tfilestream;
begin
  memo1.Lines.add('2');
  f:=tfilestream.Create(fn,fmopenread);
  memo1.Lines.Add('2,5');    \\всё до этого включительно выводится, а дальше - нет
  asender.Context.Connection.SendCmd('iwriteit');
  memo1.Lines.add('3');
  try
    asender.Context.connection.IOHandler.WriteBufferOpen;
    memo1.lines.add('3,5');
    ASender.Context.Connection.IOHandler.write(f);
    asender.Context.connection.IOHandler.WriteBufferClose;
  finally
    memo1.Lines.add('4');
    f.Free;
  end;
end;
3) Сервер получает команду 'iwriteit' и принимает файловый поток от клиента:

Код:
procedure TForm1.IdCmdTCPServer1CommandHandlers4Command(ASender: TIdCommand);   \\получение сервером 'iwriteit'
var f:tfilestream;
begin
  f:=tfilestream.Create('e:\slanm\server\receive'+FormatDateTime('yyyy.mm.dd hh.nn.ss.zzz', Now)+'.zip',fmcreate);
  try
    memo1.Lines.add('3');   \\до 3 включительно выводится, дальше -нет 
    asender.Context.Connection.iohandler.ReadStream(f);
  finally
  memo1.lines.Add('4');
    f.free;
  end;
  memo1.Lines.Add(datetostr(now)+' '+timetostr(now)+', были приняты данные от клиента.');
end;
В общем, на диске появляется принятый архив, весящий 0 байт и повреждённый, что означает - сервер создаёт архив и хочет считать туда данные с принятого потока, но не делает этого. Почему?

Последний раз редактировалось _CyberHedgehog_; 23.08.2013 в 13:16.
_CyberHedgehog_ вне форума Ответить с цитированием
Старый 23.08.2013, 13:20   #7
_CyberHedgehog_
Пользователь
 
Регистрация: 25.01.2012
Сообщений: 12
По умолчанию

Иногда на диске появляются принятые файлы размером 1,5 Гб или 1,8 Гб. При отправке файла размером 1 байт :D
Но я пока не понял, при каких обстоятельствах это происходит. И вообще, это могут быть файлы из прошлых вариаций кода. Потому, не буду говорить точно, дабы не ввести в заблуждение.
_CyberHedgehog_ вне форума Ответить с цитированием
Старый 23.08.2013, 13:59   #8
_CyberHedgehog_
Пользователь
 
Регистрация: 25.01.2012
Сообщений: 12
По умолчанию

Попробовал поработать с memorystream. Так, на всяк случай:

Код писать весь, думаю, не нужно. Я просто использовал memorystream, вместо filestream. Ну, теперь вообще ничего не происходит с файлами на стороне сервера, но удалось заметить кое-что.
Если после нажатия кнопки "Принять" на сервере, принудительно закрыть окно клиента, то на сервере вылетит ошибка "Out of memory" и красным начнёт светится строка:

Код:
procedure TForm1.IdCmdTCPServer1CommandHandlers4Command(ASender: TIdCommand);
var mem:tmemorystream;
begin
  mem:=tmemorystream.Create;
  try
    asender.Context.Connection.iohandler.ReadStream(mem);
    mem.SaveToFile('e:\slanm\server\receive'+FormatDateTime('yyyy.mm.dd hh.nn.ss.zzz', Now)+'.zip');  \\ Эта строка!! 
  finally
    mem.free;
  end;
  memo1.Lines.Add(datetostr(now)+' '+timetostr(now)+', были приняты данные от клиента.');
end;
Наводит на мысли, что сервер принимает файл, но почему-то не может его сохранить. :/
_CyberHedgehog_ вне форума Ответить с цитированием
Старый 23.08.2013, 14:25   #9
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

как работает ReadStream? так - читает 4 байта (или больше? зависит от проперти LargeStream) размера и далее читает этот размер...
как работает write? так - тупо пишет содержимое стрима...
в чем разница? в размере! но есть магический параметр...
procedure Write(AStream: TStream; ASize: Int64 = 0; AWriteByteCount: Boolean = False);
в итоге имеем
ASender.Context.Connection.IOHandle r.write(f,0,true);
Не стесняемся, плюсуем!

Последний раз редактировалось Slym; 23.08.2013 в 14:36.
Slym вне форума Ответить с цитированием
Старый 23.08.2013, 14:26   #10
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
Так, на всяк случай
Так, на всякий случай всетки еще раз предложу IdFTP.
Я тут выкладывал пример своего ФТП сервера. Не жалею что написал его - работает как часы.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сравнение времени локального Zip архива с Zip архивом на FTP Qwerty192837 Общие вопросы Delphi 1 28.05.2013 10:20
Распаковка zip архива используя Ionic.Zip santaXZ C# (си шарп) 1 20.04.2013 02:46
DSPack воспроизведение из ZIP архива Adult_Master Мультимедиа в Delphi 0 22.01.2013 18:32
Delphi 2010 создания zip архива MORPEH Общие вопросы Delphi 5 11.12.2012 16:03
Чтение с zip архива Nikk[UA] Общие вопросы Delphi 15 21.06.2012 00:15