您的位置:首页 > 其它

QQ状态查询程序

2005-09-10 00:00 211 查看
前几天在网上看到的方法,打开地址http://wpa.qq.com/pa?p=1:88888:4能看到88888的在线状态。刚才把它弄成个小程序,自己编程特烂,希望高手指出错误。
开始用IDHTTP组件,不知道为啥老出错,所以改用CLIENTSOCKET组件了。



unit UtMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, StdCtrls, Buttons, ScktComp, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
CS: TClientSocket;
Memo1: TMemo;
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
Edit1: TEdit;
Label2: TLabel;
Memo2: TMemo;
SpeedButton1: TSpeedButton;
BitBtn2: TBitBtn;
function senddata(QQ:string):string;
procedure CSConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
procedure CSDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CSError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure CSConnecting(Sender: TObject; Socket: TCustomWinSocket);
procedure Memo2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}

procedure TForm1.CSConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text:='已建立连接';
Socket.SendText(Senddata(Edit1.Text));
end;
procedure TForm1.CSRead(Sender: TObject; Socket: TCustomWinSocket);
var
rec:string;
begin
StatusBar1.Panels[0].Text:='读取数据';
Memo1.Text:=Socket.ReceiveText;
rec:=Memo1.Text;
if pos('http://wpslogo.qq.com/qq1_offline.gif',rec)>0 then
Memo2.Lines.Add(EDIT1.Text+'离线')
else
begin
if pos('http://wpslogo.qq.com/qq1_online.gif',rec)>0 then
Memo2.Lines.Add(EDIT1.Text+'在线')
else
Memo2.Lines.Add(EDIT1.Text+'不能确定');
end;
end;
procedure TForm1.Memo2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Memo2.Lines.Count>25 then
Memo2.ScrollBars:=ssVertical
else
Memo2.ScrollBars:=ssNone;
end;

procedure TForm1.CSDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text:='已断开连接';
end;
procedure TForm1.CSError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
StatusBar1.Panels[0].Text:='连接出错';
end;
procedure TForm1.CSConnecting(Sender: TObject; Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text:='正在连接';
end;
function TForm1.senddata(QQ:string):string;
const
h=#13#10;
begin
result:='GET /pa?p=1:'+QQ+':4 HTTP/1.1'+H;
result:=result+'Accept: */*'+H;
result:=result+'Accept: */*'+H;
result:=result+'Accept-Language: zh-cn'+H;
result:=result+'Accept-Encoding: gzip, deflate'+H;
result:=result+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MyIE2)'+H;
result:=result+'Host: wpa.qq.com'+H;
result:=result+'Connection: Keep-Alive'+H;
result:=result+H;
result:=result+'!'+H;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(Form1.Handle,200,AW_CENTER);
Edit1.clear;
Memo1.clear;
Memo2.clear;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
ReleaseCapture;
Form1.perform(WM_SysCommand, $F012, 0);
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
CS.Active:=False;
CS.Host:='wpa.qq.com';
CS.Port:=80;
CS.Active:=True;
StatusBar1.Panels[0].Text:='开始连接';
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
close;
end;
end.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: