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

Coderr

Дата 14.12.2007, 03:38 (ссылка)

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

Загрузка ...

Бывалый

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

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

А как я узнаю что пакет полный?

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

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

VICTAR

Дата 14.12.2007, 03:50 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Coderr @ 14.12.2007, 03:38

)

А как я узнаю что пакет полный?

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

Coderr

Дата 14.12.2007, 04:03 (ссылка)

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

Загрузка ...

Бывалый

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

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

Сделал так, создал глобальную переменную

Код


buf: TByteArray;

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

Код


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

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

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

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

VICTAR

Дата 14.12.2007, 04:08 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Coderr @ 14.12.2007, 04:03

)

А как мне прибавить к массиву пакет?

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

Coderr

Дата 14.12.2007, 04:19 (ссылка)

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

Загрузка ...

Бывалый

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

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

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

Добавлено через 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 (ссылка)

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

Загрузка ...

Эксперт

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

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

Что-нибудь наподобии, остальное додумай сам

Код


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 (ссылка)

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

Загрузка ...

Бывалый

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

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

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

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

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

Coderr

Дата 16.12.2007, 19:29 (ссылка)

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

Загрузка ...

Бывалый

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

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

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

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

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

VICTAR

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

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

Загрузка ...

Эксперт

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

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

Я написал примерный план действий. Тебе осталось только доделать.

Andrey_znet

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

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

Загрузка ...

Новичок

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

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

А как осуществить поиск контактов?

Matematik

Дата 31.1.2008, 02:44 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

Я так сделал с приемом пакетов
(базовый код взят у Coderr http://forum.vingrad.ru/index.php?showtopi...t&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;

Это сообщение отредактировал(а) Matematik - 31.1.2008, 03:07

Granata005

Дата 23.3.2008, 22:59 (ссылка)

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

Загрузка ...

Новичок

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

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

удалите пожалуйста

Это сообщение отредактировал(а) Granata005 - 23.3.2008, 23:07

Rodeon

Дата 21.11.2009, 00:23 (ссылка)

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

Загрузка ...

Шустрый

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

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

По ссылке выше качаем компонент, в нем файлы:
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 найденных контактов!
В прикрепленном компоненте кажись урезанный вариант для рассылки СМСок, но в инете видел полный такой же компонент с указанием где и что именно измененно и путем обратных изменений получаем готовый СМС спаммер, сам не скажу точно, правда или нет, так как СМС меня не сильно интересовало!

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

Mrim.rar 29,96 Kb

Rodeon

Дата 25.1.2012, 16:09 (ссылка)

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

Загрузка ...

Шустрый

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

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

В этой ветке обновление:
тынц

Rodeon

Дата 29.1.2012, 19:23 (ссылка)

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

Загрузка ...

Шустрый

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

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

Подправил поля поиска, теперь найденные данные соответствуют названиям полей.
Вот список полей:
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 - 'Музыка'

Это сообщение отредактировал(а) Rodeon - 30.1.2012, 00:56

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

client.rar 14,97 Kb

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