unit RUtilites;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ToolWin, HexGrid, SendThread;

const
  WM_ThreadDoneErrMsg = WM_APP + 10;
  WM_ThreadDoneOkMsg = WM_APP + 11;
  strIsNotAnswer='Is not answer from programmer!';
  strIsNotValidAnswer='Is not valid answer from programmer!';
  strUnproperTreeView='Unproper TreeView';
  strIsNotAnswerFromDev='Is not answer from device!';

Type DataBuf = array[0..255] of byte;

Function HexB(B : Byte) : string;
Function Buf_to_HEXStr(N,Addr:Word;const Buf: array of byte):String;
Function HEXStr_to_Buf(str:string;var Addr,HiAddr:word;var Buf: array of byte):integer;
Function HEXStr_to_GridBuf(str:string;OffSet:Cardinal ;Buf:PDataBuf ):Word;
Function GridBuf_To_HEXStr(N,Addr:Word;OffSet:Longint ;const Buf: PDataBuf): String;
Function Addr_To_HEXstr(Addr:Longint): String;
Function GetCRC(str:String):string;
Procedure LoadHexFile(FName:String;Grid:THexGrid;LoFirstOrder:boolean);
Procedure LoadBinFile(FName:String;Grid:THexGrid);
Procedure SaveHexFile(FName:String;Grid:THexGrid);
Procedure SaveBinFile(FName:String;Grid:THexGrid);

Function DecodeReceivedBuf(var bufStr:String;InBuf:TThreadBuf;Cnt:word;DataBuf:PDataBuf;var Indx:Longint;len:byte):boolean;
Function DecodeReceivedBufToArray(var bufStr:string;InBuf:TThreadBuf;Cnt:word;var DataBuf:array of byte; var Indx:LongInt; len:byte):boolean;

Function CompareWithMask(b:word;strMask:string):boolean;
Function SetByMask(b:word;strMask:string):Word;
function SetVerMaskByMask(m:word;strMask:string):Word;
function GetTSC: Int64; assembler; stdcall;
function GetTSCLow: Cardinal;
function GetTSCHigh: Cardinal;
function DelayCalibrating: double;
procedure DelayUs(N:Longint);
var
  CalibrConst: double;

implementation


function HexB(B : Byte) : string;
const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';
begin
  SetLength(Result, 2);
  HexB[1] := Digits[B shr 4];
  HexB[2] := Digits[B and $F];
end;

Function Buf_To_HEXStr(N,Addr:Word;const Buf: array of byte): String;
var str:string;
    i:byte;
    CRC:byte;
begin

  if N=0 then begin
    Buf_To_HEXStr:=':00000001FF';
    Exit;
  end;
  CRC:=N+Lo(Addr)+Hi(Addr);
  str:=':'+HexB(N)+HexB(Hi(Addr))+HexB(Lo(Addr))+'00';
  for i:=0 to N-1 do
  begin
    str:=str+HexB(Buf[i]);
    CRC:=CRC+Buf[i];
  end;
  Buf_To_HEXStr:=str+HexB((not CRC) + 1);
end;

Function GridBuf_To_HEXStr(N,Addr:Word;OffSet:Longint ;const Buf: PDataBuf): String;
var str:string;
    i,b:byte;
    CRC:byte;
begin

  if N=0 then begin
    Result:=':00000001FF'+Chr($0d);
    Exit;
  end;
  CRC:=Byte(N+Lo(Addr)+Hi(Addr));
  str:=':'+HexB(N)+HexB(Hi(Addr))+HexB(Lo(Addr))+'00';
  for i:=0 to N-1 do
  begin
    b:=Buf^.data[i+OffSet];  
    str:=str+HexB(b);
    CRC:=Byte(CRC+b);
  end;
  Result:=str+HexB(Byte((not CRC) + 1))+Chr($0d);
end;

Function Addr_To_HEXstr(Addr:Longint): String;
var CRC:byte;
begin
  CRC:=6;
  Result:=':02000004'+HexB(Hi(Word(Addr)))+HexB(Lo(Word(Addr)));
  CRC:=CRC+Hi(Word(Addr))+Lo(Word(Addr));
  Result:=Result+HexB((not CRC) + 1)+#13+#10;
end;


Function HEXStr_to_Buf(str:string; var Addr,HiAddr:word; var Buf: array of byte):integer;
var i:integer;
    K,B,CRC:byte;
begin
  result:=0;
  Addr:=0;
  if str[1]<>':' then exit;
  if copy(str,8,2)='01' then exit;
  CRC:=0;
  try
   K:=StrToInt('$'+copy(str,2,2));
   Addr:=StrToInt('$'+copy(str,4,4));
  except
    Raise Exception.Create('Невозможна конвертация адресной части HEX строки:'+
                           #13+#10+Str);
  end;
  try
    for i:=0 to K-1 do
    begin
      B:=StrToInt('$'+copy(str,10+i*2,2));
      Buf[i]:=B;
      CRC:=Byte(CRC+B);
    end;
  except
    Raise Exception.Create('Невозможна конвертация данных HEX строки:'+#13+#10+Str);
  end;
  // Проверка контрольной суммы
  CRC:=Byte(CRC+K+StrToInt('$'+copy(str,4,2))+StrToInt('$'+copy(str,6,2))+StrToInt('$'+copy(str,8,2)));
  if HexB(Byte((CRC xor $FF)+1))<>copy(str,10+K*2,2) then
    Raise Exception.Create('Несовпадение контрольной суммы в HEX строке:'
                            +#13+#10+Str+#13+#10+'CRC='+HexB((CRC xor $FF)+1));
  if copy(str,8,2)='04' then
  begin
    result:=0;
    HiAddr:=StrToInt('$'+copy(str,10,4))
  end
  else
    result:=K;
end;

Function HEXStr_to_GridBuf(str:string;OffSet:Cardinal ;Buf:PDataBuf ):word;
var i:word;
    K,CRC:byte;
    Addr:Cardinal;
begin
  result:=0;
  if str[1]<>':' then
  begin
    result:=0;
    exit;
  end;
  if copy(str,8,2)='01' then exit;
  CRC:=0;
  K:=StrToInt('$'+copy(str,2,2));
  Addr:=StrToInt('$'+copy(str,4,4));
  for i:=0 to K-1 do
  begin
    CRC:=CRC+StrToInt('$'+copy(str,10+i*2,2));;
  end;
  // Проверка контрольной суммы
  CRC:=CRC+K+StrToInt('$'+copy(str,4,2))+StrToInt('$'+copy(str,6,2));
  if HexB((CRC xor $FF)+1)<>copy(str,10+K*2,2) then  exit;
  for i:=0 to K-1 do
  begin
    Buf^.data[i+OffSet+Addr]:=StrToInt('$'+copy(str,10+i*2,2))
  end;
  result:=k;
end;


Function GetCRC(str:String):string;
var i:integer;
    crc:byte;
begin
  result:='';
  crc:=0;
  str:=Copy(str,2,Length(str)-1);
  for i:=0 to (Length(str) div 2)-1 do
    crc:=crc+StrToInt(Copy(str,i*2+1,2));
  crc:=(crc xor $FF)+1;
  result:=Format('%.2x',[crc]);
end;



procedure LoadHexFile(FName:String;Grid:THexGrid;LoFirstOrder:boolean);
var FHexBuf:TStringList;
    i,j,N,AddrMin,AddrMax,LAddr:Longint;
    Buf:array[0..255] of byte;
    Addr,HiAddr:word;
    dcnt:Longint;
begin
  FHexBuf:=TStringList.Create;
  try
    FHexBuf.LoadFromFile(FName);
    AddrMin:=MaxLongInt;
    AddrMax:=0;
    HiAddr:=0;
    for i:=0 to FHexBuf.Count-1 do
    begin
      N:=HEXStr_to_Buf(FHexBuf.Strings[i],Addr,HiAddr,Buf);
      if N>0 then
      begin
        LAddr:=Addr+(HiAddr shl 16);
        if AddrMin>LAddr then AddrMin:=LAddr;
        if AddrMax<(LAddr+N-1) then AddrMax:=LAddr+N-1;
      end;
    end;
    if (AddrMax-AddrMin+1)>$1000000 then
       MessageDlg('File longer than 16 777 216 Byte!',mtError,[mbOK],0)
    else
    begin
       AddrMin:=0;
       dcnt:= Grid.DataCount;
       Grid.DataCount:=0;
       Grid.DataCount:=dcnt;
       dcnt:=AddrMax-AddrMin+1;

       if dcnt> Grid.DataCount then
         Grid.DataCount:= dcnt;
  //   Grid.BegAddr:=AddrMin;
      HiAddr:=0;
      for i:=0 to FHexBuf.count-1 do
      begin
        N:=HEXStr_to_Buf(FHexBuf.Strings[i],Addr,HiAddr,Buf);
        LAddr:=Addr+(HiAddr shl 16);
        for j:=0 to N-1 do
        begin
          if (LoFirstOrder=true) and (Grid.DataSize=dsWord) then
          begin
            if (j and 1) =0 then
              Grid.AData[j+LAddr-AddrMin+1]:=Buf[j]
            else
              Grid.AData[j+LAddr-AddrMin-1]:=Buf[j];
          end
          else
          begin
            Grid.AData[j+LAddr-AddrMin]:=Buf[j];
          end;
        end;
      end;
    end;
  finally
    FHexBuf.Free;
  end;
end;

procedure LoadBinFile(FName:String;Grid:THexGrid);
var FFile:TFileStream;
    Buf:PDataBuf;
    fsize,i:Longint;
begin
   FFile:=TFileStream.Create(FName,fmOpenRead);
   fsize:=FFile.Size;
   try
     if fsize>$1000000 then
       MessageDlg('File longer than 16 777 216 Byte!',mtError,[mbOK],0)
     else
     begin
       if fsize<Grid.DataCount then
       begin
         // Если файл меньше размера буфера текущей сетки то подстроить
         // его под размер сетки с дополнением байтами $FF
         Buf:=AllocMem(Grid.DataCount+SizeOf(Buf.Count));
         for i:=fsize to Grid.DataCount-1 do
           Buf^.data[i]:=$FF;
         try
           FFile.Read(Buf^.data[0],fsize);
           Buf^.count:=Grid.DataCount;
           Grid.AssignDataBuf(Buf);
         except
           FreeMem(Buf,FFile.size+SizeOf(Buf.Count)) ;
           Raise;
         end;
       end
       else
       begin
         Buf:=AllocMem(FFile.size+SizeOf(Buf.Count));
         try
           FFile.Read(Buf^.data[0],Grid.DataCount);
           Buf^.count:=Grid.DataCount;
           Grid.AssignDataBuf(Buf);
         except
           FreeMem(Buf,FFile.size+SizeOf(Buf.Count)) ;
           Raise;
         end;
       end;
     end;
   finally
     FFile.free;
   end;

end;

procedure SaveHexFile(FName:String;Grid:THexGrid);
var FFile:TFileStream;
    count,OldHiAddr,HiAddr,CurAddr,tmp:Longint;
    Addr:word;
    N:byte;
//    Buf:array[0..255] of byte;
    str:string;
    Pstr:PChar;
begin
  FFile:=TFileStream.Create(FName,fmCreate);
  try
  OldHiAddr:=0;
  count:=0;
  Addr:=Word(Grid.BegAddr);
  while count<Grid.DataCount do
  begin
    CurAddr:=Grid.BegAddr+Cardinal(count);
    HiAddr:=CurAddr shr 16;
    if HiAddr<>OldHiAddr then
    begin
      OldHiAddr:=HiAddr;
      str:=Addr_To_HEXstr(HiAddr);
      Pstr:=PChar(str);
      FFile.Write(Pstr^,Length(str));
    end;
    N:=16;
    tmp:=(((CurAddr shr 16)+1) shl 16)- CurAddr;
    if tmp < N then N:=tmp;
    tmp:=Grid.DataCount-Count;
    if tmp < N then N:=tmp;
    str:=GridBuf_To_HEXStr(N,addr,Count,Grid.DataBufer)+#10;
    Pstr:=PChar(str);
    FFile.Write(Pstr^,Length(str));
    count:=count+N;
    addr:=word(addr+N);
  end; {while}
  str:=':00000001FF';
  Pstr:=PChar(str);
  FFile.Write(Pstr^,Length(str));
  finally
    FFile.Free;
  end;
end;

procedure SaveBinFile(FName:String;Grid:THexGrid);
var FFile:TFileStream;
begin
   FFile:=TFileStream.Create(FName,fmCreate);
   try
     FFile.Write(PDataBuf(Grid.DataBufer)^.data[0],PDataBuf(Grid.DataBufer)^.count)
   finally
     FFile.free;
   end;
end;


Function DecodeReceivedBuf(var bufStr:string;InBuf:TThreadBuf;Cnt:word;DataBuf:PDataBuf; var Indx:LongInt; len:byte):boolean;
var i,j,k,l:integer;
    st:string;
begin

 result:=true;
 // сформировать строку данных
 for l:=0 to Cnt-1 do
 begin
   bufStr:=bufStr+InBuf[l];
   if InBuf[l]=Chr($0a) then
   begin
     k:=0;
     st:='';
     // искать в буфере знак =
     for i:=1 to Length(bufStr)-3 do
     begin
       if bufStr[i]='=' then
       begin
         for j:=i+1 to Length(bufStr)-1 do
           if bufStr[j] in ['0'..'9','a'..'f','A'..'F'] then
           begin
             st:=st+bufStr[j];
             if Length(st)=len then
             begin
               DataBuf^.data[k+indx]:=Byte(StrToInt('$'+st));
               k:=k+1;
               st:='';
             end;
           end
           else
           begin
             indx:=indx+k;
             bufStr:='';
             break;
           end;
         break;
       end;
     end;
   end;    {if #10}

   if InBuf[l]='>' then
   begin
     result:=false;
     exit;
   end;

 end;

end;


Function DecodeReceivedBufToArray(var bufStr:string;InBuf:TThreadBuf;Cnt:word;var DataBuf:array of byte; var Indx:LongInt; len:byte):boolean;
var i,j,k,l:integer;
    st:string;
begin

 result:=true;
 // сформировать строку данных
 for l:=0 to Cnt-1 do
 begin
   bufStr:=bufStr+InBuf[l];
   if InBuf[l]=Chr($0a) then
   begin
     k:=0;
     st:='';
     // искать в буфере знак =
     for i:=1 to Length(bufStr)-3 do
     begin
       if bufStr[i]='=' then
       begin
         for j:=i+1 to Length(bufStr)-1 do
           if bufStr[j] in ['0'..'9','a'..'f','A'..'F'] then
           begin
             st:=st+bufStr[j];
             if Length(st)=len then
             begin
               DataBuf[k+indx]:=Byte(StrToInt('$'+st));
               k:=k+1;
               st:='';
             end;
           end
           else
           begin
             indx:=indx+k;
             bufStr:='';
             break;
           end;
         break;
       end;
     end;
   end;    {if #10}

   if InBuf[l]='>' then
   begin
     result:=false;
     exit;
   end;

 end;

end;

function CompareWithMask(b:word;strMask:string):boolean;
var i:integer;
    bm,m:word;
begin
  bm:=0;
  m:=0;
  for i:=1 to length(strMask) do
  begin
    case strMask[i] of
   '0': begin bm:= word(bm shl 1); m:= word(m shl 1) or 1  end;
   '1': begin bm:= word(bm shl 1) or 1; m:= word(m shl 1) or 1 end;
    else
      bm:= word(bm shl 1);
      m:= word(m shl 1);
    end;
  end;
  result:= ((b and m)= bm);
end;

function SetByMask(b:word;strMask:string):Word;
var i:integer;
    mAnd,mOr:word;
begin
  mAnd:=$FFFF;
  mOr:=0;
  for i:=1 to length(strMask) do
  begin
    case strMask[i] of
   '0': begin mAnd:= word(mAnd shl 1); mOr:= word(mOr shl 1)  end;
   '1': begin mAnd:= word(mAnd shl 1); mOr:= word(mOr shl 1) or 1 end;
    else
      mAnd:= word(mAnd shl 1) or 1;
      mOr:= word(mOr shl 1);
    end;
  end;
  result:= (b and mAnd) or mOr;
end;

function SetVerMaskByMask(m:word;strMask:string):Word;
var i:integer;
    mask:word;
begin
  mask:=0;
  for i:=1 to length(strMask) do
    if strMask[i] in ['0','1'] then
      mask:=(mask shl 1) or 1
    else
      mask:=mask shl 1;
  result:= mask or m;
end;


function GetTSC: Int64; assembler; stdcall;      // because the inline assembler
asm                  // has no mnemonic for "rdtsc" we have to take the op-codes
                 cli
                 db    0Fh                      // 1. op-code byte for "rdtsc"
                 db    31h                      // 2. op-code byte for "rdtsc"
                 sti
end;
//------------------------------------------------------------------------------

// Reads the lower 32-bit value of the TimeStampCounter

function GetTSCLow: Cardinal;
begin
  Result:=Cardinal(GetTSC);
end;
//------------------------------------------------------------------------------

// Reads the upper 32-bit value of the TimeStampCounter

function GetTSCHigh: Cardinal;
begin
  Result:=GetTSC shr 32;
end;

//
// Вычислить константу калибровки равную времени выполнения одного цикла for в мкс
function DelayCalibrating: double;
var i,N:LongInt;
  PriorityClass,Priority: Integer;
  StartTime,EndTime,StartTime1,EndTime1: Int64;
  CPUSpeed: Double;
const
  CalibrateDelayTime = 500; // Time for calibation in ms
begin
  N:=10000;  //
  PriorityClass:=GetPriorityClass(GetCurrentProcess);
  Priority:=GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess,REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread,{THREAD_PRIORITY_TIME_CRITICAL}31);
  Sleep(10);
  StartTime:=GetTSC;
  Sleep(CalibrateDelayTime);
  EndTime:=GetTSC;
  StartTime1:=GetTSC;
  for i:=1 to N do;
  EndTime1:=GetTSC;
  SetThreadPriority(GetCurrentThread,Priority);
  SetPriorityClass(GetCurrentProcess,PriorityClass);
  CPUSpeed:=(EndTime - StartTime) / (CalibrateDelayTime*0.001);
  DelayCalibrating:=(EndTime1- StartTime1)*1000000/(CPUSpeed*N);
end;
procedure DelayUs(N:Longint);
var i:longint;
begin
  for i:=1 to N do;
end;

end.
