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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.03.2013, 11:20   #1
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию winsock - теряется часть сообщения

Доброго времени суток. Столкнулся с такой проблемкой:

с клиента посылаю сообщение с текстом "connected" функцией:

Код:
function SendTextPacket(sock: TSOCKET; PacketType: integer; const s: string): integer;
var
  ph: PacketHeader;
begin
  ph.PacketType := PacketType;
  ph.PacketLength := Length(s);
  send(sock, ph, sizeof(ph), 0);
//  showmessage(inttostr(length(s)));
  if Length(s) > 0 then  Result := send(sock, Pointer(s)^, Length(s), 0)
  else Result := 0;
end;
в сервере ловлю так:

Код:
procedure TfmMain.MPacketFromClient(var m: TMessage);
var
  phwcn: ^PacketHeaderWithClientNumber;
  t : PChar;
  s, s2: string;
  i: integer;
begin
  WParam(phwcn) := m.WParam;
  case phwcn^.ph.PacketType of
    PACKETTYPE_LOGINQUERY:
      begin
        t := PChar(m.LParam);
        s := '';
        for i := 0 to phwcn^.ph.PacketLength - 1 do s := s + t[i];
 
        if s = 'connected' then
        begin
..........................................
в итоге сервер получает только часть сообщения, т.е. например "conn" и два квадратика или ??, в общем какие то символы ...

В чем может быть проблема?

p.s. использую 2010 Delphi , в старом проекте под Delphi 7 все работает.
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 29.03.2013, 12:05   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

А где код сервера в котором выполняется WinSock.recv( возможно там не все данные принимаются а кусками, буфер нужно правильно делать для приема иначе он кусками будет, вот эти куски нужно собрать, а потом работать уже с полным буфером.

Еще покажите код как строиться передача сообщения видимо через SendMessage

И еще попробуйте так

Код:
procedure TfmMain.MPacketFromClient(var m: TMessage);
var
  phwcn: ^PacketHeaderWithClientNumber;
  S : String;
begin
  phwcn := Pointer(m.WParam);
  case phwcn^.ph.PacketType of
    PACKETTYPE_LOGINQUERY:
    if phwcn^.ph.PacketLength > 0 then
      begin
       SetLength(s, phwcn^.ph.PacketLength);
       Move(Pointer(m.LParam)^, Pointer(s)^, phwcn^.ph.PacketLength);

И почему бы вам не передавать сразу в записи текст примерно так
Код:
function SendTextPacket(sock: TSOCKET; PacketType: integer; const s: string): integer;
var
  ph: PacketHeader;
 Size: Integer;
begin
  ph.PacketType := PacketType;
  ph.PacketLength := Length(s);
  ph.Text:= s; // значение добавить в запись
 Size:= send(sock, ph, sizeof(ph) + Length(s)-1, 0);
if Size <> SOCKET_ERROR then
  Result:= Size
  else 
Result := 0;
end;
Прием но это для коротких сообщений, для больших нужно накапливать буфер о чем и написал выше

Код:
  ph: ^PacketHeader;
 Size: Integer;
begin

    Result:= 0;
     ioctlsocket(sock, FIONREAD, Size); // Ловим размер данных
     if Size > 0 then
     begin
      GetMem(ph, Size);
       Size := WinSock.recv(sock, ph^, Size, 0);
        if (Size <> SOCKET_ERROR) then
       result:= Size;
  что то сделать с полученными данными...............
.......................................................................

   FreeMem(ph);
end;

end;
Но это все примерно, я незнаю как у вас сделан прием данных

Последний раз редактировалось Aliens_wolfs; 29.03.2013 в 12:57.
Aliens_wolfs вне форума Ответить с цитированием
Старый 29.03.2013, 13:29   #3
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию

вот полная функция, именно приема (как я понял) ...

Код:
function ClientThread(p: pointer): DWORD; stdcall;
var
  Params: ^SocketParams;

  buf: pointer;
  got, toget: integer;
  res: integer;
  ph: PacketHeader;
  phwcn: PacketHeaderWithClientNumber;

  procedure CloseConnection;
  begin
    closesocket(Params^.Socket);
  end;
begin
  res := IncrementClientCount;

  Result := 0;

  Params := p;

  if res <= MAX_CLIENTS then
  begin
    res := 1;
    while (res < MAX_CLIENTS) and (ClientsArray[res].connected) do inc(res);
    Params^.index := res;
    ClientsArray[Params^.index].Answers.Clear;
    ClientsArray[Params^.index].connected := true;
    ClientsArray[Params^.index].Socket := Params^.Socket;
    ClientsArray[Params^.index].Hand := false;
    ClientsArray[Params^.index].LessonName := '';
    SendMessage(fmMain.Handle, M_CLIENTCONNECTED, res, 0);
    while true do
    begin
      got := 0;
      res := 1;
      while (got < sizeof(ph)) and (res <> SOCKET_ERROR) and (res <> 0) do
      begin
        toget := sizeof(ph) - got;
        res := recv(Params^.Socket, ph, toget, 0);
        inc(got, res);
      end;
      if (res <> SOCKET_ERROR) and (res <> 0) then
      begin
        if ph.PacketType <> 0 then
        begin
          begin
            GetMem(buf, ph.PacketLength);

            got := 0;
            while (got < ph.PacketLength) and (res <> SOCKET_ERROR) and (res <> 0) do
            begin
              if ph.PacketLength - got > 1024 then toget := 1024 else
                toget := ph.PacketLength - got;
              res := recv(Params^.Socket, pointer(integer(buf) + got)^, toget, 0);
              inc(got, res);
            end;
            if (res = SOCKET_ERROR) or (res = 0) then
            begin
              FreeMem(buf);
              Break
            end
            else begin
              phwcn.ph := ph;
              phwcn.ClientNumber := Params^.Index;
              phwcn.PacketProcessed := false;
              if ph.PacketType = PACKETTYPE_GETMEDIAFILE then
              begin
                SendMediaFile(phwcn.ClientNumber, phwcn.ph.PacketLength, buf);
              end
              else
                SendMessage(fmMain.Handle, M_PACKETFROMCLIENT, WParam(@phwcn), LParam(buf));
              FreeMem(buf);
            end;
          end;
          if (res = SOCKET_ERROR) or (res = 0) then Break;
        end
        else break;
      end else break;
    end;
  end;
  if Params^.index = 0 then CloseConnection
  else if ClientsArray[Params^.index].connected then
  begin
    CloseConnection;
    ClientsArray[Params^.index].connected := false;
    //DrawUser(Params^.index, false);
    ClientsArray[Params^.index].PlaceNumber := '';
  end;
  PostMessage(fmMain.Handle, M_CLIENTDISCONNECTED, Params^.index, 0);
  dispose(Params);
  DecrementClientCount;
end;
p.s. программу изначально не я писал ... сижу разбираюсь ... но она была под Delphi 7, а я на 2010 делаю ... возможно в этом проблема ...
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 29.03.2013, 15:53   #4
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Еще может быть проблема в переменных, Pchar в Delphi10 это PAnsiChar в приеме
Aliens_wolfs вне форума Ответить с цитированием
Старый 29.03.2013, 16:06   #5
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию

Я уже все вариации типов перепробовал... Разница между PChar и PAnsiChar в этом случае, дают примерно такой результат:

Отправляю слово: connected (типа string)

Приходит:
PChar - 'conn□□'
PAnsiChar - 'c□o□n□n□e'

примечательно то что во втором случае, количество символов соблюдается, но сами символы теряются ...
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 30.03.2013, 20:53   #6
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию

Немного сдвинулся с места, сделал одинаковый тип PAnsiChar и для отправки и для приема(точнее пост обработки, после приема), в результате приходит то что нужно, но дополнительно с каким то мусором ... т.е. отправляю например: connected, а приходит : connectedpoe ... и так каждый раз, для разных сообщений разный мусор в конце появляется ... из за чего потом в функции GetMem() появляется переполнение памяти ...
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 30.03.2013, 21:32   #7
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию

Обнаружил сейчас такую аномальную штуку:
если отправлять 7 байт (Connect) - все нормально отправляет, и получает
если отправить от 8 до 12 (connecte, connected ...) - то появляются дополнительные символы, которые дополняют до 12, т.е. если отправили 8, то приходит 8 те что отправили и плюс 4 с потолка, если отправили 9, то 3 с потолка...
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 01.04.2013, 09:14   #8
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуйте это, правда я незнаю для чего вам столько много масивов записей нужно, но оставил, лишь изменил цикл:
Код:
function ClientThread(p: pointer): DWORD; stdcall;
var
  Params: ^SocketParams;

  buf: pointer;
  got, toget: integer;
  Size: integer;
  ph: ^PacketHeader;
  phwcn: PacketHeaderWithClientNumber;

  procedure CloseConnection;
  begin
    closesocket(Params^.Socket);
  end;
begin
  res := IncrementClientCount;

  Result := 0;

  Params := p;

  if res <= MAX_CLIENTS then
  begin
    res := 1;
    while (res < MAX_CLIENTS) and (ClientsArray[res].connected) do inc(res);
    Params^.index := res;
    ClientsArray[Params^.index].Answers.Clear;
    ClientsArray[Params^.index].connected := true;
    ClientsArray[Params^.index].Socket := Params^.Socket;
    ClientsArray[Params^.index].Hand := false;
    ClientsArray[Params^.index].LessonName := '';
    SendMessage(fmMain.Handle, M_CLIENTCONNECTED, res, 0);

got := 0;
buf:= nil;
while true do
begin
     ioctlsocket(sock, FIONREAD, Size); // Ловим размер данных но это для TCP в UDP может работать неправильно
 //Если размер больше 0 то принимаем данные
  if Size > 0 then
  begin
  if (got = 0) then
    GetMem(buf, Size) // выделяем новую область памяти для буфера
  else
    ReallocMem(buf, got + Size);  //нужно расширять область памяти когда она уже выделена, а не выделять новую область
  inc(got, Size);
  Size := WinSock.recv(sock, pointer(integer(buf) + got)^, Size, 0);
 end
 else
 begin
//Если размер 0 то проверяем что буфер получил адрес памяти и обрабатываем его
 if (buf <> nil)and(got > 0) then
 begin
  ph:= buf;
  phwcn.ph := ph;
  phwcn.ClientNumber := Params^.Index;
  phwcn.PacketProcessed := false;
  if ph.PacketType = PACKETTYPE_GETMEDIAFILE then
  SendMediaFile(phwcn.ClientNumber, phwcn.ph.PacketLength, pointer(integer(buf) + SizeOf(PacketHeader))
  else
  SendMessage(fmMain.Handle, M_PACKETFROMCLIENT, WParam(@phwcn), LParam(pointer(integer(buf) + SizeOf(PacketHeader))));
  FreeMem(buf);
  break;
  end
  else
  break;

 end;
end;

  if Params^.index = 0 then CloseConnection
  else if ClientsArray[Params^.index].connected then
  begin
    CloseConnection;
    ClientsArray[Params^.index].connected := false;
    //DrawUser(Params^.index, false);
    ClientsArray[Params^.index].PlaceNumber := '';
  end;
  PostMessage(fmMain.Handle, M_CLIENTDISCONNECTED, Params^.index, 0);
  dispose(Params);
  DecrementClientCount;
end;
Был бы полный проект можно было бы в нем проверить.

Последний раз редактировалось Aliens_wolfs; 01.04.2013 в 09:28.
Aliens_wolfs вне форума Ответить с цитированием
Старый 01.04.2013, 09:38   #9
DenProx
Форумчанин
 
Аватар для DenProx
 
Регистрация: 23.11.2009
Сообщений: 191
По умолчанию

вот мой мини проект (без ваших дополнений), на данный момент вроде как принимаю и отправляю сообщения. Хотелось бы чтоб посмотрел на код более опытный человек

Исходники.rar
Чаще всего, у большенства людей, поиск Истины заканчивается набором слова в Гугле
DenProx вне форума Ответить с цитированием
Старый 01.04.2013, 10:07   #10
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Программа клиент тоже выложи, там тоже нужно проверять, немного подправил.

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


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
быстродействие запуска теряется и размер проекта немножко больше стает beegl Общие вопросы Delphi 2 05.01.2013 21:51
Office.Interop.Word Find.Execute Method теряется форматирование Squash_ Microsoft Office Word 0 09.08.2011 12:23
Label при запуске приложения текст теряется pavellyba Общие вопросы Delphi 4 04.04.2011 00:44
теряется жосткий диск. podujanin Помощь студентам 18 03.06.2010 22:12
Часть фона одним цветом а другая часть другим (без таблиц). Lanselot HTML и CSS 4 25.04.2008 18:41