From 868daf94f29ce1ffdd799a68c07bb668cd373bcd Mon Sep 17 00:00:00 2001
From: HP\李良庭 <liliangting@lanpucloud.cn:1111>
Date: 星期二, 08 七月 2025 11:49:03 +0800
Subject: [PATCH] 提交分辨率自适应版本V3.1.0.1500
---
src/init/uInit.pas | 616 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 616 insertions(+), 0 deletions(-)
diff --git a/src/init/uInit.pas b/src/init/uInit.pas
new file mode 100644
index 0000000..843c36a
--- /dev/null
+++ b/src/init/uInit.pas
@@ -0,0 +1,616 @@
+{------------------------------------------------------------------------------}
+{单元名称：uInit.pas }
+{模块名称：初始化函数库 }
+{模块说明：包括主进程启动时，全局变量初始化、系统目录初始化、配置加载 }
+{建立日期：2009-12-20 }
+{修改修改：2023-02-21 }
+{版权所有：李良庭 liangtingli@outlook.com }
+{------------------------------------------------------------------------------}
+
+unit uInit;
+
+interface
+
+uses
+ Windows, Classes, Messages, Forms, Dialogs, SysUtils, StrUtils, DateUtils,
+ StdCtrls, Variants, ComCtrls, Buttons, Math, IniFiles, Graphics, ShellAPI,
+ SQLite3, SQLiteTable3;
+
+ {申明全局公共调用函数}
+ procedure OpenOnScreenKeyboard();
+ procedure InitGlobal();
+ procedure InitSystemDir();
+ procedure InitDatas();
+ procedure LoadSystemInfo();
+ procedure LoadOptions();
+ procedure SaveOptions();
+ function GetCurrMsgPos(index:Integer):TPoint;
+
+ //授权文件检查模块
+ function GetMachineCode():String;
+ function CheckLicense(sFilename, sCode:String):Boolean;
+ procedure RegCheckMode();
+ procedure RegCheck1Mode();
+ //保存csv数据
+ procedure WriteCsvFile(name: string; mois,temp,water: Double);
+ //刷新故障码
+ function RefashFaultCode(cod:Integer):String;
+ //自动模式下刷新故障码
+ function AutoFaultCode(cod:Integer):string;
+implementation
+
+uses
+ uMain, log4me, uDM, PubUtils, MsgVar, Global, uSaveData, CpuidInfo, UntDes;
+
+ {函数方法}
+
+//------- 调用三方键盘 ------------------------------------
+//调用osk键盘
+procedure OpenOnScreenKeyboard();
+type TWow64DisableWow64FsRedirection = function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
+type TWow64RevertWow64FsRedirection = function(var Wow64RevertWow64FsRedirection: LongBool): LongBool; StdCall;
+var
+ hHandle: THandle;
+ Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
+ Wow64RevertWow64FsRedirection: TWow64RevertWow64FsRedirection;
+ OldValue: LongBool;
+ rs: Integer;
+begin
+ //切换32位文件系统
+ try
+ hHandle := GetModuleHandle('kernel32.dll');
+ @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');
+ if ((hHandle <> 0) and (@Wow64DisableWow64FsRedirection <> nil)) then
+ Wow64DisableWow64FsRedirection(OldValue);
+ except
+ end;
+ //调用osk屏幕键盘
+ rs := ShellExecute(Application.Handle, 'open', 'osk.exe', nil, nil, SW_SHOWNORMAL);
+ if rs <= 32 then begin
+ ShowMessage(Format('错误：无法打开屏幕键盘，错误代码-[%d].',[rs]));
+ log4Info(Format('错误：无法打开屏幕键盘，错误代码-[%d].',[rs]));
+ end
+ else
+ log4Info('系统：上位机软件打开 osk 系统屏幕键盘.');
+ //用回64位文件系统
+ try
+ hHandle := GetModuleHandle('kernel32.dll');
+ @Wow64RevertWow64FsRedirection := GetProcAddress(hHandle, 'Wow64RevertWow64FsRedirection');
+ if ((hHandle <> 0) and (@Wow64RevertWow64FsRedirection <> nil)) then
+ Wow64RevertWow64FsRedirection(OldValue);
+ except
+ end;
+end;
+
+//---------------------------------------------------------------------------
+//初始化全局变量
+procedure InitGlobal();
+begin
+ //程序路径
+ glAppPath := ExtractFilePath(Application.ExeName);
+
+ //configDB file
+ glConfig_db := glAppPath + CONFIG_DIR + t_Config + '.db';
+ glConn_db := glAppPath + CONFIG_DIR + t_Conn + '.db';
+ glGrain_db := glAppPath + CONFIG_DIR + t_Grain + '.db';
+ glWeight_db := glAppPath + CONFIG_DIR + t_Weight + '.db';
+ glManager_db := glAppPath + CONFIG_DIR + t_Manager + '.db';
+ glData_db := glAppPath + CONFIG_DIR + t_Data + '.db';
+ //初始化Calc全局变量
+ glCalcOutput := '';
+ glCurrFocus := 0;
+ //初始化手动模式返回口令值
+ frmMain.sLoginPwd := '';
+ //初始化样本存储变量
+ smp.flag := false;
+ smp.info := '';
+ smp.prefix := '';
+ smp.dir := '';
+end;
+
+//初始化系统目录
+procedure InitSystemDir();
+var
+ path : String;
+begin
+ //创建配置文件夹
+ path := glAppPath + CONFIG_DIR;
+ if not DirectoryExists(path) then ForceDirectories(path);
+
+ //创建数据文件夹
+ path := glAppPath + DATA_DIR;
+ if not DirectoryExists(path) then ForceDirectories(path);
+
+ //创建日志文件夹
+ path := glAppPath + LOG_DIR;
+ if not DirectoryExists(path) then ForceDirectories(path);
+end;
+
+//初始化数据采集结构
+procedure InitDatas();
+begin
+ //初始化Datas测量数据
+ Datas.Voltage := 0; //原始电平
+ Datas.Weight := 0; //重量
+ Datas.Temp := 0; //温度
+ Datas.Humid:= 0; //湿度
+ //初始化自动检测标签
+ frmMain.lblAutoRet.Caption := '';
+ frmMain.lblAutoRet_error.Caption := '';
+end;
+
+//加载系统信息界面
+procedure LoadSystemInfo();
+begin
+ with frmMain do begin
+ //初始化水分仪串口下拉菜单
+ cbSerialPort.Items.Clear;
+ EnumComPorts(cbSerialPort.Items);
+ //加载水分仪参数
+ cbSerialPort.Text := WrConn.SerialPort;
+ edtBaud.Text := IntToStr(WrConn.baud);
+ edtParity.Text := WrConn.parity;
+ edtData_bit.Text := IntToStr(WrConn.data_bit);
+ edtStop_bit.Text := IntToStr(WrConn.stop_bit);
+ cbAutoRun.Checked := glAutoRun;
+ //增加两个时间设置值
+ edtTime1.Text := IntToStr(glTime1);
+ edtTime2.Text := IntToStr(glTime2);
+
+ //加载扦捡系统参数
+ edtIP.Text := PlcConn.ip;
+ edtPort.Text := IntToStr(PlcConn.port);
+ edtHeartIP.Text := PlcConn.heart_ip;
+ edtHeartPort.Text := IntToStr(PlcConn.heart_port);
+
+ //加载手动检测和参数配置界面的数据存储参数
+ cbTestAutoSave.Checked := smp.flag;
+ edtSampleName.Text := smp.info;
+ cbAutoSave.Checked := smp.flag;
+ edtPrefix.Text := smp.prefix;
+ edtDir.Text := smp.dir;
+
+ //加载登录口令
+ edtPassword.Text := SysConfig.password;
+ edtDelay.Text := IntToStr(SysConfig.delay);
+ end;
+end;
+
+//加载参数到界面
+procedure LoadOptions();
+begin
+ with frmMain do begin
+ //手动检测界面
+ mtManClock.Value := 0;
+ edtMoisture.Text := '';
+ edtWeightRatio.Text := '';
+ edtWeight.Text := '';
+ edtTemp.Text := '';
+ edtWater.Text := '';
+ lbType.ItemIndex := Grain.Code-1; //粮种代码与界面ItemIndex的对应关系
+ sLabel15.Caption := Format('粮食种类 - [%s]',[Grain.Name]);
+ sLabel3.Caption := Format('选择 - [%s]',[Grain.Name]);
+ //仪器校准界面
+ lbType1.ItemIndex := Grain.Code-1;
+ edtAutoCoef1.Text := Grain.coef[0];
+ edtAutoCoef2.Text := Grain.coef[1];
+ edtAutoCoef3.Text := Grain.coef[2];
+ edtAutoCoef4.Text := Grain.coef[3];
+ edtAutoCoef5.Text := Grain.coef[4];
+ //参数设置界面
+ edtVolume.Text := FloatToStr(SysConfig.Volume);
+ edtTare.Text := FloatToStr(SysConfig.Tare);
+ edtFreq.Text := FloatToStr(SysConfig.Freq);
+ edtDecay.Text:= FloatToStr(SysConfig.Decay);
+ edtStartFreq.Text := FloatToStr(SysConfig.StartFreq);
+ edtStopFreq.Text := FloatToStr(SysConfig.StopFreq);
+ edtStep.Text := IntToStr(SysConfig.Step);
+ lbASK.ItemIndex := SysConfig.Ask; //ASK代码与界面ItemIndex的对应关系
+ //系统信息界面
+ lblVersion.Caption := Format('版本 %s ', [glFileVersion]);
+ end;
+end;
+
+//保存界面参数
+procedure SaveOptions();
+begin
+ //
+end;
+
+//------ 功能函数 -------------------------------------------------------------
+//获取当前焦点输入框的绝对坐标
+function GetCurrMsgPos(index:Integer):TPoint;
+var
+ x1,y1 : Integer; //修正值
+ x3,x45,y2 : Integer;
+begin
+ with frmMain do begin
+ x1 := edtMois1.Width + 5;
+ y1 := -100;
+ x3 := edtMois1.Width - 8;
+ x45 := -473;
+ y2 := -250;
+ case index of
+ 1:begin
+ Result.X := Left+edtMois1.Left+x1;
+ Result.Y := Top+edtMois1.Top+y1;
+ end;
+ 2:begin
+ Result.X := Left+edtMois2.Left+x1;
+ Result.Y := Top+edtMois2.Top+y1;
+ end;
+ 3:begin
+ Result.X := Left+edtMois3.Left+x3;
+ Result.Y := Top+edtMois3.Top+y1;
+ end;
+ 4:begin
+ Result.X := Left+edtMois4.Left+x45;
+ Result.Y := Top+edtMois4.Top+y1;
+ end;
+ 5:begin
+ Result.X := Left+edtMois5.Left+x45;
+ Result.Y := Top+edtMois5.Top+y1;
+ end;
+ 6:begin
+ Result.X := Left+edtManCoef1.Left+x1;
+ Result.Y := Top+edtManCoef1.Top+y2;
+ end;
+ 7:begin
+ Result.X := Left+edtManCoef2.Left+x1;
+ Result.Y := Top+edtManCoef2.Top+y2;
+ end;
+ 8:begin
+ Result.X := Left+edtManCoef3.Left+x3;
+ Result.Y := Top+edtManCoef3.Top+y2;
+ end;
+ 9:begin
+ Result.X := Left+edtManCoef4.Left+x45;
+ Result.Y := Top+edtManCoef4.Top+y2;
+ end;
+ 10:begin
+ Result.X := Left+edtManCoef5.Left+x45;
+ Result.Y := Top+edtManCoef5.Top+y2;
+ end;
+ 11:begin
+ Result.X := Left+edtIp.Left+edtIp.Width+35;
+ Result.Y := Top+edtIp.Top+edtIp.Height+70;
+ end;
+ 12:begin
+ Result.X := Left+edtPort.Left+edtPort.Width+30;
+ Result.Y := Top+edtPort.Top+edtPort.Height+70;
+ end;
+ 13:begin
+ Result.X := Left+edtTime1.Left+edtTime1.Width+35;
+ Result.Y := Top+edtTime1.Top+edtTime1.Height+190;
+ end;
+ 14:begin
+ Result.X := Left+edtTime2.Left+edtTime2.Width+35;
+ Result.Y := Top+edtTime2.Top+edtTime2.Height+190;
+ end;
+ 15:begin
+ Result.X := Left+edtWeight1.Left+edtWeight1.Width+5;
+ Result.Y := Top+edtWeight1.Top+edtWeight1.Height-50;
+ end;
+ 16:begin
+ Result.X := Left+edtWeight2.Left+edtWeight2.Width+5;
+ Result.Y := Top+edtWeight2.Top+edtWeight2.Height-50;
+ end;
+ 17:begin
+ Result.X := Left+edtWeight3.Left-475;
+ Result.Y := Top+edtWeight3.Top+edtWeight3.Height-50;
+ end;
+ 18:begin
+ Result.X := Left+edtWeight3.Left-220;
+ Result.Y := Top+edtWeight3.Top+edtWeight3.Height-120;
+ end;
+ 19:begin
+ Result.X := Left+edtWeight3.Left-220;
+ Result.Y := Top+edtWeight3.Top+edtWeight3.Height-60;
+ end;
+ 20:begin
+ Result.X := Left+edtVolume.Left+edtVolume.Width+5;
+ Result.Y := Top+edtVolume.Top+edtVolume.Height-45;
+ end;
+ 21:begin
+ Result.X := Left+edtTare.Left+edtTare.Width+5;
+ Result.Y := Top+edtTare.Top+edtTare.Height-45;
+ end;
+ 22:begin
+ Result.X := Left+edtDelay.Left+edtDelay.Width+35;
+ Result.Y := Top+edtDelay.Top+edtDelay.Height+140;
+ end;
+ 23:begin
+ Result.X := Left+edtPassword.Left+35;
+ Result.Y := Top+edtPassword.Top+210;
+ end;
+ 24:begin
+ Result.X := Left+edtManVal.Left+x1;
+ Result.Y := Top+edtManVal.Top-120;
+ end;
+ 25:begin
+ Result.X := Left+edtIntercept.Left+x1;
+ Result.Y := Top+edtIntercept.Top-180;
+ end;
+ 26:begin
+ Result.X := Left+edtHeartIp.Left+40;
+ Result.Y := Top+edtHeartIp.Top+120;
+ end;
+ 27:begin
+ Result.X := Left+edtHeartPort.Left+40;
+ Result.Y := Top+edtHeartPort.Top+120;
+ end;
+ end;
+ end;
+end;
+
+//------- 系统授权相关函数 -----------------------------------------------------
+//计算本机机器码，输出机器码密文
+function GetMachineCode():String;
+var
+ ss : string;
+begin
+ SetCPU(GetCurrentProcess,1);
+ ss := GetCnCPUID();
+ //生成一个机器码
+ Result := EncryStrHex(ss, sConfig);
+end;
+
+//授权文件校验，返回校验结果
+//入参：sfilename-校验文件
+// sCode-计算本机机器码
+//返回：true-校验成功；false-校验失败
+function CheckLicense(sFilename, sCode:String):Boolean;
+var
+ i : Integer;
+ sDecry : String; //解密后的明文
+ sl : TStringList;
+begin
+ //容错处理
+ if not FileExists(sFileName) then begin
+ Result := false;
+ Exit;
+ end;
+
+ //获取密文
+ sl := TStringlist.Create();
+ try
+ sl.LoadFromFile(sFilename);
+ sDecry := Trim(sl.Text);
+ finally
+ FreeAndNil(sl);
+ end;
+
+ //对密文信息进行解码，按默认level=8
+ for i:=1 to 8 do
+ sDecry := DecryStrHex(sDecry, sConfig); //编码,生成明文
+
+ //获取RegCode+RegDate+RegLevel+RegType+RegKey 机器码
+ sDESMachineCode := SplitStr(sDecry,' ',0);
+ sDESDate := SplitStr(sDecry,' ',1);
+ sDESLevel := SplitStr(sDecry,' ',2);
+ sDESType := SplitStr(sDecry,' ',3);
+ sDESKey := SplitStr(sDecry,' ',4);
+
+ //返回比较机器码
+ Result := AnsiSameStr(sCode, sDESMachineCode);
+end;
+//License授权检查模块，如未注册则自动退出
+procedure RegCheckMode();
+var
+ sl : TStringList;
+ sLicFile, sMchCod, sLicText : String;
+begin
+ //======验证授权文件===============================
+ sLicFile := glAppPath + LICENSE_FILE;
+ sMchCod := GetMachineCode();
+ if CheckLicense(sLicFile, sMchCod) then
+ glRegSuccess := true
+ else begin
+ //存注册码
+ sl := TStringList.Create();
+ sl.Add('机器码：' + sMchCod);
+ sl.Add('生成日期：' + FormatDateTime('yyyy-mm-dd hh:nn:ss',Now()));
+ sl.SaveToFile(glAppPath+'机器码.txt');
+ FreeAndNil(sl);
+ //提示要获取授权文件
+ glRegSuccess := false; //注册失败，调整标志，准备释放退出定时器
+ sLicText := '警告：系统尚未注册，已在软件目录生成 [机器码] 文件，请将该文件提供给系统供应商，以获取正式授权文件！';
+ MessageBox(frmMain.handle,PChar(sLicText),'注册提示对话框',MB_OK+MB_ICONWARNING);
+ //开启退出定时器, 0.5s内退出
+ dm.tmRegFault.Enabled := true;
+ end;
+end;
+
+//静默授权检查模块
+procedure RegCheck1Mode();
+var
+ sLicFile, sMchCod : String;
+begin
+ sLicFile := glAppPath + LICENSE_FILE;
+ sMchCod := GetMachineCode();
+ if not CheckLicense(sLicFile, sMchCod) then
+ dm.tmRegFault.Enabled := true;
+end;
+
+//------------------------------------------------------------------------------
+function GetLastNum(const FileName: string): Integer;
+var
+ FileStream: TextFile;
+ LastDataLine,Line,Fields: string;
+begin
+ Result := 0;
+ // 检查文件是否存在
+ if not FileExists(FileName) then Exit;
+
+ // 打开文件
+ AssignFile(FileStream, FileName);
+ try
+ Reset(FileStream);
+ // 跳过标题行
+ if not Eof(FileStream) then ReadLn(FileStream);
+ // 读取文件的每一行
+ LastDataLine := '';
+ while not Eof(FileStream) do begin
+ ReadLn(FileStream, Line);
+ if Line <> '' then
+ LastDataLine := Trim(Line);
+ end;
+ // 解析最后一行
+ if LastDataLine <> '' then begin
+ Fields := SplitStr(LastDataLine,',',0);
+ Result := StrToIntDef(Fields,0);
+ end;
+ finally
+ CloseFile(FileStream);
+ end;
+end;
+
+// 将检测结果保存到 csv文件
+procedure WriteCsvFile(name: string; mois,temp,water: Double);
+var
+ pMyFile: textFile;
+ sfile,sTitle,sMsg,time : string;
+ no : integer;
+begin
+ //初始化路径和标题
+ sFile := smp.dir + smp.prefix + FormatDateTime('yyyymmdd', Now) + '.csv';
+ sTitle:= '序号,样本信息,含水率,温度,湿度,日期';
+
+ //读取文件历史no序号
+ no := GetLastNum(sFile)+1;
+ time := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
+ sMsg := Format('%d,%s,%.2f,%.2f,%.2f,%s', [no,name,mois,temp,water,time]);
+ try
+ AssignFile(pMyFile,sFile);
+ if FileExists(sFile) then
+ Append(pMyFile)
+ else begin
+ ReWrite(pMyFile);
+ WriteLn(pMyFile,sTitle); //新建csv，先写入标题
+ end;
+ WriteLn(pMyFile,sMsg); //写入内容
+ finally
+ CloseFile(pMyFile);
+ end;
+end;
+
+//刷新设备故障码
+function RefashFaultCode(cod:Integer):string;
+var
+ str : string;
+begin
+ //翻译cod
+ case cod of
+ -1:str := '通讯故障';
+ 0: str := '正常';
+ 1: str := '上阀门关故障';
+ 2: str := '下阀门关故障';
+ 3: str := '双阀门关故障';
+ 4: str := '上阀门开故障';
+ 5: str := '上阀门开关故障';
+ 6: str := '上阀门开、下阀门关故障';
+ 7: str := '上阀门开关、下阀门关故障';
+ 8: str := '下阀门开故障';
+ 9: str := '下阀门开、上阀门关故障';
+ 10: str := '下阀门开关故障';
+ 11: str := '下阀门开关、上阀门关故障';
+ 12: str := '双阀门开故障';
+ 13: str := '上阀门开关、下阀门开故障';
+ 14: str := '下阀门开关、上阀门开故障';
+ 15: str := '双阀门开关故障';
+ 16: str := '没有粮食在漏斗中';
+ 32: str := '抽屉没有放好';
+ 256:str := '故障重启';
+ else str := '故障未定义';
+ end;
+
+ //返回故障字符串
+ result := str;
+
+ //输出到界面
+ with frmMain do begin
+ sLabel72.Caption := Format('设备状态-[%s]',[str]); //更新调整截距界面
+ sLabel73.Caption := Format('设备状态-[%s]',[str]); //更新手动检测界面
+ sLabel74.Caption := Format('设备状态-[%s]',[str]); //更新自动模式界面
+ sLabel75.Caption := Format('设备状态-[%s]',[str]); //更新手动校准界面
+ sLabel76.Caption := Format('设备状态-[%s]',[str]); //更新手动模式界面
+ sLabel77.Caption := Format('设备状态-[%s]',[str]); //更新仪器维护界面
+
+ //修改样式
+ if cod=0 then begin
+ sLabel72.Font.Color := clLime;
+ sLabel73.Font.Color := clLime;
+ sLabel74.Font.Color := clLime;
+ sLabel75.Font.Color := clLime;
+ sLabel76.Font.Color := clLime;
+ sLabel77.Font.Color := clLime;
+ end
+ else if (cod>=1)or(cod<=15) then begin
+ sLabel72.Font.Color := clRed;
+ sLabel73.Font.Color := clRed;
+ sLabel74.Font.Color := clRed;
+ sLabel75.Font.Color := clRed;
+ sLabel76.Font.Color := clRed;
+ sLabel77.Font.Color := clRed;
+ end
+ else begin
+ sLabel72.Font.Color := clSilver;
+ sLabel73.Font.Color := clSilver;
+ sLabel74.Font.Color := clSilver;
+ sLabel75.Font.Color := clSilver;
+ sLabel76.Font.Color := clSilver;
+ sLabel77.Font.Color := clSilver;
+ end;
+
+ //强制刷新标签
+ sLabel72.Repaint;
+ sLabel73.Repaint;
+ sLabel74.Repaint;
+ sLabel75.Repaint;
+ sLabel76.Repaint;
+ sLabel77.Repaint;
+ end;
+end;
+
+//自动模式下，刷新设备故障码
+function AutoFaultCode(cod:Integer):string;
+var
+ str : string;
+begin
+ //翻译cod
+ case cod of
+ -1:str := '通讯故障';
+ 0: str := '未知故障';
+ 1: str := '上阀门关故障';
+ 2: str := '下阀门关故障';
+ 3: str := '双阀门关故障';
+ 4: str := '上阀门开故障';
+ 5: str := '上阀门开关故障';
+ 6: str := '上阀门开、下阀门关故障';
+ 7: str := '上阀门开关、下阀门关故障';
+ 8: str := '下阀门开故障';
+ 9: str := '下阀门开、上阀门关故障';
+ 10: str := '下阀门开关故障';
+ 11: str := '下阀门开关、上阀门关故障';
+ 12: str := '双阀门开故障';
+ 13: str := '上阀门开关、下阀门开故障';
+ 14: str := '下阀门开关、上阀门开故障';
+ 15: str := '双阀门开关故障';
+ 16: str := '没有粮食在漏斗中';
+ 32: str := '抽屉没有放好';
+ 256:str := '故障重启';
+ else str := '故障未定义';
+ end;
+ //输出到界面
+ with frmMain do begin
+ //更新自动模式界面
+ sLabel74.Caption := Format('设备状态-[%s]',[str]);
+ //修改样式
+ sLabel74.Font.Color := clRed;
+ sLabel74.Repaint;
+ end;
+ //返回故障字符串
+ result := str;
+end;
+
+end.
--
Gitblit v1.9.3