开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > 查看源码
Unit1.~pas
资源名称：whocq2src.zip　[点击查看]
上传用户：sunrenlu
上传日期：2007-01-08
资源大小：199k
文件大小：27k
源码类别：

Internet/网络编程

开发平台：

Delphi

Unit1.~pas：源码内容
  1. unit Unit1;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ComCtrls, StatusBarEx, ExtCtrls, OleCtrls, SHDocVw, StdCtrls,
  8.   Buttons, FmxUtils, NMUDP, ShellAPI, ImgList,Winsock, ToolWin,
  9.   Ingusclass, Protohdr, IngusPacket;
  11. const
  12.   WM_MY_Notify=WM_USER+100;
  14. type
  15.   SArray = array[$0..$ffff] of integer;
  16.   TForm1 = class(TForm)
  17.     MainMenu1: TMainMenu;
  18.     N1: TMenuItem;
  19.     StatusBarEx1: TStatusBarEx;
  20.     Panel1: TPanel;
  21.     Panel2: TPanel;
  22.     Adver: TWebBrowser;
  23.     PageControl1: TPageControl;
  24.     TabSheet1: TTabSheet;
  25.     TabSheet2: TTabSheet;
  26.     TabSheet3: TTabSheet;
  27.     TabSheet4: TTabSheet;
  28.     GroupBox1: TGroupBox;
  29.     GroupBox2: TGroupBox;
  30.     GroupBox3: TGroupBox;
  31.     GroupBox4: TGroupBox;
  32.     BitBtn1: TBitBtn;
  33.     SmMess: TMemo;
  34.     SmInfo: TRichEdit;
  35.     Label1: TLabel;
  36.     Label2: TLabel;
  37.     SmIp: TEdit;
  38.     SmPort: TEdit;
  39.     Label3: TLabel;
  40.     SmNum: TEdit;
  41.     Label4: TLabel;
  42.     SmFace: TComboBox;
  43.     CheckBox1: TCheckBox;
  44.     BitBtn2: TBitBtn;
  45.     Sender1: TNMUDP;
  46.     Timer1: TTimer;
  47.     CheckBox2: TCheckBox;
  48.     PopupMenu1: TPopupMenu;
  49.     TrayPop: TMenuItem;
  50.     N21: TMenuItem;
  51.     Image1: TImage;
  52.     GroupBox5: TGroupBox;
  53.     Label5: TLabel;
  54.     IPSearchArea: TEdit;
  55.     Label6: TLabel;
  56.     IPSearchPort: TEdit;
  57.     GroupBox6: TGroupBox;
  58.     IPDeted: TListView;
  59.     ImageList1: TImageList;
  60.     BitBtn3: TBitBtn;
  61.     BitBtn4: TBitBtn;
  62.     GroupBox7: TGroupBox;
  63.     IPSearcher: TNMUDP;
  64.     ReSender: TNMUDP;
  65.     SearchInfo: TLabel;
  66.     DetePro: TProgressBar;
  67.     DLab1: TLabel;
  68.     DLab2: TLabel;
  69.     DetedPop: TPopupMenu;
  70.     TabSheet5: TTabSheet;
  71.     Image2: TImage;
  72.     TabSheet6: TTabSheet;
  73.     N2: TMenuItem;
  74.     WEB1: TMenuItem;
  75.     GroupBox8: TGroupBox;
  76.     Label10: TLabel;
  77.     PDeteIP: TEdit;
  78.     Label11: TLabel;
  79.     PDeteB: TEdit;
  80.     Label12: TLabel;
  81.     PDeteE: TEdit;
  82.     GroupBox9: TGroupBox;
  83.     PortDeted: TListView;
  84.     GroupBox10: TGroupBox;
  85.     BitBtn6: TBitBtn;
  86.     Label13: TLabel;
  87.     BitBtn5: TBitBtn;
  88.     Label14: TLabel;
  89.     Label15: TLabel;
  90.     PDetePro: TProgressBar;
  91.     PortSearcher: TNMUDP;
  92.     PSearchMess: TLabel;
  93.     IP1: TMenuItem;
  94.     PopupMenu2: TPopupMenu;
  95.     N3: TMenuItem;
  96.     WEB2: TMenuItem;
  97.     GroupBox11: TGroupBox;
  98.     GroupBox12: TGroupBox;
  99.     Label7: TLabel;
  100.     ComboBox1: TComboBox;
  101.     chudp: TCheckBox;
  102.     GroupBox13: TGroupBox;
  103.     FriendList: TListView;
  104.     CheckBox4: TCheckBox;
  105.     BitBtn7: TBitBtn;
  106.     GroupBox14: TGroupBox;
  107.     Memo1: TMemo;
  108.     FLPop: TPopupMenu;
  109.     IP2: TMenuItem;
  110.     N4: TMenuItem;
  111.     Label17: TLabel;
  112.     Label18: TLabel;
  113.     Label19: TLabel;
  114.     Label8: TLabel;
  115.     Label20: TLabel;
  116.     Label9: TLabel;
  117.     Label21: TLabel;
  118.     Label22: TLabel;
  119.     Label23: TLabel;
  120.     Label24: TLabel;
  121.     Label25: TLabel;
  122.     Label26: TLabel;
  123.     BitBtn8: TBitBtn;
  124.     IPLab: TLabel;
  125.     Label27: TLabel;
  126.     GroupBox15: TGroupBox;
  127.     Label16: TLabel;
  128.     Label28: TLabel;
  129.     Edit1: TEdit;
  130.     Edit2: TEdit;
  131.     GroupBox16: TGroupBox;
  132.     Label29: TLabel;
  133.     Label30: TLabel;
  134.     Edit3: TEdit;
  135.     ComboBox2: TComboBox;
  136.     CheckBox3: TCheckBox;
  137.     CheckBox5: TCheckBox;
  138.     GroupBox17: TGroupBox;
  139.     Memo2: TMemo;
  140.     GroupBox18: TGroupBox;
  141.     BitBtn9: TBitBtn;
  142.     BitBtn10: TBitBtn;
  143.     ListView1: TListView;
  144.     NetTest: TTimer;
  146.     procedure FormCreate(Sender: TObject);
  147.     procedure Timer1Timer(Sender: TObject);
  148.     procedure BitBtn2Click(Sender: TObject);
  149.     procedure BitBtn1Click(Sender: TObject);
  150.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  151.     procedure Sender1DataReceived(Sender: TComponent; NumberBytes: Integer;
  152.       FromIP: String; Port: Integer);
  153.     procedure BitBtn4Click(Sender: TObject);
  154.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  155.     procedure BitBtn3Click(Sender: TObject);
  156.     procedure IPSearcherDataReceived(Sender: TComponent;
  157.       NumberBytes: Integer; FromIP: String; Port: Integer);
  158.     procedure Label8Click(Sender: TObject);
  159.     procedure Label9Click(Sender: TObject);
  160.     procedure IPDetedSelectItem(Sender: TObject; Item: TListItem;
  161.       Selected: Boolean);
  162.     procedure N2Click(Sender: TObject);
  163.     procedure WEB1Click(Sender: TObject);
  164.     procedure BitBtn5Click(Sender: TObject);
  165.     procedure BitBtn6Click(Sender: TObject);
  166.     procedure PortSearcherDataReceived(Sender: TComponent;
  167.       NumberBytes: Integer; FromIP: String; Port: Integer);
  168.     procedure IP1Click(Sender: TObject);
  169.     procedure PortDetedSelectItem(Sender: TObject; Item: TListItem;
  170.       Selected: Boolean);
  171.     procedure N3Click(Sender: TObject);
  172.     procedure WEB2Click(Sender: TObject);
  173.     procedure chudpClick(Sender: TObject);
  174.     procedure FormDestroy(Sender: TObject);
  175.     procedure BitBtn7Click(Sender: TObject);
  176.     procedure FriendListSelectItem(Sender: TObject; Item: TListItem;
  177.       Selected: Boolean);
  178.     procedure N4Click(Sender: TObject);
  179.     procedure IP2Click(Sender: TObject);
  180.     procedure Label23Click(Sender: TObject);
  181.     procedure Label27Click(Sender: TObject);
  182.     procedure BitBtn8Click(Sender: TObject);
  183.     procedure NetTestTimer(Sender: TObject);
  186.     
  187. //        function GetComputerName(IP:string):string;
  188.     
  189.   private
  190.     { Private declarations }
  191.     TBRect: TRect;
  192.     sIngus: TIngusSniffer;
  193.     procedure GetAdve;
  194.     procedure SetTrayIcon(WIcon:hwnd; Job:Integer);
  195.     procedure MainTrayIconClick(var msg : TMessage); Message WM_My_Notify;
  196.     procedure DeMessStru(Num,Face,Mess:string); //消息结构定义
  197.     procedure SendMess1(IP,Num,Face,Mess:string;Port,LocalPort:integer);//定向单信息发送
  198.     procedure SendReMess(IP,Num:string;Port:integer);
  199.     procedure IPSearchMess(Area:string;RemotePort:integer);
  200.     procedure WSmInfo(color:Tcolor;mess:string;bold:boolean);
  201.     procedure WMNcPaint(var m: TMessage);message WM_NCPAINT; // 当画标题栏时进入该过程
  202.     procedure DrawCaptionBtn(uEdge: UINT);
  203.     procedure WMNcActivate(var m: TMessage);message WM_NCACTIVATE;// 当标题栏在激活与非激活之间切换时进入该过程
  204.     procedure WMNcLButtonDown(var m: TMessage);message WM_NCLBUTTONDOWN;// 当在标题栏上按下鼠标左按钮时进入该过程
  205.     procedure WMNcLButtonUp(var m: TMessage);message WM_NCLBUTTONUP;// 当在标题栏上放开鼠标左按钮时进入该过程
  207.   public
  208.     { Public declarations }
  209.     procedure OnParsePacketHandle( nPacketSeq: Longint; uBuffer: PChar;
  210.                                    nRecvBytes: integer; sPacket: TIngusPacketBase );
  211.     procedure OnAfterGetMacAddress(bStatus: Boolean; pMacAddr: PChar);
  212.     procedure OnAfterGetAdapterDesc(bStatus: Boolean; sAdapterDesc: string);
  213.     end;
  215. var
  216.   Form1 : TForm1;
  217.   MainTrayIcon: PNotifyIconDataA;
  218.   MessStru,ReMess : SArray; //消息结构数组
  219.   SendStream : TMemoryStream;
  220.   Rzz : integer;  //随机数种子
  221.   DetedSb1,DetedSb2,DetedSb3:string;
  222.   RecvMessbuffer:string;
  223.   Closebool : integer;
  224. implementation
  226. {$R *.DFM}
  229. procedure TForm1.GetAdve;
  230. var
  231.   Flags: OLEVariant;
  232. begin
  233. Flags := 0;
  234. Adver.Navigate(WideString('http://oq998.yeah.net'), Flags, Flags, Flags, Flags);
  236. end;
  239. procedure TForm1.DeMessStru(Num,Face,Mess:string);
  240. var i,RandBuff : integer;
  241.     DebugStr : string;
  242. begin
  243. MessStru[0] := $02;//HEADER
  244. MessStru[1] := $03;
  245. MessStru[2] := $0a;
  246. MessStru[3] := $00;
  247. MessStru[4] := $78;
  248. MessStru[5] := $3a;//MESSAGE CHANGE
  249. MessStru[6] := $2b;
  250. MessStru[7] := $34;//ICQ Number
  251. MessStru[8] := $33;
  252. MessStru[9] := $30;
  253. MessStru[10] := $34;
  254. MessStru[11] := $34;
  255. MessStru[12] := $36;//^^^
  256. MessStru[13] := $1f;//Split
  257. MessStru[14] := $30;
  258. MessStru[15] := $1f;//Split
  259. MessStru[16] := $31;//Face
  260. MessStru[17] := $37;
  261. MessStru[18] := $32;//^^^
  262. MessStru[19] := $1f;
  263. MessStru[20] := $33;
  264. MessStru[21] := $30;
  265. MessStru[22] := $30;
  266. MessStru[23] := $30;
  267. MessStru[24] := $2d;
  268. MessStru[25] := $30;
  269. MessStru[26] := $39;
  270. MessStru[27] := $2d;
  271. MessStru[28] := $30;
  272. MessStru[29] := $36;
  273. MessStru[30] := $1f;
  274. MessStru[31] := $30;
  275. MessStru[32] := $38;
  276. MessStru[33] := $3a;
  277. MessStru[34] := $34;
  278. MessStru[35] := $39;
  279. MessStru[36] := $3a;
  280. MessStru[37] := $31;
  281. MessStru[38] := $33;
  282. MessStru[39] := $1f;
  283. MessStru[40] := $50;
  284. MessStru[41] := $03;
  286. SendStream := TMemoryStream.Create;
  287. for i := 0 to 4 do SendStream.Write(MessStru[i],1);
  288. RandBuff := Random(Rzz);
  289. RandBuff := Random(Rzz);
  290. RandBuff := Random(Rzz);
  291. //showmessage(inttostr(RandBuff));
  292. SendStream.Write(RandBuff,1);
  293. RandBuff := Random(Rzz);
  294. SendStream.Write(RandBuff,1);
  295. DebugStr := inttostr(Length(Num));
  296. //showmessage(DebugStr);
  297. SendStream.Write(Num[1],Length(Num));
  298. for i := 13 to 15 do SendStream.Write(MessStru[i],1);
  299. SendStream.Write(Face[1],Length(Face));
  300. for i := 19 to 39 do SendStream.Write(MessStru[i],1);
  301. SendStream.Write(Mess[1],Length(Mess));
  302. SendStream.Write(MessStru[41],1);
  303. end;
  306. procedure TForm1.SendMess1(IP,Num,Face,Mess:string;Port,LocalPort:integer);
  308. begin
  309. DeMessStru(Num,Face,Mess);
  310. Sender1.RemoteHost := IP;
  311. Sender1.RemotePort := Port;
  312. Sender1.LocalPort  := LocalPort;
  313. //showMessage
  314.   try
  315.      Sender1.SendStream(SendStream);
  316.   finally
  317.     SendStream.Free;
  318.   end;
  319. end;
  322. procedure TForm1.WSmInfo(color:Tcolor;mess:string;bold:boolean);
  323. var n:integer;
  324. begin
  325. n := Length(mess);
  326. SmInfo.Lines.Add(mess);
  327. SmInfo.SelLength:=-n-2;
  328. if bold then SmInfo.SelAttributes.Style :=[fsBold];
  329. SmInfo.SelAttributes.Color:=color;
  330. postmessage(SmInfo.handle, WM_VSCROLL, 1, SB_LINEDOWN);
  331. end;
  335. procedure TForm1.FormCreate(Sender: TObject);
  336. begin
  337. Closebool := 0;
  338. //SetTrayIcon(Form1.Icon.Handle,0);
  339. //SetTrayIcon(Form1.Icon.Handle,0);
  340. //SetTrayIcon(Form1.Icon.Handle,0);
  341. SetTrayIcon(Form1.Icon.Handle,0);
  342. DrawCaptionBtn(EDGE_RAISED);
  343. GetAdve;
  344. RecvMessbuffer := '';
  345. Rzz := 13;
  347. //Sniff INI
  348.   sIngus := TIngusSniffer.Create;
  349.   sIngus.OnParsePacket := OnParsePacketHandle;
  350.   //sIngus.OnAfterGetAdapterDesc := OnAfterGetAdapterDesc;
  351.   //sIngus.OnAfterGetMacAddress := OnAfterGetMacAddress;
  352.   ComboBox1.Items.Assign(sIngus.AdapterNameList);
  353.   ComboBox1.ItemIndex := 0;
  356. end;
  358. procedure TForm1.Timer1Timer(Sender: TObject);
  359. begin
  360. if Rzz < $100 then Rzz := Rzz +1
  361. else Rzz := 13;
  362. end;
  364. procedure TForm1.BitBtn2Click(Sender: TObject);
  365. begin
  366. SendMess1(SmIp.Text,SmNum.Text,SmFace.Text,SmMess.Text,strtoint(SmPort.Text),1234);
  367. WSmInfo(clGreen,'消息已经发往：'+SmIp.Text,False);
  368. if CheckBox2.Checked = True then SmMess.Clear;
  369. end;
  371. procedure TForm1.BitBtn1Click(Sender: TObject);
  372. begin
  373. //SetTrayIcon(Form1.Icon.Handle,0);
  374. SmInfo.Clear;
  375. end;
  377. procedure TForm1.SetTrayIcon (WIcon:hwnd; Job:Integer);
  378. begin
  379. if Job = 0 then
  380. begin
  381. NEW(MainTrayIcon);
  382. MainTrayIcon^.Wnd := Form1.Handle;
  383. MainTrayIcon^.uID := 0;
  384. MainTrayIcon^.uFlags := NIF_ICON+NIF_MESSAGE+NIF_TIP;
  385. MainTrayIcon^.hIcon := WIcon;
  386. MainTrayIcon^.uCallbackMessage := WM_MY_Notify;
  387. MainTrayIcon^.szTip := 'Left Click hide or restore WhoCQ window! Right Click pop Menu';
  388. //showmessage(inttostr(Form1.Handle)+'/'+inttostr(NIF_ICON+NIF_MESSAGE+NIF_TIP)+'/'+inttostr(WIcon));
  389. Shell_NotifyIcon(NIM_ADD,MainTrayIcon);
  390. end;
  392. if Job = 2 then
  393. begin
  394. Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
  395. end;
  396. end;
  399. procedure TForm1.MainTrayIconClick(var msg : TMessage);
  400. var p:TPoint;
  401. begin
  402.  try
  403.      case msg.LParam of
  404.       WM_LBUTTONDOWN:
  405.         begin
  406.         GetCursorPos(p);
  407.         TrayPop.Checked := not TrayPop.Checked;
  408.         if TrayPop.Checked = False then
  409.         begin
  410.         Form1.show;
  411.         Application.Restore;
  412.         SendMessage(Handle,WM_NCACTIVATE,HTCaption,GetMessagePos);
  413.         end
  414.         else
  415.         begin
  417.         //Application.Minimize;
  418.         //SetWindowLong(Application.handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  419.         Form1.hide;
  420.         end;
  421.         end;
  422.       WM_RBUTTONDOWN:
  423.         begin
  424.         GetCursorPos(p);
  425.         PopupMenu1.Popup(p.x,p.y);
  426.         end;
  427.       WM_LBUTTONDBLCLK:
  428.         begin
  429.         //ShowMessage('LBDD');
  430.         end;
  431.       WM_RBUTTONDBLCLk:
  432.         begin
  433.         //ShowMessage('RBDD');
  434.         end;
  435.      end;
  436.  except
  437.  end;
  438. end;
  440. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  441. begin
  442. Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
  443. sIngus.StopSnoop;
  445. //SetTrayIcon(Form1.Icon.Handle,2);
  446. end;
  450. procedure TForm1.DrawCaptionBtn(uEdge: UINT);
  451. var
  452.    hCaptionDC: HDC; // 标题条Device Context
  453.    //hOldFont: HFONT; // 原来的字体
  454.    r: TRect;
  455. begin
  456.      hCaptionDC := GetWindowDC(Self.Handle);
  457.           // 注意不能用GetDC,那样的话，将得不到标题栏
  458.           // 的设备上下文
  459.           //画按钮的样子，如果uEdge=EDGE_RAIS，
  460.           //则画出的样子为凸起；如果
  461.           //uEdge=EDGE_SUNKEN，则画出的样子为凹下。
  462.      DrawEdge(hCaptionDC, TBRect, uEdge, BF_RECT or BF_MIDDLE or BF_SOFT);
  463.            //设置标题栏的设备上下文为透明状态
  464.      SetBkMode(hCaptionDC, TRANSPARENT);
  465.            //设置标题栏设备上下文的字体
  466.            //hOldFont:= SelectObject(hCaptionDC, CBBtnFont.Handle);
  467.            //画按钮
  468.      if uEdge = EDGE_RAISED then
  469.         begin
  470.         SetRect(TBRect,459,5,475,19);
  471.         DrawText(hCaptionDC, '*',1, TBRect, DT_CENTER);
  472.         end
  473.      else begin
  474.         r := TBRect;
  475.         SetRect(r,459,5,475,19);
  476.         OffsetRect(r, 1, 1);
  477.         DrawText(hCaptionDC, '*', 1, r, DT_CENTER);
  478.      end;
  479.             //还原为原来的字体
  480.             //SelectObject(hCaptionDC, hOldFont);
  481. end;
  483. procedure TForm1.WMNcActivate(var m: TMessage);
  484. begin
  485.      inherited;
  486.      DrawCaptionBtn(EDGE_RAISED);
  487. end;
  489. procedure TForm1.WMNcPaint(var m: TMessage);
  490. begin
  491.      inherited;
  492.      DrawCaptionBtn(EDGE_RAISED);
  493. end;
  495. procedure TForm1.WMNcLButtonDown(var m: TMessage);
  496. var
  497.    p: TPoint;
  498. begin
  499.      p.x := LOWORD(m.lParam) - Self.Left;
  500.      p.y := HIWORD(m.lParam) - Self.Top;
  501.      if PtInRect(TBRect, p) then  // 如果按在了按钮区域
  502.      begin
  503.         Self.BringToFront;
  504.         DrawCaptionBtn(EDGE_SUNKEN);
  505.      end
  506.      else
  507.         inherited; // 执行默认的操作
  508. end;
  510. procedure TForm1.WMNcLButtonUp(var m: TMessage);
  511. var
  512.    p: TPoint;
  513. begin
  514.      p.x := LOWORD(m.lParam) - Self.Left;
  515.      p.y := HIWORD(m.lParam) - Self.Top;
  516.      if PtInRect(TBRect, p) then //如果在标题栏按钮区域释放鼠标
  517.      begin
  518.         DrawCaptionBtn(EDGE_RAISED);
  519.         Form1.hide;
  520.      end
  521.      else
  522.         inherited; // 执行默认的操作
  523. end;
  527. procedure TForm1.Sender1DataReceived(Sender: TComponent;
  528.   NumberBytes: Integer; FromIP: String; Port: Integer);
  529. var RecvStream:TMemoryStream;
  530.     RecvString,RecvNum:String;
  531.     Bcount:integer;
  532. begin
  533. //StatusBar1.Panels[4].Text := 'R: '+inttostr(NumberBytes)+' bytes from '+FromIP;
  534. RecvStream := TMemoryStream.Create;
  535. Try
  536.    Sender1.ReadStream(RecvStream);
  537.    SetLength(RecvString,NumberBytes);
  538.    RecvStream.Read(RecvString[1],NumberBytes);
  540. finally
  541.    RecvStream.Free;
  542.    Bcount := 8;
  543.    while RecvString[Bcount] <> RecvString[NumberBytes] do
  544.    begin
  545.    RecvNum := RecvNum+RecvString[Bcount];
  546.    Bcount := Bcount+1;
  547.    end;
  548.    //showmessage(RecvNum);
  549.    if RecvMessbuffer <> RecvNum then
  550.    begin
  551.    WSmInfo(clNavy,RecvNum,False);
  552.    RecvMessbuffer := RecvNum;
  553.    end;
  554.    SendReMess(FromIP,SmNum.Text,Port);
  555.    //DetedShow(FromIP,Port,RecvNum);
  556. end;
  557. end;
  559. procedure TForm1.BitBtn4Click(Sender: TObject);
  560. begin
  561. IPDeted.Items.Clear;
  562. end;
  564. procedure TForm1.SendReMess(IP,Num:string;Port:integer);
  565. var ReStream:TMemoryStream;
  566.     ri:integer;
  567. begin
  568. ReMess[0] := $02;
  569. ReMess[1] := $02;
  570. ReMess[2] := $00;
  571. ReMess[3] := $00;
  572. ReMess[4] := $79;
  573. ReMess[5] := $0b;
  574. ReMess[6] := $b7;
  575. ReMess[7] := $34;//Number begin
  576. ReMess[8] := $32;
  577. ReMess[9] := $35;
  578. ReMess[10] := $34;
  579. ReMess[11] := $38;
  580. ReMess[12] := $30;
  581. ReMess[13] := $39;//End
  582. ReMess[14] := $03;
  583. ReStream := TMemoryStream.Create;
  584.  Try
  585.    if chudp.Checked then sIngus.StopSnoop;
  586.    for ri := 0 to 6 do ReStream.Write(ReMess[ri],1);
  587.    Restream.Write('20000',5);
  588.    Restream.Write(ReMess[14],1);
  589.    ReSender.RemoteHost := IP;
  590.    ReSender.RemotePort := Port;
  591.    ReSender.SendStream(ReStream);
  592.   Finally
  593.    ReStream.Free;
  594.    if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
  595.   end;
  596. end;
  599. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  600. begin
  601. Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
  602. end;
  604. procedure Tform1.IPSearchMess(Area:string;RemotePort:integer);
  605. var i1,i2,i3,i4,CNbuffer:integer;
  607. begin
  608. if chudp.Checked then sIngus.StopSnoop;
  609. DeMessStru('20000','001',SearchInfo.caption);
  610. DLab1.Enabled := True;
  611. DLab2.Enabled := True;
  612. IPSearcher.RemotePort := RemotePort;
  613. IPSearcher.LocalPort := 1235;
  614.   try
  615.    for i4 := 0 to 255 do
  616.     begin
  617.    for i1 := 0 to 25 do
  618.      begin
  619.        for i2 := 1 to 10 do
  620.          begin
  621.            for i3 := 1 to 3 do;
  622.              begin
  623.               CNbuffer := i1*10+i2;
  624.               if CNbuffer < 255 then
  625.                 begin
  626.                   IPSearcher.RemoteHost := Area + '.' + inttostr(i4)+'.'+inttostr(CNbuffer);
  627.                   IPSearcher.SendStream(SendStream);
  628.                 end;
  629.              end;
  630.          DLab2.Caption := IPSearcher.RemoteHost;
  631.          DetePro.StepIt;
  632.          end;
  633.       sleep(100);
  634.      end;
  635.      end;
  636.   finally
  637.   SendStream.Free;
  638.   if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
  639.   end;
  640. DLab1.Enabled := False;
  641. DLab2.Enabled := False;
  642. DetePro.Position := 0;
  643. showmessage('对'+Area+'区域的探索已经完成!');
  644. end;
  650. procedure TForm1.BitBtn3Click(Sender: TObject);
  651. begin
  653. IPSearchMess(IPSearchArea.Text,strtoint(IPSearchPort.text));
  655. end;
  657. procedure TForm1.IPSearcherDataReceived(Sender: TComponent;
  658.   NumberBytes: Integer; FromIP: String; Port: Integer);
  659. var RecvStream:TMemoryStream;
  660.     RecvString,RecvNum:String;
  661.     Bcount,i,ibool:integer;
  662.     DeteItem:TListItem;
  663. begin
  664. ibool := 0;
  665. RecvStream := TMemoryStream.Create;
  666. Try
  667.    IPSearcher.ReadStream(RecvStream);
  668.    SetLength(RecvString,NumberBytes);
  669.    RecvStream.Read(RecvString[1],NumberBytes);
  671. finally
  672.    RecvStream.Free;
  673.    Bcount := 8;
  674.    while RecvString[Bcount] <> RecvString[NumberBytes] do
  675.    begin
  676.    RecvNum := RecvNum+RecvString[Bcount];
  677.    Bcount := Bcount+1;
  678.    end;
  679. for i := 0 to IPDeted.Items.count-1 do
  680.  begin
  681.   if FromIP = IPDeted.Items[i].Caption then ibool := 1;
  682.  end;
  683. if ibool = 0 then
  684.  begin
  685.    DeteItem := IPDeted.Items.Add;
  686.    DeteItem.Caption := FromIP;
  687.    DeteItem.SubItems.Add(inttostr(Port));
  688.    DeteItem.SubItems.Add(RecvNum);
  689.  end;
  690. end;
  691. end;
  693. procedure TForm1.Label8Click(Sender: TObject);
  694. begin
  695. ExecuteFile('mailto:tyler_zhong@gre.net.cn','','',0);
  696. end;
  698. procedure TForm1.Label9Click(Sender: TObject);
  699. begin
  700. ExecuteFile('http://leosoft.home.dhs.org','','',0);
  701. end;
  703. procedure TForm1.IPDetedSelectItem(Sender: TObject; Item: TListItem;
  704.   Selected: Boolean);
  705. begin
  706. DetedSb1 := Item.Caption;
  707. DetedSb2 := Item.SubItems[0];
  708. DetedSb3 := Item.SubItems[1];
  709. end;
  711. procedure TForm1.N2Click(Sender: TObject);
  712. begin
  713. SmIp.Text := DetedSb1;
  714. SmPort.Text := DetedSb2;
  715. PageControl1.ActivePageIndex := 0;
  716. end;
  718. procedure TForm1.WEB1Click(Sender: TObject);
  719. var URL : string;
  720. begin
  721. URL :=  'http://search.tencent.com/cgi-bin/friend/user_show_info?ln='+DetedSb3;
  722. ExecuteFile(URL,'','',0);
  723. end;
  727. procedure TForm1.BitBtn5Click(Sender: TObject);
  728. var i1,i2:integer;
  729. begin
  730. PortDeted.Items.Clear;
  731. sleep(1000);
  732. if (strtoint(PDeteB.Text) > strtoint(PDeteE.Text)) or (strtoint(PDeteB.Text)<1) or (strtoint(PDeteE.Text)>65535)  then
  733. begin
  734. showmessage('端口号是1到65535的整数且必须遵循由小至大的顺序');
  735. end
  736. else
  737. if (strtoint(PDeteE.Text)-strtoint(PDeteb.Text)) > 300 then
  738. begin
  739. showmessage('一次最多只能探测300个端口');
  740. end
  741. else
  742. begin
  743. if chudp.Checked then sIngus.StopSnoop;
  744. PDetePro.Max := strtoint(PDeteE.Text)-strtoint(PDeteb.Text);
  745. DeMessStru('20001','001',PSearchMess.caption);
  746. //Label5.Caption := PDeteIP.Text;
  747. PortSearcher.RemoteHost := PDeteIP.Text;
  748. PortSearcher.LocalPort := 1236;
  749.  Try
  750.   for i1 := strtoint(PDeteb.Text) to strtoint(PDeteE.Text) do
  751.    begin
  752.     PortSearcher.RemotePort := i1;
  753.     for i2 := 1 to 3 do
  754.      begin
  755.      PortSearcher.SendStream(SendStream);
  756.      end;
  757.     PDetePro.StepIt;
  758.     sleep(100);
  759.    end;
  760.  Finally
  761.  SendStream.Free;
  762.  PDetePro.Position := 0;
  763.  showmessage('对'+PDeteIP.Text+'的'+PDeteb.Text+'到'+PDeteE.Text+'端口探测已经完成!');
  764.  if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
  765. end;
  766. end;
  767. end;
  769. procedure TForm1.BitBtn6Click(Sender: TObject);
  770. begin
  771. PortDeted.Items.Clear;
  772. end;
  774. procedure TForm1.PortSearcherDataReceived(Sender: TComponent;
  775.   NumberBytes: Integer; FromIP: String; Port: Integer);
  776. var RecvStream:TMemoryStream;
  777.     RecvString,RecvNum:String;
  778.     Bcount,i,ibool:integer;
  779.     DeteItem:TListItem;
  780. begin
  781. ibool := 0;
  782. RecvStream := TMemoryStream.Create;
  783. Try
  784.    PortSearcher.ReadStream(RecvStream);
  785.    SetLength(RecvString,NumberBytes);
  786.    RecvStream.Read(RecvString[1],NumberBytes);
  787. finally
  788.    RecvStream.Free;
  789.    Bcount := 8;
  790.    while RecvString[Bcount] <> RecvString[NumberBytes] do
  791.    begin
  792.    RecvNum := RecvNum+RecvString[Bcount];
  793.    Bcount := Bcount+1;
  794.    end;
  795.    for i := 0 to PortDeted.Items.count-1 do
  796.      begin
  797.       if inttostr(Port) = PortDeted.Items[i].Caption then ibool := 1;
  798.      end;
  799.    if ibool = 0 then
  800.      begin
  801.       DeteItem := PortDeted.Items.Add;
  802.       DeteItem.Caption := inttostr(Port);
  803.       DeteItem.SubItems.Add(RecvNum);
  804.      end;
  805. end;
  806. end;
  808. procedure TForm1.IP1Click(Sender: TObject);
  809. begin
  810. PDeteIP.Text := DetedSb1;
  811. PageControl1.ActivePageIndex := 2;
  812. end;
  814. procedure TForm1.PortDetedSelectItem(Sender: TObject; Item: TListItem;
  815.   Selected: Boolean);
  816. begin
  817. DetedSb1 := PDeteIP.Text;
  818. DetedSb2 := Item.Caption;
  819. DetedSb3 := Item.SubItems[0];
  820. end;
  822. procedure TForm1.N3Click(Sender: TObject);
  823. begin
  824. SmIp.Text := DetedSb1;
  825. SmPort.Text := DetedSb2;
  826. PageControl1.ActivePageIndex := 0;
  827. end;
  829. procedure TForm1.WEB2Click(Sender: TObject);
  830. var URL : string;
  831. begin
  832. URL :=  'http://search.tencent.com/cgi-bin/friend/user_show_info?ln='+DetedSb3;
  833. ExecuteFile(URL,'','',0);
  834. end;
  840. procedure TForm1.OnParsePacketHandle( nPacketSeq: Longint; uBuffer: PChar;
  841.                                       nRecvBytes: integer; sPacket:
  842.                                       TIngusPacketBase );
  843. var
  844.   sMacAddr,DAddr,DPort: string;
  845.   UDPbool,UDPbool2,i:integer;
  846.   sIpPacket: TIngusIPPacket;
  847.   //sIcmpPacket: TIngusICMPPacket;
  848.   sTCPPacket: TIngusTCPPacket;
  849.    nDestPort: integer; //nSrcPort,
  850.   DeteItem,Itembuff:TListItem;
  851. begin
  852.   UDPbool := 0;
  853.   UDPbool2 := 1;
  854.   if sPacket.EthernetProtocol <> PROTO_IP then exit;
  855.   sIPPacket := TIngusIPPacket(sPacket);
  857.   sMacAddr := Format( '网络适配器实时地址: %.2X:%.2X:%.2X:%.2X:%.2X:%.2X',
  858.                       [ UCHAR(sIngus.MacAddr[0]), UCHAR(sIngus.MacAddr[1]),
  859.                         UCHAR(sIngus.MacAddr[2]), UCHAR(sIngus.MacAddr[3]),
  860.                         UCHAR(sIngus.MacAddr[4]), UCHAR(sIngus.MacAddr[5]) ] );
  861.   sTCPPacket := TIngusTCPPacket(sPacket);
  862.   nDestPort := sTCPPacket.DestPort;
  863.   DAddr :=  Format('%u.%u.%u.%u', [ UCHAR((sIPPacket.IPDestAddr)^),
  864.                                                        UCHAR((sIPPacket.IPDestAddr+1)^),
  865.                                                        UCHAR((sIPPacket.IPDestAddr+2)^),
  866.                                                        UCHAR((sIPPacket.IPDestAddr+3)^) ]);
  867.   DPort := inttostr(nDestPort);
  868.   case sIPPacket.IPProtocol of
  869.   17: begin
  870.       UDPbool := 1;
  871.       for i := 0 to FriendList.Items.Count -1 do
  872.          begin
  873.            Itembuff := FriendList.Items[i];
  874.            if (Itembuff.SubItems[0] = DAddr) and (Itembuff.SubItems[1] = DPort) then UDPbool2 := 0;    //and (Itembuff.SubItems[1] <> DPort)
  875.          end;
  876.       //UDPT.caption := 'UDP';
  877.      end;
  878.   end;
  880.   case sPacket.PacketDirection of
  881.   pdInput:
  882.     begin
  883.       //Input;
  884.     end;
  885.   pdOutput:
  886.     begin
  887.          if (UDPbool = 1) and (UDPbool2 = 1) then
  888.            begin
  889.              DeteItem := FriendList.Items.Add;
  890.              DeteItem.Caption := '校验被禁止';
  891.              DeteItem.SubItems.Add(DAddr);
  892.                           DeteItem.SubItems.Add(inttostr(nDestPort));
  893.              postmessage(FriendList.handle, WM_VSCROLL, 1, SB_LINEDOWN);
  894.             end;
  895.     end;
  896.   end;
  898. end;
  900. procedure TForm1.OnAfterGetAdapterDesc(bStatus: Boolean; sAdapterDesc: string);
  901. begin
  902.   //Memo1.Lines.Add('网卡适配器型号: '+sAdapterDesc);
  903. end;
  905. procedure TForm1.OnAfterGetMacAddress(bStatus: Boolean; pMacAddr: PChar);
  906. begin
  907.   //Memo1.Lines.Add(Format( '网卡适配器实时地址: %.2X:%.2X:%.2X:%.2X:%.2X:%.2X',
  908.   //                        [ UCHAR(pMacAddr^), UCHAR((pMacAddr+1)^), UCHAR((pMacAddr+2)^),
  909.   //                          UCHAR((pMacAddr+3)^), UCHAR((pMacAddr+4)^), UCHAR((pMacAddr+5)^) ] ));
  910. end;
  913. procedure TForm1.chudpClick(Sender: TObject);
  914. begin
  915. if  chudp.Checked then
  916.   begin
  917.     showmessage('开始侦测好友号码');
  918.     sIngus.StartSnoop(ComboBox1.ItemIndex);
  919.   end
  920. else
  921.   begin
  922.   sIngus.StopSnoop;
  923.   showmessage('停止侦测好友号码');
  924.   end;
  925. end;
  927. procedure TForm1.FormDestroy(Sender: TObject);
  928. begin
  929. sIngus.Free;
  930. end;
  933. procedure TForm1.BitBtn7Click(Sender: TObject);
  934. begin
  935. FriendList.Items.Clear;
  936. end;
  938. procedure TForm1.FriendListSelectItem(Sender: TObject; Item: TListItem;
  939.   Selected: Boolean);
  940. begin
  941. DetedSb1 := Item.SubItems[0];
  942. DetedSb2 := Item.SubItems[1];
  943. end;
  945. procedure TForm1.N4Click(Sender: TObject);
  946. begin
  947. SmIp.Text := DetedSb1;
  948. SmPort.Text := DetedSb2;
  949. PageControl1.ActivePageIndex := 0;
  950. end;
  952. procedure TForm1.IP2Click(Sender: TObject);
  953. begin
  954. PDeteIP.Text := DetedSb1;
  955. PageControl1.ActivePageIndex := 2;
  956. end;
  958. procedure TForm1.Label23Click(Sender: TObject);
  959. begin
  960. ExecuteFile('http://oqforum.home.dhs.org','','',0);
  961. end;
  965. procedure TForm1.Label27Click(Sender: TObject);
  966. begin
  967. ExecuteFile('http://whocq.yeah.net','','',0);
  968. end;
  970. procedure TForm1.BitBtn8Click(Sender: TObject);
  971. begin
  972. ExecuteFile('help.html','','',0);
  973. end;
  975. procedure TForm1.NetTestTimer(Sender: TObject);
  976. var
  977.   WSData:TWSAData;
  978.   Buffer:array[0..63]of Char;
  979.   HostEnt:PHostEnt;
  980.   PPInAddr:^PInAddr;
  981.   //返回值
  982.   //LocalIP:DWord;
  983.   IPString:String;
  984. begin
  986.   //LocalIP:=0;
  987.   IPString:='';
  988.   WSAStartUp($101,WSData);
  989.   try
  990.     GetHostName(Buffer,SizeOf(Buffer));
  991.     HostEnt:=GetHostByName(Buffer);
  992.     if Assigned(HostEnt) then
  993.     begin
  994.       PPInAddr:=@(PInAddr(HostEnt.H_Addr_List^));
  995.       while Assigned(PPInAddr^) do
  996.       begin
  997.         IPString:=StrPas(INet_NToA(PPInAddr^^));
  998.         //LocalIP:=PPInAddr^^.S_Addr;
  999.         Inc(PPInAddr);
  1000.       end;
  1001.     end;
  1002.   finally
  1003.     WSACleanUp;
  1004.     if Closebool = 0 then
  1005.     begin
  1006.     if IPString = '127.0.0.1' then
  1007.     begin
  1008.     Closebool := 1;
  1009.     //Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
  1010.     //Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
  1011.     //sIngus.StopSnoop;
  1012.     //sIngus.Free;
  1014.     showmessage('尚未连接到网络，无法运行程序！');
  1015.     Form1.Close;
  1016.     Nettest.Free;
  1017.     halt;
  1018.     //sleep(2000);
  1019.     //halt;
  1020.     end;
  1021.     end;
  1022.     IPLab.caption := '当前此机器的IP地址为：'+IPString;
  1023.   end;
  1025. end;
  1027. end.