Mega Code Archive

Yahoo messenger protocol part i

Implementing instant messaging protocols yahoo turn The yahoo protocol has been updated, possibly rendering this article unservable I recently came across a plethora of implementations of instant messaging protocols in C, C++ but no implementation on pascal so i decided to try to implement one so I decided to start with the yahoo messenger one (ICQ is too complicated for me) The protocol used by yahoo is very extensive, this article covers how to login to yahoo messenger server, get buddy list, ignore list and wheter the user has mail or not, this is still very beta (it is just me working on it, so progress is very slow) In order to implement this code you will need the Indy Internet Library or any internet library with an HTTP component that you know how to use. <-------------------------------BEGIN UNIT CODE ------------------------------> unit YahooLogin; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, idGlobal; type TForm1 = class(TForm) HTTP: TIdHTTP; Panel1: TPanel; Label1: TLabel; Edit1: TEdit; Label2: TLabel; Edit2: TEdit; Button1: TButton; ListBox1: TListBox; Label3: TLabel; ListBox2: TListBox; Label4: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } FRemoteFile: TStringList; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const LoginURL = 'http://msg.edit.yahoo.com/config/ncclogin?&n=1&login=%s&passwd=%s'; procedure TForm1.Button1Click(Sender: TObject); var Tmp, UserName, Password: String; i, BuddyBegin, BuddyEnd: Integer; begin if (Edit1.Text = '') or (Edit2.Text = '') then raise Exception.Create('Login/Password cannot be blank'); UserName := URLEncode(Edit1.Text); PassWord := URLEncode(Edit2.Text); Tmp := Format(LoginURL, [UserName, PassWord]); FRemoteFile.Text := Http.Get(Tmp); if FRemoteFile[0] = 'OK' then begin for i := 0 to HTTP.Response.ExtraHeaders.Count -1 do if pos('Set-Cookie', HTTP.Response.ExtraHeaders[i]) > 0 then begin //We only care about the first cookie ShowMessage('Received Cookie: '+ Copy(HTTP.Response.ExtraHeaders[i], Length('set0cookie.'), Length(HTTP.Response.ExtraHeaders[i]))); //So we break after getting the first cookie Break end; //Buddy list is delimited by a BEGIN BUDDYLIST and END BUDDYLIST BuddyBegin := FRemoteFile.IndexOf('BEGIN BUDDYLIST') +1; BuddyEnd := FRemoteFile.IndexOf('END BUDDYLIST') -1; for i := BuddyBegin to BuddyEnd do //These is the "raw" buddy list parsing is needed for it to make sense //Since this is an example I discarded this code ListBox1.Items.Add(FRemoteFile[i]); BuddyBegin := FRemoteFile.IndexOf('BEGIN IGNORELIST') +1; BuddyEnd := FRemoteFile.IndexOf('END IGNORELIST') -1; for i := BuddyBegin to BuddyEnd do ListBox2.Items.Add(FRemoteFile[i]); for i := 0 to FRemoteFile.Count -1 do if pos('Mail=', FRemoteFile[i]) > 0 then begin Tmp := Copy(FRemoteFile[i], length('mail01'), Length(FRemoteFile[i])); if StrToInt(Tmp) = 1 then ShowMessage('You have a yahoo mail account') else ShowMessage('You dont have a yahoo mail account'); Break; end; end else raise Exception.Create('Couldnt log you on'); end; procedure TForm1.FormCreate(Sender: TObject); begin FRemoteFile := TStringList.Create; end; end. <-----------------------------END UNIT CODE---------------------------------> <-----------------------------BEGIN FORM CODE-------------------------------> object Form1: TForm1 Left = 192 Top = 121 Width = 379 Height = 443 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 120 TextHeight = 16 object Label3: TLabel Left = 16 Top = 136 Width = 65 Height = 16 Caption = 'Buddys list' end object Label4: TLabel Left = 194 Top = 138 Width = 64 Height = 16 Caption = 'Ignore lists' end object Panel1: TPanel Left = 11 Top = 3 Width = 342 Height = 113 TabOrder = 0 object Label1: TLabel Left = 11 Top = 24 Width = 63 Height = 16 Caption = 'Username' end object Label2: TLabel Left = 11 Top = 56 Width = 60 Height = 16 Caption = 'Password' end object Edit1: TEdit Left = 94 Top = 18 Width = 233 Height = 24 TabOrder = 0 end object Edit2: TEdit Left = 96 Top = 51 Width = 233 Height = 24 TabOrder = 1 end object Button1: TButton Left = 139 Top = 82 Width = 75 Height = 25 Caption = 'Login' TabOrder = 2 OnClick = Button1Click end end object ListBox1: TListBox Left = 15 Top = 160 Width = 171 Height = 239 ItemHeight = 16 TabOrder = 1 end object ListBox2: TListBox Left = 192 Top = 160 Width = 171 Height = 239 ItemHeight = 16 TabOrder = 2 end object HTTP: TIdHTTP Request.Accept = 'text/html, */*' Request.ContentLength = 0 Request.ContentRangeEnd = 0 Request.ContentRangeStart = 0 Request.ProxyPort = 0 Request.UserAgent = 'Mozilla/4.6 (compatible; Indy Library)' Left = 320 Top = 48 end end