Initial commit - Delphi MES client project
This commit is contained in:
Developer
+341
@@ -0,0 +1,341 @@
|
||||
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
|
||||
|
||||
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;
|
||||
result := 'QMES' + #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;
|
||||
var
|
||||
i,vii,iii:integer;
|
||||
V,VV,VVV:Integer;
|
||||
s:string;
|
||||
begin
|
||||
VVV:= Value;
|
||||
i:= VVV div 34;
|
||||
|
||||
while i*34<VVV do
|
||||
begin
|
||||
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);
|
||||
end;
|
||||
|
||||
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;
|
||||
var
|
||||
i,y: integer;
|
||||
s:string;
|
||||
iss:long;
|
||||
begin
|
||||
Result := 0;
|
||||
try
|
||||
iss:= 0;
|
||||
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);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WorkLog.Error('转换错误: %s', [E.Message]);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure SetTime(Value: String);
|
||||
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;
|
||||
DateTime:=VarToDateTime(Value);
|
||||
DateTimeToSystemTime(DateTime,systemtime);
|
||||
SetLocalTime(SystemTime);
|
||||
GetLocalTime(SystemTime);
|
||||
DateTime:=SystemTimeToDateTime(SystemTime);
|
||||
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);
|
||||
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.
|
||||
Reference in New Issue
Block a user