QQ狀態查詢程式

來源:互聯網
上載者:User

前幾天在網上看到的方法,開啟地址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.

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.