Dracula
سه شنبه 20 خرداد 1382, 09:56 صبح
با سلام خدمت همه دوستان عزیز
پیرو درخواست یکی از دوستان جهت معرفی مقاله یا کامپوننتی برای کار با پیامگیر یاهو اینجانب جستجو کردم و این مقاله رو که به همراه یک کد کامل جهت برقراری ارتباط با پیامگیر یاهو هستش رو به شرح ذیل پیدا کردم:
امید است که مفید واقع شود .
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
<-----------------------------END FORM CODE ------------------------------->
If anyone want to help me in the implementation of the yahoo protocol, please send me an email with the subject YahooLIB.pas, the source of this code is based upon the works of LibYahoo an open source implementation of the protocol in C, C++
موفق باشید . :wink:
پیرو درخواست یکی از دوستان جهت معرفی مقاله یا کامپوننتی برای کار با پیامگیر یاهو اینجانب جستجو کردم و این مقاله رو که به همراه یک کد کامل جهت برقراری ارتباط با پیامگیر یاهو هستش رو به شرح ذیل پیدا کردم:
امید است که مفید واقع شود .
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
<-----------------------------END FORM CODE ------------------------------->
If anyone want to help me in the implementation of the yahoo protocol, please send me an email with the subject YahooLIB.pas, the source of this code is based upon the works of LibYahoo an open source implementation of the protocol in C, C++
موفق باشید . :wink: