?? unit1.~pas
字號:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdMessage, IdBaseComponent, IdComponent,Inifiles,Winsock,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, ExtCtrls, Buttons,NB30,
ComCtrls;
type
TForm1 = class(TForm)
SMTP1: TIdSMTP;
IdMsg: TIdMessage;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Memo1: TMemo;
Edit3: TEdit;
Button2: TButton;
Label6: TLabel;
Edit4: TEdit;
Label7: TLabel;
Edit5: TEdit;
Label8: TLabel;
Edit6: TEdit;
OpenDialog1: TOpenDialog;
Edit7: TEdit;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
Bevel1: TBevel;
Button3: TButton;
Label9: TLabel;
Edit8: TEdit;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Timer1: TTimer;
CheckBox1: TCheckBox;
Button4: TButton;
Label10: TLabel;
Edit9: TEdit;
Label11: TLabel;
UpDown1: TUpDown;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
function NBGetAdapterAddress(a: integer):String;
procedure CheckBox1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure UpDown1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
private
{ Private declarations }
public
{ Public declarations }
mInifile:Tinifile;
end;
TIP_Option_Information = packed record
TTL: Byte; // 存活時間 (用于路由跟蹤)
TOS: Byte; // 服務(wù)類型（通常為0）
Flags: Byte; // IP頭標(biāo)志（通常為0）
OptionsSize: Byte; // 附加數(shù)據(jù)大小（通常為0，最大為40）
OptionsData: PChar; // 附加數(shù)據(jù)
end;
TIcmp_Echo_Reply = packed record
Address: DWord; // 應(yīng)答的主機(jī)地址
Status: DWord; // IP狀態(tài)碼
RTT: DWord; // 往返旅行時間（以毫秒計(jì)）
DataSize: Word; // 回波應(yīng)答數(shù)據(jù)大小（以字節(jié)計(jì)）
Reserved: Word; // 系統(tǒng)保留
Data: Pointer; // 回波應(yīng)答數(shù)據(jù)指針
Options: TIP_Option_Information; // 回波應(yīng)答參數(shù)
end;
PIP_Option_Information = ^TIP_Option_Information;
PIcmp_Echo_Reply = ^TIcmp_Echo_Reply;
function IcmpCreateFile: THandle; stdcall; external 'ICMP.DLL';
function IcmpCloseHandle(IcmpHandle: THandle): Boolean; stdcall; external 'ICMP.DLL';
function IcmpSendEcho(
IcmpHandle: THandle; // 用ICMPCreateFile函數(shù)打開的ICMP句柄
DestinationAddress: DWord; // 目標(biāo)主機(jī)地址
RequestData: Pointer; // 回波請求所發(fā)數(shù)據(jù)的緩沖區(qū)
RequestSize: Word; // 回波請求數(shù)據(jù)緩沖區(qū)大小（以字節(jié)計(jì)）
RequestOptions: PIP_Option_Information; // 回波請求中IP報(bào)頭選項(xiàng)地址，可以為空
ReplyBuffer: Pointer; // 用于存儲回波應(yīng)答數(shù)據(jù)的緩沖區(qū)
ReplySize: DWord; // 回波應(yīng)答緩沖區(qū)大小（以字節(jié)計(jì)）
Timeout: Dword // 等待回應(yīng)的時間（以毫秒計(jì)）
): DWord; stdcall; external 'ICMP.DLL';
var
Form1: TForm1;
PHostEntry: PHostEnt;
IcmpHandle: THandle;
implementation
{$R *.dfm}
const
PacketSize = 32; // 發(fā)送的數(shù)據(jù)包大小（以字節(jié)計(jì)）
TimeOut = 3000; // 超時設(shè)定（以毫秒計(jì)）
//定義測試PING函數(shù)
procedure Ping(TheIPAddress: string);
var
WSAData: TWSAData; // Winsock數(shù)據(jù)結(jié)構(gòu)
DestAddress: DWord; // 目標(biāo)主機(jī)IP地址
RequestDataBuffer: Pointer; // 請求數(shù)據(jù)緩沖區(qū)指針
ReplyDataBuffer: Pointer; // 應(yīng)答數(shù)據(jù)緩沖區(qū)指針
ICMPEchoReplyBuffer: PIcmp_Echo_Reply;// ICMP回波應(yīng)答緩沖區(qū)
IPOptionInfo: TIP_Option_Information; // 待發(fā)送數(shù)據(jù)包的IP選項(xiàng)
begin
if WSAStartup($102,WSAdata) <> 0 then // 初始化Winsock
begin
ShowMessage('Winsock初始化失敗！');
Exit;
end;
ICMPHandle := IcmpCreateFile; // 打開ICMP句柄
if ICMPHandle = INVALID_HANDLE_VALUE then // 錯誤處理
begin
ShowMessage('無法獲得ICMP句柄！');
Exit;
end;
DestAddress := inet_addr(PChar(TheIPAddress)); // 將目標(biāo)地址轉(zhuǎn)換成網(wǎng)絡(luò)格式
GetMem(RequestDataBuffer, PacketSize); // 分配請求數(shù)據(jù)緩沖區(qū)
FillChar(RequestDataBuffer^, PacketSize, $FF); // 填充請求數(shù)據(jù)緩沖區(qū)
FillChar(IPOptionInfo, SizeOf(IPOptionInfo), 0); // 填充IP選項(xiàng)數(shù)據(jù)
IPOptionInfo.TTL := 64; // 設(shè)置存活期
GetMem(ReplyDataBuffer, PacketSize); // 分配應(yīng)答數(shù)據(jù)緩沖區(qū)
// 分配回波應(yīng)答結(jié)構(gòu)緩沖區(qū)
GetMem(ICMPEchoReplyBuffer, SizeOf(TIcmp_Echo_Reply) + PacketSize);
ICMPEchoReplyBuffer^.Data := ReplyDataBuffer; // 填入緩沖區(qū)指針
if IcmpSendEcho(ICMPHandle, DestAddress, // 發(fā)送回波請求，并等待回波應(yīng)答
RequestDataBuffer, PacketSize,
@IPOptionInfo, ICMPEchoReplyBuffer,
SizeOf(TIcmp_Echo_Reply) + PacketSize, TimeOut) <> 0 then
ShowMessage('向' + TheIPAddress + // 顯示測試結(jié)果
'地址發(fā)送了' + IntToStr(PacketSize) + '字節(jié)數(shù)據(jù),'+ #10#13 +
'在' + IntToStr(ICMPEchoReplyBuffer^.RTT) + ' 毫秒內(nèi)從' +
StrPas(inet_ntoa(TInAddr(ICMPEchoReplyBuffer^.Address))) +
'接收了' + IntToStr(ICMPEchoReplyBuffer^.DataSize) + '字節(jié).')
else
ShowMessage('無法連接主機(jī)' + TheIPAddress + '!');
FreeMem(ICMPEchoReplyBuffer); // 釋放分配的內(nèi)存空間
FreeMem(ReplyDataBuffer);
FreeMem(RequestDataBuffer);
IcmpCloseHandle(ICMPHandle); // 關(guān)閉ICMP句柄
if WSACleanup <> 0 then // 關(guān)閉Winsock
ShowMessage('無法關(guān)閉winsock！');
end;
//定義獲取IP地址、計(jì)算機(jī)名、MAC地址
function TForm1.NBGetAdapterAddress(a: integer):String;
//a指定多個網(wǎng)卡適配器中的哪一個0，1，2...
Var
NCB:TNCB; // Netbios control block file://NetBios控制塊
ADAPTER:TADAPTERSTATUS; // Netbios adapter status//取網(wǎng)卡狀態(tài)
LANAENUM:TLANAENUM; // Netbios lana
intIdx:Integer; // Temporary work value//臨時變量
cRC:Char; // Netbios return code//NetBios返回值
strTemp:String; // Temporary string//臨時變量
Begin
// Initialize
Result:='';
Try
// Zero control blocl
ZeroMemory(@NCB,SizeOf(NCB));
// Issue enum command
NCB.ncb_command:=Chr(NCBENUM);
cRC :=NetBios(@NCB);
// Reissue enum command
NCB.ncb_buffer:= @LANAENUM;
NCB.ncb_length:=SizeOf(LANAENUM);
cRC:= NetBios(@NCB);
If Ord(cRC)<>0 Then
exit;
// Reset adapter
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command :=Chr(NCBRESET);
NCB.ncb_lana_num :=LANAENUM.lana[a];
cRC := NetBios(@NCB);
If Ord(cRC)<>0 Then
exit;
// Get adapter address
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
StrPCopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := SizeOf(ADAPTER);
cRC := NetBios(@NCB);
// Convert it to string
strTemp := '';
For intIdx := 0 To 5 Do
strTemp:=strTemp+InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);
Result:= strTemp;
Finally
End;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if (trim(Edit1.Text)='') or (trim(Edit2.Text)='') or (trim(Edit3.Text)='') or
(trim(Edit4.Text)='') or (trim(Edit5.Text)='') or (trim(Edit6.Text)='') or
(trim(Edit8.Text)='') then
showmessage('請先設(shè)置‘服務(wù)器’、‘帳號密碼’、‘發(fā)件人’、‘收件人’、‘主題’、‘監(jiān)控地址’等信息！')
else
begin
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -