VPF::Протокол Mail.Ru - Форум программистов

Coderr

Дата 14.11.2007, 21:35 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Блин. Никак не получается... От указателей уже башка едет... smile

Помогите написать основные функции ивзвлечения/добавления UL, LPS данных создания и отправки пакетов. Использую компонент TClientSocket.
Ниже привожу код, который получился у меня:

Структура заголовка пакета:

Код


TPacketHeader = record
   magic     : LongWord;              // Magic
   proto     : LongWord;              // Версия протокола
   seq       : LongWord;              // Номер последовательности
   msg       : LongWord;              // Тип пакета
   dlen      : LongWord;              // Длина данных
   from      : LongWord;              // Адрес отправителя
   fromport  : LongWord;              // Порт отправителя
   reserved  : array[0..15] of byte;  // Зарезервированно
  end;
  PPacketHeader = ^TPacketHeader;

Создание заголовка пакета:

Код


procedure TForm1.CreatePacket(var Data: Pointer; Sequence, Command: LongWord);
var
  Packet: PPacketHeader;
begin
 New(Packet);
 FillChar(Packet^, sizeof(TPacketHeader), 0);
 with Packet^ do begin
  magic    := CS_MAGIC;
  proto    := PROTO_VERSION;
  seq      := Sequence;
  dlen     := 0;
  msg      := Command;
  from     := inet_addr('10.15.6.57');
  fromport := ClientSocket.Port;
 end;
 Data := Pointer(Packet); // Далее я использую data, как указатель на первый элемент всего пакета
end;

Добавление UL блока:

Код


procedure TForm1.AddPacketUL(var Data: Pointer; UL: Longword);
begin
 ReallocMem(Data, PPacketHeader(Data).dlen + SizeOf(Longword));
 MoveMemory(Pointer(Longword(Data) + PPacketHeader(Data).dlen), @UL, SizeOf(Longword));
 PPacketHeader(Data).dlen := PPacketHeader(Data).dlen + SizeOf(Longword);
end;

Добавление LPS блока:

Код


procedure TForm1.AddPacketLPS(var Data: Pointer; LPS: String);
var
  LengthLPS: Longword;
begin
 LengthLPS := Length(LPS);
 ReallocMem(Data, PPacketHeader(Data).dlen + SizeOf(Longword) + LengthLPS);
 MoveMemory(Pointer(Longword(Data) + PPacketHeader(Data).dlen), @LengthLPS, SizeOf(LengthLPS));
 if LengthLPS > 0 then
  MoveMemory(Pointer(Longword(Data) + PPacketHeader(Data).dlen + SizeOf(LengthLPS)), PChar(LPS), LengthLPS);
 PPacketHeader(Data).dlen := PPacketHeader(Data).dlen + SizeOf(LengthLPS) + LengthLPS;
end;

Извлечение UL блока из принятых данных:

Код


function TForm1.GetPacketUL(var Data: Pointer): LongWord;
begin
 Result := PCardinal(Data)^;
 Data := Pointer(Longword(Data) + SizeOf(LongWord));
end;

Функцию извлечения LPS блока из принятых данных я ещё не писал.

Вот так я принимаю данные:

Код


procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Header: PPacketHeader;
 Data: Pointer;
 Packet: PData;
 Size: Integer;
begin
 Size := Socket.ReceiveLength;
 if Size > 0 then begin
  GetMem(Packet, Size);
  Socket.ReceiveBuf(Pointer(Packet)^, Size);
  New(Header);
  Header := PPacketHeader(Packet);
  memo.Lines.Add('Size: '+inttostr(Size)+':  '+Inttostr(Header.dlen));
  Data := Pointer(Longword(Packet) + sizeof(TPacketHeader));
  case Header.msg of
   MRIM_CS_HELLO_ACK: Packet_MRIM_CS_HELLO_ACK(Data);
   MRIM_CS_CONNECTION_PARAMS: Packet_MRIM_CS_CONNECTION_PARAMS(Data);
   MRIM_CS_LOGIN_ACK:ShowMessage('ACK');
   MRIM_CS_LOGIN_REJ:ShowMessage('REJ');
  end;
  FreeMem(Packet);
 end;
end;

А вот так я создаю пакеты:

Код


var
  sequence: Longword;

...

procedure TForm1.Packet_MRIM_CS_HELLO;
var
  Packet: Pointer;
begin
 GetMem(Packet, sizeof(TPacketHeader));
 CreatePacket(Packet, Sequence, MRIM_CS_HELLO);
 ClientSocket.Socket.SendBuf(Pointer(Packet)^, sizeof(TPacketHeader));
 FreeMem(Packet);
 inc(Sequence);
end;

procedure TForm1.Packet_MRIM_CS_HELLO_ACK(var Data: Pointer);
begin
 Packet_MRIM_CS_PING;
 TimerPing.Enabled := False;
 TimerPing.Interval := GetPacketUL(Data)*1000;
 TimerPing.Enabled := True;
 Packet_MRIM_CS_LOGIN;
end;

procedure TForm1.Packet_MRIM_CS_PING;
var
  Packet: Pointer;
begin
 GetMem(Packet, sizeof(TPacketHeader));
 CreatePacket(Packet, Sequence, MRIM_CS_PING);
 ClientSocket.Socket.SendBuf(Pointer(Packet)^, sizeof(TPacketHeader));
 FreeMem(Packet);
 inc(Sequence);
end;

procedure TForm1.Packet_MRIM_CS_CONNECTION_PARAMS(var Data: Pointer);
begin
 TimerPing.Enabled := False;
 TimerPing.Interval := GetPacketUL(Data)*1000;
 TimerPing.Enabled := True;
end;

procedure TForm1.Packet_MRIM_CS_LOGIN;
var
  Packet: Pointer;
begin
 if Connected then begin
  GetMem(Packet, sizeof(TPacketHeader));
  CreatePacket(Packet, Sequence, MRIM_CS_LOGIN2);
  AddPacketLPS(Packet, LoginEdit.Text);
  AddPacketLPS(Packet, PasswordEdit.Text);
  AddPacketUL(Packet, STATUS_ONLINE);
  AddPacketLPS(Packet, 'Thumbelina');
  ClientSocket.Socket.SendBuf(Pointer(Packet)^,sizeof(TPacketHeader)+PPacketHeader(Packet).dlen);
  FreeMem(Packet);
  inc(Sequence);
 end;
end;

И ещё один вопрос напоследок. Иногда сервер меня дисконнектит. Это связано с тем, что я шлю ему неправильный пакет?

ЗЫ Помогите, пожалуйста, а то я точно свихнусь... smile

В аттаче полный исходник.

Присоединённый файл ( Кол-во скачиваний: 20 )

Mail_client.rar 27,62 Kb

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 14.11.2007, 22:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Имхо ты тут много всего лишнего наделал.

Код


PPacket = ^TPacket;
TPacket = record
  Header: TPacketHeader;
  Data: TByteArray;
end;

Выделяй/освобождай память лучше с помощью New/Dispose.

Чтение например UL

Код


var a: Cardinal;
    Packet: PPacket;
...
Move(Packet^.Data[0], a, 4);

Остальное по аналогии

Ну про прием я уже говорил. Так как у тебя сейчас сделано не пойдет.

Цитата(Coderr @ 14.11.2007, 21:35

)

Это связано с тем, что я шлю ему неправильный пакет?

Да

Coderr

Дата 15.11.2007, 00:57 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Спасибо Виктару сегодня опробую.

Добавлено через 3 минуты и 17 секунд
Хотел только один момент уточнить... Вот у нас тело пакета хранится в массиве байтов. А чтоб достать/положить LPS строку, что надо делать?

Присоединённый файл ( Кол-во скачиваний: 15 )

Mail_client.rar 27,62 Kb

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 15.11.2007, 01:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Запись
Move(длина_строки, Packet^.Data[позиция], 4);
Move(Строка[1], Packet^.Data[позиция], длина_строки);
Чтение
Move(Packet^.Data[позиция], длина_строки, 4);
SetLength(строка, длина_строки);
Move(Packet^.Data[позиция], Строка[1], длина_строки);

Coderr

Дата 15.11.2007, 23:07 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Типы:

Код


TPacketHeader = record
   magic     : LongWord;              // Magic
   proto     : LongWord;              // Версия протокола
   seq       : LongWord;              // Номер последовательности
   msg       : LongWord;              // Тип пакета
   dlen      : LongWord;              // Длина данных
   from      : LongWord;              // Адрес отправителя
   fromport  : LongWord;              // Порт отправителя
   reserved  : array[0..15] of byte;  // Зарезервированно
  end;

  PPacket = ^TPacket;
  TPacket = record
   Header : TPacketHeader;

   Data   : TByteArray;

  end;

Сделал вот такие функции...

Код


function TForm1.CreatePacket(Sequence, Command: LongWord): PPacket;
var
  Packet: PPacket;
begin
 New(Packet);
 FillChar(Packet^, sizeof(TPacket), 0);
 with Packet^.Header do begin
  magic    := CS_MAGIC;
  proto    := PROTO_VERSION;
  seq      := Sequence;
  dlen     := 0;
  msg      := Command;
  from     := inet_addr('10.15.6.57');
  fromport := ClientSocket.Port;
 end;
 Result := Pointer(Packet);
end;

procedure TForm1.AddUL(var Packet: PPacket; UL: Longword);
begin
 ReallocMem(Packet^.Data, Packet^.Header.dlen+4);
 Move(UL, Packet^.Data[Packet^.Header.dlen], 4);
 Packet^.Header.dlen := Packet^.Header.dlen+4;
end;

procedure TForm1.AddLPS(var Packet: PPacket; LPS: String);
var
  LPSLength: Longword;
begin
 LPSLength := length(LPS);
 ReallocMem(Packet^.Data, Packet^.Header.dlen+LPSLength+4);
 Move(LPSLength, Packet^.Data[Packet^.Header.dlen], 4);
 Move(LPS[1], Packet^.Data[Packet^.Header.dlen+4], 4);
 Packet^.Header.dlen := Packet^.Header.dlen+LPSLength+4;
end;

function TForm1.GetLPS(Packet: PPacket; var Offset: Longword): String;
var
  LPSLength: Longword;
begin
 Move(Packet^.Data[Offset], LPSLength, 4);
 Offset := Offset+4;
 SetLength(Result, LPSLength);
 Move(Packet^.Data[Offset], Result[1], LPSLength);
 Offset := Offset+LPSLength;
end;

function TForm1.GetUL(Packet: PPacket; var Offset: Longword): Longword;
begin
  Move(Packet^.Data[Offset], Result, 4);
  Offset := Offset+4;
end;

...и вот такие пакеты:

Код


procedure TForm1.Packet_MRIM_CS_HELLO;
var
  Packet: PPacket;
begin
 New(Packet);
 Packet := CreatePacket(Sequence, MRIM_CS_HELLO);
 ClientSocket.Socket.SendBuf(Packet, sizeof(TPacketHeader));
 Dispose(Packet);
 inc(Sequence);
end;

procedure TForm1.Packet_MRIM_CS_HELLO_ACK(var Packet: PPacket);
var
  Offset: Longword;
begin
 TimerPing.Enabled := False;
 Offset := 0;
 TimerPing.Interval := GetUL(Packet, Offset)*1000;
 Packet_MRIM_CS_PING;
 TimerPing.Enabled := True;
 Packet_MRIM_CS_LOGIN;
end;

procedure TForm1.Packet_MRIM_CS_PING;
var
  Packet: PPacket;
begin
 New(Packet);
 Packet := CreatePacket(Sequence, MRIM_CS_PING);
 ClientSocket.Socket.SendBuf(Pointer(Packet)^, sizeof(Packet));
 Dispose(Packet);
 inc(Sequence);
end;

procedure TForm1.Packet_MRIM_CS_CONNECTION_PARAMS(var Packet: PPacket);
var
  Offset: Longword;
begin
 TimerPing.Enabled := False;
 Offset := 0;
 TimerPing.Interval := GetUL(Packet, Offset)*1000;
 Packet_MRIM_CS_PING;
 TimerPing.Enabled := True;
end;

procedure TForm1.Packet_MRIM_CS_LOGIN;
var
  Packet: PPacket;
begin
 if Connected then begin
  New(Packet);
  Packet := CreatePacket(Sequence, MRIM_CS_LOGIN2);
  AddLPS(Packet, LoginEdit.Text);
  AddLPS(Packet, PasswordEdit.Text);
  AddUL(Packet, STATUS_ONLINE);
  AddLPS(Packet, 'Thumbelina');
  ClientSocket.Socket.SendBuf(Pointer(Packet)^,sizeof(Packet));
  Dispose(Packet);
  inc(Sequence);
 end;
end;

Принимаю данные теперь так:

Код


procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Size: Integer;
 Packet: PPacket;
begin
 Size := Socket.ReceiveLength;
 if Size > 0 then begin
  New(Packet);
  Socket.ReceiveBuf(Pointer(Packet)^, Size);
  memo.Lines.Add('Size: '+inttostr(Size)+':  '+Inttostr(Packet^.Header.dlen));
  case Packet^.Header.msg of
   MRIM_CS_HELLO_ACK: Packet_MRIM_CS_HELLO_ACK(Packet);
   MRIM_CS_CONNECTION_PARAMS: Packet_MRIM_CS_CONNECTION_PARAMS(Packet);
   MRIM_CS_LOGIN_ACK:ShowMessage('ACK');
   MRIM_CS_LOGIN_REJ:ShowMessage('REJ');
  end;
  Dispose(Packet);
 end;
end;

... вылетаю после HELLO пакета... smile

Трассировал - все данные на месте. Кстати, если так попробовать откомпилить - ничего не выйдет. Остановится на строке, например :

Код


 ReallocMem(Packet^.Data, Packet^.Header.dlen+4);

по причине несовпадения типов. А вот если задать тип так:

Код


PPacket = ^TPacket;
  TPacket = record
   Header : TPacketHeader;

   Data   : PByteArray; // Изменили тип

  end;

то всё нормально работает, за исключением дисконнекта. Где я опять напортачил??? smile

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 15.11.2007, 23:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

ReallocMem зачем? память ты уже выделил при создании пакета

Код


procedure TForm1.AddUL(Packet: PPacket; UL: Longword); //var здесь не нужен, ибо указатель
begin
 Move(UL, Packet^.Data[Packet^.Header.dlen], 4);
 inc(Packet^.Header.dlen, 4);
end;

Coderr

Дата 15.11.2007, 23:31 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Чтобы изменять размер занимаемой памяти. Ну исправил я. Всё равно на хэллоу обырается... =(

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 15.11.2007, 23:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Не в обиду, но ты вряд ли понимаешь, что делаешь

Код


procedure TForm1.Packet_MRIM_CS_HELLO;
var
  Packet: PPacket;
begin
 New(Packet); //зачем? память выделяется в CreatePacket
 Packet := CreatePacket(Sequence, MRIM_CS_HELLO);
 ClientSocket.Socket.SendBuf(Packet, sizeof(TPacketHeader)); //Packet^
 Dispose(Packet);
 inc(Sequence);
end;

Весь код не смотрел, но даже беглым взглядом заметно много ошибок и недочетов

Coderr

Дата 16.11.2007, 00:33 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Хм... Да уж. Спасибо! New что-то не заметил. А с указателями работать я начал только вот месяц назад, но пока с ними у меня плохо...
Вобщем, мегаРЕСПЕКТ тебе. К серваку приконнектился, вродь норм. Правда, статус мой не отображается у других(т.е. я красный в КЛ). Сменить статус?

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 16.11.2007, 01:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Свой статус ты посылаешь в MRIM_CS_LOGIN2

Coderr

Дата 16.11.2007, 01:30 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Ну правильно!
Вот это так выглядит:

Код


procedure TForm1.Packet_MRIM_CS_LOGIN;
var
  Packet: PPacket;
begin
 if Connected then begin
  Packet := CreatePacket(Sequence, MRIM_CS_LOGIN2);
  AddLPS(Packet, LoginEdit.Text);
  AddLPS(Packet, PasswordEdit.Text);
  AddUL(Packet, STATUS_ONLINE);
  AddLPS(Packet, 'Thumbelina');
  ClientSocket.Socket.SendBuf(Packet^,sizeof(Packet));
  Dispose(Packet);
  inc(Sequence);
 end;
end;

И по идее пакет отправился верно(меня не скинуло). Вот только на mail агенте не видно, что я в сети...
Что я опть не так сделал???
ЗЫ На нахождение в списках виз/инвиз и игнор не сслыться, ибо эта версия проверялась отдельно.

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 16.11.2007, 12:23 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Не вижу у тебя TimerPing.OnTimer. Что там?

Coderr

Дата 16.11.2007, 19:14 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

ДА всё, я разобрался =))) Ошибка была примитивно простые.

Код


procedure TForm1.AddLPS(Packet: PPacket; LPS: String);
var
  LPSLength: Longword;
begin
 LPSLength := length(LPS);
 Move(LPSLength, Packet^.Data[Packet^.Header.dlen], 4);
 Move(LPS[1], Packet^.Data[Packet^.Header.dlen+4], LPSLength); // Вместо LPSLength стояло 4 =))) Не заметил
 Packet^.Header.dlen := Packet^.Header.dlen+LPSLength+4;
end;

Везде, где пакет был больше чем 44 байта(т.е. в Data что-то было), я делал так:

Код


ClientSocket.Socket.SendBuf(Packet^, Sizeof(Packet));

поменял на:

Код


ClientSocket.Socket.SendBuf(Packet^, 44+Packet^.Header.dlen);

Исправил, работает.

--------------------

Кодинг - это стиль жизни!

Coderr

Дата 18.11.2007, 23:33 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0

Вопрос по смс.

Код


  MRIM_CS_SMS = $1039;
    // UL - unknown
    // LPS - number
    // LPS - text

  MRIM_CS_SMS_ACK = $1040;
    // UL - status

а что за unknown?

--------------------

Кодинг - это стиль жизни!

VICTAR

Дата 18.11.2007, 23:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 3
Всего: 80

Честно говоря не знаю, поснифь официального агента, но там вроде должен быть 0. Короче этот параметр не важен.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »