unitpubfunction.pas

对俄罗斯火花雷达进行控制

unit UnitPubFunction;

interface

uses Windows, SysUtils, Forms, IniFiles, ADODB, Graphics, FileCtrl,
     PlateDSPV2_TLB, Unit_Declare, Registry, RzCmboBx, Classes, Unit1,
     TLHelp32;

    function hex(c:char):Integer ;
    function HexToInt(S:String): Integer;
    function shsjh : string;                                                    //随机数函数
    function shsjh1 : string;
    function CpoyName(SN: string):string;
    function GetPicTime: string;
    function GetData: integer;   
    procedure Delay(MSecs: Longint);
    procedure ErrorMsgBox(title,msg:string);                                    //错误对话框
    procedure ErrorMessage(tile:string;msg:string);
    procedure EnterKey(var key: Char);
    procedure SaveDBtoXml(qry : TADOQuery; XmlFileName : string);
    procedure TransfersSaveDBtoXml(qry : TADOQuery; XmlFileName : string);
    function SmallCar_IsNo(Speed_Int_Num: Integer): Boolean;
    function TitleText(TTComId, TTLawlessTime, TTLawlessAddress , TTMph , TTPrincipal , TTLimitSpeed : string):string;
    procedure AddNearPicTitle(PltV3:TPlateDSP2V; TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed : string ; TopY :Integer);
    function AddLongOnePicTitle(BmpPic1:TBitmap; TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed : string ; TopY :Integer): TBitmap;
    procedure GetComX(ComBox : TRzComboBox);
    function GetFactSpeed(SpeedN : string): string;
    procedure DvrAllData;
    function CopyDate(DT:string):string;
    function CopyTime(TT:string):string;
    procedure DelFlistFile(flist:TFileListBox;filename:string);
    procedure killexe(exename:string);
    function DeletePath(mDirName: string): Boolean;


implementation

function hex(c:Char):Integer;
var
      x:integer;
begin
     if c=' ' then
        x:=0
     else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
     else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
     else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
     else
        //输入错误
        x:=-1;
      Result:=x;
end;

function HexToInt(S:String): Integer;
var
    tmpInt1,tmpInt2:Integer ;
begin
   if Length(S)=1 then
   begin
      Result:=hex(S[1]);
   end
   else if Length(S)=2 then
   begin
      tmpInt1:=hex(S[1]);
      tmpInt2:=hex(S[2]);
      if (tmpInt1=-1) or (tmpInt2=-1) then
          Result:=-1
      else
          Result:= tmpInt1*16+tmpInt2;
      end
   else
      //输入错误，转换失败
      Result:=-1;
end;

function shsjh : string;
var
    motime : Tsystemtime;
    j : integer;
//    a1 : DWORD;
    a2,A3 : dword;
    getstr : STRING;
begin
     A3:=GetTickCount();
     WHILE (A3=GetTickCount()) DO ;
     A3:=GetTickCount();
     getsystemtime(motime);
     a2:=(motime.whour*3600+motime.wminute*60+motime.wsecond)*1000+A3 mod 1000;
     getstr:='';
     while a2>36 do
     begin
      j:=a2 mod 36;
      if j<10 then getstr:=inttostr(j)+getstr else getstr:=chr(j+55)+getstr;
      a2:=a2 div 36;
     end;
     result:=copy(getstr,2,3);
end;

function shsjh1 : string;
var
    i:integer;
    sjs : string;
begin
//    for j:=0 to 1000 do
//    begin
    Randomize;
    i := Random(1000);
    if Length(IntToStr(i)) < 3 then
    begin
        if Length(IntToStr(i)) = 1 then
        begin
           sjs := '00' + IntToStr(i);
        end
        else
        begin
           sjs := '0' + IntToStr(i);
        end;
    end
    else
    begin
        sjs := IntToStr(i);
    end;
    Result := sjs;
//    end;
end;

function CpoyName(SN: string):string;
var
    i : Integer;
begin
       i := Length(SN);
       SN := Copy(SN, 1, i-4);
       Result := SN;
end;

procedure Delay(MSecs: Integer);
var
  c1:int64;
  t1,t2:int64;
//  r1:double;
begin
    QueryPerformanceFrequency(c1);                                              //WINDOWS API 返回计数频率(Intel86:1193180)(获得系统的高性能频率计数器在一毫秒内的震动次数)
    QueryPerformanceCounter(t1);                                                //WINDOWS API 获取开始计数值
    repeat
      Application.ProcessMessages;
      QueryPerformanceCounter(t2);                                              //获取结束计数值
    until (((t2-t1)/c1*1000) >= MSecs)
//    r1:=(t2-t1)/c1;//取得计时时间，单位秒(s)
//    r1:=(t2-t1)/c1*1000000;//取得计时时间，单位微秒
end;

procedure ErrorMessage(tile:string;msg:string);
var
  myini:TIniFile ;
begin
  myini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'\'+'error.ini');
  myini.WriteString(tile,DateTimeToStr(now),msg);
end;

procedure ErrorMsgBox(title,msg:string);  //对话框
begin
  if title='' then
    title:='提示';
  Application.messagebox(PChar(msg), PChar(title), mb_ok + MB_ICONSTOP);
end;

procedure EnterKey(var key: Char);
begin
     if (Key='0') or (Key='1') or (Key='2') or (Key='3') or (Key='4') or (Key='5') or (Key='6') or (Key='7') or (Key='8') or (Key='9') or (Key=Chr(8)) or (Key=Chr(46)) then
     begin
       Exit;
     end
     else
     begin
         Key := #0;
     end;
end;

procedure SaveDBtoXml(qry : TADOQuery; XmlFileName : string);
var
    XmlPath:string;
begin
    XmlPath := ExtractFilePath(Application.ExeName) + 'XmlFile\';
    qry.SaveToFile(XmlPath + XmlFileName,pfXML);
end;

procedure TransfersSaveDBtoXml(qry : TADOQuery; XmlFileName : string);
begin
    qry.SaveToFile(XmlFileName,pfXML);
end;

function SmallCar_IsNo(Speed_Int_Num: Integer): Boolean;        //小车是否超速
begin
    if Speed_Int_Num >= StrToInt(FactSmallSpeed) then
       Result:=True
    else
       Result:=False;
end;

function TitleText(TTComId, TTLawlessTime, TTLawlessAddress , TTMph , TTPrincipal , TTLimitSpeed : string):string;
var
    ALawlessTime, ALawlessAddress , AMph , APrincipal , ALimitSpeed : string;
    Title : string;
begin
    if AddTime = '1' then
    begin
        ALawlessTime := '时间:' + TTLawlessTime + ' ';
    end
    else
    begin
        ALawlessTime := '';
    end;
    if AddIllicitly = '1' then
    begin
        ALawlessAddress :='违法地点:' + TTLawlessAddress + ' ';
    end
    else
    begin
        ALawlessAddress := '';
    end;
    if AddMph = '1' then
    begin
        AMph := '速度:' + TTMph +' ';
    end
    else
    begin
        AMph := '';
    end;
    if AddPrincipal = '1' then
    begin
        APrincipal := '执法人:' + TTPrincipal + ' ';
    end
    else
    begin
        APrincipal := '';
    end;
    if AddLimitSpeed = '1' then
    begin
        ALimitSpeed := '限速:' + TTLimitSpeed + 'KM/h ';
    end
    else
    begin
        ALimitSpeed := '';
    end;


    Title := TTComId + ALawlessTime + ALawlessAddress + AMph + APrincipal + ALimitSpeed;
    Result := Title;
end;

procedure AddNearPicTitle(PltV3:TPlateDSP2V; TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed : string ; TopY :Integer);
var
    TitleInfo : string;
begin
    TitleInfo := TitleText(TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed);
    PltV3.setImageStreamTitle(-1,-1,'');
    PltV3.setImageStreamTitle(1,TopY,WideString(TitleInfo));
end;

function AddLongOnePicTitle(BmpPic1:TBitmap; TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed : string ; TopY :Integer): TBitmap;
var
    TitleInfo : string;
begin
    TitleInfo := TitleText(TComId, TLawlessTime, TLawlessAddress , TMph , TPrincipal , TLimitSpeed);
    TextOut(BmpPic1.Canvas.Handle,1,TopY,PChar(TitleInfo),Length(TitleInfo));
    Result := BmpPic1;
end;

function GetPicTime: string;                                                    //获得系统时间函数
var
    tm : SYSTEMTIME;
begin
    GetLocalTime(tm);
    Result := IntToStr(tm.wYear) + '-' + IntToStr(tm.wMonth) + '-' + IntToStr(tm.wDay) + ' ' +
              IntToStr(tm.wHour) + ':' + IntToStr(tm.wMinute) + ':' + IntToStr(tm.wSecond);
end;

function GetData: integer;
begin
    Result := strtoint(FormatDateTime('yyyymmdd',now()));
end;

procedure GetComX(ComBox : TRzComboBox);
var
    my : TRegistry;
    i : Integer;
begin
    my := TRegistry.Create;
    my.RootKey := HKEy_LOCAL_MACHINE;
    my.OpenKey('HARDWARE\\DEVICEMAP\\SERIALCOMM',True);
    ComBox.Sorted := False;
    my.GetValueNames(ComBox.Items);
    ComBox.Items.BeginUpdate;
    for i := 0 to ComBox.Items.Count - 1 do
    begin
        ComBox.Items.Strings[i] := my.ReadString(ComBox.Items.Strings[i]);
        ComBox.Items.EndUpdate;
        ComBox.Sorted := True;
    end;
end;

function GetFactSpeed(SpeedN : string): string;
var
    FactSpeed : Integer;
begin
    FactSpeed := Trunc(StrToInt(SpeedN) / 10 + strToInt(SpeedN));
    Result := IntToStr(FactSpeed);
end;

procedure DvrAllData;
begin
//    PositionNum := PositionNum + 1;
////    myDVRini.WriteString('plate',inttostr(plt.getDvrCurrentPosition),Plt.getPlateNumber);
//    myDVRini.WriteString('speed',inttostr(PositionNum),inttostr(Targetspeed));
//    myDVRini.WriteString('datetime',inttostr(PositionNum),DateTimeToStr(now));
end;

function CopyDate(DT: string): string;
var
    i : Integer;
begin
    i := Length(DT);
    DT := Copy(DT, 1, i-14);
    Result := DT;
end;

function CopyTime(TT: string): string;
var
    i,j : Integer;
begin
    i := Length(TT);
    for j := 1 to i-14 do
    Delete(TT, 1, 1);
    Result := TT;
end;

procedure DelFlistFile(flist:TFileListBox;filename:string);
var
  tems:TStrings;
  i,j:Integer;
begin
  tems := TStrings.Create;
  tems := flist.Items;
  j := -1;

 for i:=0 to tems.Count-1 do
   begin
    if tems.Strings[i]=filename then
      j:=i;
   end;
   if j>=0 then
   flist.Items.Delete(j);
end;

procedure killexe(exename:string);
var
    lppe:tprocessentry32;
    sshandle:thandle;
    hh:hwnd;
    found:boolean;
begin
    sshandle :=createtoolhelp32snapshot(TH32CS_SNAPALL,0);
    found :=process32first(sshandle,lppe);
    while found do
    begin
        if uppercase(extractfilename(lppe.szExeFile))=exename then //**
        begin
          hh:=OpenProcess(PROCESS_ALL_ACCESS,true,lppe.th32ProcessID);
          TerminateProcess(hh,0);
        end;
        found:=process32next(sshandle,lppe);
    end;
end;

function DeletePath(mDirName: string): Boolean; { 返回删除指定目录是否成功 }
var
  vSearchRec: TSearchRec;
  vPathName: string;
  K: Integer;  
begin
  Result := True;
  vPathName := mDirName + '\*.*';
  K := FindFirst(vPathName, faAnyFile, vSearchRec);
  while K = 0 do begin
    if (vSearchRec.Attr and faDirectory > 0) and
      (Pos(vSearchRec.Name, '..') = 0) then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, faDirectory);
      Result := DeletePath(mDirName + '\' + vSearchRec.Name);
    end else if Pos(vSearchRec.Name, '..') = 0 then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, 0);
      Result := DeleteFile(PChar(mDirName + '\' + vSearchRec.Name));
    end;
    if not Result then Break;
    K := FindNext(vSearchRec);
  end;
  FindClose(vSearchRec);
  Result := RemoveDir(mDirName);
end; { DeletePath }

end.