大华ACS通讯秤demo
DahuaScale 类单元文件
点击查看代码
unit DahuaScale;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, System.SyncObjs,
System.RegularExpressions; // 新增正则单元
type
// 回调：原始报文、重量KG、单价、金额
TScaleWeightNotify = procedure(Sender: TObject; RawStr: string; WKg, Price, Total: Double) of object;
TDahuaScale = class(TObject)
private
FComPort: string;
FBaud: Integer;
FHandle: THandle;
FIsOpen: Boolean;
FRecvThread: TThread;
FOnScaleData: TScaleWeightNotify;
FCrit: TCriticalSection;
FScaleReg: TRegEx; // 缓存正则
procedure ParseScaleData(const Buf: string; out WKg, Price, Total: Double);
procedure DoDataNotify(Raw: string; W, P, T: Double);
protected
public
constructor Create;
destructor Destroy; override;
// 设置串口参数，打开前调用
procedure SetPortParam(const ComName: string; BaudRate: Integer = 9600);
// 打开/关闭串口
function Open: Boolean;
procedure Close;
property IsOpen: Boolean read FIsOpen;
// 核心业务指令
function QueryWeight: Boolean; // 主动查询重量 W
function Tare: Boolean; // 去皮 T
function Zero: Boolean; // 置零 Z
// 底层发送原始指令
function SendCmd(const S: string): Boolean;
// 实时重量回调（秤自动推送+查询返回都会触发）
property OnScaleData: TScaleWeightNotify read FOnScaleData write FOnScaleData;
end;
// 后台接收线程
TScaleRecvThread = class(TThread)
private
FOwner: TDahuaScale;
FBuffer: string;
FRawCache: string;
FW, FP, FT: Double;
procedure ReadSerial;
procedure SyncCallback; // 主线程同步执行回调
protected
procedure Execute; override;
public
constructor Create(AOwner: TDahuaScale);
end;
implementation
{ TScaleRecvThread }
constructor TScaleRecvThread.Create(AOwner: TDahuaScale);
begin
inherited Create(True);
FOwner := AOwner;
FreeOnTerminate := False;
FBuffer := '';
end;
procedure TScaleRecvThread.ReadSerial;
const
READ_BUF_SIZE = 256;
var
TempBuf: array[0..READ_BUF_SIZE - 1] of Byte;
ReadLen: DWORD;
i: Integer;
TempFrame: string;
CR_Pos: Integer;
begin
if not FOwner.FIsOpen then
Exit;
// 一次性读取全部缓冲区数据
if not ReadFile(FOwner.FHandle, TempBuf, READ_BUF_SIZE, ReadLen, nil) or (ReadLen = 0) then
Exit;
try
// 字节追加到缓冲
for i := 0 to ReadLen - 1 do
FBuffer := FBuffer + Char(TempBuf[i]);
CR_Pos := Pos(#13, FBuffer);
while CR_Pos > 0 do
begin
TempFrame := Copy(FBuffer, 1, CR_Pos - 1);
// 区分后面有没有#10，统一清理换行符
if (CR_Pos + 1 <= Length(FBuffer)) and (FBuffer[CR_Pos + 1] = #10) then
Delete(FBuffer, 1, CR_Pos + 1)
else
Delete(FBuffer, 1, CR_Pos);
if Trim(TempFrame) <> '' then
begin
FRawCache := TempFrame;
//FNotifyW := FOwner.ParseWeight(TempFrame);
FOwner.ParseScaleData(TempFrame, FW, FP, FT);
Synchronize(SyncCallback);
end;
CR_Pos := Pos(#13, FBuffer);
end;
finally
end;
end;
procedure TScaleRecvThread.SyncCallback;
begin
// 此代码运行在主线程，安全操作VCL控件
FOwner.DoDataNotify(FRawCache, FW, FP, FT);
end;
procedure TScaleRecvThread.Execute;
begin
while not Terminated do
begin
ReadSerial;
Sleep(8);
end;
end;
{ TDahuaScale }
constructor TDahuaScale.Create;
begin
inherited;
FCrit := TCriticalSection.Create;
FHandle := INVALID_HANDLE_VALUE;
FIsOpen := False;
FRecvThread := nil;
FComPort := 'COM4';
FBaud := 9600;
FScaleReg := TRegEx.Create('(\d+)\s+(\d+)\s+(\d+)');
end;
destructor TDahuaScale.Destroy;
begin
Close;
FCrit.Free;
inherited;
end;
procedure TDahuaScale.SetPortParam(const ComName: string; BaudRate: Integer);
begin
if FIsOpen then
Exit;
FComPort := ComName;
FBaud := BaudRate;
end;
procedure TDahuaScale.DoDataNotify(Raw: string; W, P, T: Double);
begin
if Assigned(FOnScaleData) then
FOnScaleData(self, Raw, W, P, T);
end;
procedure TDahuaScale.ParseScaleData(const Buf: string; out WKg, Price, Total: Double);
var
sTrim: string;
Match: TMatch;
Reg: TRegEx;
function GramToKg(const NumStr: string): Double;
var
Gram: Int64;
begin
Gram := StrToIntDef(Trim(NumStr), 0);
Result := Gram / 1000;
end;
function STToKg(const NumStr: string): Double;
var
sNum: string;
begin
Result := 0;
if Length(NumStr) = 6 then
begin
sNum := Copy(NumStr, 1, 4) + '.' + Copy(NumStr, 5, 2);
Result := StrToFloatDef(sNum, 0);
end;
end;
begin
WKg := 0.000;
Price := 0.00;
Total := 0.00;
sTrim := Trim(Buf);
if sTrim = '' then
Exit;
//分支1 ST / W 协议保持不变
if Copy(sTrim, 1, 2) = 'ST' then
begin
WKg := STToKg(Copy(sTrim, 3, 6));
Exit;
end;
if Copy(sTrim, 1, 1) = 'W' then
begin
WKg := StrToFloatDef(Copy(sTrim, 2, MaxInt), 0.00);
Exit;
end;
// ========== 正则核心：一行匹配三段数字，自动忽略所有空白 ==========
Match := FScaleReg.Match(sTrim);
if Match.Success then
begin
// 捕获组1=重量，组2=单价，组3=金额
WKg := GramToKg(Match.Groups[1].Value);
Price := StrToFloatDef(Match.Groups[2].Value, 0);
Total := StrToFloatDef(Match.Groups[3].Value, 0);
end;
end;
// 极简解析：只处理 ST自动推送 / W查询返回两种主流报文
function TDahuaScale.SendCmd(const S: string): Boolean;
var
WriteLen: DWORD;
begin
Result := False;
if not FIsOpen then
Exit;
FCrit.Enter;
try
Result := WriteFile(FHandle, PChar(S)^, Length(S), WriteLen, nil);
if Result then
FlushFileBuffers(FHandle); // 强制刷写硬件，指令立刻下发
finally
FCrit.Leave;
end;
end;
function TDahuaScale.QueryWeight: Boolean;
begin
Result := SendCmd('W'#13#10);
end;
function TDahuaScale.Tare: Boolean;
begin
Result := SendCmd('T'#13#10);
end;
function TDahuaScale.Zero: Boolean;
begin
Result := SendCmd('Z'#13#10);
end;
function TDahuaScale.Open: Boolean;
var
DCB: TDCB;
CommTO: TCOMMTIMEOUTS;
begin
Result := False;
if FIsOpen then
begin
Result := True;
Exit;
end;
// 打开串口，支持COM10及以上
FHandle := CreateFile(PChar('\\.\' + FComPort), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if FHandle = INVALID_HANDLE_VALUE then
Exit;
// 固定 8N1
FillChar(DCB, SizeOf(DCB), 0);
DCB.DCBlength := SizeOf(DCB);
GetCommState(FHandle, DCB);
DCB.BaudRate := FBaud;
DCB.ByteSize := 8;
DCB.Parity := NOPARITY;
DCB.StopBits := ONESTOPBIT;
SetCommState(FHandle, DCB);
// 修复超时：扩大总超时，保证缓冲区数据能完整读取
FillChar(CommTO, SizeOf(CommTO), 0);
CommTO.ReadIntervalTimeout := 5;
//CommTO.ReadTotalTimeoutMultiplier := 1;
CommTO.ReadTotalTimeoutConstant := 300;
SetCommTimeouts(FHandle, CommTO);
// 清空收发缓冲区
PurgeComm(FHandle, PURGE_RXCLEAR or PURGE_TXCLEAR);
FIsOpen := True;
FRecvThread := TScaleRecvThread.Create(Self);
FRecvThread.Start;
Result := True;
end;
procedure TDahuaScale.Close;
begin
if Assigned(FRecvThread) then
begin
FRecvThread.Terminate;
FRecvThread.WaitFor;
FRecvThread.Free;
FRecvThread := nil;
end;
if FHandle <> INVALID_HANDLE_VALUE then
begin
CloseHandle(FHandle);
FHandle := INVALID_HANDLE_VALUE;
end;
FIsOpen := False;
end;
end.
点击查看代码
unit uDaHuaMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,DahuaScale;
type
TForm2 = class(TForm)
btnSetCom: TButton;
btnClose: TButton;
btnQuery: TButton;
btnTare: TButton;
btnZero: TButton;
lblWeight: TLabel;
MemoLog: TMemo;
Button1: TButton;
edtCom: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnSetComClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnQueryClick(Sender: TObject);
procedure btnTareClick(Sender: TObject);
procedure btnZeroClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FScale:TDahuaScale;
procedure ScalDataEvent(Sender:TObject;RawStr: string; WKg,Price,Total: Double);
public
{ Public declarations }
kaiguan:Boolean;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.btnCloseClick(Sender: TObject);
begin
FScale.Close;
MemoLog.Lines.Add('串口已关闭');
end;
procedure TForm2.btnSetComClick(Sender: TObject);
begin
FScale.SetPortParam(edtCom.Text) ;
MemoLog.Lines.Add('已设置串口为'+edtCom.Text+'。如果失败，无法获取数据请检查串口是否被占用！')
end;
procedure TForm2.btnQueryClick(Sender: TObject);
begin
FScale.QueryWeight;
MemoLog.Lines.Add('主动查询重量');
end;
procedure TForm2.btnTareClick(Sender: TObject);
begin
FScale.Tare;
MemoLog.Lines.Add('发送去皮指令');
end;
procedure TForm2.btnZeroClick(Sender: TObject);
begin
IF FScale.Zero then MemoLog.Lines.Add('发送置零指令');
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
kaiguan:=false;
if FScale.Open then MemoLog.Lines.Add('已打开') else MemoLog.Lines.Add('失败');
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
FScale:=TDahuaScale.Create;
FScale.SetPortParam('COM4',9600);
FScale.OnScaleData:=ScalDataEvent;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FScale.free;
end;
procedure TForm2.ScalDataEvent(Sender: TObject; RawStr: string; WKg, Price, Total: Double);
begin
MemoLog.Lines.Add(Format('原始：%s | 重量：%.2f KG | 单价：%.2f | 金额：%.3f',
[RawStr, WKg, Price/100, Total/100]));
lblWeight.Caption := Format('当前重量：%.3f KG', [WKg]);
end;
end.
一、项目整体功能总结
大华计价秤串口数据解析组件，支持两种报文自动识别解析：
老式计价报文：重量 多空格 单价 多空格 金额（单位：克、分）
标准收银 ST/W 报文：STxxxxKG / Wxxx（单位：千克）
功能：实时串口接收 → 清洗报文 → 正则提取三段数字 → 单位换算 → 主线程界面展示重量、单价、金额。
二、最终方案核心特点
- 健壮容错（解决前期所有 BUG）
自动兼容任意空白分隔：单空格、连续多空格、回车#13、换行#10，无需手动批量替换字符串；
不会丢失第三段金额，彻底解决原生分割丢段问题；
无死循环风险：删除所有while空格清理循环，规避卡死；
双协议自动兼容，无需切换配置；
数据兜底：匹配失败、空报文自动返回 0，程序不崩溃。 - 性能优化
正则对象全局缓存，仅初始化编译 1 次，避免每次解析新建正则带来内存、CPU 开销；
称重串口低频（1~10 帧 / 秒）场景零卡顿，哪怕提升至工业仪表 20Hz 也无压力；
子线程接收、主线程同步刷新 UI，不阻塞串口读取。 - 代码简洁易维护
一段正则表达式替代十几行字符串截取、分割、清洗代码；
分层解耦：底层只做原始数值解析，界面统一做单位换算（分 ÷100 转为元）；
分段逻辑集中，报文格式修改仅需改正则模板，改动极小。 - 数值计算规范
秤原始重量单位克，统一除以 1000 换算千克；
单价、金额原始单位分，界面统一除以 100 换算元；
浮点数格式化可控，可自由选择四舍五入 / 截断小数展示。
三、用到的技术知识点
（一）Delphi 基础语法
字符串操作：Trim、Copy、Pos、StrToIntDef、StrToFloatDef；
格式化输出 Format、浮点数保留小数规则（四舍五入）；
函数静态变量 static：函数内缓存对象，仅初始化一次；
过程输出参数 out：一次性向外输出重量、单价、金额三个结果；
局部嵌套函数：内部工具函数封装换算逻辑，代码整洁。
（二）正则表达式（核心优化点）
单元：System.RegularExpressions（XE 及以上内置，无第三方控件）；
核心类型：TRegEx（正则模板）、TMatch（匹配结果）、TGroup（捕获分组）；
正则语法：
\d+：匹配一串纯数字；
\s+：匹配任意数量任意空白（空格、回车、换行、制表符）；
(\d+)\s+(\d+)\s+(\d+) 三组捕获，分别提取重量、单价、金额；
性能要点：TRegEx是 Record 值类型，非 TObject，无需 Free 释放；缓存复用模板减少重复编译。
（三）串口多线程编程
子线程持续读取串口数据流，不阻塞 UI；
Synchronize主线程同步回调，禁止子线程直接操作 VCL 控件（防跨线程报错）；
事件回调封装：自定义回调事件一次性返回原始报文 + 三组数值，窗体统一处理展示。
（四）报文处理设计思想
多协议分支判断：先判断 ST/W 标准报文，再走正则三段计价报文；
数据分层：底层解析保存原始最小单位（克、分），界面层再做单位换算，避免精度丢失；
容错设计：空字符串、匹配失败全部默认赋 0，保证程序稳定。
（五）前期踩坑对比（反衬正则方案优势）
原生TStringList按空格分割缺陷：多空格、尾部换行导致分段缺失；
手动while循环清理多空格：逻辑写错会触发无限死循环、程序卡死；
正则统一屏蔽所有空白干扰，消除大量容错代码。
四、关键技术总结一句话
使用 Delphi 内置正则表达式替代传统字符串分割，配合静态缓存优化性能，结合多线程串口同步回调，兼容两种称重报文格式，实现高容错、低维护、稳定的电子秤数据解析功能。
浙公网安备 33010602011771号