?? 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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -