unit WinUtl;

interface
uses
  SysUtils, Classes{v0.34}, Windows{v0.34}{v0.39}, FileCtrl, UtlType{/v0.39}
  {v0.45}, BinHex{/v0.45};
{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}
procedure MemFree(var P{:pointer});
  { tries to free memory allocated to P (if P <> nil), then sets it = nil }

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

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

function StreamReadln(AStream: TStream; var AString: shortstring): 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}
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). AExt is e.g.:  .TXT  Returns false if the ext not
    found }
{/v0.16}

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 }

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

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 = '' }

{v0.44}
function ParseLine(Delimitor: SetOfChar; const ALine: string; AList: TStrings): boolean;
  { splits given ALine to its parts separated by Delimitors to AList (AList.Clear called first) }
{/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);

function DateTimePartsToStr(ADate: TDateTime; dt1, dt2: TDateTimePart): string;
  { returns (index like) 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 StrToDateTimeParts(const AStr: string; dt1, dt2: TDateTimePart): TDateTime;
  { decode the string created by the DateTimePartsToStr function }

function DateTimeGetYYYYMM(const ADateTime: TDateTime): string;

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

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}

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

{v0.30}
type
  TDateTimeFormat = (dtDateString, dtDateTimeString);

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}
procedure GetSystemDateTime(var ADateTime: TDateTime);
  { returns GMT }
procedure GetLocalStdDateTime(var ADateTime: TDateTime; var DST: boolean);
  { 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.  }
{/v0.39}

{/DateTime}

{v0.35}
function ExecuteCommand(const ADir: string; const ACommand: string; Wait: boolean): integer;
  { 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 <> '') }
{/v0.35}

{FileNames-DirNames}
{v0.13}
function RelativeFileName(const ADir: string; const AFileName: TFileName{v0.36}; const ADefExt: string{/v0.36}): TFileName;
  { Returns filename stripped of specified (or current, if ADir = '')
    directory, if present. strips also extension if is equal to ADefExt. }
{/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) and
    appended ADefExt if extension was = '' }
{/v0.24}

{v0.36}
procedure FileNameSplit(const AFileName: string; var APath: string; var ABaseName: string;
  var AExt: string);
{/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) }

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

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

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. }

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

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).
    If Sorted is true, then ListSort is called before converting. }
procedure NumsStrToList(const AStr: string; AList: TList);

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

function NumsIsInList(ANumber: integer; AList: TList; ASorted: boolean): 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.) }
{/v0.44}

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

function GetDateTimeFileName(const ABaseName: TFileName; ADateTime: TDateTime; ADateTimePart: TDateTimePart): string;
  { creates filename with date/time info included in filename (before extension). }
function GetFileNameDateTime(const AFileName: TFileName; ADateTimePart: TDateTimePart): TDateTime;
  { extract date/time info from filename created by GetDateTimeFileName with specified ADateTimePart
    as a parameter }

function CharRepeat(Ch: char; ALen: integer): string;
  { returns string consisting of ALen chars Ch (e.g. CharRepeat('x',4) = 'xxxx')}

function PadLeft(const AStr: string; Ch: char; ALen: integer): string;
  { 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 }

{/v0.45}
{v0.46}
function GetEnv(EnvVar: String): string;
{/v0.46}

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 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);
  else
    raise Exception.Create('Invalid DTGetStr ' + IntToStr(ord(dt)));
  end;
end;

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

  function cp(start, len: integer): word;
  var code:integer;
  begin
    val(copy(s, start, len), result, code);
  end;

begin
  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
    raise Exception.Create('Invalid TDateTimeFormat ' + IntToStr(ord(dt)));
  end;
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(paramstr(0)), '.INI');
  ed := ExtractFileDir(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;

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 := 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;
begin
  SetLength(Result, 260);
  GetEnvironmentVariable(PChar(EnvVar), PChar(Result), 260);
  SetLength(Result, StrLen(PChar(Result)));
end;
{/v0.46}



end.
