Вконтакте Личные сообщения

[KWN, lnc]

Уважаемые программисты.

перерыл весь форум...

киньте пожалуйста рабочий исходник.. как получать статус сообщении как в VKTray

label.caption := 'сообщении ' + status;
label2.caption := 'от'

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, StrUtils;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function vk_login(Login, Pass : string; IdHTTP : TIdHTTP): Boolean;
var
  sl : TStringList;
  text : string;
begin
  sl := TStringList.Create;
  sl.Add('email=' + Login + '&pass=' + Pass + '&expire=&vk=');
  text := IdHTTP.Post('http://login.vk.com/?act=login',sl);
  if Pos('Aoia',text)<>0 then begin
    MessageBox(Application.Handle,'Iaaa?iua aaiiua: Eiaei , Ia?ieu','Ioeaea',0);
    Result := False;
  end else begin
    text := Copy(text,Pos('name=' + #39 + 's' + #39,text)+16,PosEx(#39,text,Pos('name=' + #39 + 's' + #39,text)+17)-Pos('name=' + #39 + 's' + #39,text)-16);
    IdHTTP.Request.CustomHeaders.Add('Cookie:remixchk=5; remixsid=' + text);
    Result := True;
  end;
  sl.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 vk_login(Edit1.Text,Edit2.Text,IdHTTP1);
end;

function VK_ParsEmail(s:string; IdHTTP1:TIdHTTP): TStringList;
var
  i : Integer;
  mess_full, mess_text,
  mess_id, mess_new,
  mess_aut, mess_aut_id,
  mess_date, mess_title : string;
  sl : TStringList;
begin
  Result := TStringList.Create;
  i := 1;
  s := Copy(s,PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))+6,PosEx('</table>',s,Pos('<div id="messages_wrap">',s))-PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))-6);
  while PosEx('<tr ',s,i)<>0 do
  begin
    mess_full := Copy(s,PosEx('<tr ',s,i),PosEx('</tr>',s,PosEx('<tr ',s,i))-PosEx('<tr ',s,i));

    // Iieo?aiea id niiauaiey
    mess_id := Copy(mess_full,Pos('id="',mess_full)+8,PosEx('"',mess_full,Pos('id="',mess_full)+9)-Pos('id="',mess_full)-8);

    // iiaia ee yoi niiauaiea
    if Pos('class='+#39+'newRow'+#39,mess_full)<>0 then mess_new := '1' else mess_new := '0';

    if mess_new = '1' then
    begin
      // Io eiai niiauaiea
      mess_aut := Copy(mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+2,PosEx('</a>',mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+3)-PosEx('">',mess_full,Pos('<div>',mess_full)+19)-2);

      // EA iieuciaaoaey, eioi?ue i?eneae niiauaiea
      mess_aut_id := Copy(mess_full,Pos('href="',mess_full)+7,PosEx('">',mess_full,Pos('href="',mess_full)+8)-Pos('href="',mess_full)-7);

      // Aaoa, eiaaa i?eoei niiauaiea
      mess_date := Copy(mess_full,Pos('class="date">',mess_full)+13,PosEx('</div',mess_full,Pos('class="date">',mess_full)+14)-Pos('class="date">',mess_full)-13);

      //Oaia niiauaiey
      mess_title := Copy(mess_full,PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))+6,PosEx('</span>',mess_full,Pos('new messageSubject',mess_full))-PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))-6);

      // Oaeno niiauaiey
      mess_text := IdHTTP1.Get('http://vkontakte.ru/mail.php?act=show&id='+ mess_id);
      mess_text := Copy(mess_text,PosEx(';">',mess_text,Pos('class="messageText"',mess_text))+3,PosEx('</div>',mess_text,Pos('class="messageText"',mess_text))-PosEx(';">',mess_text,Pos('class="messageText"',mess_text))-3);
    end;

    Result.Add(mess_aut+' '+mess_aut_id+' '+mess_date+' '+mess_text);
    i := PosEx('<tr ',s,i)+2;
    Sleep(300);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Memo1.Lines := VK_ParsEmail(IdHTTP1.Get('http://vkontakte.ru/mail.php'),IdHTTP1);
end;

end.

этот код, почему то не работает (( выручайте... плиззз..

[kangreon]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan, IdHTTP, IdCompressorZLib, StrUtils, ComCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Button2: TButton;
    RichEdit1: TRichEdit;
    procedure Edit1DblClick(Sender: TObject);
    procedure Edit2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  VKAS = 'Состояние: %s';

  VKMS = 'Сообщение от: %s'#13#10'Время: %s'#13#10+
  'ID Человека: %s'#13#10'Тема: %s'#13#10+
  'Сообщение: %s'#13#10;

var
  Form1: TForm1;
  http: TIdHTTP;
  comp: TIdCompressorZLib;

implementation

{$R *.dfm}



procedure VK_Mail;
var
  s : string;
  i, y : Integer;
  mf, te, id, ti, me : string;
begin
  s := http.Get('http://vkontakte.ru/mail.php');
  i := Pos('</tr>',s)+5;
  s := Copy(s,i,PosEx('bar clearFix footerBar',s,i)-i);
  while Pos('<tr',s)<>0 do
  begin
    y := Pos('<tr',s);
    i := PosEx('"name"',s,y)+10;
    i := PosEx('">',s,i)+2;
    mf := Copy(s,i,PosEx('<',s,i)-i);
    i := PosEx('date',s,y);
    i := PosEx('>',s,i)+1;
    te := Copy(s,i,PosEx('<',s,i)-i);
    i := PosEx('/id',s,y)+1;
    id := Copy(s,i,PosEx('"',s,i)-i);
    i := PosEx('messageSubject',s,y);
    i := PosEx('n>',s,i)+2;
    ti := Copy(s,i,PosEx('<',s,i)-i);
    i := PosEx('messageBody',s,y);
    i := PosEx('>',s,i)+1;
    me := Copy(s,i,PosEx('<',s,i)-i);
    
    Form1.RichEdit1.Lines.Add(Format(VKMS,[mf,te,id,ti,me]));
    Delete(s,y,4);
  end;  
end;

function VK_Auth(login, password : string): Boolean;
var
  s:string;
  remixchk, remixsid : string;
  i : integer;
begin
  Result := False;

  try
    http.Get('http://vkontakte.ru/login.php?m=1&email='+login+'&pass='+password);
  except
    Result := True;
    s := http.Response.RawHeaders.Text;
    i := Pos('remixchk',s);
    remixchk := Copy(s,i,PosEx(';',s,i)-i+1);
    i := Pos('remixsid',s);
    remixsid := Copy(s,i,PosEx(';',s,i)-i+1);
    http.Request.CustomHeaders.Text := 'Cookie:' +
    remixchk + remixsid;
    Exit;
  end;
end;


procedure TForm1.Edit1DblClick(Sender: TObject);
begin
  Edit1.SelectAll;
end;

procedure TForm1.Edit2DblClick(Sender: TObject);
begin
  Edit2.SelectAll;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Caption := Format(VKAS,['no']) ;

  http := TIdHTTP.Create;
  comp := TIdCompressorZLib.Create;
  http.Compressor := comp;
  http.AllowCookies := False;
  http.HandleRedirects := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if VK_Auth(Edit1.Text,Edit2.text) then
    Label1.Caption := Format(VKAS,['yes'])
  else
    Label1.Caption := Format(VKAS,['no'])
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  VK_Mail;
end;

end.

[KWN, lnc]

kangreon, к сожалению не работает ((( почему так? просто прогрузит при авторизации несколько секунд со статусом (не отвечает) после оф. статус [no] и все (((

хотя запустил на другом. компьютере и заработало!
- а как сделать чтобы новые сообщения высвечивалтсь? а не все ((

[serj1985]

кстати, читает не все сообщения, а только 20, т.е. первую страницу

[KWN, lnc]

а вот как сделать так чтобы именно новые?
ну вот пришло 2 новых, так он и выводит

Пришло сообщение от Пользователя
и уже у вас 2 новых сообщении

[kangreon]

Замените

  while Pos('<tr',s)<>0 do
  begin
    y := Pos('<tr',s);

на

  while Pos('<tr class=',s)<>0 do
  begin
    y := Pos('<tr class=',s);

Должночитать только новые сообщения.
PS не проверял

[KWN, lnc]

IdCompressorZLib, требует!
- где взять (((

[mihali4]

Ввести в поисковую строку гугля "IdCompressorZLib" и скачать IdCompressorZLib.pas.

[dark007]

Уважаемые программисты ,помогите пожалуйста получить количество непрочитанных сообщений,нигде кода нормального найти не могу,поделитесь пожалуйста знаниями