کمک خواستن در مورد اتصال به یاهو با دلفی

[oracle]

به من کمک کنید
من اوراکل هستم
و می خوام :oops: از طریق دفلی یک یوز رو ان لاین کنم ولی نمی تونم
اگه راهنمایی کنید خیلی ممنون می شم

[Inprise]

برگرفته از Delphi3000.com


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

توضیح : از اجزاء Indy در این کد استفاده شده است .

خوش باشید

[امیر-نا]

من اینو خواستم کامپایل کنم یه سری error داد؟
:cry:
امیر

[hr110]

:) فکر نمیکنه که یک خورده زود اومدی ؟؟؟ (:D)

[امیر-نا]

از مهمون نوازی شما ممنون هستم ولی

فکر نمیکنه که یک خورده زود اومدی ؟؟؟
دلیل نمیشه؟ نه

مرسی ممنون
امیر

[oracle]

خیلی ممنون
ولی یاهو بازم پروتوکلش رو عوض کرده :mrgreen: