Initial commit - Delphi MES client project

This commit is contained in:
Developer
2026-05-07 20:25:34 +08:00
commit 819b4824f6
466 changed files with 1176403 additions and 0 deletions
+751
View File
@@ -0,0 +1,751 @@
unit uConfigManager;
interface
uses
SysUtils, Classes, System.JSON, System.Generics.Collections, System.IniFiles,
System.IOUtils, System.Rtti, System.StrUtils;
type
TConfigValueType = (cvString, cvInteger, cvBoolean, cvFloat, cvArray, cvObject);
TConfigItem = record
Key: string;
Value: TValue;
ValueType: TConfigValueType;
DefaultValue: TValue;
Description: string;
Section: string;
procedure Clear;
class function Create(const AKey, ASection: string; AValue: TValue; ADescription: string = ''): TConfigItem; static;
end;
TConfigManager = class
private
FConfigFile: string;
FConfigItems: TDictionary<string, TConfigItem>;
FINIFile: TIniFile;
FJSONFile: string;
FIsReadOnly: Boolean;
FAutoSave: Boolean;
procedure LoadFromINI;
procedure SaveToINI;
procedure LoadFromJSON;
procedure SaveToJSON;
function GetFullKey(const Section, Key: string): string;
function GetConfigValue(const Key: string; const Default: TValue): TValue;
public
constructor Create(const AConfigFile: string; AAutoSave: Boolean = True);
destructor Destroy; override;
procedure Load;
procedure Save;
function GetString(const Section, Key, Default: string): string;
function GetInteger(const Section, Key: string; Default: Integer): Integer;
function GetBoolean(const Section, Key: string; Default: Boolean): Boolean;
function GetFloat(const Section, Key: string; Default: Double): Double;
function GetArray(const Section, Key: string; Default: TArray<string>): TArray<string>;
function GetObject(const Section, Key: string; Default: TJSONObject = nil): TJSONObject;
procedure SetString(const Section, Key, Value: string);
procedure SetInteger(const Section, Key: string; Value: Integer);
procedure SetBoolean(const Section, Key: string; Value: Boolean);
procedure SetFloat(const Section, Key: string; Value: Double);
procedure SetArray(const Section, Key: string; Value: TArray<string>);
procedure SetObject(const Section, Key: string; Value: TJSONObject);
procedure AddConfigItem(const Item: TConfigItem);
function HasKey(const Section, Key: string): Boolean;
procedure RemoveKey(const Section, Key: string);
procedure Clear;
function GetAllKeys(const Section: string): TArray<string>;
property ConfigFile: string read FConfigFile write FConfigFile;
property IsReadOnly: Boolean read FIsReadOnly write FIsReadOnly;
property AutoSave: Boolean read FAutoSave write FAutoSave;
end;
TAppConfig = class
private
FConfigManager: TConfigManager;
public
constructor Create;
destructor Destroy; override;
property ConfigMgr: TConfigManager read FConfigManager;
function GetServerURL: string;
function GetServerPort: Integer;
function GetTimeout: Integer;
function GetRetryCount: Integer;
function GetPLCHost: string;
function GetPLCPort: Integer;
function GetSerialPort: string;
function GetBaudRate: Integer;
function GetBatchSize: Integer;
function GetAutoSave: Boolean;
function GetLogLevel: Integer;
function GetFileServerPath: string;
function GetBackupServerPath: string;
function GetSyncInterval: Integer;
function GetMaxRetryCount: Integer;
function GetLogFileDir: string;
function GetLogFileMaxSize: Integer;
function GetCORSOrigin: string;
function GetAPIPath: string;
function GetAdminAPIPath: string;
procedure Save;
end;
function Config: TAppConfig;
implementation
var
FAppConfig: TAppConfig;
function Config: TAppConfig;
begin
if FAppConfig = nil then
FAppConfig := TAppConfig.Create;
Result := FAppConfig;
end;
{ TConfigItem }
procedure TConfigItem.Clear;
begin
Key := '';
Value := TValue.Empty;
ValueType := cvString;
DefaultValue := TValue.Empty;
Description := '';
Section := '';
end;
class function TConfigItem.Create(const AKey, ASection: string; AValue: TValue; ADescription: string): TConfigItem;
begin
Result.Key := AKey;
Result.Section := ASection;
Result.Value := AValue;
Result.DefaultValue := AValue;
Result.Description := ADescription;
if AValue.IsType<string> then
Result.ValueType := cvString
else if AValue.IsType<Integer> then
Result.ValueType := cvInteger
else if AValue.IsType<Boolean> then
Result.ValueType := cvBoolean
else if AValue.IsType<Double> then
Result.ValueType := cvFloat
else
Result.ValueType := cvString;
end;
{ TConfigManager }
constructor TConfigManager.Create(const AConfigFile: string; AAutoSave: Boolean);
begin
inherited Create;
FConfigFile := AConfigFile;
FConfigItems := TDictionary<string, TConfigItem>.Create;
FAutoSave := AAutoSave;
FIsReadOnly := False;
FJSONFile := ChangeFileExt(AConfigFile, '.json');
Load;
end;
destructor TConfigManager.Destroy;
begin
if FAutoSave then
Save;
FConfigItems.Free;
if Assigned(FINIFile) then
FINIFile.Free;
inherited;
end;
function TConfigManager.GetFullKey(const Section, Key: string): string;
begin
Result := Section + '.' + Key;
end;
function TConfigManager.GetConfigValue(const Key: string; const Default: TValue): TValue;
var
Item: TConfigItem;
begin
if FConfigItems.TryGetValue(Key, Item) then
Result := Item.Value
else
Result := Default;
end;
procedure TConfigManager.LoadFromINI;
var
Sections: TStringList;
Section, Key, ValueStr: string;
Items: TStringList;
I, J: Integer;
begin
if not FileExists(FConfigFile) then
Exit;
FINIFile := TIniFile.Create(FConfigFile);
try
Sections := TStringList.Create;
try
FINIFile.ReadSections(Sections);
for I := 0 to Sections.Count - 1 do
begin
Section := Sections[I];
Items := TStringList.Create;
try
FINIFile.ReadSection(Section, Items);
for J := 0 to Items.Count - 1 do
begin
Key := Items[J];
ValueStr := FINIFile.ReadString(Section, Key, '');
FConfigItems.AddOrSetValue(GetFullKey(Section, Key),
TConfigItem.Create(Key, Section, TValue.From(ValueStr)));
end;
finally
Items.Free;
end;
end;
finally
Sections.Free;
end;
finally
FINIFile.Free;
FINIFile := nil;
end;
end;
procedure TConfigManager.SaveToINI;
var
Item: TConfigItem;
FullKey: string;
begin
FINIFile := TIniFile.Create(FConfigFile);
try
for FullKey in FConfigItems.Keys do
begin
Item := FConfigItems[FullKey];
case Item.ValueType of
cvString:
FINIFile.WriteString(Item.Section, Item.Key, Item.Value.AsType<string>);
cvInteger:
FINIFile.WriteInteger(Item.Section, Item.Key, Item.Value.AsType<Integer>);
cvBoolean:
FINIFile.WriteBool(Item.Section, Item.Key, Item.Value.AsType<Boolean>);
cvFloat:
FINIFile.WriteFloat(Item.Section, Item.Key, Item.Value.AsType<Double>);
end;
end;
finally
FINIFile.Free;
FINIFile := nil;
end;
end;
procedure TConfigManager.LoadFromJSON;
var
JSONStr: string;
JSONObj: TJSONObject;
Section, Key: string;
SectionObj: TJSONObject;
Pair: TJSONPair;
InnerPair: TJSONPair;
Val: TValue;
begin
if not FileExists(FJSONFile) then
Exit;
JSONStr := TFile.ReadAllText(FJSONFile, TEncoding.UTF8);
JSONObj := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObj = nil then
Exit;
try
for Pair in JSONObj do
begin
Section := Pair.JsonString.Value;
if Pair.JsonValue is TJSONObject then
begin
SectionObj := Pair.JsonValue as TJSONObject;
for InnerPair in SectionObj do
begin
Key := InnerPair.JsonString.Value;
Val := TValue.From(InnerPair.JsonValue.Value);
FConfigItems.AddOrSetValue(GetFullKey(Section, Key),
TConfigItem.Create(Key, Section, Val));
end;
end;
end;
finally
JSONObj.Free;
end;
end;
procedure TConfigManager.SaveToJSON;
var
JSONObj: TJSONObject;
SectionObj: TJSONObject;
Item: TConfigItem;
FullKey: string;
Sections: TDictionary<string, TJSONObject>;
begin
JSONObj := TJSONObject.Create;
Sections := TDictionary<string, TJSONObject>.Create;
try
for FullKey in FConfigItems.Keys do
begin
Item := FConfigItems[FullKey];
if not Sections.TryGetValue(Item.Section, SectionObj) then
begin
SectionObj := TJSONObject.Create;
Sections.Add(Item.Section, SectionObj);
JSONObj.AddPair(Item.Section, SectionObj);
end;
case Item.ValueType of
cvString:
SectionObj.AddPair(Item.Key, Item.Value.AsType<string>);
cvInteger:
SectionObj.AddPair(Item.Key, TJSONNumber.Create(Item.Value.AsType<Integer>));
cvBoolean:
SectionObj.AddPair(Item.Key, TJSONBool.Create(Item.Value.AsType<Boolean>));
cvFloat:
SectionObj.AddPair(Item.Key, TJSONNumber.Create(Item.Value.AsType<Double>));
cvArray, cvObject:
SectionObj.AddPair(Item.Key, TJSONString.Create(Item.Value.AsType<string>));
end;
end;
TFile.WriteAllText(FJSONFile, JSONObj.ToJSON, TEncoding.UTF8);
finally
JSONObj.Free;
Sections.Free;
end;
end;
procedure TConfigManager.Load;
begin
FConfigItems.Clear;
if FileExists(FConfigFile) then
LoadFromINI
else if FileExists(FJSONFile) then
LoadFromJSON;
end;
procedure TConfigManager.Save;
begin
if FIsReadOnly then
Exit;
if EndsText('.ini', FConfigFile) then
SaveToINI
else
SaveToJSON;
end;
function TConfigManager.GetString(const Section, Key, Default: string): string;
var
FullKey: string;
Val: TValue;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(Default));
Result := Val.AsType<string>;
end;
function TConfigManager.GetInteger(const Section, Key: string; Default: Integer): Integer;
var
FullKey: string;
Val: TValue;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(Default));
Result := Val.AsType<Integer>;
end;
function TConfigManager.GetBoolean(const Section, Key: string; Default: Boolean): Boolean;
var
FullKey: string;
Val: TValue;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(Default));
Result := Val.AsType<Boolean>;
end;
function TConfigManager.GetFloat(const Section, Key: string; Default: Double): Double;
var
FullKey: string;
Val: TValue;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(Default));
Result := Val.AsType<Double>;
end;
function TConfigManager.GetArray(const Section, Key: string; Default: TArray<string>): TArray<string>;
var
FullKey: string;
Val: TValue;
JSONStr: string;
JSONArray: TJSONArray;
I: Integer;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(string('[]')));
JSONStr := Val.AsType<string>;
JSONArray := TJSONArray.ParseJSONValue(JSONStr) as TJSONArray;
if JSONArray = nil then
begin
Result := Default;
Exit;
end;
try
SetLength(Result, JSONArray.Count);
for I := 0 to JSONArray.Count - 1 do
Result[I] := JSONArray.Items[I].Value;
finally
JSONArray.Free;
end;
end;
function TConfigManager.GetObject(const Section, Key: string; Default: TJSONObject): TJSONObject;
var
FullKey: string;
Val: TValue;
JSONStr: string;
begin
FullKey := GetFullKey(Section, Key);
Val := GetConfigValue(FullKey, TValue.From(string('{}')));
JSONStr := Val.AsType<string>;
Result := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if Result = nil then
Result := Default;
end;
procedure TConfigManager.SetString(const Section, Key, Value: string);
var
FullKey: string;
Item: TConfigItem;
begin
FullKey := GetFullKey(Section, Key);
Item := TConfigItem.Create(Key, Section, TValue.From(Value));
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.SetInteger(const Section, Key: string; Value: Integer);
var
FullKey: string;
Item: TConfigItem;
begin
FullKey := GetFullKey(Section, Key);
Item := TConfigItem.Create(Key, Section, TValue.From(Value));
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.SetBoolean(const Section, Key: string; Value: Boolean);
var
FullKey: string;
Item: TConfigItem;
begin
FullKey := GetFullKey(Section, Key);
Item := TConfigItem.Create(Key, Section, TValue.From(Value));
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.SetFloat(const Section, Key: string; Value: Double);
var
FullKey: string;
Item: TConfigItem;
begin
FullKey := GetFullKey(Section, Key);
Item := TConfigItem.Create(Key, Section, TValue.From(Value));
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.SetArray(const Section, Key: string; Value: TArray<string>);
var
FullKey: string;
Item: TConfigItem;
JSONArray: TJSONArray;
I: Integer;
begin
FullKey := GetFullKey(Section, Key);
JSONArray := TJSONArray.Create;
try
for I := 0 to Length(Value) - 1 do
JSONArray.Add(Value[I]);
Item := TConfigItem.Create(Key, Section, TValue.From(JSONArray.ToJSON));
finally
JSONArray.Free;
end;
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.SetObject(const Section, Key: string; Value: TJSONObject);
var
FullKey: string;
Item: TConfigItem;
JSONStr: string;
begin
FullKey := GetFullKey(Section, Key);
if Value = nil then
JSONStr := '{}'
else
JSONStr := Value.ToJSON;
Item := TConfigItem.Create(Key, Section, TValue.From(JSONStr));
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
procedure TConfigManager.AddConfigItem(const Item: TConfigItem);
var
FullKey: string;
begin
FullKey := GetFullKey(Item.Section, Item.Key);
FConfigItems.AddOrSetValue(FullKey, Item);
if FAutoSave then
Save;
end;
function TConfigManager.HasKey(const Section, Key: string): Boolean;
begin
Result := FConfigItems.ContainsKey(GetFullKey(Section, Key));
end;
procedure TConfigManager.RemoveKey(const Section, Key: string);
begin
FConfigItems.Remove(GetFullKey(Section, Key));
if FAutoSave then
Save;
end;
procedure TConfigManager.Clear;
begin
FConfigItems.Clear;
if FAutoSave then
Save;
end;
function TConfigManager.GetAllKeys(const Section: string): TArray<string>;
var
FullKey: string;
Item: TConfigItem;
Count, I: Integer;
begin
Count := 0;
for FullKey in FConfigItems.Keys do
begin
Item := FConfigItems[FullKey];
if Item.Section = Section then
Inc(Count);
end;
SetLength(Result, Count);
I := 0;
for FullKey in FConfigItems.Keys do
begin
Item := FConfigItems[FullKey];
if Item.Section = Section then
begin
Result[I] := Item.Key;
Inc(I);
end;
end;
end;
{ TAppConfig }
constructor TAppConfig.Create;
begin
inherited Create;
FConfigManager := TConfigManager.Create(ExtractFilePath(ParamStr(0)) + 'config.ini');
if not FConfigManager.HasKey('Network', 'ServerURL') then
FConfigManager.SetString('Network', 'ServerURL', 'http://192.168.0.150:8080');
if not FConfigManager.HasKey('Network', 'ServerPort') then
FConfigManager.SetInteger('Network', 'ServerPort', 8080);
if not FConfigManager.HasKey('Network', 'Timeout') then
FConfigManager.SetInteger('Network', 'Timeout', 30000);
if not FConfigManager.HasKey('Network', 'RetryCount') then
FConfigManager.SetInteger('Network', 'RetryCount', 3);
if not FConfigManager.HasKey('Device', 'PLCHost') then
FConfigManager.SetString('Device', 'PLCHost', '192.168.1.100');
if not FConfigManager.HasKey('Device', 'PLCPort') then
FConfigManager.SetInteger('Device', 'PLCPort', 502);
if not FConfigManager.HasKey('Device', 'SerialPort') then
FConfigManager.SetString('Device', 'SerialPort', 'COM1');
if not FConfigManager.HasKey('Device', 'BaudRate') then
FConfigManager.SetInteger('Device', 'BaudRate', 9600);
if not FConfigManager.HasKey('Business', 'BatchSize') then
FConfigManager.SetInteger('Business', 'BatchSize', 100);
if not FConfigManager.HasKey('Business', 'AutoSave') then
FConfigManager.SetBoolean('Business', 'AutoSave', True);
if not FConfigManager.HasKey('Business', 'LogLevel') then
FConfigManager.SetInteger('Business', 'LogLevel', 2);
if not FConfigManager.HasKey('FileServer', 'FileServerPath') then
FConfigManager.SetString('FileServer', 'FileServerPath', '\\192.168.0.250\DataSava');
if not FConfigManager.HasKey('FileServer', 'BackupServerPath') then
FConfigManager.SetString('FileServer', 'BackupServerPath', '\\192.168.0.250\Backup');
if not FConfigManager.HasKey('Sync', 'SyncInterval') then
FConfigManager.SetInteger('Sync', 'SyncInterval', 60000);
if not FConfigManager.HasKey('Sync', 'MaxRetryCount') then
FConfigManager.SetInteger('Sync', 'MaxRetryCount', 5);
if not FConfigManager.HasKey('Log', 'LogFileDir') then
FConfigManager.SetString('Log', 'LogFileDir', ExtractFilePath(ParamStr(0)) + 'log');
if not FConfigManager.HasKey('Log', 'LogFileMaxSize') then
FConfigManager.SetInteger('Log', 'LogFileMaxSize', 10485760);
if not FConfigManager.HasKey('Network', 'CORSOrigin') then
FConfigManager.SetString('Network', 'CORSOrigin', '*');
if not FConfigManager.HasKey('Network', 'APIPath') then
FConfigManager.SetString('Network', 'APIPath', '/prod-api');
if not FConfigManager.HasKey('Network', 'AdminAPIPath') then
FConfigManager.SetString('Network', 'AdminAPIPath', '/admin-api');
end;
destructor TAppConfig.Destroy;
begin
FConfigManager.Free;
inherited;
end;
function TAppConfig.GetServerURL: string;
begin
Result := FConfigManager.GetString('Network', 'ServerURL', 'http://192.168.0.150:8080');
end;
function TAppConfig.GetServerPort: Integer;
begin
Result := FConfigManager.GetInteger('Network', 'ServerPort', 8080);
end;
function TAppConfig.GetTimeout: Integer;
begin
Result := FConfigManager.GetInteger('Network', 'Timeout', 30000);
end;
function TAppConfig.GetRetryCount: Integer;
begin
Result := FConfigManager.GetInteger('Network', 'RetryCount', 3);
end;
function TAppConfig.GetPLCHost: string;
begin
Result := FConfigManager.GetString('Device', 'PLCHost', '192.168.1.100');
end;
function TAppConfig.GetPLCPort: Integer;
begin
Result := FConfigManager.GetInteger('Device', 'PLCPort', 502);
end;
function TAppConfig.GetSerialPort: string;
begin
Result := FConfigManager.GetString('Device', 'SerialPort', 'COM1');
end;
function TAppConfig.GetBaudRate: Integer;
begin
Result := FConfigManager.GetInteger('Device', 'BaudRate', 9600);
end;
function TAppConfig.GetBatchSize: Integer;
begin
Result := FConfigManager.GetInteger('Business', 'BatchSize', 100);
end;
function TAppConfig.GetAutoSave: Boolean;
begin
Result := FConfigManager.GetBoolean('Business', 'AutoSave', True);
end;
function TAppConfig.GetLogLevel: Integer;
begin
Result := FConfigManager.GetInteger('Business', 'LogLevel', 2);
end;
function TAppConfig.GetFileServerPath: string;
begin
Result := FConfigManager.GetString('FileServer', 'FileServerPath', '\\192.168.0.250\DataSava');
end;
function TAppConfig.GetBackupServerPath: string;
begin
Result := FConfigManager.GetString('FileServer', 'BackupServerPath', '\\192.168.0.250\Backup');
end;
function TAppConfig.GetSyncInterval: Integer;
begin
Result := FConfigManager.GetInteger('Sync', 'SyncInterval', 60000);
end;
function TAppConfig.GetMaxRetryCount: Integer;
begin
Result := FConfigManager.GetInteger('Sync', 'MaxRetryCount', 5);
end;
function TAppConfig.GetLogFileDir: string;
begin
Result := FConfigManager.GetString('Log', 'LogFileDir', ExtractFilePath(ParamStr(0)) + 'log');
end;
function TAppConfig.GetLogFileMaxSize: Integer;
begin
Result := FConfigManager.GetInteger('Log', 'LogFileMaxSize', 10485760);
end;
function TAppConfig.GetCORSOrigin: string;
begin
Result := FConfigManager.GetString('Network', 'CORSOrigin', '*');
end;
function TAppConfig.GetAPIPath: string;
begin
Result := FConfigManager.GetString('Network', 'APIPath', '/prod-api');
end;
function TAppConfig.GetAdminAPIPath: string;
begin
Result := FConfigManager.GetString('Network', 'AdminAPIPath', '/admin-api');
end;
procedure TAppConfig.Save;
begin
FConfigManager.Save;
end;
end.
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+360
View File
@@ -0,0 +1,360 @@
unit uPucFun;
interface
uses SysUtils,Winapi.Messages,Winapi.Windows,FMX.Objects,System.Classes,FMX.Controls,
System.StrUtils, System.Variants, System.Win.Registry;
const arrStr34: Array[0..33] of String =('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','J','K','L','M','N','P','Q','R','S','T','U','V','W','X','Y','Z');
function GetSysTimeByFormate: string;
procedure ShowTouchKeyBoard();
procedure HideTouchKeyBoard();
procedure TxtShowErrorInfo(TxtError:TText;ErrorInfo:string);
function GetBuildInfo: string;
function CheckParameter(sValue:string;var sDevName,sIp,sPort:string):boolean;
procedure DelayedSetFocus(control:TControl);
procedure ShowNumericTouchKeyboard;
function IntToStr34(Value: Integer):String; //批号转34位
function Str34ToInt(Value: String):Integer; //34位转批号
procedure SetTime(Value: String);
procedure GetComPorts(var aComList: TStringList);
function GetComPortList: TStrings;
var
ComName, ComType, FactoryCode:String;
implementation
//引用单元:SysUtils
uses uSafeLog;//目的:实现跨环境兼容不同日期格式,如果不做强制格式处理,不同环境存在发生问题的可能性;
function GetSysTimeByFormate: string;
var
dtFormate: TFormatSettings;
begin
try
dtFormate.ShortDateFormat := 'yyyy/MM/dd';
dtFormate.DateSeparator := '/';
dtFormate.LongTimeFormat := 'hh:mm:ss';
dtFormate.TimeSeparator := ':';
Result := DateTimeToStr(Now(),dtFormate);
except
end;
end;
procedure ShowTouchKeyBoard();
VAR
ShellTrayWnd: THandle;
TrayHandle:HWND;
begin
HideTouchKeyBoard();
Sleep(100);
ShellTrayWnd := FindWindow('Shell_TrayWnd', nil);
if ShellTrayWnd > 0 then
begin
TrayHandle := FindWindowEx(ShellTrayWnd, 0, 'TrayNotifyWnd', nil);
if TrayHandle > 0 then
begin
TrayHandle := FindWindowEx(TrayHandle, 0, 'TIPBand', nil);
end;
end;
PostMessage(TrayHandle, WM_LBUTTONDOWN, MK_LBUTTON, $00010001);
PostMessage(TrayHandle, WM_LBUTTONUP, 0, $00010001);
end;
procedure HideTouchKeyBoard();
VAR
TrayHandle: THandle;
begin
TrayHandle:=FindWindow(pchar('IPTip_Main_Window'),nil);
if TrayHandle<>0 then PostMessage(TrayHandle,WM_SYSCOMMAND,SC_CLOSE,0);
end;
procedure TxtShowErrorInfo(TxtError:TText;ErrorInfo:string);
begin
TxtError.Visible:=ErrorInfo<>'';
TxtError.Text:=ErrorInfo;
end;
function GetBuildInfo: string; //获取版本号
var
verinfosize : DWORD;
verinfo : pointer;
vervaluesize : dword;
vervalue : pvsfixedfileinfo;
dummy : dword;
v1,v2,v3,v4 : word;
begin
verinfosize := getfileversioninfosize(pchar(paramstr(0)),dummy);
if verinfosize = 0 then begin
dummy := getlasterror;
result := '0.0.0.0';
Exit;
end;
getmem(verinfo,verinfosize);
try
if getfileversioninfo(pchar(paramstr(0)),0,verinfosize,verinfo) then
begin
if verqueryvalue(verinfo,'\',pointer(vervalue),vervaluesize) then
begin
with vervalue^ do begin
v1 := dwfileversionms shr 16;
v2 := dwfileversionms and $ffff;
v3 := dwfileversionls shr 16;
v4 := dwfileversionls and $ffff;
end;
// 使用Unicode字符串确保中文字符正确显示
result := '春景智慧工厂' + #13#10 + 'Version ' + IntToStr(v1) + '.' + IntToStr(v2) + '.' + IntToStr(v3) + '.' + IntToStr(v4);
end else
result := '0.0.0.0';
end else
result := '0.0.0.0';
finally
freemem(verinfo,verinfosize);
end;
end;
function CheckParameter(sValue:string;var sDevName,sIp,sPort:string):boolean;
var
tmpList:Tstrings;
i:integer;
begin
tmpList:=TStringlist.Create;
try
tmpList.DelimitedText:=sValue;
tmpList.Delimiter:=',';
Result:=(tmpList.Count=3) and (strtointdef(tmpList.Strings[2],0)<>0);
if Result then
begin
sDevName:=tmpList.Strings[0];
sIp:=tmpList.Strings[1];
sPort:=tmpList.Strings[2];
end;
finally
tmpList.Free;
end;
end;
procedure DelayedSetFocus(control:TControl);
begin
TThread.CreateAnonymousThread(
procedure
begin
TThread.Synchronize( nil,
procedure
begin
control.SetFocus;
end
);
end
).Start;
end;
function GetNumericTouchKeyboardHandle: HWND;
begin
Result := FindWindow('NumericKeyPadClass', nil);
end;
// 显示数字触摸键盘
procedure ShowNumericTouchKeyboard;
var
KeyboardHandle: HWND;
begin
KeyboardHandle := GetNumericTouchKeyboardHandle;
if KeyboardHandle <> 0 then
SendMessage(KeyboardHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
end;
// 隐藏数字触摸键盘
procedure HideNumericTouchKeyboard;
var
KeyboardHandle: HWND;
begin
KeyboardHandle := GetNumericTouchKeyboardHandle;
if KeyboardHandle <> 0 then
SendMessage(KeyboardHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
function IntToStr34(Value: Integer):String; //批号转34位
var
i,vii,iii:integer;
V,VV,VVV:Integer;
s:string;
begin
VVV:= Value; //123456 34T2
i:= VVV div 34;
while i*34<VVV do
begin
// if s<>'' then s:=s+',';
try
s:= ArrStr34[VVV-i*34]+s;
except
on E: Exception do
begin
WorkLog.Error('数组访问越界: %s', [E.Message]);
s := ''; // 设置默认值
end;
end;
VVV:= VVV div 34;
i:= VVV div 34;
end;
WorkLog.MessageInfo('IntToStr34:'+s);
Str34ToInt(s);
// if i*34<Value then
// begin
// v:= Value-i*34; //2
// end;
end;
// 添加缺失的Str34Index函数
function Str34Index(Value: String): Integer;
var
ii: integer;
begin
Result := -1;
for ii := Low(ArrStr34) to High(ArrStr34) do
if ArrStr34[ii] = Value then
begin
Result := ii;
Exit;
end;
end;
function Str34ToInt(Value: String):Integer; //34位转批号
var
i,y: integer;
s:string;
iss:long;
begin
Result := 0; // 初始化返回值
try
iss:= 0; //34T2 123456
for I := Length(Value) downto 1 do
begin
if Length(Value)-i=0 then
iss:=Str34Index(Value[I]);
if Length(Value)-i=1 then
iss:=iss+Str34Index(Value[I])*34;
if Length(Value)-i=2 then
iss:=iss+Str34Index(Value[I])*34*34;
if Length(Value)-i=3 then
iss:=iss+Str34Index(Value[I])*34*34*34;
s:= s+Value[I];
end;
WorkLog.MessageInfo('Int:'+intToStr(iss)+',s:'+s);
// RightStr();
except
on E: Exception do
begin
WorkLog.Error('转换错误: %s', [E.Message]);
end;
end;
end;
procedure SetTime(Value: String);
//delphi中设置系统时间方法
var
systemtime:Tsystemtime;
DateTime:TDateTime;
v:Variant;
function StrToDateTimeStr(Value1: String):String;
begin
if Value1='' then exit;
if pos('/',Value1)=0 then
begin
Result:= Copy(Value1,1,4)+'/'+Copy(Value1,5,2)+'/'+Copy(Value1,7,Length(Value1)-6);
end
else
Result:= Value1;
end;
begin
if Value='' then Exit;
Value:= StrToDateTimeStr(Value.Replace('T',' '));
WorkLog.MessageInfo('返回服务器日期时间:'+Value);
try
v:= Value;
// Format('yyyy/MM/dd HH:mm:ss',Value);
DateTime:=VarToDateTime(Value); //获得时间(TDateTime格式)
// WorkLog.MessageInfo('返回服务器日期时间1'+FormatDateTime('YYYY/MM/dd HH:mm:ss',DateTime));
DateTimeToSystemTime(DateTime,systemtime); //把Delphi的TDateTime格式转化为API的TSystemTime格式
SetLocalTime(SystemTime); //设置系统时间
GetLocalTime(SystemTime); //读取系统时间
DateTime:=SystemTimeToDateTime(SystemTime); //把API的TSystemTime格式 转化为 Delphi的TDateTime格式
//Edit2.Text:=DateTimeToStr(DateTime); //显示当前系统的时间
Except
end;
end;
procedure GetComPorts(var aComList: TStringList);
var
reg: TRegistry;
ts: TStrings;
i: integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\SerialComm', False);
ts := TStringList.Create;
reg.GetValueNames(ts);
WorkLog.MessageInfo('Com:'+ts.Text);
// self.mmo1.Lines.AddStrings(ts);
for i := 0 to ts.Count - 1 do
begin
aComList.Add(reg.ReadString(ts.Strings[i]));
WorkLog.MessageInfo(aComList.Strings[i]);
end;
ts.Free;
reg.CloseKey;
reg.Free;
end;
{ ----------------------获取端口列表-------------------------------- }
function GetComPortList: TStrings;
var
Reg: TRegistry;
sts1,sts2: TStrings;
i: Integer;
RegPath: string; //注册表中存放串口路径
begin
Result := nil;
Reg := TRegistry.Create;
try
sts1 := TStringList.Create;
try
sts2 := TStringList.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
RegPath := 'hardware\devicemap\SerialComm';
if Reg.OpenKey(RegPath, False) then
begin
Reg.GetValueNames(sts1);
WorkLog.MessageInfo('Com2:'+sts1.Text);
for i := 0 to sts1.Count-1 do
sts2.Add(Reg.ReadString(sts1.Strings[i]));
end;
Result := sts2;
sts2 := nil;
finally
FreeAndNil(sts1);
end;
finally
Reg.CloseKey;
FreeAndNil(Reg);
end;
end;
end.