unit WinUtl;{ General utilities functions. }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
{$I define.pas}
uses
  SysUtils, Variants, Classes, Windows
  {$IFNDEF CONSOLE}
  ,StdCtrls, Forms, Dialogs {for TFindOptions}
  {$ENDIF}
  , {$IFDEF DELPHI4} FileCtrl, {$ENDIF}
  BinHex, DLLUtl, UtlType;

const
  SC_DragMove = $F012;{61458} {winutl}
  SC_SizeRightDown = $F008;
  {
    F001 - size control left
    F002 - size control right
    F003 - size control top
    F004 - size control left top
    F005 - size control top right
    F006 - size control down
    F007 - size control left down
    F008 - size control right down
    F009 - move control
    F00A - nothing
    F00B - size control top
    F00C - mouse up/down size control right edge(left/right)

  TForm.XXXXMousedown handlers can do:
    ReleaseCapture;
    XXXX.Perform(WM_SysCommand,SC_DragMove, 0);
  }

{v0.39}
type
  EAppException = class(Exception);

  { Used in DLLs for showing Forms. }
  {$IFNDEF CONSOLE}
const
  GuiApplication: TApplication = nil;
  {$ENDIF}

{ Tries to free memory allocated to P (if P <> nil), then sets it = nil. }
procedure MemFree(var P{:pointer});

{ Tries to call P.Free (if P <> nil), then assigns P = nil. }
procedure ClassFree(var P{:TObject});

procedure StreamWriteln(AStream: TStream; const AString: shortstring);

function StreamReadln(AStream: TStream; var AString: shortstring): boolean;

function StreamReadLine(AStream: TStream; var AString: string): boolean;

function GetExtFromFileDialogFilter(const AFilter: string; AIndex: integer): string;
  { extracts from Save or OpenDialog's Filter property extension that corresponds
    to AIndex (1 based) }

{v0.16}
{ Finds out what is the index of the extension AExt in the AFilter (property
  of Save/OpenDialog component). AExt is e.g.:  .TXT  Returns false if the ext
  not found }
function GetDialogFilterIndexFromExt(const AFilter: string; const AExt: string; var AIndex: integer):boolean;
{/v0.16}

{ Replaces all decimal separator chars "," or "." with the one specified
  in SysUtils unit, so that the resulting number won't generate exception
  upon submiting it to SysUtils. StrToInt or StrToFloat functions }
function FixDecSep(const s: string): string;
{v0.22}

const
  EngMonthAbbr: array [1..12] of string[3] = ('Jan','Feb','Mar','Apr','May','Jun',
   'Jul','Aug','Sep','Oct','Nov','Dec');

function EngMonthAbbrToMonth(const AAbbr: string): integer;

type
  SetOfChar = set of char;


{ Extracts from Line first Word that is followed with one of the chars in Delimitors,
  the Word and the delimitor will be removed from the Line.
  Returns false only if Line = ''. }
function ExtractWord(Delimitors: SetOfChar; var Word: string; var Line: string): boolean;

{v0.44}
{ Splits given ALine to its parts separated by Delimitors to AList
  (AList.Clear called first). }
function ParseLine(Delimitor: SetOfChar; const ALine: string; AList: TStrings): boolean;
{/v0.44}

{DateTime}
{v0.45}
const
  DateTimePartWidths: array[TDateTimePart] of byte = (3, 2, 2, 2, 2, 2, 4);

function EncodeDateTime(const ADateTimeArray: TDateTimeArray): TDateTime;
procedure DecodeDateTime(ADateTime: TDateTime; var ADateTimeArray: TDateTimeArray);

{ Returns (for index suitable) string composed from given date/time parts,
  in given order (i.e. from dt1 to dt2), e.g. dtYear,dtDay -> YYYYMMDD; dtDay,
  dtYear -> DDMMYYYY }
function DateTimePartsToStr(ADate: TDateTime; dt1, dt2: TDateTimePart): string;

{ Decode the string created by the DateTimePartsToStr function }
function StrToDateTimeParts(const AStr: string; dt1, dt2: TDateTimePart): TDateTime;

function DateTimeGetYYYYMM(const ADateTime: TDateTime): string;

function DaysInMonth(Year, Month: Integer) : Integer;

{ Counts the date that will be from the day, month, year after Period days. }
procedure GetPeriodDate(Year, Month, Day: word; Period : integer;
  var NewYear, NewMonth, NewDay: word);

procedure DateTimeInc(var ADateTime: TDateTime; dt: TDateTimePart; AIncrement: integer);
{/v0.45}

{v0.30}
type
  TDateTimeFormat = (
    dtDateString,     {=yyyymmdd}
    dtDateTimeString, {=yyyymmddhhmmss}
    dtTimeString, {=hhmmss}
    dtYYYYMM,
    dtMMDD,
    dtMonthYear, { mm.yyyy }
    dtDatum, {dd.mm.yyyy}
    dtCas { hh:mm }
  );

function DateTimeToIndexStr(ADateTime: TDateTime): string;
function IndexStrToDateTime(const AValue: string): TDateTime;
{/v0.30}

{v0.32}
function UsrDateTimeToIndexStr(const AText: string): string;
function IndexStrToUsrDateTime(const AIndexStr: string): string;
{/v0.32}

{v0.39}
{ Returns GMT }
procedure GetSystemDateTime(var ADateTime: TDateTime);

{ Returns Local (winter=non daylight saving time) time, DST set true if
  is daylight saving time on; i.e. if DST then ADateTime = Now - 1/24.
  Use if retrieving repeatedly ADateTime values that will be compared -
  internally store ADateTime, for displaying to user check DST and increase
  by one hour if true.  }
procedure GetLocalStdDateTime(var ADateTime: TDateTime; var DST: boolean);
{/v0.39}//now

function DateTimeGetStr(ADateTime: TDateTime; dt: TDateTimeFormat): string;

function DateTimeSetStr(var ADateTime: TDateTime; dt: TDateTimeFormat; const s:string): boolean;

{/DateTime}

{v0.35}
{ Change current dir to ADir (if ADir <> ''), then execute ACommand line
  (and wait for it until finished if Wait = true), then change dir back
  to the original one (if ADir <> ''). }
function ExecuteCommand(const ADir: string; const ACommand: string; Wait: boolean): integer;
{/v0.35}

{FileNames-DirNames}
{v0.13}
{ Returns filename stripped of specified (or current, if ADir = '')
  directory, if present. Strips also extension if is equal to ADefExt. }
function RelativeFileName(const ADir: string; const AFileName: TFileName{v0.36}; const ADefExt: string{/v0.36}): TFileName;
{/v0.13}
{v0.24}
{ Returns AFileName with eventually prepended ADir (if AFileName was relative)
  and appended ADefExt if extension was = ''. }
function AbsoluteFileName(const ADir: string; const AFileName: TFileName{v0.36}; const ADefExt: string{/v0.36}): TFileName;
{/v0.24}

{v0.36}
procedure FileNameSplit(const AFileName: string; var APath: string; var ABaseName: string;
  var AExt: string);
{/v0.36}

{v0.39}
{ Returns name of .INI file either in current dir or if not found here then
  name of the ini file in EXE directory (even if does not exists). }
function FindIniFile: string;

{ Looks for AParentIniFileName either in HInstance directory or it's parent
  directory (in this order). If not found anywhere, returns name in the
  HInstance  directory. }
function FindParentIniFile(const AParentIniFileName:string): string;

{ Obsolete. Use SysUtils.ExcludeTrailingPathDelimiter instead. }
function DelBackSlash(const Dir : string) : string;

{ Obsolete. Use SysUtils.IncludeTrailingPathDelimiter instead. }
function AddBackSlash(const Dir : string): string;

{ Check if the directory Dir ("\" must be the last char) exists,
  if not, creates it (and all subdirs). Returns false if the directory
  does not exist and can not be created. }
function CheckDirExists(const Dir: string): boolean;

function ChangeFileDir(const AFileName: string; const ADir: string): string;

{/FileNames-DirNames}

{
function SetString(var APString:PShortString; AString:string):boolean;
begin
  SetString := false;
  DisposeStr(APString);
  APString := nil;
  if AString <> '' then begin
    APString := NewStr(AString);
    if APString = nil then
      exit;
  end;
  SetString := true;
end;

function GetString(APString:PString): string;//returns '' for nil, otherwise APString^
begin
  if APString = nil then
    GetString := ''
  else
    GetString := APString^
end;
}

{ Appends the whole content of the file AFromFileName to the and of
  file AToFileName, returns true if OK. }
function AppendToFile(const AToFileName: string;
  const AFromFileName: string): boolean;

{ Appends to file AToFileName lines from AFromFileName. Line numbers (0 based)
  are specified in AFirstLineIndex and ALastLineIndex. If ALastLineIndex < 0,
  then all lines, i.e. up to eof (starting AFirstLineIndex one) will be
  appended. }
function AppendLinesFromTextFile(const AToFileName: string;
  const AFromFileName: string; AFirstLineIndex,
  ALastLineIndex: integer): integer;

{/v0.39}
{v0.44}
function ListSortCompareInt(Item1: pointer; Item2: pointer):integer;

function ListFind(AList: TList; AListSortCompare: TListSortCompare;
  Duplicates: TDuplicates; AItem: pointer; var Index: Integer): boolean;

function ReplaceExt(const AFileName: TFileName; const ANewExt: TFileName;
  Force: Boolean): TFileName;

{ Makes ASCII, space separated list of numbers specified in AList as
  items (items[i] = pointer(x), x: integer, use List.Add(pointer(x)) to add values).
  If Sorted is true, then ListSort is called before converting. }
procedure NumsListToStr(AList: TList; var AStr: string; ASorted: boolean);

procedure NumsStrToList(const AStr: string; AList: TList);

{ Returns -1 if not in list, position in AStr if it is there }
function NumsIsInList(ANumber: integer; const AStr: string): integer; overload;

{ Tries to find ANumber in AList. If Sorted, then assumes that the AList is sorted
  (faster, AList must be sorted first e.g. by calling
  ListFind(AList, ListSortCompareInt, true..). Returns -1 if not in list,
  otherwise index in AList.) }
function NumsIsInList(ANumber: integer; AList: TList; ASorted: boolean): integer; overload;
{/v0.44}

{v0.45}
function StringToInteger(const AValue: string; dk: TDataDispKind; ADataSize: integer): integer;
function IntegerToString(AValue: integer; dk: TDataDispKind; ADataSize: integer): string;

{ Creates filename with date/time info included in filename (before extension). }
function GetDateTimeFileName(const ABaseName: TFileName; ADateTime: TDateTime; ADateTimePart: TDateTimePart): string;

{ Extract date/time info from AFileName created by GetDateTimeFileName function
  (see above) with specified ADateTimePart as a parameter. }
function GetFileNameDateTime(const AFileName: TFileName; ADateTimePart: TDateTimePart): TDateTime;

{v0.47 Use System.StringOfChar instead}{/v0.47
function CharRepeat(Ch: char; ALen: integer): string;}
  { returns string consisting of ALen chars Ch (e.g. CharRepeat('x',4) = 'xxxx');
}

{ Pads AStr from the left side with (ALen-Length(AStr)) chars Ch
  (e.g. PadLeft('xy', ' ', 4) = '  xy'); if AStr longer then ALen, then
  the excess chars will be stripped from the left }
function PadLeft(const AStr: string; Ch: char; ALen: integer): string;

{/v0.45}
{v0.46}
{ Returns value of environmental variable of the given name. Returns
  empty string of no such var found. }
function GetEnv(EnvVar: String): string;
{/v0.46}

{v0.47}
const
  WordDelimitors: setofchar = [' ',',','.',#13,#10,#9,';','?','!',':','(',')',
    '[',']','{','{','"',''''];

{v0.50}
{ Looks for '%xxx%' strings and replaces them with value of
  corresponding environment variables (if found, otherwise with empty string). }
function ReplaceEnvVars(const ASource: string): string;

{ Returns StringList filled with enviromental variables (always returns pointer
  to the same instance - DONT FREE IT); use EnvVars[i] or EnvVars.Names[i]
  and EnvVars.Values[i] to retrieve corresp. strings;
  i = 0 .. EnvVars.Count - 1 }
function EnvVars: TStrings;

{ Set value of environmental variable of AName to the new value AValue. }
function SetEnv(const AName: string; const AValue: string): boolean;

{$IFNDEF CONSOLE}
{ Tries to locate ATextToFind in AText using fo options (frDown, frMatchCase,
  frWholeWord) starts to locate from CurPos (set it to 0 if calling first time);
  returns true if ATextToFind found and CurPos will be set to the position
  in AText. If called with CurPos > 0, it will be increased by length(AText)
  before the actual search will begin, i.e. FindText can be called repeatedly
  to find more instances of AText without changing CurPos outside the function. }
function FindText(const ATextToFind: string; const AText: string; fo: TFindOptions; var CurPos: integer): boolean;
{$ENDIF}

{/v0.50}

{v0.60}
{ Returns string representation of the Value rounded to ValidDigits,
  for abs(exponent number) >= EFromExpValue the value will be in scientific
  notation (with E) }
function FloatToRoundStr(Value: extended; ValidDigits: integer; EFromExpValue: integer): string;

function RepeatChar(ch: char; len: integer):string;
{/v0.60}

{v0.62}
function IntToString(i:longint;len:integer): string;
{/v0.62}

{v0.63}
{ Add '0' from the left. }
function LZero(st: string; len:integer): string;

function LTrim(s: string): string;

{ Pads a string to a specified length, by adding spaces right;
  Cuts to Len if lengt(s) > len) }
function Pad(s: string; len: integer): string;
function LPad(const st: string; len: integer): string;

{ e.g. from "InsertSpaces" makes "Insert Spaces" }
function InsertSpacesIntoMultiWordName(const AText: string): string;

{ Returns first (searching from posp) substring not containing character from
  delimset and set new position (posp) in the strng (after the substring) where
  to start next searching. If nothing found returns '' and set posp=0. }
function FindWord(delimset: setofchar; strng: string;
  var posp: integer; forw: boolean): string;

{ As SysUtils.StrToInt, but does not raise exception if s is not integer value,
  returns 0 in that case. }
function StrToInteger(const s: string): integer;

procedure GetManLog(r: real; var m: real; var l: integer);

function RealToString(R: Extended; Len, Dec:integer):string;

{/v0.63}
{v0.66}
{ Creates a TStringList, calls its LoadFromFile method, returns it. }
function FileToStrings(const AFileName: string): TStringList;

{ Adds a ALine line to the text file AFileName, if it is not present
  on the line, that has index (number of the line counted from 0)
  equal to indexof(ATagLine) + ATagOffset. Used for modifying of source
  files from designer. }
procedure AddLineToFileIfNeeded(const AFileName: string;
  const ATagLine: string; ATagOffset: integer;
  const ALine: string);

//utltype
//function SetToInt(const ASet: SetOfByte): longint;
//function SetToHexStr(const ASet: SetOfByte): string;
{/v0.66}
{v0.70}
{ Returns either number or 0 if S is not a number or is empty. }
function StringToInt(const S: string): integer;
{/v0.70}

{v0.75}
{ Returns true if AFileName is valid name for a file, false, if
  not and suggests corrected form in a ASuggestedFileName.
  If ASuggestedFileName is empty, no suggestion could be made (e.g.
  for empty AFileName) }
function IsValidFileName(const AFileName: string; var ASuggestedFileName: string): boolean;
{/v0.75}

type
  { Information about position and last value of a number in otherwise
    non-digit containing string (for autoincrementing filenames etc.) }
  TNumInStr = record
    pos: integer; // at what position the number starts?; -1 if no number found
    len: integer; // how many digits it has
    val: integer; // what is the value of the last number encountered?
  end;

function IncNumInStr(const S: string; var ANumInStr: TNumInStr): string;
  { Find a number in S, if found, set the info to ANumInStr, create a new
    string with incremented value of the number and return it (ANumInStr.value
    is set to the incremented value). If no number found in the S, just return
    S and set ANumInStr.pos to 0. }

{ Parse pascal source file named AFileName, adds all found type and const
  definitions to AConsts and ATypes strings (Name=Value). }
procedure ParseTypeFile(const AFileName: string; AConsts: TStrings; ATypes: TStrings);

function VarToInt(AVariant: Variant): integer;

type
  { Objects controlling (freeing) string list, accessing by name }
  TDict = class(TStringList)
  private
    function GetObj(const AName: string): TObject;
    procedure SetObj(const AName: string; AObj: TObject);
    function GetDict(const AName: string): TDict;
    procedure SetDict(const AName: string; ADict: TDict);
  public
    procedure Clear; override;
    procedure Delete(Index: integer); override;
    destructor Destroy; override;
    property Obj[const AName:string]: TObject read GetObj write SetObj;
    property Dict[const AName: string]: TDict read GetDict write SetDict; default;
  end;

  { Python like joining list of strings to a big one using Delim as delimitor
    between the AList strings. }
  function join(AList: TStrings; Delim: string): string;

{$IFNDEF CONSOLE}
{ Use in forms to implement temporary rendering of log lines using TMemo.
  Will delete half of lines if a limit reachaed }
procedure MemoLog(AMemo: TMemo; const msg: string);
{$ENDIF}
const
  { Set in initialization to SysUtils.DecimalSeparator }
  SystemDecimalSeparator: char = '.';

  ExportDecimalSeparator: char = ',';
implementation

const
  CrLf:array[0..1]of char = (#13,#10);

procedure StreamWriteln(AStream: TStream; const AString: shortstring);
begin
  AStream.WriteBuffer(AString[1], length(AString));
  AStream.WriteBuffer(CrLf, length(CrLf));
end;

function StreamReadLine(AStream: TStream; var AString: string): boolean;
var ch:char;
begin
  AString := '';
  Result := true;
  repeat
    if AStream.Read(ch, 1) = 1 then begin
      case ch of
        #13:;
        #10: break;
      else
        AString := AString + ch;
      end;
    end else begin
      if AString = '' then
        Result := false;
      break;
    end;
  until false;
end;

function StreamReadln(AStream: TStream; var AString: shortstring): boolean;
var ch:char;
begin
  AString := '';
  Result := true;
  repeat
    if AStream.Read(ch, 1) = 1 then begin
      case ch of
        #13:;
        #10: break;
      else
        AString := AString + ch;
      end;
    end else begin
      if AString = '' then
        Result := false;
      break;
    end;
  until false;
end;

function GetExtFromFileDialogFilter(const AFilter: string; AIndex: integer): string;
var
  p, i: integer;
  inDesc: boolean;
begin
  { filter="Desc1|Ext1;Ext1b;Ext1c|Desc2|Ext2|..." }
  p := 1;
  i := 1;
  Result := '';
  inDesc := true;
  while p <= length(AFilter) do begin
    if (AFilter[p] = '|') then begin
      if inDesc then begin
        if i = AIndex then begin
          inc(p);
          while (p <= length(AFilter)) and
            (not (AFilter[p] in [';','|'])) do
          begin
            if AFilter[p] <> '*' then
              Result := Result + AFilter[p];
            inc(p);
          end;
          break;
        end;
        inDesc := false;
      end else begin
        inc(i);
        inDesc := true;
      end;
    end;
    inc(p);
  end;
end;

{v0.16}
function GetDialogFilterIndexFromExt(const AFilter: string; const AExt: string; var AIndex: integer):boolean;
  { finds out what is the index of the extension AExt in the AFilter (property
    of Save/OpenDialog component) }
var
  p: integer;
  inDesc: boolean;
  ce, e: string;

begin
  { filter="Desc1|Ext1;Ext1b;Ext1c|Desc2|Ext2|..." }
  e := UpperCase(AExt);
  p := 1;
  Result := false;
  inDesc := true;
  ce := '';
  AIndex := 0;
  while p <= length(AFilter) do begin
    if AFilter[p] = '|' then begin
      if inDesc then begin
        ce := '';
        inDesc := false;
        inc(AIndex);
      end else begin
        if (UpperCase(ce) = e) then begin
          Result := true;
          exit;
        end;
        inDesc := true;
      end;
    end else begin
      if not inDesc then begin
        case AFilter[p] of
          '*':;
          ';': begin
            if (UpperCase(ce) = e) then begin
              Result := true;
              exit;
            end;
            ce := '';
          end;
        else
          ce := ce + AFilter[p];
        end;
      end;
    end;
    inc(p);
  end;
  if (not inDesc) and (UpperCase(ce) = e) then
    Result := true;
end;
{/v0.16}

procedure MemFree(var P{:pointer});
  { tries to free memory allocated to P, then sets it = nil }
var ptr: pointer absolute P;
begin
  if ptr <> nil then begin
    FreeMem(ptr);
    ptr := nil;
  end;
end;

procedure ClassFree(var P{:TObject});
  { tries to call P.Free, then assigns P = nil }
var o: TObject absolute P;
begin
  if o <> nil then begin
    o.Free;
    o := nil;
  end;
end;

function FixDecSep(const s: string): string;
  { replaces all decimal separator chars "," or "." with the one specified
    in SysUtils unit, so that the resulting number won't generate exception
    upon submiting it to SysUtils. StrToInt or StrToFloat functions }
var
  i: integer;
begin
  Result := '';
  for i := 1 to length(s) do begin
    if s[i] in [',','.'] then
      Result := Result +  DecimalSeparator {SysUtils, set in UlanGlob to '.'}
    else
      Result := Result + s[i];
  end;
end;

{v0.13}
function RelativeFileName(const ADir: string; const AFileName: TFileName{v0.36}; const ADefExt: string{/v0.36}): TFileName;
{SysUtils ExtractRelativePath}
var
  d, fn: string;
  i: integer;
begin
  if ADir = '' then begin
    GetDir(0, d);
  end else begin
    d := ADir;
  end;
  fn := ExpandFileName(AFileName);
  i := pos(UpperCase(d), UpperCase(fn));
  if {v0.24}i = 1{/v0.24 i > 0} then begin
    if d[length(d)] = PathDelim then
      i := 1
    else
      i := 2;
    Result := copy(fn, length(d) + i, length(fn) - length(d));
  end else begin
    Result := AFileName;
  end;
  {v0.36}
  if (ADefExt <> '') then begin
    d := ExtractFileExt(Result);
    if (d <> '') and (Uppercase(d) = Uppercase(ADefExt)) then
      Result := ChangeFileExt(Result, '');
  end;
  {/v0.36}
end; {ulstringgrid}
{/v0.13}

{v0.24}
function AbsoluteFileName(const ADir: string; const AFileName: TFileName{v0.36}; const ADefExt: string{/v0.36}): TFileName;
  { Returns AFileName with eventually prepended ADir (if AFileName was relative) }
var d: string;
begin
  d := ADir;
  if (d <> '') then begin
    if d[length(d)] <> PathDelim then begin
      d := d + PathDelim;
    end;
  end;
  if AFileName <> '' then begin
    if AFileName[1] = PathDelim then begin
      {if ((length(ADir) = 2) or (length(ADir) = 3)) and (ADir[2] = ':') then
      begin
        Result := ADir + AFileName;
      end else }
      begin
        Result := AFileName;
      end;
    end else begin
      if length(AFileName) > 1 then begin
        if AFileName[2] = ':' then
          Result := AFileName
        else
          Result := d + AFileName
      end else begin
        Result := d + AFileName;
      end;
    end;
    {v0.36}
    if (ADefExt <> '') and (ExtractFileExt(Result) = '') then begin
      Result := Result + ADefExt;
    end;
    {/v0.36}
  end else begin
    Result := '';
  end;
end;
{/v0.24}

{v0.22}
function ExtractWord(Delimitors: setofchar; var Word: string; var Line: string): boolean;
{ Extracts from Line first Word that is followed with one of the chars in Delimitors,
  the Word and the delimitor will be removed from the Line.
  Returns false only if Line = '' }

var i: integer;
begin
  Result := false;
  if Line = '' then
    exit;
  Result := true;
  for i := 1 to length(line) do begin
    if line[i] in delimitors then begin
      word := copy(line, 1, i - 1);
      line := copy(line, i + 1, length(line));
      exit;
    end;
  end;
  word := line;
  line := '';
end;

{v0.44}
function ParseLine(Delimitor: SetOfChar; const ALine: string; AList: TStrings): boolean;
  { splits given ALine to its parts separated by Delimitors to AList; returns true
    if AList.Count > 0 }
var wrd, line: string;
begin
  AList.Clear;
  line := ALine;
  while ExtractWord(Delimitor, wrd, line) do begin
    AList.Add(wrd);
  end;
  Result := AList.Count > 0;
end;
{/v0.44}

function EngMonthAbbrToMonth(const AAbbr: string): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to 12 do begin
    if AAbbr = EngMonthAbbr[i] then begin
      Result := i;
      exit;
    end;
  end;
end;

{/v0.22}

{v0.30}
function DateTimeGetStr(ADateTime: TDateTime; dt: TDateTimeFormat): string;
begin
  case dt of
    dtDateTimeString: DateTimeToString(Result, 'yyyymmddhhmmss', ADateTime);
    dtDateString: DateTimeToString(Result, 'yyyymmdd', ADateTime);
    dtTimeString: DateTimeToString(Result, 'hhmmss', ADateTime);
    dtYYYYMM: DateTimeToString(Result, 'yyyymm', ADateTime);
    dtMMDD: DateTimeToString(Result, 'mmdd', ADateTime);
    dtMonthYear: DateTimeToString(Result, 'mm.yyyy', ADateTime);
    dtDatum: DateTimeToString(Result, 'dd.mm.yyyy', ADateTime);
    dtCas: DateTimeToString(Result, 'hh:mm:ss', ADateTime);

  else
    raise Exception.Create('Invalid DTGetStr ' + IntToStr(ord(dt)));
  end;
end;

function DateTimeSetStr(var ADateTime: TDateTime; dt: TDateTimeFormat; const s:string): boolean;
var
  ok: boolean;
  function cp(start, len: integer): word;
  var code: integer;
  begin
    val(copy(s, start, len), result, code);
    if code <> 0 then
      ok := false;
  end;

begin
  ok := true;
  case dt of
    dtDateTimeString, dtDateString: begin
      //YYYYMMDDHHMMSS
      //1   5 7 9 1113
      ADateTime := EncodeDate(cp(1,4), cp(5, 2), cp(7, 2)) +
        EncodeTime(cp(9,2), cp(11,2), cp(13,2),0)
    end;
  else
    ok := false;
    raise Exception.Create('Invalid TDateTimeFormat ' + IntToStr(ord(dt)));
  end;
  Result := ok;
end;

function DateTimeToIndexStr(ADateTime: TDateTime): string;
begin
  DateTimeToString(Result, 'yyyymmddhhmmss', ADateTime);
end;

function IndexStrToDateTime(const AValue: string): TDateTime;
begin
  DateTimeSetStr(Result, dtDateTimeString, AValue);
end;
{/v0.30}

{v0.32}
function UsrDateTimeToIndexStr(const AText: string): string;
begin
  Result := '';
  if AText <> '' then
    Result := DateTimeToIndexStr(StrToDateTime(AText));
end;

function IndexStrToUsrDateTime(const AIndexStr: string): string;
begin
  Result := '';
  if AIndexStr <> '' then
    Result := DateTimeToStr(IndexStrToDateTime(AIndexStr));
end;
{/v0.32}
{v0.39}
procedure GetSystemDateTime(var ADateTime: TDateTime);
  { returns GMT }
var
  st: TSYSTEMTIME;
{   WORD wYear;
    WORD wMonth;
    WORD wDayOfWeek;
    WORD wDay;
    WORD wHour;
    WORD wMinute;
    WORD wSecond;
    WORD wMilliseconds;}
begin
  GetSystemTime(st);
  ADateTime := SystemTimeToDateTime(st);
{  EncodeDate(st.wYear, st.wMonth, st.wDay)
     + EncodeTime(st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);}
end;

procedure GetLocalStdDateTime(var ADateTime: TDateTime; var DST: boolean);
var
  st: TSYSTEMTIME;
  tzi: TIME_ZONE_INFORMATION;
begin
  GetLocalTime(st);
  ADateTime := SystemTimeToDateTime(st);
  DST := (TIME_ZONE_ID_DAYLIGHT = GetTimeZoneInformation(tzi));
  if DST then
    ADateTime := ADateTime - 1/24;
end;
{/v0.39}


{v0.35}
function ExecuteCommand(const ADir: string; const ACommand: string; Wait: boolean): integer;
var
{  cmd: array[0..255] of char;}
  si: TStartupInfo;
  pi: TProcessInformation;{windows}
  odir:string;
begin
  Result := 0;
  if ADir <> '' then begin
    GetDir(0, odir);
    {$I-}
    ChDir(ADir);
    Result := IOResult;
    if Result <> 0 then
      exit;
  end;
  try
    {StrPCopy(cmd, ACommand);}
    fillchar(si, sizeof(si), 0);
    fillchar(pi, sizeof(pi), 0);
    if CreateProcess(nil, PChar(ACommand){cmd}, nil, nil,{ lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;}
      false{bInheritHandles}, 0{dwCreationFlags: DWORD}, nil{lpEnvironment: Pointer;},
      nil{lpCurrentDirectory: PChar; }, si,{TStartupInfo} pi{TProcessInformation}) then
    begin
      if Wait then
        WaitForSingleObject(pi.hProcess, INFINITE);
    end else begin
      Result := GetLastError;
    end;
  finally
    if ADir <> '' then begin
      ChDir(odir);
    end;
  end;
end;
{/v0.35}

{v0.36}
procedure FileNameSplit(const AFileName: string; var APath: string; var ABaseName: string;
  var AExt: string);
begin
  APath := ExtractFilePath(AFileName);
  ABaseName := ExtractFileName(AFileName);
  AExt := ExtractFileExt(ABaseName);
  ABaseName := ChangeFileExt(ABaseName, '');
end;
{/v0.36}

{v0.39}
function FindIniFile: string;
  { returns name of .INI file either in current dir or if not found here then
    name of the ini file in EXE directory (even if does not exists) }
var
  bn: string;
  ed, cd: string;
begin
  bn := ChangeFileExt(ExtractFileName({v0.61}GetModuleName(HInstance){/v0.61 paramstr(0)}), '.INI');
  ed := ExtractFileDir({v0.61}GetModuleName(HInstance){/v0.61 paramstr(0)});
  GetDir(0, cd);
  Result := FileSearch(bn, cd +';' + ed);
  if Result = '' then begin
    Result := ed + PathDelim + bn;
  end else begin
    Result := ExpandFileName(Result);
  end;
end;

function FindParentIniFile(const AParentIniFileName:string): string;
var
  ed: string;
begin
  ed := ExtractFileDir(GetModuleName(HInstance));
  Result := FileSearch(AParentIniFileName, ed +';' + ed + PathDelim + '..');
  if Result = '' then begin
    Result := ed + PathDelim + AParentIniFileName;
  end else begin
    Result := ExpandFileName(Result);
  end;
end;
{
function SetString(var APString:PString; AString:string):boolean;
begin
  SetString := false;
  DisposeStr(APString);
  APString := nil;
  if AString <> '' then begin
    APString := NewStr(AString);
    if APString = nil then
      exit;
  end;
  SetString := true;
end;

function GetString(APString:PString):string;
//returns '' for nil, otherwise APString^
begin
  if APString = nil then
    GetString := ''
  else
    GetString := APString^
end;
}


function DelBackSlash(const Dir : string) : string;
begin
  Result := ExcludeTrailingPathDelimiter(Dir);
  {
  if (Length(Dir) > 3) then begin
    if (Dir[Length(Dir)] = PathDelim) then SetLength(Dir, length(Dir) - 1);
  end else begin
    if (Dir[Length(Dir)] = PathDelim) then begin
      if Length(Dir) > 1 then begin
        if (Length(Dir) < 3) or (Dir[2] <> ':') then SetLength(Dir, Length(Dir) - 1);
      end;
    end;
  end;
  Result := Dir;}
end;

function AddBackSlash(const Dir : string): string;
begin
  Result := IncludeTrailingPathDelimiter(Dir);
  {
  if (Dir <>  '') and (Dir[Length(Dir)] <> PathDelim) then begin
    if (Length(Dir) <> 2) or (Dir[2] <> ':') then Dir := Dir + PathDelim;
  end;
  Result := Dir;}
end;

function CheckDirExists(const Dir: string): boolean;
var
  i: integer;
begin
  Result := true;
  for i := 1 to length(Dir) do begin
    if Dir[i] = PathDelim then begin
      if not DirectoryExists(copy(Dir, 1, i - 1)) then begin
        if not CreateDir(copy(Dir, 1, i - 1)) then begin
          Result := false;
          exit;
        end;
      end;
    end;
  end;
end;

function AppendToFile(const AToFileName: string; const AFromFileName: string): boolean;
  { appends the whole content of the file AFromFileName to the and of file AToFileName,
    returns true if OK }
var t, f: TFileStream;
begin
  Result := false;
  try
    if FileExists(AToFileName) then begin
      t := TFileStream.Create(AToFileName, fmOpenReadWrite + fmShareExclusive);
    end else begin
      t := TFileStream.Create(AToFileName, fmCreate);
    end;
    try
      t.Position := t.Size;
      try
        f := TFileStream.Create(AFromFileName, fmOpenRead + fmShareDenyNone);
        try
          t.CopyFrom(f, 0);
        finally
          f.Free;
        end;
        Result := true;
      except
      end;
    finally
      t.Free;
    end;
  except
  end;
end;

function ChangeFileDir(const AFileName: string; const ADir: string): string;
begin
  Result := AddBackSlash(ADir) + ExtractFileName(AFileName);
end;

function AppendLinesFromTextFile(const AToFileName: string; const AFromFileName: string;
  AFirstLineIndex, ALastLineIndex: integer): integer;
  { Appends to file AToFileName lines from AFromFileName. Line numbers (0 based)
    are specified in AFirstLineIndex and ALastLineIndex. If ALastLineIndex < 0,
    then all lines, i.e. up to eof (starting AFirstLineIndex one) will be appended.
    Returns 0 if all went OK (non existence of AFromFileName is not an error) }
var
  fdest, fsrc: text;
  i, li: integer;
  line: string;
begin
  Result := -1;
  try
    AssignFile(fdest, AToFileName);
    if not FileExists(AToFileName) then begin
      Rewrite(fdest);
      {$IFOPT I-}
      i := ioresult;
      if i <> 0 then begin
        Result := i;
        raise EAppException.Create('Rewrite(' + AToFileName + ') failed: ' + IntToStr(Result));
      end;
      {$ENDIF}
    end else begin
      Append(fdest);
      {$IFOPT I-}
      i := ioresult;
      if i <> 0 then begin
        Result := i;
        raise EAppException.Create('Append(' + AToFileName + ') failed: ' + IntToStr(Result));
      end;
      {$ENDIF}
    end;
    try
      if FileExists(AFromFileName) then begin
        Assign(fsrc, AFromFileName);
        Reset(fsrc);
        {$IFOPT I-}
        i := ioresult;
        if i <> 0 then begin
          Result := i;
          raise EAppException.Create('Reset(' + AFromFileName + ') failed: ' + IntToStr(Result));
        end;
        {$ENDIF}
        try
          li := 0;
          while not eof(fsrc) do begin
            readln(fsrc, line);

            {$IFOPT I-}
            i := ioresult;
            if i <> 0 then begin
              Result := i;
              raise EAppException.Create('Readln(' + AFromFileName + ') failed: ' + IntToStr(Result));
            end;
            {$ENDIF}

            if li >= AFirstLineIndex then begin
              if (ALastLineIndex < 0) or (li <= ALastLineIndex) then begin
                writeln(fdest, line);
                {$IFOPT I-}
                i := ioresult;
                if i <> 0 then
                  raise EAppException.Create('Reset(' + AFromFileName + ') failed: ' + IntToStr(i));
                {$ENDIF}
              end else begin
                break;
              end;
            end;
            inc(li);
          end;
          Result := 0;
        finally
          Close(fsrc);
        end;
      end;
    finally
      Close(fdest);
    end;
  except
    if Result = 0 then
      Result := -1;
  end;
end;

{/v0.39}

{v0.44}

function ListSortCompareInt(Item1:pointer; Item2:pointer):integer;
var
  i1: integer absolute Item1;
  i2: integer absolute Item2;
begin
  if i1 > i2 then
    Result := 1
  else if i1 < i2 then
    Result := -1
  else
    Result := 0;
end;

function ListFind(AList: TList; AListSortCompare: TListSortCompare; Duplicates: TDuplicates; AItem: pointer; var Index: Integer): boolean;
{ derived from classes TStringList.Find }
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := AList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := AListSortCompare(AList.Items[I], AItem);
    if C < 0 then
      L := I + 1
    else begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> dupAccept then
          L := I;
      end;
    end;
  end;
  Index := L;
end;

function ReplaceExt(const AFileName: TFileName; const ANewExt: TFileName; Force: Boolean): TFileName;
begin
  if (ExtractFileExt(AFileName) = '') or Force then
    Result := ChangeFileExt(AFileName, ANewExt)
  else
    Result := AFileName;
end;

function ReplaceDir(const AFileName: TFileName; const ANewDir: TFileName; Force:boolean): TFileName;
begin
  if (ExtractFileDir(AFileName) = '') or Force then begin
    Result := AddBackSlash(ANewDir) + ExtractFileName(AFileName);
  end else begin
    Result := AFileName;
  end;
end;

procedure NumsListToStr(AList: TList; var AStr: string; ASorted: boolean);
  { makes ASCII, space separated list of numbers specified in AList as
    items (items[i] = pointer(x), x: integer, use List.Add(pointer(x)) to add values) }
var i: integer;
begin
  AStr := '';
  if (AList = nil) or (AList.Count = 0) then
    exit;
  if ASorted then
    AList.Sort(ListSortCompareInt);
  for i := 0 to AList.Count - 1 do begin
    AStr := AStr + IntToStr(integer(AList.Items[i])) + ' ';
  end;
end;

procedure NumsStrToList(const AStr: string; AList: TList);
var
  w, l: string;
  i, code: integer;
begin
  if AList = nil then
    exit;
  l := AStr;
  while ExtractWord([' '], w, l) do begin
    val(w, i, code);
    if code = 0 then
      AList.Add(pointer(i));
  end;
end;

function NumsIsInList(ANumber: integer; const AStr: string): integer;
begin
  Result := pos(' ' + IntToStr(ANumber) + ' ', ' ' + AStr + ' ');
  if Result = 0 then
    Result := -1
end;

function NumsIsInList(ANumber: integer; AList: TList; ASorted: boolean): integer;
  { Tries to find ANumber in AList. If Sorted, then assumes that the AList is sorted
    (faster, AList must be sorted first e.g. by calling
    ListFind(AList, ListSortCompareInt, true..) ) }
var
  i: integer;
begin
  Result := -1;
  if (AList = nil) or (AList.Count = 0) then
    exit;
  if ASorted then begin
    ListFind(AList, ListSortCompareInt, dupAccept, pointer(ANumber), Result);
  end else begin
    for i := 0 to AList.Count - 1 do begin
      if integer(AList.Items[i]) = ANumber then begin
        Result := i;
        exit;
      end;
    end;
  end;
end;
{/v0.44}

{v0.45}
function StringToInteger(const AValue: string; dk: TDataDispKind; ADataSize: integer): integer;
var
{  i: integer;}
  b: array[0..3] of byte absolute Result;
begin
  Result := 0;
  case dk of
    dkHexa: begin
      if ADataSize = 1 then
        Result := HexToByte(copy(trim(AValue), 1, 2))
      else if ADataSize = 2 then
        Result := HexToWord(copy(trim(AValue), 1, 4))
      else
        Result := HexToLong(copy(trim(AValue), 1, 8));
    end;
    dkDecimal: Result := StrToInt(trim(AValue));
  end;

  {dkHexa: begin .. different by order
    if (ADataSize > 0) and (ADataSize <= 4) then begin
      HexToRec(Trim(AValue), Result, ADataSize);
    end;
  end;
  dkDecimal: Result := StrToInt(Trim(AValue));
  dkBCD: begin
    for i := 1 to length(AValue) do begin
      if i >= ADataSize * 2 then
        break;
    end;
  end;  }
end;

function IntegerToString(AValue: integer; dk: TDataDispKind; ADataSize: integer): string;
begin
  Result := '';
  case dk of
    dkHexa: begin
      if ADataSize = 1 then
        Result := ByteToHex(lo(AValue))
      else if ADataSize = 2 then
        Result := WordToHex(word(AValue))
      else
        Result := LongToHex(AValue);
    end;
    dkDecimal: Result := IntToStr(AValue);
  end;
end;

procedure DecodeDateTime(ADateTime: TDateTime; var ADateTimeArray: TDateTimeArray);
begin
  DecodeDate(ADateTime, ADateTimeArray[dtYear], ADateTimeArray[dtMonth],
    ADateTimeArray[dtDay]);
  DecodeTime(ADateTime, ADateTimeArray[dtHour], ADateTimeArray[dtMinute],
    ADateTimeArray[dtSecond], ADateTimeArray[dtMilisecond]);
end;

function EncodeDateTime(const ADateTimeArray: TDateTimeArray): TDateTime;
begin
  Result := EncodeDate(ADateTimeArray[dtYear], ADateTimeArray[dtMonth],
    ADateTimeArray[dtDay]) +
    EncodeTime(ADateTimeArray[dtHour], ADateTimeArray[dtMinute],
    ADateTimeArray[dtSecond], ADateTimeArray[dtMilisecond]);
end;
{v0.47}{/v0.47
function CharRepeat(Ch: char; ALen: integer): string;
begin
  Result := '';
  while length(Result) < ALen do
    Result := Result + Ch;
end;}

function PadLeft(const AStr: string; Ch: char; ALen: integer): string;
var i: integer;
begin
  i := ALen - length(AStr);
  if i > 0 then begin
    Result := {v0.47}StringOfChar(Ch, i){/v0.47 CharRepeat(Ch, i)} + AStr;
  end else if i < 0 then begin
    Result := copy(AStr, -i + 1, ALen);
  end else begin
    Result := AStr;
  end;
end;

function DateTimePartsToStr(ADate: TDateTime; dt1, dt2: TDateTimePart): string;
var
  dt: TDateTimePart;
  dta: TDateTimeArray;
begin
  DecodeDateTime(ADate, dta);
  Result := '';
  if dt1 > dt2 then begin
    for dt := dt1 downto dt2 do begin
      Result := Result + PadLeft(IntToStr(dta[dt]), '0', DateTimePartWidths[dt]);
    end;
  end else begin
    for dt := dt1 to dt2 do begin
      Result := Result + PadLeft(IntToStr(dta[dt]), '0', DateTimePartWidths[dt]);
    end;
  end;
end;

function DateTimeGetYYYYMM(const ADateTime: TDateTime): string;
var y,m,d:word;
begin
  DecodeDate(ADateTime, y, m, d);
  Result := IntToStr(y) + PadLeft(IntToStr(m), '0', 2);
end;

function StrToDateTimeParts(const AStr: string; dt1, dt2: TDateTimePart): TDateTime;
var
  dt: TDateTimePart;
  dta: TDateTimeArray;
  i: integer;

  procedure Cut;
  begin
    dta[dt] := StrToInt(copy(AStr, i, DateTimePartWidths[dt]));
    inc(i, DateTimePartWidths[dt]);
  end;

begin
  fillchar(dta, sizeof(dta), 0);
  i := 1;
  if dt1 > dt2 then begin
    for dt := dt1 downto dt2 do begin
      Cut;
    end;
  end else begin
    for dt := dt1 to dt2 do begin
      Cut;
    end;
  end;
  Result := EncodeDateTime(dta);
end;

function DaysInMonth(Year, Month: Integer) : Integer;
const
  DaysInMonthArr: array[1..12] of Byte =
     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  DaysInMonth := DaysInMonthArr[Month] + Byte((Year mod 4 = 0) and (Month = 2));
end;

procedure GetPeriodDate(Year, Month, Day: word; Period : Integer;
          var NewYear, NewMonth, NewDay: word); {counts the date that
            will be from the day, month, year after Period days,
            Period can be < 0}
var dim : integer;
begin
{$IFDEF DEBUG}
  if Year < 1980 then
    Year := 1980
  else if Year > 2099 then
    Year := 2099;

  if Month > 12 then
    Month := 12
  else if Month < 1 then
    Month := 1;

  if Day < 1 then
    Day := 1
  else if Day > DaysInMonth(Year, Month) then
    Day := DaysInMonth(Year, Month);
{$ENDIF}

  NewDay := Day;
  NewMonth := Month;
  NewYear := Year;
  if Period > 0 then begin
    while Period > 0 do begin
      dim := DaysInMonth(NewYear, NewMonth);
      if NewDay + Period > dim then begin
        Period := Period - (dim - NewDay) - 1;
        NewDay := 1;
        inc(NewMonth);
        if NewMonth > 12 then begin
          inc(NewYear);
          NewMonth := 1;
        end;
      end else begin
        NewDay := NewDay + Period;
        Period := 0;
      end;
    end;
  end else begin
    Period := - Period;
    dim := NewDay;
    while Period > 0 do begin
      if NewDay - Period > 0 then begin
        NewDay := NewDay - Period;
        Period := 0;
      end else begin
        Period := Period - dim;
        dec(NewMonth);
        if NewMonth = 0 then begin
          NewMonth := 12;
          dec(NewYear);
        end;
        dim := DaysInMonth(NewYear, NewMonth);
        NewDay := dim;
      end;
    end;
  end;
end;


procedure DateTimeInc(var ADateTime: TDateTime; dt: TDateTimePart; AIncrement: integer);
var
  dta: TDateTimeArray;
  decrement: integer;
begin
  DecodeDateTime(ADateTime, dta);
  try
    if AIncrement > 0 then begin
      case dt of
        dtYear: inc(dta[dtYear], AIncrement);
        dtMonth: begin
          inc(dta[dtMonth], AIncrement);
          while dta[dtMonth] > 12 do begin
            dec(dta[dtMonth], 12);
            inc(dta[dtYear]);
          end;
          if dta[dtDay] > DaysInMonth(dta[dtYear], dta[dtMonth]) then
            dta[dtDay] := DaysInMonth(dta[dtYear], dta[dtMonth]);
        end;
        dtDay: begin
          GetPeriodDate(dta[dtYear], dta[dtMonth], dta[dtDay], AIncrement,
            dta[dtYear], dta[dtMonth], dta[dtDay]);
        end;
        {dtWeek: begin
          GetPeriodDate(dta[dtYear], dta[dtMonth], dta[dtDay], Increment * 7,
            dta[dtYear], dta[dtMonth], dta[dtDay]);
        end;}
      end;
    end else begin
      decrement := - AIncrement;
      case dt of
        dtYear: dec(dta[dtYear], decrement);
        dtMonth: begin
          while decrement > 12 do begin
            dec(dta[dtYear]);
            dec(decrement, 12);
          end;
          dec(dta[dtMonth], decrement);
          if dta[dtMonth] <= 0 then begin
            dec(dta[dtYear]);
            inc(dta[dtMonth], 12);
          end;
          if dta[dtDay] > DaysInMonth(dta[dtYear], dta[dtMonth]) then
            dta[dtDay] := DaysInMonth(dta[dtYear], dta[dtMonth]);
        end;
        dtDay: begin
          GetPeriodDate(dta[dtYear], dta[dtMonth], dta[dtDay], AIncrement, dta[dtYear], dta[dtMonth], dta[dtDay]);
        end;
        {
        incWeek: begin
          GetPeriodDate(Year, Month, Day, Increment * 7, Year, Month, Day);
        end;}
      end;
    end;
  finally
    ADateTime := EncodeDateTime(dta);
  end;
end;

function GetDateTimeFileName(const ABaseName: TFileName; ADateTime: TDateTime; ADateTimePart: TDateTimePart): string;
  { creates filename with date/time info included in filename (before extension). }
begin
  Result := ExtractFilePath(ABaseName) + ChangeFileExt(ExtractFileName(ABaseName),'') +
    DateTimePartsToStr(ADateTime, dtYear, ADateTimePart) + ExtractFileExt(ABaseName);
end;

function GetFileNameDateTime(const AFileName: TFileName; ADateTimePart: TDateTimePart): TDateTime;
  { extract date/time info from filename created by GetDateTimeFileName with specified ADateTimePart
    as a parameter }
var
  s, bn: string;
{  l: integer;}
begin
  s := DateTimePartsToStr(Now, dtYear, ADateTimePart);
  bn := ChangeFileExt(ExtractFileName(AFileName),'');
  Result := StrToDateTimeParts(copy(bn, length(bn) - length(s) + 1, length(s)), dtYear, ADateTimePart);
end;
{/v0.45}

{v0.46}
function GetEnv(EnvVar: String): string;
{v0.50}var l: integer;{/v0.50}
begin
  SetLength(Result, 260);
  {v0.50}l := {/v0.50}GetEnvironmentVariable(PChar(EnvVar), PChar(Result), 260);
  SetLength(Result, {v0.50}l{/v0.50 StrLen(PChar(Result))});
end;
{/v0.46}

{v0.50}
function ReplaceEnvVars(const ASource: string): string;
  { looks for '%xxx%' strings and replaces them with value of
    corresponding environment variables (if found, otherwise with empty string)}
var
  i: integer;
  start: integer;
begin
  Result := '';
  start := 0;
  i := 1;
  while i <= length(ASource) do begin
    if ASource[i] = '%' then begin
      if start = 0 then begin
        start := i + 1;
      end else begin
        Result := Result + GetEnv(copy(ASource, start, i - start));
        start := 0;
      end;
    end else begin
      if start = 0 then
        Result := Result + ASource[i];
    end;
    inc(i);
  end;
end;

var
  FEnvVars: TStrings = nil;

function EnvVars: TStrings;
var
  p: PByte;
  s: string;
begin
  if FEnvVars = nil then begin
    FEnvVars := TStringList.Create;
    p := PByte(GetEnvironmentStrings());
    s := '';
    repeat
      while p^ <> 0 do begin
        s := s + chr(p^);
        inc(p);
      end;
      FEnvVars.Add(s);
      s := '';
      inc(p);
    until p^ = 0;
  end;
  Result := FEnvVars;
end;

function SetEnv(const AName: string; const AValue: string): boolean;
begin
  Result := SetEnvironmentVariable(PChar(AName), PChar(AValue));
  if Result then
    ClassFree(FEnvVars);
end;
{/v0.50}

{v0.50}
{$IFNDEF CONSOLE}
function FindText(const ATextToFind: string; const AText: string; fo: TFindOptions; var CurPos: integer): boolean;
var
  StartPos: integer;
  i, j: integer;
  ok: boolean;

  function Match(c1, c2: char): boolean;
  begin
    if frMatchCase in fo then begin
      Result := (c1 = c2)
    end else begin
      Result := (AnsiUppercase(c1) = AnsiUppercase(c2));
    end;
  end;

  function CheckWholeWord: boolean;
  begin
    Result := false;
    if frWholeWord in fo then begin
      if i > 1 then begin
        if not (AText[i - 1] in WordDelimitors) then
          exit;
      end;
      if (i + Length(ATextToFind)) <= Length(AText) then begin
        if not (AText[i + Length(ATextToFind)] in WordDelimitors) then
          exit;
      end;
    end;
    Result := true;
  end;



begin {from delphi help TFindDialog example (for richedit):}
  Result := false;

  if frDown in fo then begin
    if CurPos > 0 then
      StartPos := CurPos + Length(ATextToFind)
    else
      StartPos := 1;

    for i := StartPos to Length(AText) do begin

      ok := true;

      for j := 1 to Length(ATextToFind) do begin
        if not Match(AText[i + j - 1], ATextToFind[j]) then begin
          ok := false;
          break;
        end;
      end;

      if ok then begin
        if CheckWholeWord then begin
          Result := true;
          CurPos := i;
          break;
        end;
      end;

    end;

  end else begin

    if CurPos > 0 then
      StartPos := CurPos - length(ATextToFind)
    else
      StartPos := length(AText);

    for i := StartPos downto 1 do begin
      ok := true;

      for j := 1 to Length(ATextToFind) do begin
        if not Match(AText[i + j - 1], ATextToFind[j]) then begin
          ok := false;
          break;
        end;
      end;

      if ok then begin
        if CheckWholeWord then begin
          Result := true;
          CurPos := i;
          break;
        end;
      end;
    end;
  end;

end;
{$ENDIF}
{/v0.50}

{v0.60}
function FloatToRoundStr(Value: extended; ValidDigits: integer; EFromExpValue: integer): string;
  { Returns string representation of the Value rounded to ValidDigits,
    for abs(exponent number) >= EFromExpValue the value will be
    in scientific notation (with E) }
var
  fr: TFloatRec;
  s: string;
begin
  FloatToDecimal(fr, Value, fvExtended, ValidDigits, 9999);
  s := '';
  if (EFromExpValue <> 0) and (fr.Exponent > EFromExpValue) then begin

  end else begin
    s := fr.Digits;
    if fr.Exponent < 0 then begin
      s := RepeatChar('0', abs(fr.Exponent)) + s;
    end else if fr.Exponent > 0 then begin
      if length(s) < fr.Exponent then
        s := s + RepeatChar('0', (fr.Exponent - length(s)));
    end;
    if length(s) > fr.Exponent then
      Insert(DecimalSeparator, s, fr.Exponent + 1);
  end;
  if s <> '' then begin
    if s[1] = DecimalSeparator then
      s := '0' + s;
    if fr.Negative then
      s := '-' + s;
  end else begin
    s := '0';
  end;
  FloatToRoundStr := s;
end;

function RepeatChar(ch: char; len: integer):string;
begin
  Result := '';
  while length(Result) < len do
    Result := Result + ch;
end;

{v0.60}

{v0.62}
function IntToString(i, len: integer): string;
begin
  if len <= 0 then
    str(i, Result)
  else
    str(i: len, Result);
end;
{/v0.62}

{v0.63}
function LZero(st: string; len:integer): string;
begin
  Result := st;
  while Length(Result) < len do
    Result := '0'+ Result;
end;

function LTrim(s: string): string;
begin
  Result := TrimLeft(s);
end;

function Pad(s: string; len: integer): string;
begin
  if Length(S) > Len then
    SetLength(S, Len)
  else
    S := S + RepeatChar(' ', Len - Length(S));
  Pad := S;
end;

function LPad(const st: string; len: integer): string;
begin
  if Length(st) < len then begin
    LPad := RepeatChar(' ', len - length(st)) + st;
  end else if Length(st) > len then begin
    LPad := copy(st, Length(st) - len + 1, len);
  end else
    LPad := st;
end;

function InsertSpacesIntoMultiWordName(const AText: string): string;
{ e.g. from "InsertSpaces" makes "Insert Spaces" }
var
  i: integer; s: string;
  wasLower:boolean;
begin
  s := '';
  i := 1;
  wasLower := false;
  while i <= length(AText) do begin
    if Upcase(AText[i]) = AText[i] then begin
      if wasLower then
        s := s + ' ';
      wasLower := false;
    end else begin
      wasLower := true;
    end;
    s := s + AText[i];
    inc(i);
  end;
  InsertSpacesIntoMultiWordName := s;
end;

function FindWord{(delimset:setofchar;strng:string;
                                    var posp:integer;forw:boolean):string};
{ vraci retezec nepreruseny oddelovaci a novou posici ukazatele ve stringu,
  pripadne je-li posp mimo rozsah vraci '' a posp=0}
type chtype=string[1];
var help:string;
    ch:char; st:chtype; lenstr:integer;
begin {FIndWord}
  help:='';
  lenstr:=length(strng);
  if ((posp<1) or (posp>lenstr)or (lenstr=0)) then posp:=0 else begin
    repeat
      st:=copy(strng,posp,1); ch:=st[1];
      if forw then  posp:=succ(posp) else posp:=pred(posp);
    until ((not (ch in delimset )) or (posp>lenstr) or (posp<1));
    if posp>lenstr then posp:=succ(posp);if posp=0 then posp:=-1;
    while ((not ( ch in delimset )) and (posp<=lenstr) and (posp>=1)) do begin
      if forw then help:=help+ch else help:=ch+help;
      st:=copy(strng,posp,1); ch:=st[1];
      if forw then posp:=succ(posp) else posp:=pred(posp);
    end;
    if not(ch in delimset) then
    if forw then help:=help+ch else help:=ch+help else
    if forw then posp:=pred(posp) else posp:=succ(posp);
    if posp>lenstr then posp:=0;if posp<1 then posp:=0;
  end;
  FindWord:=help;
end;{FindWord}

function StrToInteger(const s: string): integer;
var code: integer;
begin
  val(s, Result, code);
  if code <> 0 then
    Result := 0;
end;

procedure GetManLog(r: real; var m: real; var l: integer);
var
  st:string;
  i:integer;
begin
  str(r,st);
  {$IFDEF WINDOWS}
    val(copy(st, 1, 17), m, i);
    val(copy(st, 19, 5), l, i);
  {$ELSE}
    val(copy(st,1,13),m,i);
    val(copy(st,15,3),l,i);
  {$ENDIF}
end;

function RealToString(R: Extended; Len, Dec:integer):string;
var
  st:string[40];
begin
  if Len > 0 then
    str(R:Len:Dec, st)
  else
    str(R, st);
  RealToString := st;
end;
{/v0.63}

{v0.66}
{ Creates a TStringList, calls its LoadFromFile method, returns it. }
function FileToStrings(const AFileName: string): TStringList;
begin
  Result := TStringList.Create;
  Result.LoadFromFile(AFileName);
end;

procedure AddLineToFileIfNeeded(const AFileName: string;
  const ATagLine: string; ATagOffset: integer;
  const ALine: string);
var
  sl: TStringList;
  i: integer;
  modified: boolean;
  aIndex: integer;
begin
  sl := FileToStrings(AFileName);
  try
    modified := false;
    aIndex := -2;
    for i := 0 to sl.Count - 1 do begin
      if pos(ATagLine, sl[i]) = 1 then
        aIndex := i;
      if i = aIndex + ATagOffset then begin
        if pos(ALine, sl[i]) = 0 then begin
          sl.Insert(i, ALine);
          modified := true;
          break;
        end;
      end;
    end;
    if modified then
      sl.SaveToFile(AFileName);
  finally
    sl.Free;
  end;
end;

(*
function SetToInt(const ASet: SetOfByte): longint;
var
  i: integer;
begin              //set of
  Result := 0;
  for i := integer(Low(ASet)) to integer(High(ASet)) do begin
    if i in ASet then begin
      Result := Result or (1 shl i);
    end;
  end;
end;

function SetToHexStr(const ASet: SetOfByte): string;
begin
  Result := LongToHex(SetToInt(ASet));
end;
*)
{/v0.66}

{v0.70}
{ Returns either number or 0 if S is not a number or is empty. }
function StringToInt(const S: string): integer;
var code: integer;
begin
  val(Trim(S), Result, code);
end;
{/v0.70}

{v0.75}
{ Returns true if AFileName is valid name for a file, false, if
  not and suggests corrected form in a ASuggestedFileName.
  If ASuggestedFileName is empty, no suggestion could be made (e.g.
  for empty AFileName) }
function IsValidFileName(const AFileName: string; var ASuggestedFileName: string): boolean;
var i: integer;
begin
  Result := false;
  ASuggestedFileName := Trim(AFileName);
  if ASuggestedFileName = '' then
    exit;
  Result := true;
  for i := 1 to length(ASuggestedFileName) do begin
    if ASuggestedFileName[i] in [':','\','/','?','*','>','<','"',';'] then begin
      ASuggestedFileName[i] := '_';
      Result := false;
    end;
  end;
end;
{/v0.75}

{$HINTS OFF}
function IncNumInStr(const S: string; var ANumInStr: TNumInStr): string;
  { Find a number in S, if found, set the info to ANumInStr, create a new
    string with incremented value of the number and return it (ANumInStr.value
    is set to the incremented value). If no number found in the S, just return
    S and set ANumInStr.pos to 0. }
var
  i: integer;
  code, value: integer;
  vs: string;
begin
  ANumInStr.pos := 0;
  ANumInStr.len := 0;
  Result := S;
  for i := 1 to length(S) do begin
    val(S[i], value, code);
    if code = 0 then begin
      if ANumInStr.pos = 0 then begin
        ANumInStr.pos := i;
      end;
    end else begin
      if ANumInStr.pos <> 0 then
        break;
    end;
  end;
  if ANumInStr.pos <> 0 then begin
    ANumInStr.len := i - ANumInStr.pos;
    val(copy(S, ANumInStr.pos, ANumInStr.len), ANumInStr.val, code);
    inc(ANumInStr.val);  //sysutils
    Delete(Result, ANumInStr.pos, ANumInStr.len);
    vs := IntToStr(ANumInStr.val);
    while length(vs) < ANumInStr.len do vs := '0' + vs;
    Insert(vs, Result, ANumInStr.pos);
  end;
end;
{$HINTS ON}

procedure ParseTypeFile(const AFileName: string; AConsts: TStrings; ATypes: TStrings);
var
  f: text;
  isInConst, isInType: boolean;
  right, left, line: string;
  i: integer;
begin
  AssignFile(f, AFileName);
  reset(f);
  isInConst := false;
  isInType := false;
  try
    while not eof(f) do begin
      readln(f, line);
      if pos('type', line) = 1 then begin
        isInConst := false;
        isInType := true;
        continue;
      end else if pos('const', line) = 1 then begin
        isInConst := true;
        isInType := false;
        continue;
      end else if pos('implementation', line) = 1 then begin
        isInConst := false;
        isInType := false;
        continue;
      end;
      i := pos('=', line);
      if i <> 0 then begin
        left := trim(copy(line, 1, i - 1));
        right := trim(copy(line, i + 1, length(line)));
        i := pos(';', right);
        if i > 0 then begin
          right := trim(copy(right, 1, i - 1));
        end;
        if isInType then begin
          ATypes.Values[left] := right;
        end else if isInConst then begin
          AConsts.Values[left] := right;
        end;
      end;
    end;
  finally
    close(f);
  end;
end;

function VarToInt(AVariant: Variant): integer;
var code: integer;
begin
  if VarIsNull(AVariant) then
    Result := 0
  else
    val(VarToStr(AVariant), Result, code);
end;

{TDict.}
  { Objects controlling (freeing) string list, accessing by name }
function TDict.GetObj(const AName: string): TObject;
begin
  Result := Objects[IndexOfName(AName)];
end;

procedure TDict.SetObj(const AName: string; AObj: TObject);
begin
  Values[AName] := '@';
  Objects[IndexOfName(AName)] := AObj;
end;

function TDict.GetDict(const AName: string): TDict;
begin
  Result := TDict(Obj[AName]);
end;

procedure TDict.SetDict(const AName: string; ADict: TDict);
begin
  Obj[AName] := TObject(ADict);
end;

procedure TDict.Clear;
var i: integer;
begin
  for i := 0 to Count - 1 do begin
    Objects[i].Free;
    Objects[i] := nil;
  end;
  inherited;
end;

procedure TDict.Delete(Index: integer);
begin
  Objects[Index].Free;
  inherited;
end;

destructor TDict.Destroy;
begin
  Clear;
  inherited;
end;
{/TDict.}

{ Python like joining list of strings to a big one using Delim as delimitor
  between the AList strings. }
function join(AList: TStrings; Delim: string): string;
var i: integer;
begin
  Result := '';
  for i := 0 to AList.Count - 1 do begin
    if Result = '' then
      Result := AList[i]
    else
      Result := Result + Delim + AList[i];
  end;
end;

{$IFNDEF CONSOLE}
var
  MaxLogMemoLines: integer = 200;

procedure MemoLog(AMemo: TMemo; const msg: string);
var
  i: integer;
begin
  //ExeLog.Log(msg);
  AMemo.Lines.Add(msg);
  if AMemo.Lines.Count > MaxLogMemoLines then begin
    AMemo.Lines.BeginUpdate;
    try
      for i := 0 to (MaxLogMemoLines div 2) do
        AMemo.Lines.Delete(0);
    finally
      AMemo.Lines.EndUpdate;
    end;
  end;
end;
{$ENDIF}
initialization
  SystemDecimalSeparator := DecimalSeparator;
end.
