unit1.~pas

可探索指定IP地址段内的所有OICQ用户号码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, StatusBarEx, ExtCtrls, OleCtrls, SHDocVw, StdCtrls,
  Buttons, FmxUtils, NMUDP, ShellAPI, ImgList,Winsock, ToolWin,
  Ingusclass, Protohdr, IngusPacket;

const
  WM_MY_Notify=WM_USER+100;

type
  SArray = array[$0..$ffff] of integer;
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    StatusBarEx1: TStatusBarEx;
    Panel1: TPanel;
    Panel2: TPanel;
    Adver: TWebBrowser;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    BitBtn1: TBitBtn;
    SmMess: TMemo;
    SmInfo: TRichEdit;
    Label1: TLabel;
    Label2: TLabel;
    SmIp: TEdit;
    SmPort: TEdit;
    Label3: TLabel;
    SmNum: TEdit;
    Label4: TLabel;
    SmFace: TComboBox;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    Sender1: TNMUDP;
    Timer1: TTimer;
    CheckBox2: TCheckBox;
    PopupMenu1: TPopupMenu;
    TrayPop: TMenuItem;
    N21: TMenuItem;
    Image1: TImage;
    GroupBox5: TGroupBox;
    Label5: TLabel;
    IPSearchArea: TEdit;
    Label6: TLabel;
    IPSearchPort: TEdit;
    GroupBox6: TGroupBox;
    IPDeted: TListView;
    ImageList1: TImageList;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    GroupBox7: TGroupBox;
    IPSearcher: TNMUDP;
    ReSender: TNMUDP;
    SearchInfo: TLabel;
    DetePro: TProgressBar;
    DLab1: TLabel;
    DLab2: TLabel;
    DetedPop: TPopupMenu;
    TabSheet5: TTabSheet;
    Image2: TImage;
    TabSheet6: TTabSheet;
    N2: TMenuItem;
    WEB1: TMenuItem;
    GroupBox8: TGroupBox;
    Label10: TLabel;
    PDeteIP: TEdit;
    Label11: TLabel;
    PDeteB: TEdit;
    Label12: TLabel;
    PDeteE: TEdit;
    GroupBox9: TGroupBox;
    PortDeted: TListView;
    GroupBox10: TGroupBox;
    BitBtn6: TBitBtn;
    Label13: TLabel;
    BitBtn5: TBitBtn;
    Label14: TLabel;
    Label15: TLabel;
    PDetePro: TProgressBar;
    PortSearcher: TNMUDP;
    PSearchMess: TLabel;
    IP1: TMenuItem;
    PopupMenu2: TPopupMenu;
    N3: TMenuItem;
    WEB2: TMenuItem;
    GroupBox11: TGroupBox;
    GroupBox12: TGroupBox;
    Label7: TLabel;
    ComboBox1: TComboBox;
    chudp: TCheckBox;
    GroupBox13: TGroupBox;
    FriendList: TListView;
    CheckBox4: TCheckBox;
    BitBtn7: TBitBtn;
    GroupBox14: TGroupBox;
    Memo1: TMemo;
    FLPop: TPopupMenu;
    IP2: TMenuItem;
    N4: TMenuItem;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label8: TLabel;
    Label20: TLabel;
    Label9: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    BitBtn8: TBitBtn;
    IPLab: TLabel;
    Label27: TLabel;
    GroupBox15: TGroupBox;
    Label16: TLabel;
    Label28: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    GroupBox16: TGroupBox;
    Label29: TLabel;
    Label30: TLabel;
    Edit3: TEdit;
    ComboBox2: TComboBox;
    CheckBox3: TCheckBox;
    CheckBox5: TCheckBox;
    GroupBox17: TGroupBox;
    Memo2: TMemo;
    GroupBox18: TGroupBox;
    BitBtn9: TBitBtn;
    BitBtn10: TBitBtn;
    ListView1: TListView;
    NetTest: TTimer;

    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Sender1DataReceived(Sender: TComponent; NumberBytes: Integer;
      FromIP: String; Port: Integer);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn3Click(Sender: TObject);
    procedure IPSearcherDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure Label8Click(Sender: TObject);
    procedure Label9Click(Sender: TObject);
    procedure IPDetedSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure N2Click(Sender: TObject);
    procedure WEB1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure PortSearcherDataReceived(Sender: TComponent;
      NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure IP1Click(Sender: TObject);
    procedure PortDetedSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure N3Click(Sender: TObject);
    procedure WEB2Click(Sender: TObject);
    procedure chudpClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure FriendListSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure N4Click(Sender: TObject);
    procedure IP2Click(Sender: TObject);
    procedure Label23Click(Sender: TObject);
    procedure Label27Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure NetTestTimer(Sender: TObject);


    
//        function GetComputerName(IP:string):string;
    
  private
    { Private declarations }
    TBRect: TRect;
    sIngus: TIngusSniffer;
    procedure GetAdve;
    procedure SetTrayIcon(WIcon:hwnd; Job:Integer);
    procedure MainTrayIconClick(var msg : TMessage); Message WM_My_Notify;
    procedure DeMessStru(Num,Face,Mess:string); //消息结构定义
    procedure SendMess1(IP,Num,Face,Mess:string;Port,LocalPort:integer);//定向单信息发送
    procedure SendReMess(IP,Num:string;Port:integer);
    procedure IPSearchMess(Area:string;RemotePort:integer);
    procedure WSmInfo(color:Tcolor;mess:string;bold:boolean);
    procedure WMNcPaint(var m: TMessage);message WM_NCPAINT; // 当画标题栏时进入该过程
    procedure DrawCaptionBtn(uEdge: UINT);
    procedure WMNcActivate(var m: TMessage);message WM_NCACTIVATE;// 当标题栏在激活与非激活之间切换时进入该过程
    procedure WMNcLButtonDown(var m: TMessage);message WM_NCLBUTTONDOWN;// 当在标题栏上按下鼠标左按钮时进入该过程
    procedure WMNcLButtonUp(var m: TMessage);message WM_NCLBUTTONUP;// 当在标题栏上放开鼠标左按钮时进入该过程

  public
    { Public declarations }
    procedure OnParsePacketHandle( nPacketSeq: Longint; uBuffer: PChar;
                                   nRecvBytes: integer; sPacket: TIngusPacketBase );
    procedure OnAfterGetMacAddress(bStatus: Boolean; pMacAddr: PChar);
    procedure OnAfterGetAdapterDesc(bStatus: Boolean; sAdapterDesc: string);
    end;

var
  Form1 : TForm1;
  MainTrayIcon: PNotifyIconDataA;
  MessStru,ReMess : SArray; //消息结构数组
  SendStream : TMemoryStream;
  Rzz : integer;  //随机数种子
  DetedSb1,DetedSb2,DetedSb3:string;
  RecvMessbuffer:string;
  Closebool : integer;
implementation

{$R *.DFM}


procedure TForm1.GetAdve;
var
  Flags: OLEVariant;
begin
Flags := 0;
Adver.Navigate(WideString('http://oq998.yeah.net'), Flags, Flags, Flags, Flags);

end;


procedure TForm1.DeMessStru(Num,Face,Mess:string);
var i,RandBuff : integer;
    DebugStr : string;
begin
MessStru[0] := $02;//HEADER
MessStru[1] := $03;
MessStru[2] := $0a;
MessStru[3] := $00;
MessStru[4] := $78;
MessStru[5] := $3a;//MESSAGE CHANGE
MessStru[6] := $2b;
MessStru[7] := $34;//ICQ Number
MessStru[8] := $33;
MessStru[9] := $30;
MessStru[10] := $34;
MessStru[11] := $34;
MessStru[12] := $36;//^^^
MessStru[13] := $1f;//Split
MessStru[14] := $30;
MessStru[15] := $1f;//Split
MessStru[16] := $31;//Face
MessStru[17] := $37;
MessStru[18] := $32;//^^^
MessStru[19] := $1f;
MessStru[20] := $33;
MessStru[21] := $30;
MessStru[22] := $30;
MessStru[23] := $30;
MessStru[24] := $2d;
MessStru[25] := $30;
MessStru[26] := $39;
MessStru[27] := $2d;
MessStru[28] := $30;
MessStru[29] := $36;
MessStru[30] := $1f;
MessStru[31] := $30;
MessStru[32] := $38;
MessStru[33] := $3a;
MessStru[34] := $34;
MessStru[35] := $39;
MessStru[36] := $3a;
MessStru[37] := $31;
MessStru[38] := $33;
MessStru[39] := $1f;
MessStru[40] := $50;
MessStru[41] := $03;

SendStream := TMemoryStream.Create;
for i := 0 to 4 do SendStream.Write(MessStru[i],1);
RandBuff := Random(Rzz);
RandBuff := Random(Rzz);
RandBuff := Random(Rzz);
//showmessage(inttostr(RandBuff));
SendStream.Write(RandBuff,1);
RandBuff := Random(Rzz);
SendStream.Write(RandBuff,1);
DebugStr := inttostr(Length(Num));
//showmessage(DebugStr);
SendStream.Write(Num[1],Length(Num));
for i := 13 to 15 do SendStream.Write(MessStru[i],1);
SendStream.Write(Face[1],Length(Face));
for i := 19 to 39 do SendStream.Write(MessStru[i],1);
SendStream.Write(Mess[1],Length(Mess));
SendStream.Write(MessStru[41],1);
end;


procedure TForm1.SendMess1(IP,Num,Face,Mess:string;Port,LocalPort:integer);

begin
DeMessStru(Num,Face,Mess);
Sender1.RemoteHost := IP;
Sender1.RemotePort := Port;
Sender1.LocalPort  := LocalPort;
//showMessage
  try
     Sender1.SendStream(SendStream);
  finally
    SendStream.Free;
  end;
end;


procedure TForm1.WSmInfo(color:Tcolor;mess:string;bold:boolean);
var n:integer;
begin
n := Length(mess);
SmInfo.Lines.Add(mess);
SmInfo.SelLength:=-n-2;
if bold then SmInfo.SelAttributes.Style :=[fsBold];
SmInfo.SelAttributes.Color:=color;
postmessage(SmInfo.handle, WM_VSCROLL, 1, SB_LINEDOWN);
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
Closebool := 0;
//SetTrayIcon(Form1.Icon.Handle,0);
//SetTrayIcon(Form1.Icon.Handle,0);
//SetTrayIcon(Form1.Icon.Handle,0);
SetTrayIcon(Form1.Icon.Handle,0);
DrawCaptionBtn(EDGE_RAISED);
GetAdve;
RecvMessbuffer := '';
Rzz := 13;

//Sniff INI
  sIngus := TIngusSniffer.Create;
  sIngus.OnParsePacket := OnParsePacketHandle;
  //sIngus.OnAfterGetAdapterDesc := OnAfterGetAdapterDesc;
  //sIngus.OnAfterGetMacAddress := OnAfterGetMacAddress;
  ComboBox1.Items.Assign(sIngus.AdapterNameList);
  ComboBox1.ItemIndex := 0;


end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Rzz < $100 then Rzz := Rzz +1
else Rzz := 13;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
SendMess1(SmIp.Text,SmNum.Text,SmFace.Text,SmMess.Text,strtoint(SmPort.Text),1234);
WSmInfo(clGreen,'消息已经发往：'+SmIp.Text,False);
if CheckBox2.Checked = True then SmMess.Clear;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
//SetTrayIcon(Form1.Icon.Handle,0);
SmInfo.Clear;
end;

procedure TForm1.SetTrayIcon (WIcon:hwnd; Job:Integer);
begin
if Job = 0 then
begin
NEW(MainTrayIcon);
MainTrayIcon^.Wnd := Form1.Handle;
MainTrayIcon^.uID := 0;
MainTrayIcon^.uFlags := NIF_ICON+NIF_MESSAGE+NIF_TIP;
MainTrayIcon^.hIcon := WIcon;
MainTrayIcon^.uCallbackMessage := WM_MY_Notify;
MainTrayIcon^.szTip := 'Left Click hide or restore WhoCQ window! Right Click pop Menu';
//showmessage(inttostr(Form1.Handle)+'/'+inttostr(NIF_ICON+NIF_MESSAGE+NIF_TIP)+'/'+inttostr(WIcon));
Shell_NotifyIcon(NIM_ADD,MainTrayIcon);
end;

if Job = 2 then
begin
Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
end;
end;


procedure TForm1.MainTrayIconClick(var msg : TMessage);
var p:TPoint;
begin
 try
     case msg.LParam of
      WM_LBUTTONDOWN:
        begin
        GetCursorPos(p);
        TrayPop.Checked := not TrayPop.Checked;
        if TrayPop.Checked = False then
        begin
        Form1.show;
        Application.Restore;
        SendMessage(Handle,WM_NCACTIVATE,HTCaption,GetMessagePos);
        end
        else
        begin

        //Application.Minimize;
        //SetWindowLong(Application.handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
        Form1.hide;
        end;
        end;
      WM_RBUTTONDOWN:
        begin
        GetCursorPos(p);
        PopupMenu1.Popup(p.x,p.y);
        end;
      WM_LBUTTONDBLCLK:
        begin
        //ShowMessage('LBDD');
        end;
      WM_RBUTTONDBLCLk:
        begin
        //ShowMessage('RBDD');
        end;
     end;
 except
 end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
sIngus.StopSnoop;

//SetTrayIcon(Form1.Icon.Handle,2);
end;



procedure TForm1.DrawCaptionBtn(uEdge: UINT);
var
   hCaptionDC: HDC; // 标题条Device Context
   //hOldFont: HFONT; // 原来的字体
   r: TRect;
begin
     hCaptionDC := GetWindowDC(Self.Handle);
          // 注意不能用GetDC,那样的话，将得不到标题栏
          // 的设备上下文
          //画按钮的样子，如果uEdge=EDGE_RAIS，
          //则画出的样子为凸起；如果
          //uEdge=EDGE_SUNKEN，则画出的样子为凹下。
     DrawEdge(hCaptionDC, TBRect, uEdge, BF_RECT or BF_MIDDLE or BF_SOFT);
           //设置标题栏的设备上下文为透明状态
     SetBkMode(hCaptionDC, TRANSPARENT);
           //设置标题栏设备上下文的字体
           //hOldFont:= SelectObject(hCaptionDC, CBBtnFont.Handle);
           //画按钮
     if uEdge = EDGE_RAISED then
        begin
        SetRect(TBRect,459,5,475,19);
        DrawText(hCaptionDC, '*',1, TBRect, DT_CENTER);
        end
     else begin
        r := TBRect;
        SetRect(r,459,5,475,19);
        OffsetRect(r, 1, 1);
        DrawText(hCaptionDC, '*', 1, r, DT_CENTER);
     end;
            //还原为原来的字体
            //SelectObject(hCaptionDC, hOldFont);
end;

procedure TForm1.WMNcActivate(var m: TMessage);
begin
     inherited;
     DrawCaptionBtn(EDGE_RAISED);
end;

procedure TForm1.WMNcPaint(var m: TMessage);
begin
     inherited;
     DrawCaptionBtn(EDGE_RAISED);
end;

procedure TForm1.WMNcLButtonDown(var m: TMessage);
var
   p: TPoint;
begin
     p.x := LOWORD(m.lParam) - Self.Left;
     p.y := HIWORD(m.lParam) - Self.Top;
     if PtInRect(TBRect, p) then  // 如果按在了按钮区域
     begin
        Self.BringToFront;
        DrawCaptionBtn(EDGE_SUNKEN);
     end
     else
        inherited; // 执行默认的操作
end;

procedure TForm1.WMNcLButtonUp(var m: TMessage);
var
   p: TPoint;
begin
     p.x := LOWORD(m.lParam) - Self.Left;