dyp/pas/uPucFun.pas

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.