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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 19.01.2013, 10:59   #1
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
Вопрос Delphi Socket sendbuffer

прошу помощи разобраться с кодом а не вариантом исполнения:
Код:
procedure TForm1.srvrsckt1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ms:TMemoryStream;
  buf:Pointer;
  f:TFileStream;
  s:string;
  l:integer;
begin
  if(FileExists('dest.dat')) then DeleteFile('dest.dat');
  f:=TFileStream.Create('dest.dat',fmCreate);
  l:=Socket.ReceiveLength;
  mmo1.Lines.Add('/> ReceiveLength='+inttostr(l)+', of '+inttostr(sizeof(tpckr)));
  GetMem(buf,l);
  Socket.ReceiveBuf(buf^,l);
  ms:=TMemoryStream.Create;
  //ms.SetSize(sizeof(tpckr));
  //ms.Seek(0,soFromEnd);
  ms.Write(buf^,sizeof(l));
  ms.Read(sm,sizeof(tpckr));
  f.Read(buf^,sizeof(tpckr));
  {if(FileExists('temp.dat'))then DeleteFile('temp.dat');
  f:=TFileStream.Create('temp.dat',fmCreate);
  buf:=GetMemory(l);
  ms.Read(buf,sizeof(tpckr));
  ms.Write(sm,sizeof(tpckr));
  Delete(string(buf),1,sizeof(tpckr));
  if(sm.m=0) then begin
    f.Read(buf,l-1-sizeof(tpckr));
  end else begin
    s:=Copy(buf,1,l-1-sizeof(tpckr));
  end;}
  mmo1.Lines.Add(format('/> %s > %s ,%d[%d]~%s',[sm.f,sm.t,sm.m,sm.l,sm.p]));
  //f.Free;
  ms.Free;
  FreeMem(buf);
  f.Free;
end;
tpckr=record
l:longword;//size of
m:byte;//0-str,1-file
f:ShortString;//from
t:ShortString;//too
p:ShortString;//pasw
end;

sm=tpckr

Вопрос: почему в sm пусто?
PS: прошу не обращать внимание на излишние структуры кода - болванка.
ANsy вне форума Ответить с цитированием
Старый 19.01.2013, 11:23   #2
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Код:
ms:=TMemoryStream.Create; // создали поток
ms.Write(buf^,sizeof(l)); // записали в поток 4 байта , ибо sizeof(пеерменная интеджер) это размер интеджер в байтах = 4
ms.Read(sm,sizeof(tpckr)); // читаем из потока (который вообще-то только из 4 байт состоит),
// и "позиция чтения" потока на этот момент - конец потока
Вопрос - а что странного в том, что ничего не прочитав, там ничего и нет ?
Если я правильно понял, должно быть так:
Код:
ms:=TMemoryStream.Create; // создали поток
ms.Write(buf^, l); // записали в поток именно размер буфера, а не просто сайзоф
ms.Seek(0, soFromBeginning); // перемотаем поток в начало, чтобы именно с начала читать
ms.Read(sm,sizeof(tpckr)); // теперь читаем спокойно, и именно кол-во байт сколько занимает структура
phomm вне форума Ответить с цитированием
Старый 19.01.2013, 19:10   #3
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
По умолчанию

Прав отчасти, потому что ошибка в коде :
Код:
ms.Write(buf^, sizeof(tpckr))

Последний раз редактировалось ANsy; 19.01.2013 в 19:14.
ANsy вне форума Ответить с цитированием
Старый 19.01.2013, 22:06   #4
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
По умолчанию

код не сжатый, безкоментариев...

принимаю
Код:
procedure TForm1.srvrsckt1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ms:TMemoryStream;
  buf:Pointer;
  f:TFileStream;
  s:string;
  l:integer;
begin
  if(FileExists('dest.dat')) then DeleteFile('dest.dat');
  f:=TFileStream.Create('dest.dat',fmCreate);
  l:=Socket.ReceiveLength;
  mmo1.Lines.Add('/> ReceiveLength='+inttostr(l)+', sizeof '+inttostr(sizeof(tpckr)));
  GetMem(buf,l);
  Socket.ReceiveBuf(buf^,l);
  ms:=TMemoryStream.Create;
  ms.Write(buf^,l);
  ms.Seek(0,soFromBeginning);
  ms.Read(sm,sizeof(tpckr));
  f.Write(buf^,l);
  //ms.Clear;
  if(sm.m=0) then begin
    ms.Seek(sm.l,soFromEnd);
    ms.Read(f,l-sizeof(tpckr));
    //f.Write(buf,l-1-sizeof(tpckr));
  end else begin
    ms.Seek(sm.l,soFromEnd);
    SetString(s,PChar(ms.memory),sm.l);
    //ms.Read(s[1],sm.l*sizeof(s[1]));
    //s:=Copy(buf,1,l-1-sizeof(tpckr));
  end;
  mmo1.Lines.Add(format('/> %s > %s ,%d[%d]~%s',[sm.f,sm.t,sm.m,sm.l,sm.p]));
  if(sm.m=0) then
    mmo1.Lines.Add(format('/> load File "dest.dat", "%d" bytes',[f.Size]))
  else
    mmo1.Lines.Add(format('/> [%d]s: %s',[sm.l,s]));
  //f.Free;
  ms.Free;
  FreeMem(buf);
  f.Free;
end;
отправляю
Код:
procedure TForm1.btn2Click(Sender: TObject);
var
  f:TFileStream;
  ms:TMemoryStream;
  msg:string;
  nw:integer;
  buf:Pointer;
begin
  if(FileExists('temp.dat')) then DeleteFile('temp.dadt');
  f:=TFileStream.Create('temp.dat',fmCreate);
  ms:=TMemoryStream.Create;
  msg:=edt1.Text;
  sm.f:=edit1.Text;
  sm.t:=edit2.Text;
  sm.p:=edit3.Text;
  sm.m:=1;
  sm.l:=length(msg);
  f.Write(sm,SizeOf(tpckr));
  ms.Write(sm,sizeOf(tpckr));
  ms.Write(msg[1],length(msg)*sizeof(msg[1]));//s[1], length(s) * sizeof(s[1])
  GetMem(buf,ms.Size);
  ms.Seek(0,soFromBeginning);
  ms.Read(buf^,ms.Size);
  nw:=clntsckt1.Socket.SendBuf(buf^,ms.Size);
  FreeMem(buf);
  if(nw>0) then
    mmo1.Lines.Add(format('отправлено %d',[nw]));
  ms.Free;
  f.Free;
end;
данные tpckr получаю, а вот строку не получается скушать, пустая почему то, хотя дроп в файле правильный, где то в переводе из ms (TMemorystream) в s (string) не получается?
ANsy вне форума Ответить с цитированием
Старый 19.01.2013, 23:32   #5
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Код:
SetString(s,PChar(ms.memory),sm.l); // жуть какая-то, так под строки имхо не гуд выделять память
// ведь memory указует на начало потока, а строка в середине
    //ms.Read(s[1],sm.l*sizeof(s[1])); // а вот это правильно, только, наверное, не sizeof(s[1]) а sizeof(Char)
Я бы память выделил Setlength(s, sm.l);

А вообще прием-посыл надо отделять от логики сериализации данных в буфер, имхо, а то код - мешанина.
Кстати, что пишете-то ? нехай пассворд-личер какой ?

Последний раз редактировалось phomm; 19.01.2013 в 23:36.
phomm вне форума Ответить с цитированием
Старый 20.01.2013, 15:07   #6
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
По умолчанию

Благодарю, заработало. Вы опять почти правы: проставил
Код:
ms.Seek(sizeof(tpckr),soFromBeginning);
SetLength(sv,sm.l);
ms.Read(sv[1],sm.l*sizeof(char));
...
PS(помогаю сделать курсовую св даме)
...
видел ваши поделки по теме веломобился... ответное предлдожение-вопрос: а вы машинку баумана не пробовали собрать?
ANsy вне форума Ответить с цитированием
Старый 05.02.2013, 22:10   #7
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
Вопрос

Проблемка... отправка файла происходит но не могу понять почему файл, даже на уровне клиента получается кривой (проверял в выбросе на дискв файл)?

прикладываю готовый вариант работы в sckKSOChat.zip файле...

Примечание:
универсальня функция отправки, у клиента и сервера не отличаются в принципе
Код:
function TWrkP.sendMsg(bh:TPPckR;var bf:TFileStream;bs:String):integer;
var
  vm:TMemoryStream;
  vl:Integer;
  vb:Pointer;
begin
  Result:=-1;
  vm:=TMemoryStream.Create;
  vm.Seek(0,soFromBeginning);
  vm.Write(bh^,SizeOf(TPckR));
  if (bh^.ln>0) then begin //òåêñò
    vl:=length(bs);
    if (vl>0) then vm.Write(bs[1],vl);
  end;
  if ((bh^.fn<>'')and(bf<>nil)) then begin //ôàéë
    GetMem(vb,vm.Size+bf.Size);
    //bf.Seek(0,soFromBeginning);
    ///bf.ReadBuffer(vb^,vm.Size+bf.Size);
    vm.Write(bf,bf.Size);
  end;
  GetMem(vb,vm.Size);
  vm.Seek(0,soFromBeginning);
  vm.Read(vb^,vm.Size);
  Result:=client.socket.SendBuf(vb^,vm.Size);
  vm.Seek(0,soFromBeginning);
  FreeMem(vb);
  vm.SaveToFile(GetCurrentDir+'\'+getUID+'.buf');//check
  vm.Free;
end;
Код отправки файла от клиента. Файл сначала летит на сервер потом по запросу скачивается на клиент получателя.
Код:
procedure TForm1.Button3Click(Sender: TObject);
var
  vh:tppckr;
  vs:string;
  vf:TFileStream;
  vm:TMemoryStream;
  vc:Integer;
  vl:Integer;
begin
  vc:=0;
  if (OpenDialog1.Execute) then begin
    vf:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
    //îãðàíè÷åíèå îòïðàâêè 2ÌÁ ôàéëà
    if ((vf.Size<SS_MSF)and(vf.Size>0)) then begin
      vs:=Memo2.Lines.Text;
      vl:=Length(vs);
      New(vh);
      with vh^ do begin
        ha:=WP_Sta;
        hb:=SP_Fil;
        hc:=#0;
        ln:=vl;
        fn:=ExtractFileName(OpenDialog1.FileName);
        pw:=SS_Psw;
        from:=woo.nick;
        too:=woo.getSelUsers;
        dt:=Now;
      end;
      vc:=woo.sendMsg(vh,vf,vs);
      addLogMsg(format('[%s] îòïðàâëåíî %d Áàéò äëÿ "%s"',[woo.gt,vc,vh^.too]));
      Dispose(vh);
    end else MessageDlg('Ðàçìåð ôàéëà äîëæåí áûòü îò 0 Áàéò äî 2ÌÁ Áàéò',mtError,[mbok],0);
    vf.Free;
  end;
end;
Код приема сообщения от сервера. Ловит по информации заголовка.
Код:
procedure TForm1.ServerSocket1ClientRead(Sender:TObject;Socket:TCustomWinSocket);
var
  bh:TPPckR;
  vh:TPPckR;
  vi:Integer;
  vl:Int64;
  vs:String;
  vf:TFileStream;
  buff:Pointer;
  bl:Integer;
  bm:TMemoryStream;
  fp:String;
begin
  bl:=Socket.ReceiveLength;
  GetMem(buff,bl);
  socket.ReceiveBuf(buff^,bl);
  bm:=TMemoryStream.Create;
  bm.Write(buff^,bl);
  FreeMem(buff,bl);
  New(bh);
  //øàïêà
  bm.Seek(0,soFromBeginning);
  bm.Read(bh^,SizeOf(TPckR));
  addMsgLog(Format('![%s] %s->%s : { a:%s, b:%s, ln:%d }',[woo.gt,bh^.from,bh^.too,bh^.ha,bh^.hb,bh^.ln]));
  // Ñèñòåìíûå
  if (bh^.ha=WP_Sys) then begin
    //îøèáêè
    if (bh^.hb=SP_Err) then woo.action_sysErr(Socket,bh);
    //ïîäêëþ÷åíèå
    if (bh^.hb=SP_Con) then woo.action_sysCon(Socket,bh);
    //çàïðîñ îò êëèåíòà îáíîâë ñïèñêà êëèåíòîâ
    if (bh^.hb=SP_AUp) then woo.action_sysAUp(Socket,bh);
  end;
  // Ñòàíäàðòíûå
  if (bh^.ha=WP_Sta) then begin
    //ñîîáùåíèÿ
    if (bh^.hb=SP_Msg) then woo.action_stdMsg(Socket,bm);
    //ôàéë äëÿ êëèåíòà
    if (bh^.hb=SP_Fil) then begin
      fp:=GetCurrentDir;
      fp:=fp+'\userdata';
      if not(DirectoryExists(fp)) then CreateDir(fp);
      woo.action_stdFil(Socket,bh,bm);
    end;
...
Не могу пока что разобраться почему и где в коде универсальной отправки сообщений клиента не так формирую пакет, тк его сбро с файл показывает его кривость. ps(другой варинат не подойдет ибо курсовая на тему сокетов: чат через сервер)
Вложения
Тип файла: zip sckKSOChat.zip (616.6 Кб, 19 просмотров)
ANsy вне форума Ответить с цитированием
Старый 07.02.2013, 10:56   #8
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,882
По умолчанию

Причина - обычная невнимательность:
Код:
function TWrkP.sendMsg(bh:TPPckR;var bf:TFileStream;bs:String):integer;
var
  vm:TMemoryStream;
  vl:Integer;
  vb:Pointer;
begin
  Result:=-1;
  vm:=TMemoryStream.Create; //создали МС для всей посылки
  vm.Seek(0,soFromBeginning); 
  vm.Write(bh^,SizeOf(TPckR));
  if (bh^.ln>0) then begin //текст
    vl:=length(bs);
    if (vl>0) then vm.Write(bs[1],vl);
  end;
  if ((bh^.fn<>'')and(bf<>nil)) then begin //файл
    GetMem(vb,vm.Size+bf.Size);
    //bf.Seek(0,soFromBeginning);
    ///bf.ReadBuffer(vb^,vm.Size+bf.Size);
    vm.Write(bf,bf.Size);
  end;
  GetMem(vb,vm.Size);
  vm.Seek(0,soFromBeginning);
  vm.Read(vb^,vm.Size);
  Result:=client.socket.SendBuf(vb^,vm.Size);
  vm.Seek(0,soFromBeginning);
  FreeMem(vb);
  vm.Free;
end;
Заменить write на CopyFrom, а то иначе просто память некую пишете с указателя на поток.
В приёме тот же косяк - в сервере поменять эту же функцию так же, а то принимает норм и шлёт ерунду ))
phomm вне форума Ответить с цитированием
Старый 07.02.2013, 15:51   #9
ANsy
Пользователь
 
Аватар для ANsy
 
Регистрация: 30.09.2010
Сообщений: 19
По умолчанию

ага... разобрался уже давно. На сайт зайти немог
ANsy вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Ошибка в программе [Delphi 7] при передаче данных - "socket error" -Jack- Работа с сетью в Delphi 7 18.07.2012 07:29
socket Артэс C/C++ Сетевое программирование 2 22.06.2009 17:22
НЕ могу найти Server Socket в закладке Internet в Delphi 7 для создания серверной части трояна Reds Общие вопросы Delphi 4 11.10.2008 16:27
Socket Delphi 2007 Editor Общие вопросы Delphi 1 19.04.2008 10:31
Socket Delphi 7 merax Работа с сетью в Delphi 1 09.02.2007 10:32