📄 adtcommimpl.~pas
字号:
unit ADTCommImpl;
interface
uses
SysUtils, Math, Forms, Classes, Windows, Dialogs, Controls, CPort;
const
Separator = ' ';//空格
CmdHeader = chr(36);//命令头
CmdTrail = Chr(13) + Chr(10);//命令尾,'回车 换行'
CmdFailed = '00';//指令失败的返回值
intCmdTimeout = 300;
boolInstResend = True;//指令重新发送吗?
intInstResendTimes = 2;//指令重发次数
InputSizeBuffer = 1024;//
OutputSizeBuffer = 1024;//
type
TSerialPort = (COM1, COM2, COM3, COM4);
//串口发送事件
function CommSend(Addr, Cmd, Msg: string; var Answer: string; ComPort: TComPort): Boolean;//返回TRUE:成功;否则不成功
//CmdStr: 需要加校验码的字符串,要求以十六进制的方式来表示,如??Separator??Separator...Separator??
function CheckSum(CmdStr: string): Char;
//指令格式 {终端序号 指令代码 指令类型 数字参数 文本参数 文本参数 校验码}
function CmdFormat(Addr, Cmd, Data: string; DataLen: integer): string;
//将字符串转换为16进制串
function StrToHex(Str: string): string;
//将字符串转换为三要求的格式
function StrToValid(Str: string): string;
//function ArrayToStr(): string;
function GetSerialNo(Addr: string; var strSerialNo: string; var Success: Boolean; ComPort: TComPort): Boolean;//查询桌牌的序列号
function FileExist(Addr, FileName: string; var Existed: Boolean; ComPort: TComPort): Boolean;//下位机中是否存在该文件
function OpenSysFile(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//写模式打开系统文件
function OpenFile(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//写模式打开新文件(不能是系统文件)
function WriteFlie(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//写入文件
function CloseFlie(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//结束写文件
function DelFile(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//删除文件
function FormatDisk(Addr: TStrings; var Success: Boolean; ComPort: TComPort): Boolean;//格式化磁盘
function SubDispSysInfo(Addr: TStrings; var Success: Boolean; ComPort: TComPort): Boolean;//副屏显示系统信息
function SubHideSysInfo(Addr: TStrings; var Success: Boolean; ComPort: TComPort): Boolean;//副屏不显示系统信息
function SetAddr(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//设置终端序号
function SetDate(Year, Month, Day, Week: integer; var Success: Boolean; ComPort: TComPort): Boolean;//设置系统日期
function SetTime(Hour, Minute, Second: integer; var Success: Boolean; ComPort: TComPort): Boolean;//设置系统时间
function IsOnline(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//查询下位机是否在线
function SetCurSpokesman(Addr, ED: string; var Success: Boolean; ComPort: TComPort): Boolean;//指定当前发言人
function ShowLogo(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//主屏显示LOGO标志
function ShowNameBMP(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//主屏显示姓名图片
function ShowName(Addr, Name: string; var Success: Boolean; ComPort: TComPort): Boolean;//副屏显示姓名
function ShowText(Addr, Text: string; x, y: integer; var Success: Boolean; ComPort: TComPort): Boolean;//任意位置显示文字
function SetBootLogo(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//任意位置显示文字
function ClearMainScreen(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//清除主屏显示
function CloseMSCM(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//客户模式关闭
function CloseSSCM(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//客户模式关闭
function ClearSubScreen(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//清除副屏显示
function SubShowNameBMP(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//副屏显示姓名图片
function SubShowName(Addr, Name: string; var Success: Boolean; ComPort: TComPort): Boolean;//副屏显示姓名
function OpenTextFile(FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;//打开文本文件(群发)
function SetFilePos(FileName: string; Pos: integer; var Success: Boolean; ComPort: TComPort): Boolean;//设置文本文件起始(群发)
function SetScrollSpeed(Addr: TStrings; Speed: integer; var Success: Boolean; ComPort: TComPort): Boolean;//设置滚动速度
function GetManuPos(Addr: string; var Pos: integer; var Success: Boolean; ComPort: TComPort): Boolean;//查询发言人文章起始地址
function PrepareCountDown(Addr: string; Minute, Second: integer; var Success: Boolean; ComPort: TComPort): Boolean;//准备倒计时
function SpokesCountDown(Addr: string; Minute, Second: integer; var Success: Boolean; ComPort: TComPort): Boolean;//发言倒计时
function SendMsg(Addr, Msg: string; var Success: Boolean; ComPort: TComPort): Boolean;//发送消息
function SubShowText(Addr, Text: string; x, y: integer; var Success: Boolean; ComPort: TComPort): Boolean;//副屏任意位置显示文字
function SubDispAgendaList(Addr: string; var Success: Boolean; ComPort: TComPort): Boolean;//副屏显示议程清单
//轮询终端请求代码
function QueryRequest(Addr: string; var Answer: TStrings; var Success: Boolean; ComPort: TComPort): Boolean;
//取应答码
function GetAnswer(Addr, Cmd, ReceivedMsg: string; var Answer: string): Boolean;
function HexToInt(Hex: string): integer;
implementation
uses FrmDemoImp;
function HexToInt(Hex: string): integer;
var
strTemp, strHex: string;
i: integer;
begin
Result := 0;
strHex := Hex;
i := 0;
while strHex <> '' do
begin
strTemp := Copy(strHex, Length(strHex), 1);
strHex := Copy(strHex, 1, Length(strHex) - 1);
if strTemp <= '9' then
Result := Result + Floor(StrToInt(strTemp) * Power(16, i))
else
Result := Result + Floor((Ord(strTemp[1]) - 55) * Power(16, i));
Inc(i, 1);
end;
end;
function GetAnswer(Addr, Cmd, ReceivedMsg: string; var Answer: string): Boolean;
var
strTemp, strRevStr: string;
i, intTemp: integer;
begin
Result := False;
Answer := '';
try
strRevStr := ReceivedMsg;
strTemp := IntToHex(Ord(strRevStr[2]), 2);//取地址
if strTemp <> IntToHex(StrToInt(Addr), 2) then
begin
//地址不对的处理
Exit;
end;
strTemp := IntToHex(Ord(strRevStr[3]), 2);//取命令
if strTemp <> Cmd then
begin
//命令不对的处理
Exit;
end;
intTemp := Ord(strRevStr[4]);//取返回应答码的字节数
for i := 0 to intTemp - 1 do
begin
strTemp := IntToHex(Ord(strRevStr[5 + i]), 2);
Answer := Answer + strTemp;
end;
Result := True;
except
on E: Exception do
begin
ShowMessage(E.Message);
end;
end;
end;
//串口发送事件
function CommSend(Addr, Cmd, Msg: string; var Answer: string; ComPort: TComPort): Boolean;
var
objStartTime: TDateTime;
intInstResendedTimes: integer;
strReadData: string;
label
SendInst;
begin
Result := False;
Answer := '';
if ComPort.Connected then
begin
try
intInstResendedTimes := 0;
SendInst:
strReadData := '';
objStartTime := Now();
ComPort.WriteStr(Msg);//送出数据
// if StrToInt(Addr) <> 0 then
begin
Sleep(200);//intCmdTimeout
ComPort.ReadStr(strReadData, InputSizeBuffer);
while (strReadData = '') and ((now - objStartTime) * 86400000 < intCmdTimeout) do
ComPort.ReadStr(strReadData, InputSizeBuffer);
if strReadData <> '' then
GetAnswer(Addr, Cmd, strReadData, Answer);
//增加对发送失败的处理:重新发送
if ((strReadData = '') or (Answer = CmdFailed)) and boolInstResend and (intInstResendedTimes < intInstResendTimes) then
begin
Inc(intInstResendedTimes, 1);
goto SendInst;
end;
end;
Result := True;
except
on E: Exception do
begin
ShowMessage(E.Message);
end;
end;
end;
end;
//CmdStr: 需要加校验码的字符串,要求以十六进制的方式来表示,如??Separator??Separator...Separator??
function CheckSum(CmdStr: string): char;//校验码的算法(采用LRC校验)
var
intLRC: Byte;//0..255
strCmdStr, strTemp: string;
begin
Result := Chr(0);
intLRC := 0;
try
strCmdStr := CmdStr;
while strCmdStr <> '' do
begin
strTemp := Copy(strCmdStr, 1, 1);
strCmdStr := Copy(strCmdStr, 2, Length(strCmdStr) - 1);
intLRC := (intLRC + Ord(strTemp[1])) mod 256;
end;
Result := Chr(intLRC);
except
ShowMessage('求LRC校验码时出错!');
end;
end;
function CmdFormat(Addr, Cmd, Data: string; DataLen: integer): string;
//要求,Addr, Cmd, Data都用十六进制数表示.
var
strData, strTemp: string;
begin
Result := '';
try
strData := Data;
strTemp := Chr(StrToInt(Addr)) + Chr(HexToInt(Cmd)) + Chr(DataLen) + Data;
strTemp := CmdHeader + strTemp + CheckSum(strTemp) + CmdTrail;
Result := strTemp
except
on E: Exception do
begin
ShowMessage(E.Message);
end;
end;
end;
function StrToHex(Str: string): string;
var
chrTemp: char;
strTemp: string;
begin
Result := '';
strTemp := Str;
while strTemp <> '' do
begin
chrTemp := strTemp[1];
Result := Result + IntToHex(Ord(chrTemp), 2);
strTemp := Copy(strTemp, 2, Length(strTemp) - 1);
end;
end;
function StrToValid(Str: string): string;
var
chrTemp: char;
strTemp: string;
begin
Result := '';
strTemp := Str;
while strTemp <> '' do
begin
chrTemp := strTemp[1];
Result := Result + Chr(Ord(chrTemp));
strTemp := Copy(strTemp, 2, Length(strTemp) - 1);
end;
end;
function GetSerialNo(Addr: string; var strSerialNo: string; var Success: Boolean; ComPort: TComPort): Boolean;//查询电路板的序列号
var
strAnswer: string;
begin
Result := True;
Success := False;
try
if CommSend(Addr, '06', CmdFormat(Addr, '06', '', 0), strAnswer, ComPort) then
begin
strSerialNo := strAnswer;//HexToInt(Copy(strAnswer, 1, 2)) * 256 + HexToInt(Copy(strAnswer, 3, 2));
Success := True;
Result := True;
end;
except
ShowMessage('取电路板序列号时出错!');
end;
end;
//下位机中是否存在该文件
function FileExist(Addr, FileName: string; var Existed: Boolean; ComPort: TComPort): Boolean;
var
strAnswer: string;
begin
Result := False;
try
if CommSend(Addr, '16', CmdFormat(Addr, '16', StrToValid(FileName), Length(FileName)), strAnswer, ComPort) then
begin
if (Copy(strAnswer, 1, 2) = '11') or (Copy(strAnswer, 1, 2) = '01') then//指定文件已经存在
Existed := True
else
Existed := False;
Result := True;
end;
except
ShowMessage('检查下位机“' + Addr + '”中“' + FileName + '”文件是否存在时出错!');
end;
end;
//写模式打开系统文件
function OpenSysFile(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;
//FileName:不包括文件路径,是指下位机中系统文件的名字
//Answer:返回信息
var
strAnswer: string;
begin
Result := False;
Success := False;
try
if CommSend(Addr, '13', CmdFormat(Addr, '13', StrToValid(FileName), Length(FileName)), strAnswer, ComPort) then
begin
if Copy(strAnswer, 1, 2) = '01' then//指令执行成功
Success := True;
Result := True;
end;
except
ShowMessage('写模式打开系统文件“' + FileName + '”时出错!');
end;
end;
//写模式打开新文件(不能是系统文件)
function OpenFile(Addr, FileName: string; var Success: Boolean; ComPort: TComPort): Boolean;
//FileName:不包括文件路径,是指下位机中非系统文件的名字
var
strAnswer: string;
begin
Result := False;
Success := False;
try
if CommSend(Addr, '12', CmdFormat(Addr, '12', StrToValid(FileName), Length(FileName)), strAnswer, ComPort) then
begin
if (Copy(strAnswer, 1, 2) = '11') then
CommSend(Addr, '11', CmdFormat(Addr, '11', StrToValid(FileName), Length(FileName)), strAnswer, ComPort);
if (Copy(strAnswer, 1, 2) = '01') then//指令执行成功
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -