⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 adtcommimpl.~pas

📁 完成Linux下的串口程序,串口发送延时程序
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
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 + -