Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Сети > Протокол Mail.Ru


Автор: Coderr 30.10.2007, 22:48
Здравствуйте! Решил написать Mail.Ru клиент. Вроде открытый протокол, но ничего не понятно!!! smile Описание слишком скудное и разработчики Мэйла на крик помощи не отвечают...
Единственное, что сделал - сформировал файл констант и типов методом перевода сишного заголовочника в делфовый юнит. =) Его можно взять в аттаче.
А просьба, собсно, такая. Объясните как формировать пакеты.  smile 

Автор: MetalFan 31.10.2007, 09:00
дал бы хоть ссылку на спецификацию...

Автор: Coderr 31.10.2007, 13:08
Хм... Неужели её ещё мало кто видел?  smile 
http://agent.mail.ru/developers/protocol.html?Submit=%CF%F0%E8%ED%E8%EC%E0%FE+%F1%EE%E3%EB%E0%F8%E5%ED%E8%E5

Автор: VICTAR 1.11.2007, 04:06
Усе элементарно =). Пакет=Header(44 байта) + Data(Header.dlen).
Ну а дальше флаг в руки... =)

Автор: aktuba 1.11.2007, 10:11
Цитата

Хм... Неужели её ещё мало кто видел?


Например, я не видел и не планирую в ближайшее время. Пока что использую только icq, если надо будет менять - перейду на gtalk или jabber... Но никак не на mail-агент...

Автор: Coderr 3.11.2007, 23:44
VICTAR, это, конечно, всё понятно. И с математикой у меня хорошо. А КАК??? Как отправлять/принимать? Решил для пробы использовать два ClientSocketа. Одним получать сервер к которому коннектиться, другой - для всего остального.
С получением доступного сервера и отправкой HELLO пакета  всё нормально, а вот принять MRIM_CS_HELLO_ACK не могу. Принять-то принимаю, но в нём данных нет... =( Делаю всё так:
Код

TPacketHeader = packed 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 CreatePacket(Packet: PPacketHeader; Sequence, Command, Port: Longword; IP: string);
begin
 ZeroMemory(Packet, sizeof(TPacketHeader));
 with Packet^ do begin
  magic    := CS_MAGIC;
  proto    := PROTO_VERSION;
  seq      := Sequence;
  msg      := Command;
  from     := inet_addr(PChar(IP));
  fromport := Port;
 end;
end;

procedure TForm1.Packet_MRIM_CS_HELLO;
var
  Packet: TPacketHeader;
begin
 CreatePacket(@Packet, Sequence, MRIM_CS_HELLO, ClientSocket.Port, ClientSocket.Host);
 ClientSocket.Socket.SendBuf(Packet, sizeof(TPacketHeader));
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Header: PPacketHeader;
begin
 Header := @Socket.Data;

 Memo.Lines.Add(IntToStr(Header.seq)+';'+IntToStr(Header.msg)+';'+IntToStr(Header.dlen));
 // Вывод я сделал примерно. Может я вывожу просто неправильно?
end;

procedure TForm1.FirstClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ip_port: string;
begin
 ip_port := Socket.ReceiveText;
 FirstClientConnect.Active := False;
 // Получаем IP и порт сервера
 ClientSocket.Address := copy(ip_port,1,pos(':',ip_port)-1);
 ClientSocket.Port := StrToInt(copy(ip_port,pos(':',ip_port)+1,length(ip_port)-pos(':',ip_port)-1));
 ClientSocket.Active := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FirstClientConnect.Active := True;                   // Активизируем клиент для получение доступного сервера
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 Packet_MRIM_CS_HELLO;
end;

Автор: Coderr 3.11.2007, 23:50
VICTAR, это, конечно, всё понятно. И с математикой у меня хорошо. А КАК??? Как отправлять/принимать? Решил для пробы использовать два ClientSocketа. Одним получать сервер к которому коннектиться, другой - для всего остального.
С получением доступного сервера и отправкой HELLO пакета  всё нормально, а вот принять MRIM_CS_HELLO_ACK не могу. Принять-то принимаю, но в нём данных нет... =( Делаю всё так:
Код

TPacketHeader = packed 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 CreatePacket(Packet: PPacketHeader; Sequence, Command, Port: Longword; IP: string);
begin
 ZeroMemory(Packet, sizeof(TPacketHeader));
 with Packet^ do begin
  magic    := CS_MAGIC;
  proto    := PROTO_VERSION;
  seq      := Sequence;
  msg      := Command;
  from     := inet_addr(PChar(IP));
  fromport := Port;
 end;
end;

procedure TForm1.Packet_MRIM_CS_HELLO;
var
  Packet: TPacketHeader;
begin
 CreatePacket(@Packet, Sequence, MRIM_CS_HELLO, ClientSocket.Port, ClientSocket.Host);
 ClientSocket.Socket.SendBuf(Packet, sizeof(TPacketHeader));
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Header: PPacketHeader;
begin
 Header := @Socket.Data;

 Memo.Lines.Add(IntToStr(Header.seq)+';'+IntToStr(Header.msg)+';'+IntToStr(Header.dlen));
 // Вывод я сделал примерно. Может я вывожу просто неправильно?
end;

procedure TForm1.FirstClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ip_port: string;
begin
 ip_port := Socket.ReceiveText;
 FirstClientConnect.Active := False;
 // Получаем IP и порт сервера
 ClientSocket.Address := copy(ip_port,1,pos(':',ip_port)-1);
 ClientSocket.Port := StrToInt(copy(ip_port,pos(':',ip_port)+1,length(ip_port)-pos(':',ip_port)-1));
 ClientSocket.Active := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FirstClientConnect.Active := True;                   // Активизируем клиент для получение доступного сервера
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 Packet_MRIM_CS_HELLO;
end;

Автор: VICTAR 4.11.2007, 00:58
Примерно так
Код

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Header: PPacketHeader;
  aSize: integer;
begin
  aSize := Socket.ReceiveLength;
  if aSize > 0 then
  begin
    New(Header);
    Socket.ReceiveBuf(Header^, aSize);
    Memo.Lines.Add(IntToStr(Header^.seq) + ';' + IntToStr(Header^.msg) + ';' +
      IntToStr(Header^.dlen));
    Dispose(Header);
  end;
end;


Но учти, что это не универсальный способ. За один прием у тебя может придти несколько пакетов, или вообще половина. Так что надо позаботиться о разбитии пакетов. 
PS не забывай про Data. Сейчас ты принимаешь только Header

Автор: Coderr 4.11.2007, 01:02
Спасиб. Сейчас затестю. Про Data помню, просто на сейчас я, как видишь, застопорился на HELLO пакете  smile

Добавлено через 6 минут и 12 секунд
Спасибо! Код работоспособный! =) Пойду разбираться с Authorise и пынг пакетами. =)))  smile 

Автор: W4FhLF 4.11.2007, 08:14
Поснифай официального клиента, очень поможет. 

Автор: Coderr 6.11.2007, 17:23
Хочу, чтобы data типа Pointer указывал на первый элемент пришедших данных. Сделал так:
Код

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Header: PPacketHeader;
 Data: Pointer;
 Size: integer;
begin
 Size := Socket.ReceiveLength;
 if Size > 0 then begin
  Socket.ReceiveBuf(Data, Size);
  New(Header);
  Header := PPacketHeader(Data);
 end;
end;

Не работает.  smile
Трассировка показала, что в Data попадает первые 4 байта, т.е. Magic.
Подскажите, как получить в Data указатель на первый элемент, чтобы потом просто сдвигать указатель и читать то, что мне нужно?

И ещё... Создал функцию для обработки UL блоков.
Код

function TForm1.GetPacketUL(Length: LongWord; Data: Pointer): LongWord;
begin
 Result := 0;
 Result := PCardinal(Data)^;
 Data := PCardinal(Data + SizeOf(LongWord)); // Сдвигаем указатель
end;
end;
 
Только на строке сдвига указателя при компиляции вылезает ошибка. =( Как сдвинуть указатель правильно?

Автор: Coderr 7.11.2007, 23:46
В раздел "сети" вообще хоть кто-нибудь заглядывает?  smile 

Автор: ne0n 8.11.2007, 10:33
может быть это поможет smile ?

Автор: Coderr 8.11.2007, 23:27
ne0n, сам писал? Если сам, то респект, но не  то что мне надо. =)

Автор: ne0n 9.11.2007, 14:37
Coderr, не, не сам, не помню откуда взял его, но точно помню что он за 10 баксов продаеться в электонных магазинах  smile 

Автор: Coderr 14.11.2007, 21:35
Блин. Никак не получается... От указателей уже башка едет...  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  В аттаче полный исходник.

Автор: VICTAR 14.11.2007, 22:20
Имхо ты тут много всего лишнего наделал. 
Код

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
Спасибо Виктару сегодня опробую.

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

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

Автор: Coderr 15.11.2007, 23:07
Типы:
Код

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
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
Чтобы изменять размер занимаемой памяти. Ну исправил я. Всё равно на хэллоу обырается... =(

Автор: VICTAR 15.11.2007, 23:37
Не в обиду, но ты вряд ли понимаешь, что делаешь
Код

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

Автор: VICTAR 16.11.2007, 01:02
Свой статус ты посылаешь в MRIM_CS_LOGIN2

Автор: Coderr 16.11.2007, 01:30
Ну правильно!
Вот это так выглядит:
Код

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
Не вижу у тебя TimerPing.OnTimer. Что там?

Автор: Coderr 16.11.2007, 19:14
ДА всё, я разобрался =))) Ошибка была примитивно простые.
Код

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
Вопрос по смс.
Код

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

  MRIM_CS_SMS_ACK = $1040;
    // UL - status

а что за unknown?

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

Автор: Coderr 19.11.2007, 15:52
Ну я делал так:
Код

procedure TForm1.Packet_MRIM_CS_SMS;
var
  Packet: PPacket;
begin
 if Connected then begin
  Packet := CreatePacket(Sequence, MRIM_CS_SMS);
  AddUL(Packet, 0);
  AddLPS(Packet, '+7915xxxxxxx');
  AddLPS(Packet, 'Привет! =) Получилось!');
  ClientSocket.Socket.SendBuf(Packet^, 44+Packet^.Header.dlen);
  Dispose(Packet);
  inc(Sequence);
 end;
end;

Ничего не происходит.
ЗЫ Кстати, не подскажешь хороший снифер?

Автор: VICTAR 19.11.2007, 18:27
Все правильно сделано. Посмотри какой ответ тебе приходит. Возможно "Исчерпан дневной лимит..." и т.п. Если все верно, то придет 1.

Цитата(Coderr @  19.11.2007,  15:52 Найти цитируемый пост)
ЗЫ Кстати, не подскажешь хороший снифер? 

Мне понравился UltraSniff

Автор: Coderr 19.11.2007, 20:09
Ну, получаю ответ так:
Код

function TForm1.Packet_MRIM_CS_SMS_ACK(Packet: PPacket): Longword;
var
  Offset: Longword;
begin
 Offset := 0;
 result := GetUL(Packet, Offset);
end;


В результате постоянно получаю 1, но ответы не доходят... =(

Автор: VICTAR 19.11.2007, 22:36
Попробуй послать смс на другой номер

Автор: Coderr 20.11.2007, 00:25
И другой номер пробовал! Что-то не идёт ничего. Снифал тремя снифферами - фарш какой-то...  smile 

Автор: Coderr 8.12.2007, 22:05
По ходу ещё появились вопросы...
Насчёт пакетов UIDL и получения контакт листа:
1) Как получить контакт лист? Пакет с таким номером команды не приходит!!!
2) UIDL нужно чисто копировать и передавать при удалении?

Автор: VICTAR 8.12.2007, 23:21
Цитата(Coderr @  8.12.2007,  22:05 Найти цитируемый пост)
1) Как получить контакт лист? Пакет с таким номером команды не приходит!!!

приходит. я тебя предупреждал, что приходить будет сразу по несколько пакетов.

Цитата(Coderr @  8.12.2007,  22:05 Найти цитируемый пост)
2) UIDL нужно чисто копировать и передавать при удалении?

не понял вопрос

Автор: Coderr 9.12.2007, 22:33
Мне приходит один, но большой! и код у него стрёмный...
Насчёт UIDL: Пакет UIDL используется для работы с оставленными на серваке сообщениями. В каждом таком пакете есть что-то полезное?

Автор: VICTAR 10.12.2007, 16:51
Цитата(Coderr @  9.12.2007,  22:33 Найти цитируемый пост)
Мне приходит один, но большой! и код у него стрёмный...

разбивай его на пакеты. в нем как раз и найдешь пакет с контакт листом

Цитата(Coderr @  9.12.2007,  22:33 Найти цитируемый пост)
Насчёт UIDL: Пакет UIDL используется для работы с оставленными на серваке сообщениями. 

Поправка: UIDL не пакет, а тип данных. После получения оффлайн-сообщения, ты должен скопировать его id(UIDL) и отослать пакет(MRIM_CS_OFFLINE_MESSAGE_DEL) с этим id для удаления этого сообщения с сервера.

Цитата(Coderr @  9.12.2007,  22:33 Найти цитируемый пост)
В каждом таком пакете есть что-то полезное? 

Само сообщение =)

Автор: Coderr 12.12.2007, 02:41
И всё равно не понимаю... После пакета с командой MRIM_CS_USER_INFO приходят ещё два пакета
Packet body len: 1498239028 Command: $79367434
Packet body len: 4159957998 Command: $CF0A0A34

Packet body len - это длина тела пакета после заголовка
Command - код команды

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

Автор: VICTAR 12.12.2007, 16:51
Цитата(Coderr @  12.12.2007,  02:41 Найти цитируемый пост)
Packet body len: 1498239028

Ну ты явно где-то намудрил  smile 
Приатачь весь пакет целиком, я посмотрю.

Автор: Coderr 13.12.2007, 19:58
Вот сорсы

Автор: VICTAR 14.12.2007, 00:02
Цитата(VICTAR @  4.11.2007,  00:58 Найти цитируемый пост)
За один прием у тебя может придти несколько пакетов, или вообще половина. Так что надо позаботиться о разбитии пакетов. 

я предупреждал smile 

Автор: Coderr 14.12.2007, 02:36
Хм... Да, подзабыл. Только как об этом позаботится?  smile 

Автор: VICTAR 14.12.2007, 03:16
Считывай сначала во временный буфер, затем разбирай по пакетам. Сначала читай заголовок, потом уже Body. 

Автор: Coderr 14.12.2007, 03:38
А как я узнаю что пакет полный?

Автор: VICTAR 14.12.2007, 03:50
Цитата(Coderr @  14.12.2007,  03:38 Найти цитируемый пост)
А как я узнаю что пакет полный? 

Длина пакета = длина заголовка + длина Body(Header.dlen)

Автор: Coderr 14.12.2007, 04:03
Сделал так, создал глобальную переменную 
Код

buf: TByteArray;

Добавил условие:
Код

 if (Packet^.Header.dlen+44 <> Size) then ...

А как мне прибавить к массиву пакет? Просто сделав Buf := Buf+Packet; не получится. Есть функция какая-нибудь?

Автор: VICTAR 14.12.2007, 04:08
Цитата(Coderr @  14.12.2007,  04:03 Найти цитируемый пост)
А как мне прибавить к массиву пакет?

Зачем? Непонятно.
А вообще Move поможет

Автор: Coderr 14.12.2007, 04:19
Ну а как я считаю его во временный буфер? Если даже пакет приходит неполный, то срабатывает событие. А когда приходят остатки пакета - событие вызывается ещё раз. Я правильно понимаю?

Добавлено через 11 минут и 30 секунд
Написал так:
Код

//... 
 if Size > 0 then begin
  New(Packet);
  Socket.ReceiveBuf(Packet^, Size);
  if (Packet^.Header.dlen+44 <> Size) then begin
   Move(Packet, Buf[BufSize], Size);
   BufSize := BufSize+Size;
   if (PPacket(Buf[0])^.Header.dlen+44 <> BufSize) then Exit;
  end;
  //...
 end;

Получил изнасилование доступа.  smile  Что ему не понравилось?

Автор: VICTAR 14.12.2007, 06:30
Что-нибудь наподобии, остальное додумай сам
Код

var
  lBuf: TByteArray;
  lSize, lPos: integer;
  Packet: PPacket;
begin
  lSize := Socket.ReceiveLength;
  lPos := 0;
  lSize := Socket.ReceiveBuf(lBuf[0], lSize);
  while lPos < lSize do
  begin
    ...
    Move(lBuf[lPos], Packet^.Header, 44);
    inc(lPos, 44);
    ...
  end;

Автор: Coderr 16.12.2007, 01:57
Слуш, Виктар! Чё-то совсем ничего не получается. Я написал ахинею какую-то, теперь не могу в ней разобраться. smile 

Автор: Coderr 16.12.2007, 19:29
Может напишешь как это сделать правильно? Код приводить не буду. Он всё равно бессмысленный.

Автор: VICTAR 16.12.2007, 21:21
Я написал примерный план действий. Тебе осталось только доделать.

Автор: Andrey_znet 28.1.2008, 19:19
А как осуществить поиск контактов?

Автор: Matematik 31.1.2008, 02:44
Я так сделал с приемом пакетов
(базовый код взят у Coderr http://forum.vingrad.ru/index.php?showtopic=179632&view=findpost&p=1347989 )
Читаю заголовок recv() не удаляя данные из буфера сокета (MSG_PEEK)
Проверяю что все данные пакета пришли и читаю только один пакет. Если Пакет не один вызываю прием еще раз (GoAgain)
Написано криво, просто для теста.
Еще бы хорошо добавить проверку  что пришел весь заголовок до того кае его считывать Socket.ReceiveLength>SizeOf(Header)  и проверять что возвращает recv()
Код

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 Size        : Integer;
 Packet      : PPacket;
 Header      : TPacketHeader;
 User        : String;
 Status      : Longword;
 MessID      : Longword;
 Flags       : Longword;
 From        : String;
 MsgText     : String;
 MsgTextRTF  : String;
 GoAgain     : Boolean;
begin
 GoAgain := False;
 ZeroMemory(@Header, SizeOf(Header));
 Size := Socket.ReceiveLength;
 recv(Socket.SocketHandle, Header, SizeOf(Header), MSG_PEEK);
 if Header.dlen>SizeOf(TByteArray) then
   ShowMessage('read buffer small');
 if Size >= (SizeOf(Header)+Header.dlen) then begin
  if Size > (SizeOf(Header)+Header.dlen) then
    GoAgain := True;
  Size := SizeOf(Header)+Header.dlen;
  New(Packet);
  Socket.ReceiveBuf(Packet^, Size);
  memo.Lines.Add('Size: '+inttostr(Size)+' Packet body len: '+Inttostr(Packet^.Header.dlen)+' Command: $'+IntToHex(Packet^.Header.msg,4));
  case Packet^.Header.msg of
  {...}
  end;
  Dispose(Packet);
 end;
 if GoAgain then
   ClientSocketRead(Sender, Socket)
end;

[hr]

2Andrey_znet

Поиск делается легко
например, поиск пользователя [email protected]
Код

var
  Packet: PPacket;
begin
 if not Connected then exit;
 Packet := CreatePacket(Sequence, MRIM_CS_WP_REQUEST);

 AddUL(Packet, MRIM_CS_WP_REQUEST_PARAM_USER);
 AddLPS(Packet, 'vasya');

 AddUL(Packet, MRIM_CS_WP_REQUEST_PARAM_DOMAIN);
 AddLPS(Packet, 'mail.ru');

// остальные параметры см. http://agent.mail.ru/developers/protocol.html

 SendPacket(Packet);


Прием результатов поиска
Код

procedure TForm1.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
{...}
  case Packet^.Header.msg of
   MRIM_CS_ANKETA_INFO :
     Packet_MRIM_CS_ANKETA_INFO(Packet);
   else
  end;
{...}
end;

Код

procedure TForm1.Packet_MRIM_CS_ANKETA_INFO(Packet: PPacket);
var
  Offset: Longword;
  status, fields_num, max_rows, server_time : DWORD;
  k : Integer;
  z : AnsiString;
begin
  Memo.Lines.Add('MRIM_CS_ANKETA_INFO');
  Memo.Lines.Add(StrDump(@Packet^.Data, Packet^.Header.dlen, 0, True));
  
  Offset := 0;
  status      := GetUL(Packet, Offset);
  fields_num  := GetUL(Packet, Offset);
  max_rows    := GetUL(Packet, Offset);
  server_time := GetUL(Packet, Offset);

  case status of
    MRIM_ANKETA_INFO_STATUS_OK         : Memo.Lines.Add('MRIM_ANKETA_INFO_STATUS_OK ## поиск успешно завершен');
    MRIM_ANKETA_INFO_STATUS_NOUSER     : Memo.Lines.Add('MRIM_ANKETA_INFO_STATUS_NOUSER ## не найдено ни одной подходящей записи');
    MRIM_ANKETA_INFO_STATUS_DBERR      : Memo.Lines.Add('MRIM_ANKETA_INFO_STATUS_DBERR ## Ошибка обработки данных');
    MRIM_ANKETA_INFO_STATUS_RATELIMERR : Memo.Lines.Add('MRIM_ANKETA_INFO_STATUS_RATELIMERR ## слишком много запросов, поиск временно запрещен');
    else Memo.Lines.Add('Неизвестная ошибка status ## '+IntToStr(status));
  end;
  Memo.Lines.Add('fields_num ## количество полей в анкете каждого пользователя');
  Memo.Lines.Add(IntToStr(fields_num));
  Memo.Lines.Add('max_rows ## текущее ограничение на количество результатов поиска (может быть больше, чем количество строк в данном ответе)');
  Memo.Lines.Add(IntToStr(max_rows));
  Memo.Lines.Add('server_time ## текущее время на сервере (должно использоваться для вычисления возраста). Формат времени: Количество секунд с 00:00:00 1 января 1970 года.');
  Memo.Lines.Add(FormatDateTime('dd.mm.yyyy hh:nn:ss', IncSecond(EncodeDateTime(1970, 1, 1, 0, 0, 0, 0),server_time))+' ['+IntToStr(server_time)+']');
  Memo.Lines.Add('------------------');
  while Offset<=Packet.Header.dlen do
  begin
    k := 0;
    z := '';
    while (Offset<=Packet.Header.dlen) and (k<fields_num) do
    begin
      z := z + GetLPS(Packet, Offset) + #9;
      Inc(k);
    end;
    Memo.Lines.Add(z);
  end;
end;

Автор: Granata005 23.3.2008, 22:59
удалите пожалуйста

Автор: Rodeon 21.11.2009, 00:23
По ссылке выше качаем компонент, в нем файлы:
client.dcu
proto.dcu
pworks.dcu
base64.pas
client.pas
codes.pas
proto.pas
pworks.pas
Делал в Delphi 7, под 2009 чето не получилось установить этот компонент.
В делфях через меню Component\Install Component указываем путь к файлу client.pas, жмем ОК, в закладке Sample появился компонент MailClient - кидаем его на форму.
Также кидаем TCPClient - он нам нужен будет что бы узнавать адресс на который в последующем будет коннектиться клиент!
Кидаем кнопку и пару эдитов!
В первый edit вводим свой емайл вида "имя@домен.ру"
во второй edit вводим пароль к ящику!
Настраиваем пару свойств для TCPClient:
RemoteHost:=mrim.mail.ru;
RemotePort:=2042;
Настраиваем свойства для MailClient:
MRIMHost:=mrim.mail.ru;
MRIMPort:=2042;

для кнопки делаем свойства onclick
Код

procedure TForm.ButtonClick(Sender: TObject);
var
     i: Integer;
     MrimS: string;
begin
mailclient.Mail:=edit1.Text;
mailclient.PassWord:=edit2.Text;
     TCPClient.Active:=True;
       if TCPClient.Connected then
           MrimS:=TCPClient.Receiveln(#$A); {Получили адрес и порт}

     TCPClient.Disconnect;
     if MrimS <> '' then
         for i:=1 to Length(MrimS) do
             if MrimS[i] = ':' then
                 begin
                     MailClient.Host:=Copy(MrimS, 0, i-1);
           MailClient.Port:=StrToInt(Copy(MrimS, i+1, Length(MrimS)-i));
                     break;
                 end;

     if MailClient.HostInit then
         MailClient.Connect  {Соеденяемься}
     else
         MailClient1.RequestHost;
end;

Далее обрабатываем соеденение, если оно наступило
Код

procedure TForm.MailClientConnect(Sender: TObject);
begin
MailClient.Hello;
end;

Затем еще Проходим авторизацию!
Код

procedure TForm.MailClientHello(Sender: TObject);
begin
     MailClient.Authorize;
end;


Конечное действие, если все прошло успешно, то подключение заканчивается загрузкой контакт листа
Код

procedure TForm.MailClientEndRequestContactList(Sender: TObject);
begin
{Тут выполняем необходимые действия}
end;

Как примеры:
Отправка СМСок:
Код

procedure TForm.Button2Click(Sender: TObject);
begin
     if MailClient.Connected then
         MailClient1.SendSMS(edit14.Text,edit15.Text);
end;

Edit14 и Edit15 соотвктственно телефон и само собщение!
Допустим надо найти людей (со строковыми переменными как передавать не разобрался, майловсцы молчат):
Первые три значения пустые - '' так и не понял как передать запрос текстовый, в каком формате!
(0-любой пол, 1-мужчина, 2 -женщина)
(возраст от)
(возраст до)
(город, береться по id из базы)
(знак зодиака, от 1 до 12)
(месяц рождения от 1 до 12)
(день рождения от 1 до 31)
(страна, опять же из базы, к примеру Россия код:24)
значение -1 в числовых параметрах распознаеться как "любое зачение"
как пример, что бы найти всех девушек в возрасте от 20 до 30 лет из россии надо передать строку
Код

procedure TForm.Button3Click(Sender: TObject);
begin
If MailClient.Connected then
MailClient.FindContact('','','',2,20,30,-1,-1,-1,-1,24,false);
end;

Все, ловим событие  MailClient UserFound, приходит строка со всеми данными о пользователе
За раз приходит только 1 найденный контакт, просто ставим событие, что как только находит сразу добавлять например в массив найденных, ищет за раз по 50 контактов, для следующего поиска еще раз отправлячем запрос на поиск.
Код

procedure TForm1.MailClient1UserFound(Sender: TObject; Status, FieldNum,
  MaxRows, ServerTime: Cardinal; User, Domain, Nickname, FistName,
  LastName, Sex, Birth_Day, IDCity, Location, Zodiac, BirthMonth, BirthDay,
  IDCountry, Phone, mrim_Status: String);
Begin
Memo.lines.add(User+'@'+Domain);
End;

Таким путем будет в мемо добавленно 50 найденных контактов!
В прикрепленном компоненте кажись урезанный вариант для рассылки СМСок, но в инете видел полный такой же компонент с указанием где и что именно измененно и путем обратных изменений получаем готовый СМС спаммер, сам не скажу точно, правда или нет, так как СМС меня не сильно интересовало!

Автор: Rodeon 25.1.2012, 16:09
В этой ветке обновление:
http://forum.vingrad.ru/forum/topic-275368.html

Автор: Rodeon 29.1.2012, 19:23
Подправил поля поиска, теперь найденные данные соответствуют названиям полей.
Вот список полей:
Username, Domain, Nickname, FirstName, LastName, Sex, Birthday, Zodiac, Country_id, City_ID, Location, Phone, mrim_status, status_uri, status_title, status_desc, ua_features
Измененный клиент прикрепил!
Осталось пока непонятным в какой кодировке выдаются поля статусов, у меня либо "???" либо пусто пока?
Комментарий по status_desc:
описание статуса (до 255 символов)

Комментарий по status_title:
заголовок статуса (до 16 символов)

Комментарий по status_uri:
STATUS_ONLINE - 'В сети'
STATUS_AWAY - 'Отошел'
STATUS_INVISIBLE - 'Невидимый'
status_chat - 'Готов поболтать'
status_dnd - 'Не беспокоить'
status_0' - 'Отключен'
status_1' - 'В сети'
status_2 - 'Отошел'
status_3 - ' => 'Невидимый'
status_4 - 'Болею'
status_5 - 'Дома'
status_6 - 'Кушаю'
status_7 - 'Где я?'
status_8 - 'В туалете'
status_9 - 'Готовлю'
status_10 - 'Гуляю'
status_11 - 'Я Инопланетный разум!'
status_12 - 'Йа креветко!'
status_13 - 'Я потерялся!'
status_14 - 'Я сошел с ума!'
status_15 - 'Йа утко!'
status_16 - 'Играю'
status_17 - 'Курю'
status_18 - 'На работе'
status_19 - 'На встрече'
status_20 - 'Пью пиво'
status_21 - 'Пью кофе'
status_22 - 'Работаю'
status_23 - 'Сплю'
status_24 - 'Телефон'
status_26 - 'В институте'
status_27 - 'В школе'
status_28 - 'Вы ошиблись номером'
status_29 - ':-D'
status_30 - ';-)'
status_32 - '}smile'
status_33 - '8-)'
status_34 - ':-('
status_35 - ':\'('
status_36 - 'В шоке...'
status_37 - 'Злюсь!'
status_38 - 'Диабло!'
status_39 - '(_|_)'
status_40 - 'Сердце'
status_41 - 'Сплю'
status_42 - 'Cool!'
status_43 - 'Yo!'
status_44 - 'Фига'
status_45 - 'Fuck!'
status_46 - 'Череп'
status_47 - 'Ракета'
status_48 - 'Осминог'
status_49 - 'Коза'
status_50 - 'Bad!'
status_51 - 'Белка'
status_52 - 'Звезда'
status_53 - 'Музыка'

Автор: fucil 3.3.2012, 19:30
Вот блин везде битые ссылки перезалейте (

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)