{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit xSystem;

interface
  USES Windows;

const
  cKiloByte=1024;
  cTwoGigaByte=2*Cardinal(cKiloByte)*Cardinal(cKiloByte)*Cardinal(cKiloByte)-2;

type
  t2GigaBytes=0..cTwoGigaByte;
  t2GigaBytesArrayOfChar=array[t2GigaBytes] of char;
  tChars=set of char;

function GetVersionFixedFileInfo(var VFFI:TVSFixedFileInfo):boolean;
// Возвращает ВЕРСИЮ исполняемого файла
function GetCurentExecutableVersion(var Major,Minor:cardinal):boolean;

// Возвращает имя исполняемого файла, в котором определена вызывающая процедура
function CurrentModuleFileName:AnsiString;

// Возвращает 10^N
function PowerOf10(n:byte):cardinal;

// Возвращает первое целое число из строки S
function GetIntStr(s:string):string;

// Возвращает первое целое число из строки S
function EditToInt(s:string):integer;

// Возвращает строку без символов ch
function RemoveChar(s:string; ch:char):string;
// Возвращает строку без пробелов
function RemoveSpace(s:string):string;

// Возвращает строку без символов из набора CharsToRemove
function RemoveChars(const aCharsToRemove:tChars; var aBuffer; aBufferSize:t2GigaBytes):cardinal; overload;
procedure RemoveChars(const aCharsToRemove:tChars; var aStrToRemoveFrom:string ); overload;
function RemoveChars(aStr:string; const aCharsToRemove:tChars):string; overload;

// Возвращает усеченную строку
function ShortenStr(s:string; LenghToShort:integer; BreakStr:string):string;

// Преобразование САНТИМЕТРЫ -> ДЮЙМЫ
function CM2IN(CM:extended):extended; register;
// Преобразование ДЮЙМЫ -> САНТИМЕТРЫ
function IN2CM(aIN:extended):extended; register;

function SystemErrorMessage(ErrorCode:integer):string;
function SystemLastErrorMessage:string;

  type
  tDigits=1..15;

function xRound(x:extended; Digits:tDigits):extended; register;
function xFloatToStr(x:extended; Digits:tDigits):string;

type
  tSpecial=(scDelimiter, scTabulator);
  tSpecialStr=string[2];
  tSpecialRecord=packed record
    Ch:Char;
    Str:tSpecialStr;
  end;

function ReplaceSpecialsToChars(const s:string; const ASpes:array of tSpecialRecord):string;
function ReplaceCharsToSpecials(const s:string; const ASpes:array of tSpecialRecord):string;

const
  cANSICodePref='^0';
  cDefANSIs=[#0..#31];

function ReplaceAnsiCodesToChars(const s:string):string;
function ReplaceCharsToAnsiCodes(const s:string; const AChars:tChars):string;

implementation
  USES SysUtils, Math;

function CM2IN(CM:extended):extended;
begin
  Result:=CM/2.54;
end;

function IN2CM(aIN:extended):extended;
begin
  Result:=aIN*2.54;
end;

function SystemErrorMessage(ErrorCode:integer):string;
  var p:pointer;
begin
  if FormatMessage(
    FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ALLOCATE_BUFFER,
    Nil,
    ErrorCode,
    LANG_NEUTRAL, // Default language
    @p, 0, Nil)>0 then begin
    Result:=PChar(p);
    if LocalFree(cardinal(p))<>0 then
      RaiseLastWin32Error;
  end else begin
    RaiseLastWin32Error;
  end;
end;

function SystemLastErrorMessage:string;
begin
  Result:=SystemErrorMessage(GetLastError);
end;

function GetVersionFixedFileInfo(var VFFI:TVSFixedFileInfo):boolean;
  var VerInfoSize:integer; Zero:THandle; VIPtr:Pointer; s:string;
      FFIPtr:pointer; puLen:cardinal;
  const
    cBS:pchar='\';
begin
  Result:=FALSE;
  s:=CurrentModuleFileName;
  VerInfoSize:=GetFileVersionInfoSize(PChar(s),Zero);
  VIPtr:=NIL;
  if VerInfoSize>0 then try
     GetMem(VIPtr,VerInfoSize);
     if GetFileVersionInfo(PChar(s),Zero,VerInfoSize,VIPtr) then begin
       if VerQueryValue(VIPtr,	// address of buffer for version resource
                        cBS,	// address of value to retrieve
                        FFIPtr,	// address of buffer for version pointer
                        puLen 	// address of version-value length buffer
                       ) then begin
         VFFI:=PVSFixedFileInfo(FFIPtr)^;
         Result:=TRUE;
       end;
     end;
     FreeMem(VIPtr);
     VIPtr:=NIL;
  except
    If Assigned(VIPtr) then begin
      FreeMem(VIPtr);
    end;
  end;
end;


function GetCurentExecutableVersion(var Major,Minor:cardinal):boolean;
  var VFFI:TVSFixedFileInfo;
begin
  Result:=GetVersionFixedFileInfo(VFFI);
  if Result then begin
    with VFFI do begin
      Major:=HiWord(dwFileVersionMS);
      Minor:=LoWord(dwFileVersionMS);
    end;
  end;
end;

function Replace(const ASubStr,BySubStr,InAStr:string):string;
  var i,ls, lss:integer;
begin
  Result:=InAStr;
  i:=Pos(ASubStr,Result);
  if i>0 then begin
    lss:=Length(ASubStr);
    repeat
      ls:=Length(Result);
      Result:=Copy(Result,0,Pred(i))+BySubStr+Copy(Result,(i+lss),ls);
      Inc(i,lss);
      i:=Pos(ASubStr,Copy(Result,i,ls));
    until i=0;
  end;
end;

function ReplaceSpecialsToChars(const s:string; const ASpes:array of tSpecialRecord):string;
  var i:integer; ps:^tSpecialRecord;
begin
  Result:=s;
  for i:=0 to High(ASpes) do begin
    ps:=@ASpes[i];
    Result:=Replace(ps^.Str,ps^.Ch,Result);
  end;
  Result:=ReplaceAnsiCodesToChars(Result);
end;

function ReplaceCharsToSpecials(const s:string; const ASpes:array of tSpecialRecord):string;
  var i:integer; ps:^tSpecialRecord;
begin
  Result:=s;
  for i:=0 to High(ASpes) do begin
    ps:=@ASpes[i];
    Result:=Replace(ps^.Ch,ps^.Str,Result);
  end;
  Result:=ReplaceCharsToAnsiCodes(Result,cDefANSIs);
end;

function ReplaceAnsiCodesToChars(const s:string):string;
  var i,j,j0,dj,ls,lp:integer; c:char;
begin
  Result:=s;
  i:=Pos(cANSICodePref,Result);
  lp:=Length(cANSICodePref);
  while i>0 do begin
    j0:=i+lp; j:=j0; ls:=Length(Result); dj:=0;
    while (j<=ls) and (dj<3) and (Result[j] in ['0'..'9']) do begin
      Inc(j); Inc(dj);
    end;
    if dj>0 then begin
      c:=Chr(StrToInt(Copy(Result,j0,dj)));
    end else begin
      c:=#0;
    end;
    Result:=Copy(Result,0,Pred(i))+c+Copy(Result,j,ls);
    Inc(i);
    i:=Pos(cANSICodePref,Copy(Result,i,ls));
  end;
end;

function CharToAnsiCode(AChar:Char):string;
  const cFmt='%u';
begin
  SetLength(Result,3);
  if Ord(AChar)<10 then begin
    FillMemory(@Result[1],2,Ord('0'));
    FormatBuf(Result[3], 1, cFmt, Length(cFmt), [Ord(AChar)]);
  end else if Ord(AChar)<100 then begin
    Result[1]:='0';
    FormatBuf(Result[2], 2, cFmt, Length(cFmt), [Ord(AChar)]);
  end else begin
    FormatBuf(Result[1], 3, cFmt, Length(cFmt), [Ord(AChar)]);
  end;
(*  Result:=IntToStr(Ord(AChar));
  if Length(Result)<3 then
   Result:=Copy('00',Length(Result),3)+Result;*)
end;

function ReplaceCharsToAnsiCodes(const s:string; const AChars:tChars):string;
  var l,i,dl:integer; n:string;
begin
  Result:=s;
  i:=1; l:=Length(Result);
  while i<=l do begin
    if Result[i] in AChars then begin
      n:=CharToAnsiCode(Result[i]);
      Result:=Copy(Result,0,Pred(i))+cANSICodePref+n+Copy(Result,Succ(i),l);
      dl:=Length(cANSICodePref)+2;
      Inc(l,dl); Inc(i,dl);
    end;
    Inc(i);
  end;
end;

function xRound(x:extended; Digits:tDigits):extended; register;
  var Mantissa:extended; Exponent:integer;
  const cMaxDigits=15;
begin
  Frexp(X, Mantissa, Exponent);
{$IfOpt R-}
  if Digits>High(tDigits) then Digits:=High(tDigits);
  if Digits<Low(tDigits) then Digits:=Low(tDigits);
{$EndIf Opt R-}
  x:=IntPower(10.0,Digits);
  Result:=(Round(Mantissa*x)/x)*(1 shl Exponent);
end;

function xFloatToStr(x:extended; Digits:tDigits):string;
begin
  x:=xRound(x,Digits);
  Result:=FloatToStr(x);
end;

function ShortenStr(s:string; LenghToShort:integer; BreakStr:string):string;
  var l1,l2:integer;
begin
  if Length(s)<=LenghToShort then begin
    Result:=s;
  end else begin
    if BreakStr='' then begin
      BreakStr:='...';
    end;
    l1:=(LenghToShort div 2);
    l2:=LenghToShort-l1;
    Result:=Copy(s,1,l1)+BreakStr+Copy(s,Succ(Length(s)-l2),l2);
  end;
end;

function RemoveChar(s:string; ch:char):string;
  var i,j,l:cardinal;
begin
  if Length(s)=0 then begin
    Result:=s;
  end else begin
    SetLength(Result,Length(s));
    i:=1; j:=1; l:=Length(s);
    repeat
      while (j<=l) and (s[j]<>ch) do begin
        Result[i]:=s[j];
        Inc(i); Inc(j);
      end;
      while (j<=l) and (s[j]=ch) do Inc(j);
    until j>l;
    SetLength(Result,Pred(i));
  end;
end;

function RemoveSpace(s:string):string;
begin
  Result:=RemoveChar(s,' ');
end;

function GetIntStr(s:string):string;
  var i,j,l:integer;
begin
  if Length(s)=0 then begin
    Result:='0';
  end else begin
    Result:=RemoveChars(s,[' ',#160]);
    i:=1; l:=Length(Result);
    while (i<=l) and (not (Result[i] in ['1'..'9'])) do Inc(i);
    j:=Succ(i);
    while (j<=l) and (Result[j] in ['0'..'9']) do Inc(j);
    if i=j then
      Result:='0'
    else
      Result:=Copy(Result,i,j-i);
  end;
end;

// Возвращает строку без символов из набора CharsToRemove
function RemoveChars(const aCharsToRemove:tChars; var aBuffer; aBufferSize:t2GigaBytes):cardinal;
  type tBuf=t2GigaBytesArrayOfChar;
  var i,j:cardinal;
begin
  if aBufferSize>0 then begin
    i:=0; j:=0;
    while (j<=aBufferSize) and (tBuf(aBuffer)[j] in aCharsToRemove) do Inc(j);
    while j<aBufferSize do begin
      if i<j then begin
        while (j<=aBufferSize) and not(tBuf(aBuffer)[j] in aCharsToRemove) do begin
          tBuf(aBuffer)[i]:=tBuf(aBuffer)[j];
          Inc(i); Inc(j);
        end;
      end else begin
        while (j<=aBufferSize) and not(tBuf(aBuffer)[j] in aCharsToRemove) do begin
          Inc(i); Inc(j);
        end;
      end;
      while (j<=aBufferSize) and (tBuf(aBuffer)[j] in aCharsToRemove) do Inc(j);
    end;
    Result:=Pred(i);
  end else begin
    Result:=0;
  end;
end;

// Возвращает строку без символов из набора CharsToRemove
procedure RemoveChars(const aCharsToRemove:tChars; var aStrToRemoveFrom:string );
begin
  SetLength(aStrToRemoveFrom,RemoveChars(aCharsToRemove,aStrToRemoveFrom[1],Length(aStrToRemoveFrom)));
end;

// Возвращает строку без символов из набора CharsToRemove
function RemoveChars(aStr:string; const aCharsToRemove:tChars):string;
begin
  Result:=aStr;
  UniqueString(Result);
  RemoveChars(aCharsToRemove, Result);
end;



function EditToInt(s:string):integer;
begin
  Result:=StrToInt(GetIntStr(s));
end;

function CurrentModuleFileName:AnsiString;
  const cDefaultBufLen=1024;
  var Size,RealSize:cardinal;
begin
  Size:=0;
  RealSize:=0;
  while RealSize=Size do begin
    Inc(Size,cDefaultBufLen);
    SetLength(Result,Size);
    RealSize:=GetModuleFileName(HInstance, @Result[1], Size);
  end;
  SetLength(Result,RealSize);
end;

function PowerOf10(n:byte):cardinal;
begin
  Result:=1;
  for n:=n downto 1 do begin
    Result:=Result*10;
  end;
end;

end.