www.pudn.com > whocq2src.zip > Unit1.pas
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://www.coolfan.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;
p.y := HIWORD(m.lParam) - Self.Top;
if PtInRect(TBRect, p) then //如果在标题栏按钮区域释放鼠标
begin
DrawCaptionBtn(EDGE_RAISED);
Form1.hide;
end
else
inherited; // 执行默认的操作
end;
procedure TForm1.Sender1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var RecvStream:TMemoryStream;
RecvString,RecvNum:String;
Bcount:integer;
begin
//StatusBar1.Panels[4].Text := 'R: '+inttostr(NumberBytes)+' bytes from '+FromIP;
RecvStream := TMemoryStream.Create;
Try
Sender1.ReadStream(RecvStream);
SetLength(RecvString,NumberBytes);
RecvStream.Read(RecvString[1],NumberBytes);
finally
RecvStream.Free;
Bcount := 8;
while RecvString[Bcount] <> RecvString[NumberBytes] do
begin
RecvNum := RecvNum+RecvString[Bcount];
Bcount := Bcount+1;
end;
//showmessage(RecvNum);
if RecvMessbuffer <> RecvNum then
begin
WSmInfo(clNavy,RecvNum,False);
RecvMessbuffer := RecvNum;
end;
SendReMess(FromIP,SmNum.Text,Port);
//DetedShow(FromIP,Port,RecvNum);
end;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
IPDeted.Items.Clear;
end;
procedure TForm1.SendReMess(IP,Num:string;Port:integer);
var ReStream:TMemoryStream;
ri:integer;
begin
ReMess[0] := $02;
ReMess[1] := $02;
ReMess[2] := $00;
ReMess[3] := $00;
ReMess[4] := $79;
ReMess[5] := $0b;
ReMess[6] := $b7;
ReMess[7] := $34;//Number begin
ReMess[8] := $32;
ReMess[9] := $35;
ReMess[10] := $34;
ReMess[11] := $38;
ReMess[12] := $30;
ReMess[13] := $39;//End
ReMess[14] := $03;
ReStream := TMemoryStream.Create;
Try
if chudp.Checked then sIngus.StopSnoop;
for ri := 0 to 6 do ReStream.Write(ReMess[ri],1);
Restream.Write('20000',5);
Restream.Write(ReMess[14],1);
ReSender.RemoteHost := IP;
ReSender.RemotePort := Port;
ReSender.SendStream(ReStream);
Finally
ReStream.Free;
if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
end;
procedure Tform1.IPSearchMess(Area:string;RemotePort:integer);
var i1,i2,i3,i4,CNbuffer:integer;
begin
if chudp.Checked then sIngus.StopSnoop;
DeMessStru('20000','001',SearchInfo.caption);
DLab1.Enabled := True;
DLab2.Enabled := True;
IPSearcher.RemotePort := RemotePort;
IPSearcher.LocalPort := 1235;
try
for i4 := 0 to 255 do
begin
for i1 := 0 to 25 do
begin
for i2 := 1 to 10 do
begin
for i3 := 1 to 3 do;
begin
CNbuffer := i1*10+i2;
if CNbuffer < 255 then
begin
IPSearcher.RemoteHost := Area + '.' + inttostr(i4)+'.'+inttostr(CNbuffer);
IPSearcher.SendStream(SendStream);
end;
end;
DLab2.Caption := IPSearcher.RemoteHost;
DetePro.StepIt;
end;
sleep(100);
end;
end;
finally
SendStream.Free;
if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
end;
DLab1.Enabled := False;
DLab2.Enabled := False;
DetePro.Position := 0;
showmessage('对'+Area+'区域的探索已经完成!');
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
IPSearchMess(IPSearchArea.Text,strtoint(IPSearchPort.text));
end;
procedure TForm1.IPSearcherDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var RecvStream:TMemoryStream;
RecvString,RecvNum:String;
Bcount,i,ibool:integer;
DeteItem:TListItem;
begin
ibool := 0;
RecvStream := TMemoryStream.Create;
Try
IPSearcher.ReadStream(RecvStream);
SetLength(RecvString,NumberBytes);
RecvStream.Read(RecvString[1],NumberBytes);
finally
RecvStream.Free;
Bcount := 8;
while RecvString[Bcount] <> RecvString[NumberBytes] do
begin
RecvNum := RecvNum+RecvString[Bcount];
Bcount := Bcount+1;
end;
for i := 0 to IPDeted.Items.count-1 do
begin
if FromIP = IPDeted.Items[i].Caption then ibool := 1;
end;
if ibool = 0 then
begin
DeteItem := IPDeted.Items.Add;
DeteItem.Caption := FromIP;
DeteItem.SubItems.Add(inttostr(Port));
DeteItem.SubItems.Add(RecvNum);
end;
end;
end;
procedure TForm1.Label8Click(Sender: TObject);
begin
ExecuteFile('mailto:tyler_zhong@gre.net.cn','','',0);
end;
procedure TForm1.Label9Click(Sender: TObject);
begin
ExecuteFile('http://www.coolfan.net','','',0);
end;
procedure TForm1.IPDetedSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
DetedSb1 := Item.Caption;
DetedSb2 := Item.SubItems[0];
DetedSb3 := Item.SubItems[1];
end;
procedure TForm1.N2Click(Sender: TObject);
begin
SmIp.Text := DetedSb1;
SmPort.Text := DetedSb2;
PageControl1.ActivePageIndex := 0;
end;
procedure TForm1.WEB1Click(Sender: TObject);
var URL : string;
begin
URL := 'http://search.tencent.com/cgi-bin/friend/user_show_info?ln='+DetedSb3;
ExecuteFile(URL,'','',0);
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
var i1,i2:integer;
begin
PortDeted.Items.Clear;
sleep(1000);
if (strtoint(PDeteB.Text) > strtoint(PDeteE.Text)) or (strtoint(PDeteB.Text)<1) or (strtoint(PDeteE.Text)>65535) then
begin
showmessage('端口号是1到65535的整数且必须遵循由小至大的顺序');
end
else
if (strtoint(PDeteE.Text)-strtoint(PDeteb.Text)) > 300 then
begin
showmessage('一次最多只能探测300个端口');
end
else
begin
if chudp.Checked then sIngus.StopSnoop;
PDetePro.Max := strtoint(PDeteE.Text)-strtoint(PDeteb.Text);
DeMessStru('20001','001',PSearchMess.caption);
//Label5.Caption := PDeteIP.Text;
PortSearcher.RemoteHost := PDeteIP.Text;
PortSearcher.LocalPort := 1236;
Try
for i1 := strtoint(PDeteb.Text) to strtoint(PDeteE.Text) do
begin
PortSearcher.RemotePort := i1;
for i2 := 1 to 3 do
begin
PortSearcher.SendStream(SendStream);
end;
PDetePro.StepIt;
sleep(100);
end;
Finally
SendStream.Free;
PDetePro.Position := 0;
showmessage('对'+PDeteIP.Text+'的'+PDeteb.Text+'到'+PDeteE.Text+'端口探测已经完成!');
if chudp.Checked then sIngus.StartSnoop(ComboBox1.ItemIndex);
end;
end;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
PortDeted.Items.Clear;
end;
procedure TForm1.PortSearcherDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var RecvStream:TMemoryStream;
RecvString,RecvNum:String;
Bcount,i,ibool:integer;
DeteItem:TListItem;
begin
ibool := 0;
RecvStream := TMemoryStream.Create;
Try
PortSearcher.ReadStream(RecvStream);
SetLength(RecvString,NumberBytes);
RecvStream.Read(RecvString[1],NumberBytes);
finally
RecvStream.Free;
Bcount := 8;
while RecvString[Bcount] <> RecvString[NumberBytes] do
begin
RecvNum := RecvNum+RecvString[Bcount];
Bcount := Bcount+1;
end;
for i := 0 to PortDeted.Items.count-1 do
begin
if inttostr(Port) = PortDeted.Items[i].Caption then ibool := 1;
end;
if ibool = 0 then
begin
DeteItem := PortDeted.Items.Add;
DeteItem.Caption := inttostr(Port);
DeteItem.SubItems.Add(RecvNum);
end;
end;
end;
procedure TForm1.IP1Click(Sender: TObject);
begin
PDeteIP.Text := DetedSb1;
PageControl1.ActivePageIndex := 2;
end;
procedure TForm1.PortDetedSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
DetedSb1 := PDeteIP.Text;
DetedSb2 := Item.Caption;
DetedSb3 := Item.SubItems[0];
end;
procedure TForm1.N3Click(Sender: TObject);
begin
SmIp.Text := DetedSb1;
SmPort.Text := DetedSb2;
PageControl1.ActivePageIndex := 0;
end;
procedure TForm1.WEB2Click(Sender: TObject);
var URL : string;
begin
URL := 'http://search.tencent.com/cgi-bin/friend/user_show_info?ln='+DetedSb3;
ExecuteFile(URL,'','',0);
end;
procedure TForm1.OnParsePacketHandle( nPacketSeq: Longint; uBuffer: PChar;
nRecvBytes: integer; sPacket:
TIngusPacketBase );
var
sMacAddr,DAddr,DPort: string;
UDPbool,UDPbool2,i:integer;
sIpPacket: TIngusIPPacket;
//sIcmpPacket: TIngusICMPPacket;
sTCPPacket: TIngusTCPPacket;
nDestPort: integer; //nSrcPort,
DeteItem,Itembuff:TListItem;
begin
UDPbool := 0;
UDPbool2 := 1;
if sPacket.EthernetProtocol <> PROTO_IP then exit;
sIPPacket := TIngusIPPacket(sPacket);
sMacAddr := Format( '网络适配器实时地址: %.2X:%.2X:%.2X:%.2X:%.2X:%.2X',
[ UCHAR(sIngus.MacAddr[0]), UCHAR(sIngus.MacAddr[1]),
UCHAR(sIngus.MacAddr[2]), UCHAR(sIngus.MacAddr[3]),
UCHAR(sIngus.MacAddr[4]), UCHAR(sIngus.MacAddr[5]) ] );
sTCPPacket := TIngusTCPPacket(sPacket);
nDestPort := sTCPPacket.DestPort;
DAddr := Format('%u.%u.%u.%u', [ UCHAR((sIPPacket.IPDestAddr)^),
UCHAR((sIPPacket.IPDestAddr+1)^),
UCHAR((sIPPacket.IPDestAddr+2)^),
UCHAR((sIPPacket.IPDestAddr+3)^) ]);
DPort := inttostr(nDestPort);
case sIPPacket.IPProtocol of
17: begin
UDPbool := 1;
for i := 0 to FriendList.Items.Count -1 do
begin
Itembuff := FriendList.Items[i];
if (Itembuff.SubItems[0] = DAddr) and (Itembuff.SubItems[1] = DPort) then UDPbool2 := 0; //and (Itembuff.SubItems[1] <> DPort)
end;
//UDPT.caption := 'UDP';
end;
end;
case sPacket.PacketDirection of
pdInput:
begin
//Input;
end;
pdOutput:
begin
if (UDPbool = 1) and (UDPbool2 = 1) then
begin
DeteItem := FriendList.Items.Add;
DeteItem.Caption := '校验被禁止';
DeteItem.SubItems.Add(DAddr);
DeteItem.SubItems.Add(inttostr(nDestPort));
postmessage(FriendList.handle, WM_VSCROLL, 1, SB_LINEDOWN);
end;
end;
end;
end;
procedure TForm1.OnAfterGetAdapterDesc(bStatus: Boolean; sAdapterDesc: string);
begin
//Memo1.Lines.Add('网卡适配器型号: '+sAdapterDesc);
end;
procedure TForm1.OnAfterGetMacAddress(bStatus: Boolean; pMacAddr: PChar);
begin
//Memo1.Lines.Add(Format( '网卡适配器实时地址: %.2X:%.2X:%.2X:%.2X:%.2X:%.2X',
// [ UCHAR(pMacAddr^), UCHAR((pMacAddr+1)^), UCHAR((pMacAddr+2)^),
// UCHAR((pMacAddr+3)^), UCHAR((pMacAddr+4)^), UCHAR((pMacAddr+5)^) ] ));
end;
procedure TForm1.chudpClick(Sender: TObject);
begin
if chudp.Checked then
begin
showmessage('开始侦测好友号码');
sIngus.StartSnoop(ComboBox1.ItemIndex);
end
else
begin
sIngus.StopSnoop;
showmessage('停止侦测好友号码');
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
sIngus.Free;
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
begin
FriendList.Items.Clear;
end;
procedure TForm1.FriendListSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
DetedSb1 := Item.SubItems[0];
DetedSb2 := Item.SubItems[1];
end;
procedure TForm1.N4Click(Sender: TObject);
begin
SmIp.Text := DetedSb1;
SmPort.Text := DetedSb2;
PageControl1.ActivePageIndex := 0;
end;
procedure TForm1.IP2Click(Sender: TObject);
begin
PDeteIP.Text := DetedSb1;
PageControl1.ActivePageIndex := 2;
end;
procedure TForm1.Label23Click(Sender: TObject);
begin
ExecuteFile('http://www.coolfan.net','','',0);
end;
procedure TForm1.Label27Click(Sender: TObject);
begin
ExecuteFile('http://www.coolfan.net','','',0);
end;
procedure TForm1.BitBtn8Click(Sender: TObject);
begin
ExecuteFile('help.html','','',0);
end;
procedure TForm1.NetTestTimer(Sender: TObject);
var
WSData:TWSAData;
Buffer:array[0..63]of Char;
HostEnt:PHostEnt;
PPInAddr:^PInAddr;
//返回值
//LocalIP:DWord;
IPString:String;
begin
//LocalIP:=0;
IPString:='';
WSAStartUp($101,WSData);
try
GetHostName(Buffer,SizeOf(Buffer));
HostEnt:=GetHostByName(Buffer);
if Assigned(HostEnt) then
begin
PPInAddr:=@(PInAddr(HostEnt.H_Addr_List^));
while Assigned(PPInAddr^) do
begin
IPString:=StrPas(INet_NToA(PPInAddr^^));
//LocalIP:=PPInAddr^^.S_Addr;
Inc(PPInAddr);
end;
end;
finally
WSACleanUp;
if Closebool = 0 then
begin
if IPString = '127.0.0.1' then
begin
Closebool := 1;
//Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
//Shell_NotifyIcon(NIM_DELETE,MainTrayIcon);
//sIngus.StopSnoop;
//sIngus.Free;
showmessage('尚未连接到网络，无法运行程序！');
Form1.Close;
Nettest.Free;
halt;
//sleep(2000);
//halt;
end;
end;
IPLab.caption := '当前此机器的IP地址为：'+IPString;
end;
end;
end.