unit1.pas

QQ2006.3聊天内容获取演示下载QQ2006.3聊天内容获取演示下载

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Grids,cap_ip, Buttons, StdCtrls,Registry,ShellApi;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
      DestPort: String; header: PChar; header_size: Integer; data: PChar;
      data_size: Integer);
    procedure cap_ipError(Error : string);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
   procedure sendQQMsg(qq,temp: String);
    { Public declarations }
  end;

var
  Form1        : TForm1;
  cap_ip1      : Tcap_ip;
  consoleModel : boolean = false;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with StringGrid1.Rows[0] do
   begin
    Add('源地址');
    Add('源端口');
    Add('目的地址');
    Add('目的端口');
    Add('QQ号');
   end;
  cap_ip1         := Tcap_ip.Create(self);
  cap_ip1.OnCap   := cap_ip1Cap;
  cap_ip1.OnError := cap_ipError;
  StringGrid1.RowCount:=2;
  StringGrid1.Rows[1].Clear;
end;

procedure TForm1.sendQQMsg(qq,temp: String);
var
    Registro: TRegistry;
begin
  Registro:= TRegistry.Create;
  Registro.RootKey := HKEY_LOCAL_MACHINE;
  if Registro.KeyExists('SOFTWARE\Tencent\QQ') then
  begin
  ShellExecute(GetDesktopWindow(),
                nil,
                //pchar('http://wpa.qq.com/msgrd?V=1&Uin=65845743&Site=QQliao1&Menu=yes'),
                pchar('Tencent://Message/?Menu=yes&Uin='+qq+'&websiteName='+temp),
                nil,
                nil,
                SW_SHOWNORMAL);
  end else
  begin
   showmessage('您的电脑上没有安装QQ，请先安装QQ！');
   exit;
  end;
end; 

procedure TForm1.cap_ipError(Error : string);
begin
 ShowMessage('Error :'+error);
 if consoleModel then
  writeln('捕捉出错 ：'+error);
end;

procedure TForm1.cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort,
  DestPort: String; header: PChar; header_size: Integer; data: PChar;
  data_size: Integer);
  var
   QQ : integer;
begin
 if proto= 'UDP' then
 begin
  if DestPort = '8000' then
  begin
   if(data_size mod 4 = 0) and (data_size>0) then
   begin
      if ((data[0] = char($02)) and (data[3] = char($00)) and (data[data_size-1] = char($03)))  then
      begin
                QQ := (integer(data[7]) and $ff);
                QQ := (QQ shl 8) + (integer(data[8])  and $ff);
                QQ := (QQ shl 8) + (integer(data[9])  and $ff);
                QQ := (QQ shl 8) + (integer(data[10]) and $ff);
                //showMessage(format('IP:%s QQ:%d\r',[sourceIP,QQ]));
                {    Add('源地址');
                     Add('源端口');
                     Add('目的地址');
                     Add('目的端口');
                     Add('QQ号');
                }
                if consoleModel then
                  writeln(Format('源地址:%s 源端口:%s QQ:%d 目的地址:%s',
                          [sourceIP,SourcePort,QQ,destIP]));
                  
                with StringGrid1 do
                begin
                  Cells[0,StringGrid1.RowCount-1]:=sourceIP;
                  Cells[1,StringGrid1.RowCount-1]:=SourcePort;
                  Cells[2,StringGrid1.RowCount-1]:=destIP;
                  Cells[3,StringGrid1.RowCount-1]:=DestPort;
                  Cells[4,StringGrid1.RowCount-1]:=inttostr(QQ);                  
                end;
      end;
   end;
  end;
 end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 if SpeedButton1.Caption = '开始捕捉' then
 begin
  cap_ip1.StartCap;
  SpeedButton1.Caption := '结束捕捉';
  Label2.Caption       := '正在捕捉';
 end 
 else begin
  cap_ip1.StopCap;
  SpeedButton1.Caption := '开始捕捉';
  Label2.Caption       := '已经停止';
 end; 
 
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  StringGrid1.RowCount:=2;
  StringGrid1.Rows[1].Clear;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 cap_ip1.StopCap;
 cap_ip1.Free;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
 QQ : String;
begin
 QQ := StringGrid1.Rows[StringGrid1.Selection.TopLeft.Y].Strings[4];
 if (QQ = '') then
 begin
  exit;
 end;
 sendQQMsg(qq,'');
end;

end.