Показать сообщение отдельно

vkAPI.pas
  #89  
Старый 26.01.2010, 03:31
RedFern.89
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
С нами: 8582863

Репутация: 69
Lightbulb vkAPI.pas

Код:
unit vkapi;

interface

uses
  Windows, Classes, idHTTP, idCookieManager, SysUtils, Dialogs;

var
  HTTP : TIDHTTP;

function VK_Login(email, pass: string): boolean;
procedure VK_GetFriendList(Names, OnlineFrinds: TStrings);
function VK_OpenWriteBox(id: string): string;
procedure VK_SendMessage(id, hash, msg: string);
procedure VK_GetNewMessageList(Messages: TStrings);
function VK_ReadMessage(msg_id: string): string;

implementation

function DecChas(chas: string): string;
var
 Decchas : string;
 str : string;
 I : Integer;
 Len : integer;
begin

 str := Copy(chas, 6, 12);
 Len := Length(str);

 For I := 0 To Length(str) -1 do
 begin
  Decchas := Decchas + str[len];
  Inc(len, -1);
 end;

 str := Copy(chas, 21, Length(chas) -5);
 str := str + Copy(chas, 5, 1);

 Len := Length(str);

 For I := 0 To Length(str) -1 do
 begin
   Decchas := Decchas + str[len];
   Inc(len, -1);
 end;

 Result := Decchas;
end;

function VK_Login(email, pass: string): boolean;
var
 Cookie : TidCookieManager;
 Data, Page : TStringList;
 I : Integer;
 S : string;
begin
 HTTP := TIDHTTP.Create(NIL);
 Cookie := TidCookieManager.Create(nil);



 Cookie.AddCookie('remixchk=5;', 'vkontakte.ru');
 Cookie.AddCookie('remixclosed_tabs=0;', 'vkontakte.ru');
 Cookie.AddCookie('remixlang=0;', 'vkontakte.ru');
 Cookie.AddCookie('remixgroup_closed_tabs=0;', 'vkontakte.ru');
 Cookie.AddCookie('remixnotajaxphotos=1;', 'vkontakte.ru');
 Cookie.AddCookie('remixnews_privacy_filter=0;', 'vkontakte.ru');
 Cookie.AddCookie('audio_vol=100;', 'vkontakte.ru'); 



 HTTP.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.1.7) Gecko/20091221 MRA 5.6 (build 03278) Firefox/3.5.7 sputnik 2.1.0.18';
 HTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
 HTTP.Request.AcceptLanguage := 'ru,en-us;q=0.7,en;q=0.3';
 HTTP.Request.AcceptCharSet := 'windows-1251,utf-8;q=0.7,*;q=0.7';
 HTTP.Request.Pragma := 'no-cache';
 HTTP.Request.CacheControl := 'no-cache';
 HTTP.Request.RawHeaders.Add('X-Requested-With: XMLHttpRequest');

 HTTP.AllowCookies := True;
 HTTP.HandleRedirects := True;
 HTTP.ProtocolVersion := pv1_1;
 HTTP.CookieManager := Cookie;

 Data := TStringList.Create;
 Page := TStringList.Create;

 HTTP.Post('http://vkontakte.ru/login.php', Data);

 Data.Add('act=login');
 Data.Add('email=' + email);
 Data.Add('pass=' + pass);

 Page.Text := HTTP.Post('http://login.vk.com/', Data);

 For I := 0 To Page.Count -1 Do
 begin
  If Pos('id=' + #39 + 's' + #39, Page[i]) <> 0 Then
  begin
   S := Page[i];
   S := Copy(s, Pos('value=', s) +7, Length(s));
   Delete(s, Pos(#39, s), Length(s));
  end;
 end;

 Data.Clear;

 Data.Add('redirect=0'); // При установке значения "1", при успешном логине, вы попадаете на свою страницу
 Data.Add('op=slogin');
 Data.Add('s=' + s);

 Page.Text := HTTP.Post('http://vkontakte.ru/login.php', Data);

 If Pos('error', Page.Text) <> 0 Then Result := False
 Else Result := True;

 Page.Free;
 Data.Free;
end;

procedure VK_GetFriendList(Names, OnlineFrinds: TStrings);
var
  Data : TStringList;
  I : Integer;
  id, name, FriendsData,
  OnlineFriendsData: string;
  OnlineCount, FriendCount : string;
begin
  Data := TStringList.Create;
  Data.Text := HTTP.Get('http://vkontakte.ru/friends.php');

  For I := 0 To Data.Count -1 do
  begin
    If Pos('var friendsData', Data[i]) <> 0 Then
    begin
      FriendsData := Data[i];
      FriendsData := Copy(FriendsData, Pos('friends' + #39 + ':', FriendsData) +10, Length(FriendsData));
      Delete(FriendsData, Pos('universities', FriendsData) -3, Length(FriendsData));
    end;

  If Pos('var js_fr_cnt', Data[i]) <> 0 Then
  begin
    FriendCount := data[i];
    FriendCount := Copy(FriendCount, Pos('=', FriendCount) +2, Length(FriendCount));
    Delete(FriendCount, Pos(';', FriendCount), Length(FriendCount));
  end;
end;


  For I := 0 To StrToInt(FriendCount) -1 do
  begin
   Name := Copy(FriendsData, Pos('"', FriendsData) +1, Length(FriendsData));
   Id := Copy(FriendsData, Pos(',', id)+2, Length(FriendsData));
   Delete(id, pos(',', id), Length(id));
   If Id[1] = '[' Then Delete(id, 1, 1);
   Delete(FriendsData, 1, Pos(']', FriendsData));
   Delete(id, pos(',', id), Length(id));
   Delete(name, Pos('"', name), Length(name));
   Names.Add(name + '{id:' + id + '}');
  end;

// Загружаем online друзей
Sleep(1000);

  Data.Text := HTTP.Get('http://vkontakte.ru/friends.php?filter=online');

  For I := 0 To Data.Count -1 do
  begin
    If Pos('var friendsData', Data[i]) <> 0 Then
    begin
      OnlineFriendsData := Data[i];
      OnlineFriendsData := Copy(OnlineFriendsData, Pos('friends' + #39 + ':', OnlineFriendsData) +10, Length(OnlineFriendsData));
      Delete(OnlineFriendsData, Pos('universities', OnlineFriendsData) -3, Length(OnlineFriendsData));
    end;

   If Pos('friends_common_count', Data[i]) <> 0 Then
   begin
     OnlineCount := Data[i];
     OnlineCount := Copy(OnlineCount, Pos('friends_common_count', OnlineCount) +22, Length(OnlineCount));
     Delete(OnlineCount, Pos('<', OnlineCount), Length(OnlineCount));
   end;

  end;

  For I := 0 To StrToInt(OnlineCount) -1 do
  begin
   Name := Copy(OnlineFriendsData, Pos('"', OnlineFriendsData) +1, Length(OnlineFriendsData));
   Id := Copy(OnlineFriendsData, Pos(',', id)+2, Length(OnlineFriendsData));
   Delete(id, pos(',', id), Length(id));
   If Id[1] = '[' Then Delete(id, 1, 1);
   Delete(OnlineFriendsData, 1, Pos(']', OnlineFriendsData));
   Delete(name, Pos('"', name), Length(name));
   OnlineFrinds.Add(name + '{id:' + id + '}');
  end;

 end;

function VK_OpenWriteBox(id: string): string;
var
 Str : string;
begin
 Str := HTTP.Get('http://vkontakte.ru/mail.php?act=a_write_box&to=' + id);
 str := Copy(str, Pos('decodehash', str) +12, Length(str));
 Delete(str, Pos(#39, str), Length(str));
 Result := str;
end;

procedure VK_SendMessage(id, hash, msg: string);
var
 Post : TStringList;
begin
 Post := TStringList.Create;
 Post.Add('act=sent');
 Post.Add('ajax=1');
 Post.Add('chas=' + DecChas(hash));
 Post.Add('to_id=' + id);
 Post.Add('title=Posted by Vkonatkte Messenger v1.0 by Vadim');
 Post.Add('message=' + AnsiToUTF8(msg));
 Post.Add('from_box=1');

 HTTP.Request.Referer := 'http://vkontakte.ru/mail.php?act=a_write_box&to=' + id;
 HTTP.Post('http://vkontakte.ru/mail.php', Post);
 Post.Free;
end;

procedure VK_GetNewMessageList(Messages: TStrings);
var
 Page : TStringList;
 I : Integer;
 Name, Body, id, Image,
 messId : string;
begin
 Page := TStringList.Create;
 Page.Text := HTTP.Get('http://vkontakte.ru/mail.php');

 For I := 0 To Page.Count -1 do
 begin
   If Pos('newRow', Page[i]) <> 0 Then
   begin
     Image := Page[i+8];
     Image := Copy(image, Pos(#34, image) +1, Length(image));
     Delete(image, Pos(#34, image), Length(image));

     Id := Page[i+7];
     Id := Copy(id, Pos('d', id) +1, Length(id));
     Delete(id, pos(#34, id), Length(id));

     MessId := Page[i+20];
     MessId := Copy(MessId, Pos('mail.php?', MessId) +21, Length(MessId));
     Delete(MessId, Pos('&', MessId), Length(MessId));

     Name := Page[i+13];
     Name := Copy(name, Pos('>', name) +1, length(name));
     Delete(name, Pos('<', name), Length(name));

     Body := Page[i+20];
     Body := Copy(body, Pos('Body">', body) +6, Length(body));
     Delete(body, Pos('<', body), Length(body));
     Messages.Add('id: ' + Id + ',body:' + Body + ',name:' + name + ',messid:' + MessId);
   end;
 end;

 page.Free;
end;

function VK_ReadMessage(msg_id: string): string;
var
 Page : TStringList;
 i : Integer;
 msg : string;
begin
 Page := TStringList.Create;
 Page.Text := HTTP.Get('http://vkontakte.ru/mail.php?act=show&id=' + MSG_ID + '&out=0');

 For I := 0 To Page.Count -1 do
 begin
    If Pos('<td class="label">Сообщение:</td>', Page[i]) <> 0 Then
    begin
      msg := Page[i+3];
      msg := Copy(msg, Pos('">', msg) +2, Length(msg));
      msg := StringReplace(msg, '<br>', #13, [rfReplaceAll]);
      Delete(msg, Pos('</div>', msg), Length(msg));
    end;
 end;
 Result := msg;
 Page.Free;
end;

end.

Последний раз редактировалось RedFern.89; 11.02.2010 в 18:16..
 
Ответить с цитированием