Program Design/Delphi2007/comunit.pas - master - YakuninAV/Convertors

Program Design/Delphi2007/comunit.pas
1 633 строки38 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit ComUnit;

interface

uses SysUtils,Classes,Windows,Math,Dialogs,TlHelp32;

type

  TCharSet= Set of char;
  Asc = AnsiChar;
  Asciiz= PAnsiChar;
  TLongArray= array[0..MaxLongint div 4-1] of longint;
  TIntArray= array[0..MaxLongint div 8-1] of integer;
  TByteArray= array[0..MaxLongint div 2 -1] of byte;
  PByteArray= ^TByteArray;
  PLongArray= ^TLongArray;
  PIntArray = ^TIntArray;
  TStringArray = array[0..MaxLongint div 8-1] of string;
  PStringArray = ^TStringArray;
  TAsciizArray = array[0..MaxLongint div 8-1] of PAnsiChar;
  PAsciizArray = ^TAsciizArray;
  DIntArray= Array of integer;
  DStringArray= Array of string;
  DExtArray= Array of Extended;
  DBoolArray= Array of Boolean;

  TContextTest = function(const Context,X: string): boolean;
  TStringFilter= function(const S: string): string;

  ExtendedRec= packed record
    Mantiss: int64;
    Oder   : SmallInt;
  end;

const
  cs_EveryWhere = 0;
  cs_FromBeginning =1;

  fv_ExtMaxPrecision = 11;//�� ����� ���� 12

function StrContains(const S: string; const A: TCharSet): boolean;
function StrNumContains(const S: string): boolean;

function SearchStringArray(const S: string; const A: DStringArray; Pos: integer=0): integer;
function CopyInBrackets(const S: string; Left,Right: char): string;
function ChEmptyStr(const S: string; const N: string='0'): string;

procedure SetPrecision(var E: extended; P : integer);
function CorrCompareFloat(A1,A2: extended): integer;
function CorrFloatTrunc(R: extended): int64;
function GetSelfPath: string;

function StrItemIn(const Item,Str: string; const Separator: string=','): boolean;
function StringsBufToVar(const Buffer; Count: integer): Variant;
function VarToStringsBuf(SourceVar: Variant; var Buffer): integer;
function IsDecimal(const S: string): boolean;
function TIntCompare(I1,I2: integer): integer;
function FloatEquals(F1,F2 : extended; Prec: integer=-1): boolean;
function FileOpenExt(const FileName: string; Mode: LongWord): Integer;
function FileCreateExt(const FileName: string): Integer;
function SpecZeroFilter(const S: string): string;
function SimpleStringHash(const S: string): int64;
function IsStringTerminal(const SubStr,Str: string): boolean;
function LastCharPos(const S: string; const Chars: TCharSet): integer; overload;
function LastCharPos(C: char; Str: pointer; StrLen: integer): integer; overload;
function SeparateStrMark(Separator,Mark: char; StrBuf: pointer; StrLen: integer):DStringArray; overload;
function SeparateStrMark(Separator,Mark: char; const Str: string):DStringArray; overload;
function SeparateStr(Separator: char; StrBuf: pointer; StrLen: integer; var Buffer): integer; overload;
function SeparateStr(Separator: char; StrBuf: pointer; StrLen: integer): DStringArray; overload;
function SeparateStr(Separator: char; const Str: string): DStringArray; overload;
function CheckStrPrefix(Prefix: pointer; PrefixLen: integer; Buf: pointer; BufLen: integer): boolean; overload;
function CheckStrPrefix(const Prefix: string; Buf: pointer; BufLen: integer): boolean; overload;
function FirstCharPos(const S: string; const Chars: TCharSet): integer;
function FilterString(const S: string; const Chars: TCharSet): string;
function UpFilterString(const S: string; const Chars: TCharSet): string;
function IsProcessExist(const ExeFileName: string): boolean;
function IsOnlyProcess: boolean;
function CompleteStrLen(const S: string; Prefix: char; NewLen: integer): string;
function LocalPathToNetPath(const LocalPath: string): string;
function CreateSubProcess(const ModuleFileName,CmdLine: string):boolean;
procedure BreakString(const S: string; Sep: AnsiChar; var L,R: string);
function FloatToStringF(F: Extended): string;
function FloatToStringEx(E: extended): string;
function FloatToStringP(E: extended; P: integer): string;
function IntRnd(AMin,AMax: integer): integer;
procedure GetMinMaxIn(const A: DIntArray;var AMin,AMax: integer);
procedure StoreIntegers(const A: DIntArray; S: TStream);
function LoadIntegers(S: TStream): DIntArray;

function IsContext(SubStr,Str: Asciiz; Param: integer): boolean;
function StringToFloatEx(const S: string): extended;
procedure IncIntegersFrom(Buffer: pointer; Count,From: integer); assembler;
procedure QUpAnsi(A: Asciiz; ASize: integer); assembler;
function SelfModuleFName:string;
function StringCompatibleLevel(AStr1,AStr2: Asciiz): integer;
function ShiftPtr(P: pointer;ADelta: integer): pointer;
function GetCurrentTime:Extended;
function StringToFloat(const S: string): extended;
function StringToInt(const S: string): int64;
function StringToIntEx(const S: string): int64;
function StringToCurr(const S: string): currency;
function StringToCurrEx(const S: string): currency;
procedure DeletePrimeSpaces(var S: string);
procedure DeleteLastSpaces(var S: string);

procedure CopyFile(const ASourceFile,ADestFile: string);
function CopyIntArray(const A: DIntArray) : DIntArray;
function CopyStringArray(const A: DStringArray) : DStringArray;
function AsciizLen(A: Asciiz): integer;
function AsciizComp(A1,A2: Asciiz): integer;
function AsciizPtrComp(A1,A2: pointer): integer;
function FloatPtrComp(A1,A2: pointer): integer;
function AsciizStrInt(I: integer): Asciiz;
procedure StoreAsciiz(S: TStream; A: Asciiz);
function LoadAsciiz(S: TStream):Asciiz;
function AsciizReadln(var T: Text): Asciiz;
function AscHeight(A: Asciiz; W: integer): integer;
function DeleteTab(S: string; N : integer): string;
function IsAccess(const APath: string): boolean;
function StartPath:string;
function TempPath:string;
function GetDiskFreeSpaceAvail(const PathToFolder: string): int64;
function AsciizPas(A: Asciiz): string;
function pMultChar(count:integer;value:char):string;
function pCentStr(s:string;ARes:byte):string;
function pLeftStr(s:string;ARes:byte):string;
function pRightStr(s:string;ARes:byte):string;
function PasAsciiz(S: string): Asciiz;
procedure FilterChar(AStr: Asciiz; OldCh,NewCh: char);
function CharCount(AStr: Asciiz; C: char): integer;
procedure WritelnAsciiz(var T: Text;A: Asciiz);
procedure WinToDos(A: Asciiz);
procedure DosToWin(A: Asciiz);
function GetDosStr(A: Asciiz):string;
procedure DeleteSpaces(var S: string);
procedure DeleteChar(var S: string; C: char);
procedure StoreString(const AStr: string; S: TStream);
function LoadString(S: TStream): string;
function IsCorrectBracketsA(A:Asciiz): boolean;
function QCharPosA(C: char; A: Asciiz; L: integer): integer;
function QCharPosRevA(C: char; A: Asciiz; L: integer): integer;
procedure QUpOemA(A: Asciiz; L: integer);
function MoveDest(const Source; var Dest; count : Integer ): pointer;
function MoveSrc(const Source; var Dest; count : Integer ): pointer;
function MoveDataS(const Source; var Dest;Count: integer): pointer;
function MoveDataD(const Source; var Dest;Count: integer): pointer;
function MemAvail: DWORD;
function PosFrom(const Sub,S: string; APos: integer): integer;
function ScanInteger(X: integer; Buffer: pointer; Count: integer): integer;
function ScanByte(X: byte; Buffer: pointer; Count: integer): integer;
function SimpleContextTest(const Context,X: string): boolean;
function EmptyContextTest(const Context,X: string): boolean;
function FullContextTest(const Context,X: string): boolean;
function BeginContextTest(const Context,X: string): boolean;
function FullWordContextTest(const Context,X: string): boolean;
function VarStringsToStrings(const A: Variant): DStringArray;
function StrToVarStrings(const S: string): Variant;
function VarToIntegers(const A: Variant): DIntArray;
function IntegersToVar(const A: array of integer): Variant;
function GetVarArrayLength(const V: Variant): integer;

implementation

uses
  Variants;

function StrContains(const S: string; const A: TCharSet): boolean;
var
  i: integer;
begin
  Result:=false;
  i:=Length(S);
  while (not Result) and (i>0) do
    if (S[i] in A) then Result:=true else
      dec(i);
end;

function StrNumContains(const S: string): boolean;
begin
  Result:=StrContains(S,['0'..'9']);
end;

function SearchStringArray(const S: string; const A: DStringArray; Pos: integer): integer;
var
  L: integer;
begin
  Result:=Pos; L:=Length(A);
  while (Result<L) and (S<>A[Result]) do inc(Result);
  if Result=L then Result:=-1;
end;

function CopyInBrackets(const S: string; Left,Right: char): string;
var
  P1,P2: integer;
begin
  P1:=Pos(Left,S);
  if P1>0 then
    begin
      P2:=LastCharPos(Right,PChar(S),Length(S));
      if P2>P1+1 then Result:=copy(S,P1+1,P2-P1-1) else Result:='';
    end
      else
    Result:='';
end;

function ChEmptyStr(const S: string; const N: string='0'): string;
begin
  if Length(S)=0 then Result:=N else Result:=S;
end;

procedure SetPrecision(var E: extended; P : integer);
var
  A: extended;
begin
  if P>=0 then
    begin
//      E:=Round(E*IntPower(10,P))*IntPower(10,-P);
//      if E<0 then A:=-0.500000000001 else A:=0.500000000001;
      if E<0 then A:=-0.5-IntPower(10,-(fv_ExtMaxPrecision-p+Ord(p=fv_ExtMaxPrecision)))
             else A:= 0.5+IntPower(10,-(fv_ExtMaxPrecision-p+Ord(p=fv_ExtMaxPrecision)));
      E:=Int(E*IntPower(10,P)+A)*IntPower(10,-P);
    end;
end;

function CorrCompareFloat(A1,A2: extended): integer;
var
  R: extended;
begin
  R:=A1-A2;
  if R<-0.000000000001 then Result:=1 else
  if R>0.000000000001 then Result:=-1 else
  Result:=0;
end;

function CorrFloatTrunc(R: extended): int64;
begin
  if R<0 then Result:=trunc(R-0.000000000001) else
  if R>0 then Result:=trunc(R+0.000000000001) else
  Result:=0;
end;

function GetSelfPath: string;
begin
  SetLength(Result,300);
  GetModuleFileName(HInstance,PChar(Result),300);
  Result:=String(PChar(Result));
  Result:=ExtractFilePath(Result);
end;

function StrItemIn(const Item,Str: string; const Separator: string): boolean;
begin
  Result:=Pos(Separator+Item+Separator,Separator+Str+Separator)>0;
end;

function StringsBufToVar(const Buffer; Count: integer): Variant;
var
  i: integer;
begin
  if Count>0 then
    begin
      Result:=VarArrayCreate([0,Count-1],varOleStr);
      for i:=0 to Count-1 do
        Result[i]:=PStringArray(@Buffer)[i];
    end
      else
    Result:=Null;
end;

function VarToStringsBuf(SourceVar: Variant; var Buffer): integer;
var
  i,L,H: integer;
begin
  if not(VarIsNull(SourceVar)) then
    begin
      L:=VarArrayLowBound(SourceVar,1);
      H:=VarArrayHighBound(SourceVar,1);
      for i:=L to H do
        PStringArray(@Buffer)[i-L]:=SourceVar[i];
      Result:=H-L+1;
    end
      else
    Result:=0;
end;

function IsDecimal(const S: string): boolean;
var
  C: integer;
  SS: string;
  V: extended;
begin
  SS:=S;
  FilterChar(PChar(S),',','.');
  Val(S,V,C);
  Result:= C=0;
end;

function TIntCompare(I1,I2: integer): integer;
begin
  if I1<I2 then Result:=-1 else
  if I1>I2 then Result:=1 else
  Result:=0;
end;

function FloatEquals(F1,F2 : extended; Prec: integer): boolean;
var
  P: integer;
begin
  if (Prec<0) then P:=18 else P:=Prec;
  Result:=FloatToStrF(F1,ffFixed,18,P)=FloatToStrF(F2,ffFixed,18,P);
end;

const
  ExFileAccessFlag=FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS or FILE_FLAG_SEQUENTIAL_SCAN;

function FileOpenExt(const FileName: string; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
    ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
    ExFileAccessFlag, 0));
end;

function FileCreateExt(const FileName: string): Integer;
begin
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, exFileAccessFlag, 0));
end;

function SpecZeroFilter(const S: string): string;
var
  L,i,j: integer;
begin
  L:=Length(S);
  SetLength(Result,L);
  i:=1; j:=0;
  while i<=L do
    begin
      if (S[i]='0') and ((i=1) or (not(S[i-1] in ['0'..'9']))) then
        begin
          inc(i);
          while (i<=L) and (S[i]='0') do inc(i);
        end
          else
        begin
          inc(j);
          Result[j]:=S[i];
          inc(i);
        end;
    end;
  SetLength(Result,j);
end;

function SimpleStringHash(const S: string): int64;
var
  i: integer;
begin
  Result:=0;
  for i:=1 to Length(S) do inc(Result,ord(S[i]));
end;

function IsStringTerminal(const SubStr,Str: string): boolean;
var
  SLen,SubLen: integer;
begin
  SLen:=Length(Str);
  SubLen:=Length(SubStr);
  Result:=(SubLen>0) and (SubLen<=SLen) and (copy(Str,SLen-SubLen+1,SubLen)=SubStr);
end;

function LastCharPos(const S: string; const Chars: TCharSet): integer;
begin
  Result:=Length(S);
  while (Result>0) and (not(S[Result] in Chars)) do dec(Result);
end;

function LastCharPos(C: char; Str: pointer; StrLen: integer): integer; assembler;
asm
        PUSH    EDI
        MOV     EDI,EDX
        ADD     EDI,ECX
        DEC     EDI
        STD
        REPNE   SCASB
        JNE     @1
        INC     ECX
@1:     MOV     EAX,ECX
        CLD
        POP     EDI
end;

function SeparateStrMark(Separator,Mark: char; StrBuf: pointer; StrLen: integer):DStringArray;
var
  i,L: integer;
  P: PChar;
  F: boolean;
begin
  SetLength(Result,StrLen+1);
  L:=0; F:=true; P:=StrBuf;
  for i:=0 to StrLen-1 do
    begin
      if PChar(StrBuf)[i]=Mark then F:=not(F) else
      if (F) and (PChar(StrBuf)[i]=Separator) then
        begin
          SetString(Result[L],P,cardinal(StrBuf)+i-cardinal(P));
          P:=pointer(cardinal(StrBuf)+i+1);
          inc(L);
        end;
    end;
  if StrLen>0 then
    begin
      SetString(Result[L],P,cardinal(StrBuf)+StrLen-cardinal(P));
      inc(L);
    end;
  SetLength(Result,L);
end;

function SeparateStrMark(Separator,Mark: char; const Str: string):DStringArray;
begin
  Result:=SeparateStrMark(Separator,Mark,PChar(Str),Length(Str));
end;

function SeparateStr(Separator: char; StrBuf: pointer; StrLen: integer; var Buffer): integer; assembler;
asm
        PUSH    ESI
        PUSH    EDI
        PUSH    EBX
        MOV     EDI,EDX
        XOR     ESI,ESI
        MOV     EBX,Buffer
        JECXZ   @EX
@1:
        REPNE   SCASB
        JNE     @2
        MOV     EBX[ESI*4],EDI
        INC     ESI
        JMP     @1
@2:
        INC     EDI
        MOV     EBX[ESI*4],EDI
        INC     ESI
@EX:
        MOV     EAX,ESI
        POP     EBX
        POP     EDI
        POP     ESI
end;

function SeparateStr(Separator: char; StrBuf: pointer; StrLen: integer): DStringArray;
var
  Buf: PPointerList;
  X,i: integer;
  P: PChar;
begin
  GetMem(Buf,StrLen*SizeOf(integer));
  X:=SeparateStr(Separator,StrBuf,StrLen,Buf^);
  SetLength(Result,X);
  P:=StrBuf;
  for i:=0 to X-1 do
    begin
      SetString(Result[i],P,cardinal(Buf[i])-cardinal(P)-1);
      P:=Buf[i];
    end;
  FreeMem(Buf);
end;

function SeparateStr(Separator: char; const Str: string): DStringArray;
begin
  Result:=SeparateStr(Separator,PChar(Str),Length(Str));
end;

function CheckStrPrefix(Prefix: pointer; PrefixLen: integer; Buf: pointer; BufLen: integer): boolean;
begin
  Result:=(PrefixLen<=BufLen) and (PrefixLen>0) and (CompareMem(Prefix,Buf,PrefixLen));
end;

function CheckStrPrefix(const Prefix: string; Buf: pointer; BufLen: integer): boolean;
begin
  Result:=CheckStrPrefix(PChar(Prefix),Length(Prefix),Buf,BufLen);
end;

function FirstCharPos(const S: string; const Chars: TCharSet): integer;
var
  i,L : integer;
begin
  L:=Length(S);
  i:=1;
  while (i<=L) and (not(S[i] in Chars)) do inc(i);
  if i<=L then Result:=i else Result:=0;
end;

function FilterString(const S: string; const Chars: TCharSet): string;
var
  L,i,j: integer;
begin
  L:=Length(S);
  SetLength(Result,L);
  j:=0;
  for i:=1 to L do
    if not(S[i] in Chars) then
      begin
        inc(j);
        Result[j]:=S[i];
      end;
  SetLength(Result,j);
end;

function UpFilterString(const S: string; const Chars: TCharSet): string;
begin
  Result:=AnsiUpperCase(FilterString(S,Chars));
end;

function GetModuleName(Module: HMODULE): string;
var
  ModName: array[0..MAX_PATH] of Char;
begin
  SetString(Result, ModName, Windows.GetModuleFileName(Module, ModName, SizeOf(ModName)));
end;

function IsProcessExist(const ExeFileName: string): boolean;
var
  SH: THandle;
  PInfo: TProcessEntry32;
  R: bool;
  T: string;
begin
  Result:=false;
  SH:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if SH=INVALID_HANDLE_VALUE then Exit;
  PInfo.dwSize:=SizeOf(PInfo);
  R:=Process32First(SH,PInfo);
  while (not(Result)) and (R) do
    begin
      T:=PInfo.szExeFile;
      Result:=T=ExeFileName;
      PInfo.dwSize:=SizeOf(PInfo);
      R:=Process32Next(SH,PInfo);
    end;
  CloseHandle(SH);
end;

function IsOnlyProcess: boolean;
var
  SH: THandle;
  PInfo: TProcessEntry32;
  R: bool;
  T,M: string;
  C: integer;
begin
  Result:=true;
  SH:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if SH=INVALID_HANDLE_VALUE then Exit;
  M:=GetModuleName(HInstance);
  C:=0;
  PInfo.dwSize:=SizeOf(PInfo);
  R:=Process32First(SH,PInfo);
  while (R) and (C<2) do
    begin
      T:=PInfo.szExeFile;
      if T=M then inc(C);
      PInfo.dwSize:=SizeOf(PInfo);
      R:=Process32Next(SH,PInfo);
    end;
  CloseHandle(SH);
  Result:=C>=2;
end;

function CompleteStrLen(const S: string; Prefix: char; NewLen: integer): string;
var
  L,P: integer;
begin
  L:=Length(S);
  P:=NewLen-L;
  if P>0 then begin
    SetLength(Result,NewLen);
    Move(PChar(S)^,(@Result[P+1])^,L);
    FillChar(PChar(Result)^,P,Prefix);
  end else
    Result:=S;
end;
function LocalPathToNetPath(const LocalPath: string): string;
var
  Buffer: pointer;
  BufSize: cardinal;
begin
  BufSize:=Length(LocalPath)+256;
  GetMem(Buffer,BufSize);
  Writeln(WNetGetConnectionA(PChar(LocalPath),Buffer,BufSize));
  Result:='';//String(PChar(Buffer^));
  FreeMem(Buffer);
end;

function CreateSubProcess(const ModuleFileName,CmdLine: string):boolean;
var
  StartInfo: _StartUpInfoA;
  ResultInfo: _Process_Information;
begin
  GetStartupInfo(StartInfo);
  Result:=CreateProcess(PChar(ModuleFileName),PChar(CmdLine),NIL,NIL,false,
  0,NIL,NIL,StartInfo,ResultInfo);
end;
procedure BreakString(const S: string; Sep: AnsiChar; var L,R: string);
var
  N,LN: integer;
begin
  N:=Pos(Sep,S); LN:=Length(S);
  L:=copy(S,1,N-1);
  R:=copy(S,N+1,LN-N);
end;

function FloatToStringF(F: Extended): string;
begin
  Result:=FormatFloat('0.############',F);
end;

function FloatToStringEx(E: extended): string;
var
  R: TFloatRec;
begin
  FillChar(R,SizeOf(R),0);
  FloatToDecimal(R,E,fvExtended,18,18);
  Result:=String(R.Digits);
  if R.Exponent<0 then
    begin
      Result:='0.'+pMultChar(-R.Exponent,'0')+Result;
    end
      else if R.Exponent<Length(Result) then
    begin
      insert('.',Result,R.Exponent+1);
    end
      else
    if R.Exponent>Length(Result) then
      Result:=Result+pMultChar(R.Exponent-Length(Result),'0');
  if Result='' then Result:='0' else
  if Result[1]='.' then Result:='0'+Result;
  if R.Negative then Result:='-'+Result;
end;
function AddZeros(const S: string; P: integer): string;
var
  X,L,D,PP: integer;
begin
  Result:=S;
  if P<=0 then Exit;
  if P>2 then PP:=2 else PP:=P;
  L:=Length(Result);
  X:=Pos('.',Result);
  if X=0 then
    begin
      Result:=Result+'.';
      inc(L);
      X:=L;
    end;
  D:=PP-(L-X);
  if (D>0) then Result:=Result+pMultChar(D,'0');
end;
function FloatToStringP(E: extended; P: integer): string;
var
  R: TFloatRec;
  PP,Exp: integer;
  M: extended;
  Err: boolean;
begin
  Frexp(E,M,Exp);
  FillChar(R,SizeOf(R),0);
  FloatToDecimal(R,E,fvExtended,18,18);
  Exp:=R.Exponent;
  //if P<0 then PP:=18 else PP:=P;
  if P<0 then PP:=fv_ExtMaxPrecision else PP:=P;
  if Exp>=0 then PP:=PP+Exp;
  FloatToDecimal(R,E,fvExtended,PP,18);
  //ShowMessage(IntToStr(Round(Exp/LogN(2,10)))+'  '+IntToStr(R.Exponent));
  Result:=String(R.Digits);
  if R.Exponent<0 then
    begin
      Result:='0.'+pMultChar(-R.Exponent,'0')+Result;
    end
      else if R.Exponent<Length(Result) then
    begin
      insert('.',Result,R.Exponent+1);
    end
      else
    if R.Exponent>Length(Result) then
      begin
        if R.Exponent>20 then
          begin
            Result:='#REF';
            Exit;
          end;
        Result:=Result+pMultChar(R.Exponent-Length(Result),'0');
      end;
  if Result='' then Result:='0' else
  if Result[1]='.' then Result:='0'+Result;
  if R.Negative then Result:='-'+Result;
  Result:=AddZeros(Result,P);
end;
function IntRnd(AMin,AMax: integer): integer;
begin
  Result:=Round(Random(AMax-AMin))+AMin;
end;
procedure GetMinMaxIn(const A: DIntArray;var AMin,AMax: integer);
var
  L,i: integer;
begin
  AMin:=0; AMax:=0;
  L:=Length(A);
  if L>0 then
    for i:=0 to L-1 do
      begin
        if A[i]<AMin then AMin:=A[i] else if A[i]>=AMax then AMax:=A[i];
      end;
end;
procedure StoreIntegers(const A: DIntArray; S: TStream);
var
  L: integer;
  P: pointer;
begin
  L:=Length(A);
  S.Write(L,4);
  if L>0 then
    begin
      P:=@A[0];
      S.Write(P^,L*SizeOf(Integer));
    end;
end;
function LoadIntegers(S: TStream): DIntArray;
var
  L: integer;
  P: pointer;
begin
  S.Read(L,4);
  SetLength(Result,L);
  if L>0 then
    begin
      P:=@Result[0];
      S.Read(P^,L*SizeOf(Integer));
    end;
end;
function IsContext(SubStr,Str: Asciiz; Param: integer): boolean;
var
  A,P: Asciiz;
begin
  A:=StrPos(Str,SubStr);
  //ShowMessage(IntToStr(Param));
  if Param=cs_Everywhere then
    begin
      Result:= A<>NIL;
    end
      else
    begin
      Result:=(A<>NIL) and (A=Str);
    end;
end;
function StringToFloatEx(const S: string): extended;
begin
  FilterChar(PChar(S),',','.');
  DecimalSeparator:='.';
  Result:=StringToFloat(S);
end;
procedure IncIntegersFrom(Buffer: pointer; Count,From: integer); assembler;
asm
  pushad
  pushfd
  mov           ESI,EAX
  mov           EDI,EAX
  mov           EAX,ECX
  mov           ECX,EDX
  mov           EDX,EAX // From
  or            ECX,ECX
  jz            @E
  cld
@1:
  lodsd
  cmp           EAX,EDX
  jl            @2
  inc           EAX
@2:
  stosd
  loop          @1
@E:
  popfd
  popad
end;
procedure QUpAnsi(A: Asciiz; ASize: integer); assembler;
asm
  pushad
  pushfd
  or            EDX,EDX
  jz            @E
  mov           ESI,EAX
  mov           EDI,EAX
  mov           ECX,EDX
  cld
@1:
  lodsb
  cmp           AL,224
  jb            @2
  sub           AL,32
  jmp           @W
@2:
  cmp           AL,184
  jne           @W
  mov           AL,168
@W:

  stosb
  loop          @1
@E:
  popfd
  popad
end;

function SelfModuleFName:string;
var
  S: string;
begin
  SetLength(S,300);
  GetModuleFileName(HInstance,PChar(S),300);
  SetLength(S,AsciizLen(PChar(S)));
  Result:=S;
end;

function StringCompatibleLevel(AStr1,AStr2: Asciiz): integer;
var
  LMin,LMax,L1,L2,p,i: integer;
begin
  L1:=AsciizLen(AStr1); L2:=AsciizLen(AStr2);
  LMin:=L1; LMax:=L2;
  if LMax<LMin then
    begin
      LMin:=L2; LMax:=L1;
    end;
  i:=0;
  while (i<LMin) and (AStr1[i]=AStr2[i]) do inc(i);
  Result:=i;
end;
function ShiftPtr(P: pointer;ADelta: integer): pointer; assembler;
asm
  ADD   EAX,EDX
end;

function GetCurrentTime:Extended;
var
  Hour,Min,Sec,MSec: word;
  T: TDateTime;
begin
  T:=Time;
  DecodeTime(T,Hour, Min, Sec, MSec);
  Result:=Hour*3600+Min*60+Sec+MSec*0.001;
end;
function StringToFloat(const S: string): extended;
var
  E: integer;
begin
  //FillChar(Result,SizeOf(Extended),0);
  Val(S,Result,E);
  if not(E=0) then Result:=0;
end;
function StringToInt(const S: string): int64;
var
  E: integer;
begin
  if Length(S)=0 then Result:=0 else
    begin
      Val(S,Result,E);
      if E<>0 then Result:=0;
    end;
end;

function StringToIntEx(const S: string): int64;
var
  E: integer;
begin
  if Length(S)=0 then Result:=0 else
    begin
      E:=Pos('.',S);
      if E>0 then Val(copy(S,1,E-1),Result,E) else Val(S,Result,E);
      if E<>0 then Result:=0;
    end;
end;

function StringToCurr(const S: string): currency;
begin
  if not TextToFloat(PChar(S), Result, fvCurrency) then Result:=0;
end;

function StringToCurrEx(const S: string): currency;
var
  V: string;
  X: integer;
begin
  V:=S;
  X:=Pos(',',V);
  if X>0 then V[X]:='.';
  DecimalSeparator:='.';
  if not TextToFloat(PChar(V), Result, fvCurrency) then Result:=0;
end;

procedure DeletePrimeSpaces(var S: string);
begin
  while (Length(S)>0) and (S[1]=' ') do Delete(S,1,1);
end;
procedure DeleteLastSpaces(var S: string);
begin
  while (Length(S)>0) and (S[Length(S)]=' ') do Delete(S,Length(S),1);
end;
procedure CopyFile(const ASourceFile,ADestFile: string);
var
  S,D: TFileStream;
begin
  S:=TFileStream.Create(ASourceFile,fmOpenRead);
  D:=TFileStream.Create(ADestFile,fmCreate);
  D.CopyFrom(S,S.Size);
  S.Free;
  D.Free;
end;
function CopyIntArray(const A: DIntArray) : DIntArray;
var
  i,L: integer;
begin
  L:=Length(A);
  SetLength(Result,L);
  if L>0 then
    for i:=0 to L-1 do Result[i]:=A[i];
end;

function CopyStringArray(const A: DStringArray) : DStringArray;
var
  i,L: integer;
begin
  L:=Length(A);
  SetLength(Result,L);
  if L>0 then
    for i:=0 to L-1 do Result[i]:=A[i];
end;

function AsciizLen(A: Asciiz): integer; assembler;
  asm
    or         EAX,EAX
    mov        EAX,A
    jne        @C
    xor        EAX,EAX
    jmp        @E
@C:
    call       StrLen
@E:
  end;

function AsciizComp(A1,A2: Asciiz): integer; assembler;
  var
    L1,L2: integer;
    B1,B2: Asciiz;
  asm
    mov        B1,EAX
    mov        B2,EDX
    call       AsciizLen
    mov        L1,EAX
    mov        EAX,B2
    call       AsciizLen
    mov        L2,EAX
    or         EAX,EAX
    jne        @A2notZero
    mov        EAX,L1
    or         EAX,EAX
    je         @E
    mov        EAX,1
    jmp        @E
@A2notZero:
    cmp        L1,EAX
    je         @LenEq
    jl         @1
    mov        EAX,1
    jmp        @E
@1:
    mov        EAX,-1
    jmp        @E
@LenEq:
    cld
    mov        ECX,L1
    mov        ESI,B1
    mov        EDI,B2
    repe cmpsb
    jb         @Less
    ja         @Greater
    xor        EAX,EAX
    jmp        @E
@Less:
    mov        EAX,-1
    jmp        @E
@Greater:
    mov        EAX,1
    jmp        @E
@E:
  end;

function AsciizPtrComp(A1,A2: pointer): integer;
  var
    S1,S2: string;
  begin
    S1:=StrPas(A1);
    S2:=StrPas(A2);
    if S1<S2 then Result:=-1 else
    if S1>S2 then Result:=1 else
    Result:=0;
  end;

function FloatPtrComp(A1,A2: pointer): integer;
begin
  if extended(A1^)<extended(A2^) then Result:=-1 else
  if extended(A1^)>extended(A2^) then Result:=1 else
  Result:=0;
end;

function AsciizStrInt(I: integer): Asciiz;
  var
    S: ShortString;
  begin
    Str(I,S); S:=S+#0;
    Result:=StrNew(@S[1]);
  end;

procedure StoreAsciiz(S: TStream; A: Asciiz);
  var
    L: integer;
  begin
    L:=AsciizLen(A);
    S.Write(L,4);
    S.Write(A^,L);
  end;
function LoadAsciiz(S: TStream):Asciiz;
  var
    L: integer;
    A: Asciiz;
  begin
    S.Read(L,4);
    A:=StrAlloc(L+1);
    S.Read(A^,L);
    A[L]:=#0;
    LoadAsciiz:=A;
  end;
function AsciizReadln(var T: Text): Asciiz;
  var
    S: string;
    A: Asciiz;
  begin
    Readln(T,S);
    A:=StrAlloc(Length(S)+1);
    StrPCopy(A,S);
    A[Length(S)]:=#0;
    Result:=A;
  end;

function AscHeight(A: Asciiz; W: integer): integer;
  var
    i,X0,X1,L : integer;
    C: AnsiChar;
  begin
    L:=AsciizLen(A);
    Result:=1; X0:=1; X1:=1;
    if L>0 then
      for i:=0 to L-1 do
        begin
          C:=A[i];
          if C=' ' then X1:=i+1;
          if (i-X0>=W) and (X1>X0) then
            begin
              X0:=X1;
              inc(Result);
            end;
        end;
  end;

function DeleteTab(S: string; N : integer): string;
  var
    L,i: integer;
    C: AnsiChar;
    D,A: string;
  begin
    L:=Length(S); D:='';
    if L>0 then
      for i:=1 to L do
        begin
          C:=S[i];
          if C=#9 then A:=copy('                           ',1,N- ((Length(D)+1) mod N)) else A:=C;
          D:=D+A;
        end;
    Result:=D;
  end;

function IsAccess(const APath: string): boolean;
var
  S: string;
  FHandle: integer;
begin
  Result:=false;
  S:=APath;
  if Length(S)=0 then Exit;
  if S[Length(S)]<>'\' then S:=S+'\';
  S:=S+'$$ACCS$.TMP';
  FHandle:=FileCreate(S);
  if FHandle>=0 then
    begin
      Result:=true;
      FileClose(FHandle);
      SysUtils.DeleteFile(S);
    end;
end;
function StartPath:string;
  var
    B: pointer;
  begin
    GetMem(B,32768);
    GetModuleFileName(HInstance,B,32768);
    Result:=PChar(B);
    FreeMem(B);
    Result:=ExtractFilePath(Result);
  end;

function TempPath:string;
  var
    A: ShortString;
    S: String;
  begin
    FillChar(A,SizeOf(A),0);
    GetTempPath(255,@A[1]);
    A[0]:=chr(AsciizLen(@A[1]));
    S:=A;
    TempPath:=S;
  end;

function GetDiskFreeSpaceAvail(const PathToFolder: string): int64;
var
  lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes: int64;
begin
  if GetDiskFreeSpaceEx(PChar(PathToFolder),lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes, @lpTotalNumberOfFreeBytes) then
    Result:=lpFreeBytesAvailableToCaller else Result:=0;
end;

function AsciizPas(A: Asciiz): string;
  begin
    if A=NIL then AsciizPas:='' else
      AsciizPas:=StrPas(A);
  end;
function pMultChar(count: integer;value:char):string;
{  var
    r: string[255];}
  begin
    {FillChar(r,count+1,ord(value));
    FillChar(r,1,count);
    pMultChar:=r;}
    if Count>0 then
      begin
        SetLength(Result,Count);
        FillChar(PChar(Result)^,Count,ord(Value));
      end
        else
      Result:='';
  end;
function pCentStr(s:string;ARes:byte):string;
  var
    r:string;
  begin
    if length(s)>ARes then r:=copy(s,1,ARes) else
      r:=s;
    r:=pMultChar((ARes-length(r)) div 2,' ')+r;
    r:=r+pMultChar(ARes-length(r),' ');
    pCentStr:=r;
  end;
function pLeftStr(s:string;ARes:byte):string;
  var
    r:string;
  begin
    if length(s)>ARes then r:=copy(s,1,ARes) else
      r:=s;
    r:=r+pMultChar(ARes-length(r),' ');
    pLeftStr:=r;
  end;
function pRightStr(s:string;ARes:byte):string;
  var
    r:string;
  begin
    if length(s)>ARes then r:=copy(s,1,ARes) else
      r:=s;
    r:=pMultChar(ARes-length(r),' ')+r;
    pRightStr:=r;
  end;
function PasAsciiz(S: string): Asciiz;
  var
    A: string;
  begin
    A:=S+#0;
    PasAsciiz:=StrNew(@A[1]);
  end;
procedure FilterChar(AStr: Asciiz; OldCh,NewCh: char);
  var
    L,i: integer;
  begin
    L:=AsciizLen(AStr);
    if L>0 then
      for i:=0 to L-1 do
        if AStr[i]=OldCh then AStr[i]:=NewCh;
  end;
function CharCount(AStr: Asciiz; C: char): integer;
var
  i: integer;
begin
  Result:=0;
  for i:=0 to AsciizLen(AStr)-1 do
    if AStr[i]=C then Inc(Result);
end;
{$I-}
procedure WritelnAsciiz(var T: Text;A: Asciiz);
  begin
    if A<>NIL then writeln(T,A) else writeln(T);
  end;
{$I+}
procedure WinToDos(A: Asciiz);
  var
    L: integer;
    S: Asciiz;
  begin
    L:=AsciizLen(A);
    if L>0 then
      begin
        S:=StrNew(A);
        AnsiToOem(A,S);
        Move(S^,A^,L);
        StrDispose(S);
      end;
  end;
procedure DosToWin(A: Asciiz);
  var
    L: integer;
    S: Asciiz;
  begin
    L:=AsciizLen(A);
    if L>0 then
      begin
        S:=StrNew(A);
        OemToAnsi(A,S);
        Move(S^,A^,L);
        StrDispose(S);
      end;
  end;
function GetDosStr(A: Asciiz):string;
  var
    S: string;
  begin
    S:=AsciizPas(A);
    WinToDos(PChar(S));
    Result:=S;
  end;
procedure DeleteSpaces(var S: string);
var
  N: integer;
begin
  N:=Pos(' ',S);
  while N>0 do
    begin
      Delete(S,N,1);
      N:=Pos(' ',S);
    end;
end;
procedure DeleteChar(var S: string; C: char);
var
  N: integer;
begin
  N:=Pos(C,S);
  while N>0 do
    begin
      Delete(S,N,1);
      N:=Pos(C,S);
    end;
end;
procedure StoreString(const AStr: string; S: TStream);
var
  L : integer;
  A : Asciiz;
begin
  L:=Length(AStr);
  S.Write(L,SizeOf(integer));
  if L>0 then
    begin
      A:=@AStr[1];
      S.Write(A^,L);
    end;
end;
function LoadString(S: TStream): string;
var
  L : integer;
  A : string;
  P : Asciiz;
begin
  S.Read(L,SizeOf(integer));
  SetLength(A,L);
  if L>0 then
    begin
      P:=@A[1];
      S.Read(P^,L);
    end;
  Result:=A;
end;

function IsCorrectBracketsA(A:Asciiz): boolean;
var
  L,i,C: integer;
begin
  L:=AsciizLen(A);
  Result:=true;
  C:=0;
  if L>0 then
    for i:=0 to L-1 do
      begin
        case A[i] of
          '(' : inc(C);
          ')' : dec(C);
        end;
        if C<0 then
          begin
            Result:=false;
            Exit;
          end;
      end;
end;
function QCharPosA(C: char; A: Asciiz; L: integer): integer;
asm
  push          EDI
  mov           EDI,EDX
  cld
  repne scasb
  je            @Found
  mov           EAX,-1
  jmp           @E
@Found:
  mov           EAX,EDI
  sub           EAX,EDX
  dec           EAX
@E:
  pop           EDI
end;
function QCharPosRevA(C: char; A: Asciiz; L: integer): integer;
asm
  push          EDI
  mov           EDI,EDX
  add           EDI,ECX
  dec           EDI
  std
  repne scasb
  je            @Found
  mov           EAX,-1
  jmp           @E
@Found:
  mov           EAX,ECX
  //mov           EAX,EDI
  //sub           EAX,EDX
  //dec           EAX
@E:
  cld
  pop           EDI
end;

procedure QUpOemA(A: Asciiz; L: integer);
asm
  push          ESI
  mov           ESI,EAX
  mov           ECX,EDX
  or            ECX,ECX
  jz            @E
  cld
@1:
  lodsb
  cmp           AL,160   // �
  jb            @CE
  cmp           AL,175  //�
  ja            @2
  sub           AL,32
  jmp           @CE
@2:
  cmp           AL,224  //�
  jb            @CE
  cmp           AL,239  //�
  ja            @3
  sub           AL,80
  jmp           @CE
@3:
  cmp           AL,241  //�
  jne           @CE
  dec           AL
@CE:
  mov           [ESI-1],AL
  loop          @1
@E:
  pop           ESI
end;
function MoveDest(const Source; var Dest; count : Integer ): pointer;
asm
{     ->EAX     Pointer to source       }
{       EDX     Pointer to destination  }
{       ECX     Count                   }

        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX
        MOV     EDI,EDX

        MOV     EAX,ECX

        SAR     ECX,2           { copy count DIV 4 dwords       }
        JS      @@exit

        REP     MOVSD

        MOV     ECX,EAX
        AND     ECX,03H
        REP     MOVSB           { copy count MOD 4 bytes        }
@@exit:
        MOV     EAX,EDI
        POP     EDI
        POP     ESI
end;
function MoveSrc(const Source; var Dest; count : Integer ): pointer;
asm
{     ->EAX     Pointer to source       }
{       EDX     Pointer to destination  }
{       ECX     Count                   }

        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX
        MOV     EDI,EDX

        MOV     EAX,ECX

        SAR     ECX,2           { copy count DIV 4 dwords       }
        JS      @@exit

        REP     MOVSD

        MOV     ECX,EAX
        AND     ECX,03H
        REP     MOVSB           { copy count MOD 4 bytes        }
@@exit:
        MOV     EAX,ESI
        POP     EDI
        POP     ESI
end;

function MoveDataS(const Source; var Dest;Count: integer): pointer;
begin
  Move(Source,Dest,Count);
  Result:=Ptr(Integer(@Source)+Count);
end;
function MoveDataD(const Source; var Dest;Count: integer): pointer;
asm
  or            ECX,ECX
  jnz            @1
  mov           EAX,EDX
  jmp           @E
@1:
  push          ESI
  push          EDI
  mov           ESI,EAX
  mov           EDI,EDX
  mov           EAX,EDX
  add           EAX,ECX
  cld
  rep           movsb
  pop           EDI
  pop           ESI
@E:
end;
{begin
  Move(Source,Dest,Count);
  Result:=Ptr(Integer(@Dest)+Count);
end;}
function MemAvail: DWORD;
var
  S: TMemoryStatus;
begin
  S.dwLength:=SizeOf(TMemoryStatus);
  GlobalMemoryStatus(S);
  Result:=S.dwAvailVirtual+S.dwAvailPhys+S.dwAvailPageFile;
end;
function PosFrom(const Sub,S: string; APos: integer): integer;
begin
  Result:=0;
  if APos>Length(S) then Exit;
  Result:=Pos(Sub,copy(S,APos,Length(S)-APos+1));
  if Result>0 then Result:=Result+APos-1;
end;
function ScanInteger(X: integer; Buffer: pointer; Count: integer): integer;assembler;
asm
  push          EDI
  or            ECX,ECX
  jz            @Fail
  mov           EDI,EDX
  cld
  repne scasd
  jne           @Fail
  mov           EAX,EDI
  sub           EAX,EDX
  shr           EAX,2
  dec           EAX
  jmp           @End
@Fail:
  mov           EAX,-1
@End:
  pop           EDI
end;

function ScanByte(X: byte; Buffer: pointer; Count: integer): integer;assembler;
asm
  push          EDI
  or            ECX,ECX
  jz            @Fail
  mov           EDI,EDX
  cld
  repne scasb
  jne           @Fail
  mov           EAX,EDI
  sub           EAX,EDX
  dec           EAX
  jmp           @End
@Fail:
  mov           EAX,-1
@End:
  pop           EDI
end;

function SimpleContextTest(const Context,X: string): boolean;
begin
  Result:=Pos(Context,X)>0;
end;

function EmptyContextTest(const Context,X: string): boolean;
begin
  Result:=Length(X)=0;
end;

function FullContextTest(const Context,X: string): boolean;
begin
  Result:=(Length(Context)=Length(X)) and (Context=X);
end;

function BeginContextTest(const Context,X: string): boolean;
var
  P: integer;
begin
  P:=Pos(Context,X);
  Result:=(P>0) and (((P=1) or (X[P-1] in [' ','"','('])) or (Pos(' '+Context,X)>0) or (Pos('"'+Context,X)>0) or (Pos('('+Context,X)>0));
//  Result:=(P>0) and (((P=1) or (X[P-1]=' ')) or (Pos(' '+Context,X)>0));
end;

function FullWordContextTest(const Context,X: string): boolean;
var
  P,PP,LC,LX: integer;
begin
  Result:=(Pos(Context,X)>0) and (Pos(' '+Context+' ',' '+X+' ')>0);
end;

function VarStringsToStrings(const A: Variant): DStringArray;
var
  L,H,i: integer;
begin
  if VarIsNULL(A) then
    begin
      SetLength(Result,0);
      Exit;
    end;
  L:=VarArrayLowBound(A,1);
  H:=VarArrayHighBound(A,1);
  SetLength(Result,H-L+1);
  for i:=0 to Length(Result)-1 do
    Result[i]:=A[L+i];
end;

function StrToVarStrings(const S: string): Variant;
begin
  Result:=VarArrayCreate([0,0],VarVariant);
  Result[0]:=S;
end;

function VarToIntegers(const A: Variant): DIntArray;
var
  L,H,i: integer;
begin
  if VarIsNULL(A) then
    begin
      SetLength(Result,0);
      Exit;
    end;
  L:=VarArrayLowBound(A,1);
  H:=VarArrayHighBound(A,1);
  SetLength(Result,H-L+1);
  for i:=0 to Length(Result)-1 do
    Result[i]:=A[L+i];
end;

function IntegersToVar(const A: array of integer): Variant;
var
  L,i : integer;
begin
  L:=Length(A);
  if L>0 then
    begin
      Result:=VarArrayCreate([0,L-1],VarInteger);
      for i:=0 to L-1 do
        Result[i]:=A[i];
    end
      else
    Result:=NULL;
end;

function GetVarArrayLength(const V: Variant): integer;
begin
  if VarIsArray(V) then
    begin
      Result:=VarArrayHighBound(V,1)-VarArrayLowBound(V,1)+1;
    end
      else
    Result:=0;
end;
end.