unit WinUtl;

interface
uses
  SysUtils, Classes{v0.34}, Windows{v0.34}{v0.39}, FileCtrl, UtlType{/v0.39}
  {v0.45}, BinHex{/v0.45}{v0.50 for TFindOptions}, Dialogs{/v0.50}
  {v0.61},DLLUtl{/v0.61};
{F:\T\UNITS32\WINUTL}
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);
{/v0.39}
{ 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 }
  );

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}

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;

function DelBackSlash(Dir : string) : string;
function AddBackSlash(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: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;
}

{ 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;


{ 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;

{/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}

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)] = '\' 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)] <> '\' then begin
      d := d + '\';
    end;
  end;
  if AFileName <> '' then begin
    if AFileName[1] = '\' 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);
  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;
  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 + '\' + bn;
  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(Dir : string) : string;
begin
  if (Length(Dir) > 3) then begin
    if (Dir[Length(Dir)] = '\') then SetLength(Dir, length(Dir) - 1);
  end else begin
    if (Dir[Length(Dir)] = '\') 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(Dir : string): string;
begin
  if (Dir <>  '') and (Dir[Length(Dir)] <> '\') then begin
    if (Length(Dir) <> 2) or (Dir[2] <> ':') then Dir := Dir + '\';
  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] = '\' 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;

const
  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}
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;

{/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;
var
  st: string;
begin
  st :='';
  while length(st) < len do
    st := st + ch;
  RepeatChar:=st
end;

{v0.60}
end.
