2 Star 0 Fork 0

JiangXiaoDong / CFPrint

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
datamodule.pas 5.17 KB
一键复制 编辑 原始数据 按行查看 历史
unit datamodule;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, ExtCtrls, ZConnection, ZDataset, IdHTTP, MQTT,
LR_Class, LR_Desgn, LR_DBSet, FPReportDesigner, fpreport, fpJson, intf,
LMessages, LCLIntf, Forms;
type
{ TDM }
TDM = class(TDataModule)
conn: TZConnection;
http: TIdHTTP;
InnerQry: TZQuery;
MqttAutoPing: TTimer;
pubQry: TZQuery;
procedure MqttAutoPingTimer(Sender: TObject);
private
public
MQTTClient:TMQTTClient;
WebServer:string;//服务器地址
UName:string;//登录用户名
UUID:string;//用户UUID
USign:string;//用户签名图片地址
UGonghao:string;//用户工号
UOffice:string;//用户科室
DB_Host:string;//数据库地址
DB_Name:string;//数据库名称
DB_Port:integer;//数据库端口
DB_User:string;//数据库用户名
DB_Pwd:string;//数据库密码
Use_Local_goods:boolean;//是否使用本地商品库存
Company:string;//公司名称
Department:string;//部门名称
DB_MsgHost:string;//消息服务器地址
DB_MsgPort:integer;//消息服务器端口
PrinterID:string;//打印机台编号
PrinterName:string;//选中的打印机名称
PrintTemplate:string;//打印模板文件
procedure AddSysLog(AAction,ADetail:string);//记录系统日志
procedure CreateMqttClient;//创建消息客户端对象
function ConectMqttServer:boolean;//连接到消息服务器并订阅主题
function CreateSendMessageOfJson(ATopic, APayload:string;ACategory:string=''):string;//创建发送消息时的JSON字符串
procedure OnMqttConnAck(Sender: TObject; ReturnCode: integer);
procedure OnMqttPingResp(Sender: TObject);
procedure OnMqttPublish(Sender: TObject; topic, payload: ansistring; retain: boolean);
procedure OnMqttSubAck(Sender: TObject; MessageID: integer; GrantedQoS: integer);
procedure OnMqttUnsubAck(Sender: TObject; MessageID: integer);
function ExtractDanhaoFromJsonString(AString:string):string;//从JSON字符串中解析出处方单号
end;
var
DM: TDM;
implementation
{$R *.frm}
{ TDM }
procedure TDM.MqttAutoPingTimer(Sender: TObject);
begin
if MqttClient<>nil then
begin
if MqttClient.isConnected then
begin
try
MqttClient.PingReq;
finally
end;
end;
end;
end;
procedure TDM.AddSysLog(AAction, ADetail: string);
begin
with InnerQry do
begin
Close;
Sql.Clear;
Sql.Add('insert into public.sys_logs (uuid, uname, ukind, action, detail) values (:uuid, :uname, :ukind, :action, :detail)');
Params.ParamByName('uuid').AsString:=Self.UUID;
Params.ParamByName('uname').AsString:=Self.UName;
Params.ParamByName('ukind').AsString:='s';
Params.ParamByName('action').AsString:=AAction;
Params.ParamByName('detail').AsString:=ADetail;
ExecSQL;
end;
end;
procedure TDM.CreateMqttClient;
begin
MQTTClient:=TMQTTClient.Create(Dm.DB_MsgHost,Dm.DB_MsgPort);
MQTTClient.OnConnAck:=@OnMqttConnAck;
MQTTClient.OnPingResp:=@OnMqttPingResp;
MQTTClient.OnPublish:=@OnMqttPublish;
MQTTClient.OnSubAck:=@OnMqttSubAck;
MQTTClient.OnUnSubAck:=@OnMqttUnsubAck;
end;
function TDM.ConectMqttServer: boolean;
var
mTimeout:Longword;
begin
Result:=False;
try
MqttClient.Connect;
except
Result:=False;
Exit;
end;
mTimeout:=GetTickCount64;
while (GetTickCount64-mTimeout)<30000 do
begin
if MqttClient.isConnected then
begin
//订阅主题
MqttClient.Subscribe('$queue/chufangprint/#');//处方打印
Result:=True;
Break;
end;
end;
end;
function TDM.CreateSendMessageOfJson(ATopic, APayload: string; ACategory: string
): string;
begin
//生成发送消息的JSON字符串
Result:='{"topic":"'+ATopic+'","payload":'+APayload+'}';
end;
procedure TDM.OnMqttConnAck(Sender: TObject; ReturnCode: integer);
begin
end;
procedure TDM.OnMqttPingResp(Sender: TObject);
begin
end;
procedure TDM.OnMqttPublish(Sender: TObject; topic, payload: ansistring;
retain: boolean);
var
m:string;
begin
m:=Self.CreateSendMessageOfJson(topic,payload);
SendMessage(Application.MainFormHandle,MSG_PUBLISH_MESSAGE,integer(@m),1);
end;
procedure TDM.OnMqttSubAck(Sender: TObject; MessageID: integer;
GrantedQoS: integer);
begin
end;
procedure TDM.OnMqttUnsubAck(Sender: TObject; MessageID: integer);
begin
end;
function TDM.ExtractDanhaoFromJsonString(AString: string): string;
var
mJson,mPayload:TJsonData;
mTopic:string;
mStream:TStringStream;
begin
{Payload结构:
{"sid":"101",
"sname":"李时珍",
"stime":"2021-06-01 22:18:48",
"scat":":",
"smsg":"CFSD10100000054"}
}
Result:='';
mStream:=TStringStream.Create(AString,TEncoding.UTF8);
mStream.Seek(0,soBeginning);
try
mJson:=GetJson(mStream);
except
mStream.Free;
Exit;
end;
mStream.Free;
if mJson.FindPath('topic')<>nil then
begin
mTopic:=mJson.FindPath('topic').AsString;
if Pos('chufangprint',mTopic)=1 then
begin
//只处理chufangprint频道消息
mPayload:=mJson.FindPath('payload');
if mPayload<>nil then
begin
if mPayload.FindPath('smsg')<>nil then
Result:=mPayload.FindPath('smsg').AsString;
end;
end;
end;
end;
end.
Pascal
1
https://gitee.com/1817813144/cfprint.git
git@gitee.com:1817813144/cfprint.git
1817813144
cfprint
CFPrint
master

搜索帮助