📄 outtool.pas
字号:
unit OutTool;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, Buttons, ExtCtrls, Sockets, ComCtrlsAdds,ShellAPI,
ComCtrls,WinSock, Grids, StrUtils, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TfmTool = class(TForm)
grp1: TGroupBox;
medtPort: TMaskEdit;
btnConn: TBitBtn;
mmo1: TMemo;
rg1: TRadioGroup;
btn1: TBitBtn;
lbl1: TLabel;
cbb1: TComboBox;
grp2: TGroupBox;
edt1: TEdit;
edt2: TEdit;
chk1: TCheckBox;
chk2: TCheckBox;
chk3: TCheckBox;
btnCloseCon: TBitBtn;
lbl2: TLabel;
IPAddress1: TIPAddress;
dtp1: TDateTimePicker;
btn2: TButton;
btn3: TButton;
btn4: TButton;
IPAddress2: TIPAddress;
lbl3: TLabel;
lbl4: TLabel;
edt3: TEdit;
dlgOpen1: TOpenDialog;
btnSearch: TSpeedButton;
edtSearch: TEdit;
lbl5: TLabel;
lst2: TListBox;
btn6: TBitBtn;
rg2: TRadioGroup;
edt4: TEdit;
btn5: TBitBtn;
strGrid: TStringGrid;
btnStop: TBitBtn;
btn01: TSpeedButton;
btn02: TSpeedButton;
TcpC: TIdTCPClient;
btnScreen: TButton;
lblLog: TLabel;
dtpLg: TDateTimePicker;
btnLog: TButton;
procedure btnConnClick(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure rg1Click(Sender: TObject);
procedure medtPortKeyPress(Sender: TObject; var Key: Char);
procedure btnCloseConClick(Sender: TObject);
procedure cbb1Change(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
procedure btnSearchClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn6Click(Sender: TObject);
procedure rg2Click(Sender: TObject);
procedure btn5Click(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btn02Click(Sender: TObject);
procedure btn01Click(Sender: TObject);
procedure strGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure btnScreenClick(Sender: TObject);
procedure btnLogClick(Sender: TObject);
private
{ Private declarations }
public
function GetIpByHostname(HName :String):string;
function CheckLogDate(strDate :string):Boolean;
{ Public declarations }
end;
TTSearchHostThread = class(TThread)
procedure Execute; override;
private
M_SearchGridObj :TStringGrid;
procedure SearchHost;
public
{}
published
property SearchGridObj:TStringGrid read M_SearchGridObj write M_SearchGridObj;
end;
TIP_Option_Information = packed record
TTL: Byte; // 存活时间 (用于路由跟踪)
TOS: Byte; // 服务类型（通常为0）
Flags: Byte; // IP头标志（通常为0）
OptionsSize: Byte; // 附加数据大小（通常为0，最大为40）
OptionsData: PChar; // 附加数据
end;
TIcmp_Echo_Reply = packed record
Address: DWord; // 应答的主机地址
Status: DWord; // IP状态码
RTT: DWord; // 往返旅行时间（以毫秒计）
DataSize: Word; // 回波应答数据大小（以字节计）
Reserved: Word; // 系统保留
Data: Pointer; // 回波应答数据指针
Options: TIP_Option_Information; // 回波应答参数
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函数打开的ICMP句柄
DestinationAddress: DWord; // 目标主机地址
RequestData: Pointer; // 回波请求所发数据的缓冲区
RequestSize: Word; // 回波请求数据缓冲区大小（以字节计）
RequestOptions: PIP_Option_Information; // 回波请求中IP报头选项地址，可以为空
ReplyBuffer: Pointer; // 用于存储回波应答数据的缓冲区
ReplySize: DWord; // 回波应答缓冲区大小（以字节计）
Timeout: Dword // 等待回应的时间（以毫秒计）
): DWord; stdcall; external 'ICMP.DLL';
var
fmTool: TfmTool;
PHostEntry: PHostEnt;
IcmpHandle: THandle;
M_SearchHostThread :TTSearchHostThread;
implementation
uses ViewScreen, frmLogFile;
const
PacketSize = 32; // 发送的数据包大小（以字节计）
TimeOut = 10; // 超时设定（以毫秒计）
var
StrSend :string;
{$R *.dfm}
function Ping(TheIPAddress: string):Boolean;
var
WSAData: TWSAData; // Winsock数据结构
DestAddress: DWord; // 目标主机IP地址
RequestDataBuffer: Pointer; // 请求数据缓冲区指针
ReplyDataBuffer: Pointer; // 应答数据缓冲区指针
ICMPEchoReplyBuffer: PIcmp_Echo_Reply;// ICMP回波应答缓冲区
IPOptionInfo: TIP_Option_Information; // 待发送数据包的IP选项
begin
if WSAStartup($102,WSAdata) <> 0 then // 初始化Winsock
begin
ShowMessage('Winsock初始化失败！');
Result := FALSE;
Exit;
end;
ICMPHandle := IcmpCreateFile; // 打开ICMP句柄
if ICMPHandle = INVALID_HANDLE_VALUE then // 错误处理
begin
ShowMessage('无法获得ICMP句柄！');
Result := FALSE;
Exit;
end;
DestAddress := inet_addr(PChar(TheIPAddress)); // 将目标地址转换成网络格式
GetMem(RequestDataBuffer, PacketSize); // 分配请求数据缓冲区
FillChar(RequestDataBuffer^, PacketSize, $FF); // 填充请求数据缓冲区
FillChar(IPOptionInfo, SizeOf(IPOptionInfo), 0); // 填充IP选项数据
IPOptionInfo.TTL := 64; // 设置存活期
GetMem(ReplyDataBuffer, PacketSize); // 分配应答数据缓冲区
// 分配回波应答结构缓冲区
GetMem(ICMPEchoReplyBuffer, SizeOf(TIcmp_Echo_Reply) + PacketSize);
ICMPEchoReplyBuffer^.Data := ReplyDataBuffer; // 填入缓冲区指针
if IcmpSendEcho(ICMPHandle, DestAddress, // 发送回波请求，并等待回波应答
RequestDataBuffer, PacketSize,
@IPOptionInfo, ICMPEchoReplyBuffer,
SizeOf(TIcmp_Echo_Reply) + PacketSize, TimeOut) <> 0 then
// ShowMessage('向' + TheIPAddress + // 显示测试结果
// '地址发送了' + IntToStr(PacketSize) + '字节数据,'+ #10#13 +
// '在' + IntToStr(ICMPEchoReplyBuffer^.RTT) + ' 毫秒内从' +
// StrPas(inet_ntoa(TInAddr(ICMPEchoReplyBuffer^.Address))) +
// '接收了' + IntToStr(ICMPEchoReplyBuffer^.DataSize) + '字节.')
Result := True
else
Result := False;
//ShowMessage('无法连接主机' + TheIPAddress + '!');
FreeMem(ICMPEchoReplyBuffer); // 释放分配的内存空间
FreeMem(ReplyDataBuffer);
FreeMem(RequestDataBuffer);
IcmpCloseHandle(ICMPHandle); // 关闭ICMP句柄
if WSACleanup <> 0 then // 关闭Winsock
ShowMessage('无法关闭winsock！');
end;
//由IP解析主机名
function GetNameByIP(IPAddr :string):string;
var
WSAData: TWSAData;
DestAddress: DWord;
begin
if WSAStartup($102,WSAdata) <> 0 then
begin
ShowMessage('Winsock初始化失败！');
Exit;
end;
DestAddress := inet_addr(PChar(IPAddr));
PHostEntry := GetHostByAddr(@DestAddress, 4, PF_INET);
if PHostEntry <> nil then
begin
//ShowMessage('IP地址' + StrPas(inet_ntoa(TInAddr(DestAddress))) +'对应的主机名为：' + PHostEntry^.h_name);
Result := PHostEntry^.h_name;
end
else
Result := '';
//ShowMessage('无法解析！');
if WSACleanup <> 0 then
ShowMessage('无法关闭winsock！');
end;
//由主机名解析IP
function GetIPByName(NetName :string):string;
var
WSAData: TWSAData;
DestAddress: DWord;
begin
if WSAStartup($102,WSAdata) <> 0 then
begin
ShowMessage('Winsock初始化失败！');
Exit;
end;
PHostEntry := GetHostByName(PChar(NetName));
if PHostEntry <> nil then
begin
DestAddress := LongInt(PLongInt(PHostEntry^.h_addr_list^)^);
Result := StrPas(inet_ntoa(TInAddr(DestAddress)));
//ShowMessage('名为' + PHostEntry^.h_name + '的主机对应的IP地址为' +StrPas(inet_ntoa(TInAddr(DestAddress))));
end
else
Result := '';
//ShowMessage('无法解析！');
if WSACleanup <> 0 then
ShowMessage('无法关闭winsock！');
end;
//延时。。。
procedure relaytime;
var
count:integer;
begin
count:=GetTickCount();
while Abs(count-GetTickCount) < 500 do
Application.ProcessMessages;
end;
procedure TfmTool.btnConnClick(Sender: TObject);
begin
TcpC.Host := IPAddress1.Address;
TcpC.Port := StrToInt(Trim(medtPort.Text));
try
TcpC.Disconnect;
except
end;
if not Ping(IPAddress1.Address) then
begin
Application.MessageBox('该主机地址不存在，请重新输入！','BGM提示',MB_OK);
Exit;
end;
try
TcpC.Connect(5000);
rg1.Enabled := True;
btn1.Enabled := True;
mmo1.Clear;
mmo1.Lines.Add(TcpC.ReadLn());
except
rg1.Enabled := False;
mmo1.Clear;
mmo1.Lines.Add('Connect Host is Failed ! ');
end;
end;
procedure TfmTool.btn1Click(Sender: TObject);
var
recStr :string;
FileStream :TFileStream;
buff : array of BYTE;
i : Integer;
fstream : TFileStream;
fstr : string;
str_LogDate : string;
begin
case rg1.ItemIndex of
0 ://Machine Reset
begin
StrSend := 'MachineReset;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令： "刷新系统"');
// relaytime;
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
1 ://Software Reset
begin
StrSend := 'SoftReset;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令： "刷新程序"');
// relaytime;
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
2 ://Get Status
begin
StrSend := 'GetStatus;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令： "取程序运行状态"');
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
3 ://Get Physic Memory
begin
StrSend :='GetPhys;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："取系统剩余物理内存"');
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + FloatToStr(StrToInt(recStr)/1024) + ' kb');
end;
4 : // Modified wince Name
begin
if trim(edt3.Text)='' then
begin
Showmessage('请重新设置下位机名称');
exit;
end;
StrSend := 'ModWinceName:' + Trim(edt3.Text) + ';';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："修改系统名称为"' + Trim(edt3.Text));
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
5 : // Modified wince IpAddress
begin
StrSend := 'ModIPAddresss:' + Trim(IPAddress2.Address) + ';';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："修改系统IP地址为"' + IPAddress2.Address);
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
6 ://Time Reset Machine
begin
if cbb1.ItemIndex = 0 then
begin
StrSend:='AutoReset:1;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："设置系统为自动重起"');
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
relaytime;
StrSend := 'DayReset:' + FormatDateTime('HH:MM:SS',dtp1.Time) + ';';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："设置系统重起每天时间为 "' + FormatDateTime('HH:MM:SS',dtp1.Time));
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
relaytime ;
if chk1.Checked then
begin
StrSend := 'WeekReset:' + Trim(edt2.Text) + ';';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："设置系统重起为每周星期"' +Trim(edt2.Text));
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
relaytime;
end;
if chk2.Checked then
begin
StrSend := 'MonthReset:' + Trim(edt1.Text) + ';';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："设置系统重起为每月 ' + Trim(edt1.Text) + '号"');
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
relaytime;
end;
end
else // cbb1.ItemIndex = 1
begin
StrSend:='AutoReset:0;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："设置系统为不自动重起"');
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
relaytime;
end;
end;
7 :
begin
StrSend :='DeleteFile;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："删除有误的系统文件"');
// relaytime;
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
8 :
begin
if Trim(edtSearch.Text)='' then
begin
ShowMessage('请选择正确的下位机程序,再更新！');
Exit;
end;
FileStream := TFileStream.Create(edtSearch.Text,fmOpenRead);
StrSend := 'SendAm300c:'+ Copy('00000000'+inttostr(FileStream.Size),length(inttostr(FileStream.Size))+1,8);
mmo1.Lines.Add('执行指令："更新系统程序"');
SetLength(buff,Length(StrSend));
for i:=1 to Length(StrSend) do
begin
buff[i-1]:=BYTE(StrSend[i]);
end;
TcpC.WriteBuffer((@(buff[0]))^,Length(StrSend));
TcpC.WriteStream(FileStream);
FileStream.Free;
recStr := TcpC.ReadLn();
mmo1.Lines.Add('执行结果： ' + recStr);
end;
9:
begin
//调试用，现注释掉
{case rg2.ItemIndex of
0: begin
StrSend := 'COM:' + Trim(edt4.Text);
TcpC.Sendln(StrSend);
mmo1.Lines.Add('执行指令：'+ StrSend);
if TcpC.WaitForData(500) then
mmo1.Lines.Add('执行结果：' + TcpC.Receiveln());
end;
1: begin
StrSend := 'musicplay:' + Trim(edt4.Text);
TcpC.Sendln(StrSend);
mmo1.Lines.Add('执行指令：'+ StrSend);
if TcpC.WaitForData(500) then
mmo1.Lines.Add('执行结果：' + TcpC.Receiveln());
end;
2: begin
StrSend := 'musicstop;';
TcpC.Sendln(StrSend);
mmo1.Lines.Add('执行指令：'+ StrSend);
if TcpC.WaitForData(500) then
mmo1.Lines.Add('执行结果：' + TcpC.Receiveln());
end;
end;}
//察看下位机屏幕信息
StrSend := 'CaptureScreen;';
TcpC.WriteLn(StrSend);
mmo1.Lines.Add('执行指令："查看下位机屏幕信息！"');
try
fstr := TcpC.ReadLn();
except
mmo1.Lines.Add('执行结果："下位机异常！"');
end;
if Pos('BmpLength:',fstr)>0 then
begin
Delete(fstr,1,10);
i := StrToInt(trim(fstr));
DeleteFile('bmpInfo.bmp');
try
fstream := TFileStream.Create('bmpInfo.bmp',fmCreate);
TcpC.ReadStream(fstream, i);
fstream.Free;
btnScreen.Enabled := True;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -