unit uPasExt;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

const
  SPACE       = #$20;
  TAB         = #$09;
  CR          = #$0d;
  LF          = #$0a;
  UNDERSCORE  = #$5f;
  CRLF        = #$0d#$0a;
//EOLn = CRLF; actually a function. so, can overload to use with text files

  URLSeparator      : String = DirectorySeparator;

  TAB_Default_Value : integer = 8;
  TAB_Fill_Value    : ShortString = #$20;

type
  TPathString = String;
  TByteArray = array of Byte;
  TWordArray = array of Word;
  TIntegerArray = array of Integer;
  TCharArray = array of Char;
  TStringArray = array of String;
  TPointerArray = array of Pointer;

const
  EmptyStringArray : TStringArray = ();

{ Array Handling procedures and functions }

// Maybey want to update Line function to work without EOLn on CR, LF, CRLF lines.
// However, AdjustEOLn will move convert them to current EOLn

function EOLn : ShortString; overload;
function EOLn(var t : Text) : boolean; overload;
function SetEOLn (NewEOLn : ShortString) : ShortString; overload;
function AdjustEOLn(AString:String) : String; overload;

procedure ClearArray(var A : TByteArray; ALength : integer = 0); overload;
procedure ClearArray(var A : TWordArray; ALength : integer = 0); overload;
procedure ClearArray(var A : TIntegerArray; ALength : integer = 0); overload;
procedure ClearArray(var A : TCharArray; ALength : integer = 0); overload;
procedure ClearArray(var A : TStringArray; ALength : integer = 0); overload;
procedure ClearArray(var A : TPointerArray; ALength : integer = 0); overload;

function AddToArray(var A : TByteArray; B : Byte) : integer; overload;
function AddToArray(var A : TWordArray; W : Word) : integer; overload;
function AddToArray(var A : TIntegerArray; I : Integer) : integer; overload;
function AddToArray(var A : TCharArray; C : Char) : integer; overload;
function AddToArray(var A : TStringArray; S : String) : integer; overload;
function AddToArray(var A : TPointerArray; P : Pointer) : integer; overload;

function InRange(ANum, ALow, AHigh : integer):boolean; overload;
function InRange(AString, ALow, AHigh : String):boolean; overload;

function InArray(AStr : String; AArray : TStringArray; CaseSpecific : boolean = true) : boolean; overload;

function IsAlphaNum(AStr : String) : boolean; overload;
function CountWords(AStr : String; Additional : string = '-_') : integer; overload;

function FilterExclude(AStr : String; AChars : String) : String; overload;
function FilterInclude(AStr : String; AChars : String) : String; overload;

function FilterWords(AStr : String; Additional : string = '-_') : String; overload;

function GetWord(AStr : String; ACount, AOrigin : integer; Additional : string = '-_') : string; overload;
function GetWord(AStr : String; ACount : integer; Additional : string = '-_') : string; overload;
function GetWord(AStr : String) : string; overload;
function GetLine(AStr : String; ACount, AOrigin : integer; AEOLn : string = '') : string; overload;
function GetLine(AStr : String; ACount : integer; AOrigin : integer) : string; overload;
function GetLine(AStr : String; ACount : integer = 1) : string; overload;

function PopWord(var AStr : String; ACount : integer; Additional : string = '-_') : string; overload;
function PopWord(var AStr : String; Additional : string = '-_') : string; overload;
function PopLine(var AStr : String; ACount : integer = 1) : string; overload;

function PopDelim(var AStr : String; ADelim : String) : String; overload;

function ReplaceAll(AOld, ANew, ASrc : String; AOrigin : integer = 1):String; overload;

{ search and replace of concurrent matches }
function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean; AMin : integer; AMax : integer) : string; overload;
function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean; AMin : integer = -1) : string; overload;
function Scrunch(AFrom, ATo, AIn : string; AMin : integer) : string; overload;
function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean = false) : string; overload;

function SafeFileName(AFileName: string; AAutoEnum : boolean; ARaise : boolean = true): string; overload;
function FileSafeName(AStr : String; AMax : integer = -1) : String; overload;
function WebSafeName(AStr : String; AMax : integer = -1) : String; overload;
function LocateFile(AFileName: String; ARaise: boolean = true): String; overload;

function SaveAsFile(AFileName: String; AValue : String; ARaise : boolean = true) : integer; overload;
function LoadFromFile(AFileName: String; var AValue : String; ARaise : boolean = true) : integer; overload;

function WordCase(AStr : String) : String; overload;
function TitleCase(AStr : String) : String; overload;

function CharOfStr(AStr : String; Index : integer = 1) : Char; overload;

function LastPos(ASubStr, AStr : String; AOrigin : integer = -1) : integer; overload;

function WhenTrue(AState : boolean; ATrue : String;  AFalse : String = '') : String; overload;
function WhenTrue(AState : boolean; ATrue : integer; AFalse : integer = 0) : integer; overload;
function WhenTrue(AState : boolean; ATrue : pointer; AFalse : pointer = nil) : pointer; overload;

function WhenTrue(AStr : String; ATrue : String;  AFalse : String = '') : String; overload;
function WhenTrue(AStr : String; ATrue : integer; AFalse : integer = 0) : integer; overload;
function WhenTrue(AStr : String; ATrue : pointer; AFalse : pointer = nil) : pointer; overload;

function WhenTrue(AInt : Integer; ATrue : String;  AFalse : String = '') : String; overload;
function WhenTrue(AInt : Integer; ATrue : integer; AFalse : integer = 0) : integer; overload;
function WhenTrue(AInt : Integer; ATrue : pointer; AFalse : pointer = nil) : pointer; overload;

function WhenTrue(APtr : Pointer; ATrue : String;  AFalse : String = '') : String; overload;
function WhenTrue(APtr : Pointer; ATrue : integer; AFalse : integer = 0) : integer; overload;
function WhenTrue(APtr : Pointer; ATrue : pointer; AFalse : pointer = nil) : pointer; overload;

function FirstOf(AStr : String) : String; overload;
function LastOf(AStr : String) : String; overload;

function StringofStrings(AStr : String; ACount : integer) : String; overload;

function TabExpand(AStr : String;  AOffset, ATabValue: integer) : String; overload;
function TabExpand(AStr : String; AOffset : integer = -1) : String; overload;

function LTrim(AStr : String; AChars : String = SPACE + TAB) : String; overload;
function RTrim(AStr : String; AChars : String = SPACE + TAB) : String; overload;

function MatchLength(AStr, BStr : String) : integer; overload;

function MakeRelative(AOrigin, ADestination : String) : String; overload;

function Excise(var AStr : String; AFrom : String; ATo : String = '') : String; overload;

function IsAlpha(AStr : String) : boolean; overload;
function IsHex(AStr : String) : boolean; overload;
function IsNumber(AStr : String) : boolean; overload;

function Occurs(ASubStr, AStr : String) : integer; overload;
function LineCount(AStr : String) : integer; overload;

function HasTrailing(ASubStr, AStr : String; CaseSpecific : boolean = true) : boolean; overload;
function ExcludeTrailing(ASubStr, AStr : String; CaseSpecific : boolean = true) : String; overload;
function IncludeTrailing(ASubStr, AStr : String; CaseSpecific : boolean = true) : String; overload;

function HasLeading(ASubStr, AStr : String; CaseSpecific : boolean = true) : boolean; overload;
function ExcludeLeading(ASubStr, AStr : String; CaseSpecific : boolean = true) : String; overload;
function IncludeLeading(ASubStr, AStr : String; CaseSpecific : boolean = true) : String; overload;

function StrToInt(AStr : String) : integer; overload;

function PopCSV(var AStr : string) : String; overload;
function GetCSV(AStr : String; AField : integer = 0) : String; overload;

function LeftPad(AStr : String; AWidth: integer; ASubStr : String = ' ') : String; overload;
function RightPad(AStr : String; AWidth: integer; ASubStr : String = ' ') : String; overload;
function CenterPad(AStr : String; AWidth: integer; ASubStr : String = ' ') : String; overload;

implementation

const
  EOLn_Char : ShortString = #$0d#$0a;

{ Array Handling procedures and functions }

function EOLn: ShortString;
begin
  Result := EOLn_Char;
end;

function EOLn(var t: Text): boolean;
begin
  Result := System.EOLN(T);
end;

function SetEOLn(NewEOLn: ShortString): ShortString;
begin
  Result:=EOLn_char;
  EOLn_Char:=NewEOLn;
end;

function AdjustEOLn(AString: String): String;
begin
  case EOLN_Char of
  CR : Result:=ReplaceAll(LF, CR, ReplaceAll(CRLF, CR, AString));
  LF : Result:=ReplaceAll(CR, LF, ReplaceAll(CRLF, LF, AString));
  else
    Result:=ReplaceAll(LF, EOLn_Char,
      ReplaceAll(CR, LF, ReplaceAll(CRLF, LF, AString)));
  end;
end;

procedure ClearArray(var A: TByteArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := 0;
end;

procedure ClearArray(var A: TWordArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := 0;
end;

procedure ClearArray(var A: TIntegerArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := 0;
end;

procedure ClearArray(var A: TCharArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := #0;
end;

procedure ClearArray(var A: TStringArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := '';
end;

procedure ClearArray(var A: TPointerArray; ALength: integer);
var
  I : integer;
begin
  SetLength(A, ALength);
  if Length(A) > 0 then
    for I := Low(A) to High(A) do
      A[I] := nil;
end;

function AddToArray(var A: TByteArray; B: Byte): integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := B;
  Result := Length(A);
end;

function AddToArray(var A: TWordArray; W: Word): integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := W;
  Result := Length(A);
end;

function AddToArray(var A: TIntegerArray; I: Integer): integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := I;
  Result := Length(A);
end;

function AddToArray(var A: TCharArray; C: Char): integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := C;
  Result := Length(A);
end;

function AddToArray(var A : TStringArray; S : String) : integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := S;
  Result := Length(A);
end;

function AddToArray(var A: TPointerArray; P: Pointer): integer;
begin
  SetLength(A, Length(A) + 1);
  A[High(A)] := P;
  Result := Length(A);
end;

function InRange(ANum, ALow, AHigh: integer): boolean;
begin
  Result := (ANum >= ALow) and (ANum <= AHigh);
end;

function InRange(AString, ALow, AHigh: String): boolean;
begin
  Result := (AString >= ALow) and (AString <= AHigh);
end;

function InArray(AStr: String; AArray: TStringArray; CaseSpecific: boolean
  ): boolean;
var
  I : integer;
begin
  Result := False;
  if CaseSpecific then begin
    for I := Low(AArray) to High(AArray) do
      if AStr = AArray[I] then begin
        Result := True;
        Exit;
      end;
  end else begin
    AStr := Uppercase(AStr);
    for I := Low(AArray) to High(AArray) do
      if AStr = Uppercase(AArray[I]) then begin
        Result := True;
        Exit;
      end;
  end;
end;

function IsAlphaNum(AStr: String): boolean;
var
  I : integer;
begin
  Result := False;
  for I := 1 to Length(AStr) do
    if not (InRange(Uppercase(AStr[I]), 'A', 'Z') or InRange(AStr[I], '0', '9')) then
      exit;
  Result := True;
end;

function CountWords(AStr: String; Additional: string): integer;
var
  I, R : integer;
begin
  R := 0;
  I := 1;
  // AStr := Trim(AStr);
  while I <= Length(AStr) do begin
    if IsAlphaNum(AStr[I]) or (Pos(AStr[I], Additional) > 0) then begin
      Inc(R);
      while (I <= Length(AStr)) and ( IsAlphaNum(AStr[I]) or (Pos(AStr[I], Additional) > 0) ) do
        Inc(I);
    end else Inc(I);
  end;
  Result := R;
end;

function FilterExclude(AStr: String; AChars: String): String;
var
 I : integer;
begin
  I := 1;
  While I <= Length(AStr) do
    if Pos(AStr[I], AChars) > 0 then
      Delete(AStr, I, 1)
    else
      Inc(I);
  Result := AStr;
end;

function FilterInclude(AStr: String; AChars: String): String;
var
 I : integer;
begin
  I := 1;
  While I <= Length(AStr) do
    if Pos(AStr[I], AChars) < 1 then
      Delete(AStr, I, 1)
    else
      Inc(I);
  Result := AStr;
end;

function FilterWords(AStr: String; Additional: string): String;
var
  R : String;
  I : integer;
  F : boolean;
begin
  I := 1;
  R := '';
  AStr := Trim(AStr);
  while I <= Length(AStr) do begin
    if IsAlphaNum(AStr[I]) or (Pos(AStr[I], Additional) > 0) then begin
      while (I <= Length(AStr)) and ( IsAlphaNum(AStr[I]) or (Pos(AStr[I], Additional) > 0) ) do begin
        R := R + AStr[I];
        Inc(I);
        F := True;
      end;
    end else begin
      if F then begin
        R := R + ' ';
        F := False;
      end;
      Inc(I);
    end;
  end;
  Result := Trim(R);
end;

function GetWord(AStr: String; ACount, AOrigin: integer; Additional: string
  ): string;
var
  R : String;
begin
  R := '';
  // AStr := Trim(AStr);
  if ACount < 1 then Exit;
  while AOrigin <= Length(AStr) do begin
    if IsAlphaNum(AStr[AOrigin]) or (Pos(AStr[AOrigin], Additional) > 0) then begin
      Dec(ACount);
      while (AOrigin <= Length(AStr)) and ( IsAlphaNum(AStr[AOrigin]) or (Pos(AStr[AOrigin], Additional) > 0) ) do begin
        R := R + AStr[AOrigin];
        Inc(AOrigin);
      end;
    end else begin
      if ACount < 1 then break;
      R := R + AStr[AOrigin];
      Inc(AOrigin);
    end;
  end;
  // Result := Trim(R);
  Result := R;
end;

function GetWord(AStr: String; ACount: integer; Additional: string): string;
begin
  Result := GetWord(AStr, ACount, 1, Additional);
end;

function GetWord(AStr: String): string;
begin
  Result := GetWord(AStr, 1, 1, '-_');
end;

function GetLine(AStr: String; ACount, AOrigin: integer; AEOLn: string): string;
var
  I, L, P : integer;
  R : String;
begin
  R := '';
  I := 0;
  P := 1;
  L := 1;
  while (P <= Length(AStr)) and (ACount > 0) do begin
    P := Pos(AEOLN, AStr, P);
      if P < 1 then P := Length(AStr)+1;
    if AOrigin >= I then begin
      R := R + WhenTrue(R, AEOLn) + Copy(AStr, L, P - L);
      L := P + Length(AEOLn);
      Dec(ACount);
    end;
    Inc(I);
  end;
  Result:=R;
end;

function GetLine(AStr: String; ACount: integer; AOrigin: integer): string;
begin
  Result := GetLine(AStr, ACount, AOrigin, EOLn);
end;

function GetLine(AStr: String; ACount: integer): string;
begin
  Result := GetLine(AStr, ACount, 0, EOLn);
end;

function PopWord(var AStr: String; ACount: integer; Additional: string
  ): string;
var
  S : String;
begin
  AStr := Trim(AStr);
  S := GetWord(AStr, ACount, Additional);
  if S = '' then S := AStr;
  Delete(AStr, 1, Length(S));
  AStr := Trim(AStr);
  Result := S;
end;

function PopWord(var AStr: String; Additional: string): string;
begin
  Result := PopWord(AStr, 1, Additional);
end;

function PopLine(var AStr: String; ACount: integer): string;
var
  R : String;
begin
  R := GetLine(AStr, ACount);
  Delete(AStr, 1, Length(R));
  if Copy(AStr, 1, Length(EOLn)) = EOLn then
    Delete(AStr, 1, Length(EOLn));
  Result := R;
end;

function PopDelim(var AStr : String; ADelim: String): String;
var
  P : integer;
begin
  P := Pos(ADelim, AStr);
  if P <= 0 then P := Length(AStr) + 1;
  Result := Copy(AStr, 1, P - 1);
  Delete(AStr, 1, P - 1 + Length(ADelim));
end;

function replaceAll(AOld, ANew, ASrc: String; AOrigin: integer): String;
begin
  repeat
    AOrigin := Pos(AOld, ASrc, AOrigin);
    if AOrigin > 0 then begin
      Insert(ANew, ASrc, AOrigin);
      AOrigin := AOrigin + Length(ANew);
      Delete(ASrc, AOrigin, Length(AOld));
    end;
  until AOrigin < 1;
  Result:=ASrc;
end;


function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean; AMin : integer; AMax : integer) : string; overload;
var
  S : String;
  I, F, L, C : integer;
begin
  if AMax = -1 then AMax := Length(AIn);
  I := 1;
  F := 0;
  L := 0;
  C := 0;
  if AAnyCase then AFrom := Uppercase(AFrom);
  while I <= Length(AIn) do begin
    S := Copy(AIn, I, Length(AFrom));
    if AAnyCase then S := Uppercase(AFrom);
    if (S = AFrom) then begin
      L := I;
      if F = 0 then F := I;
      Inc(C);
      Inc(I, Length(S));
    end else begin
      Inc(I);
      if (C >= AMin) and (C <= AMax) then begin
        Delete(AIn, F, L - F + Length(S));
        Insert(ATo, AIn, F);
        I := L - F + Length(ATo);
      end;
      C := 0;
      F := 0;
      L := 0;
    end;
  end;
  if (C >= AMin) and (C <= AMax) then begin
    Delete(AIn, F, L - F + Length(S));
    AIn := AIn + ATo;
  end;
  Result := AIn;
end;

function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean; AMin : integer = -1) : string; overload;
begin
  Result := Scrunch(AFrom, ATo, AIn, AAnyCase, AMin, -1);
end;

function Scrunch(AFrom, ATo, AIn : string; AMin : integer) : string; overload;
begin
  Result := Scrunch(AFrom, ATo, AIn, false, AMin, -1);
end;

function Scrunch(AFrom, ATo, AIn : string; AAnyCase : boolean = false) : string; overload;
begin
  Result := Scrunch(AFrom, ATo, AIn, AAnyCase, 1, -1);
end;


function SafeFileName(AFileName: string; AAutoEnum : boolean; ARaise: boolean): string;
var
  N, P, B, E : String;
  I : integer;
begin
  Result := '';
  P := IncludeTrailingPathDelimiter(ExtractFilePath(ExpandFileName(AFileName)));
  B := ExtractFileName(AFileName);
  E := ExtractFileExt(AFileName);
  if E <> '' then begin
     E := '.' + E;
     SetLength(B, Length(B) - Length(E));
  end;
  if not DirectoryExists(P) then begin
    if not CreateDir(P) then begin
      if ARaise then
        raise Exception.Create('Unable to create directory "' + P + '"')
      else
        Exit;
    end;
  end;
  N := P + B + E;
  I:=0;
  while FileExists(N) do begin
    Inc(I);
    N:=P + B + '_' + IntToStr(I) + E;
  end;
  if (not AAutoEnum) and (I > 0) then begin
    if ARaise then
      raise Exception.Create('file "' + AFileName + '" already exists')
    else
      Exit;

  end else
    Result:=N;
end;

function FileSafeName(AStr: String; AMax: integer): String;
var
  I : integer;
begin
  if AMax > 0 then
    AStr := Copy(AStr, 1, AMax);
  for I := 1 to Length(AStr) do
    if not (InRange(Uppercase(AStr[I]), 'A', 'Z') or InRange(AStr[I], '0', '9') or
    (Pos(AStr[I], ' ~-_+=@') > 0)) then
      AStr[I] := '_';
  while (Length(AStr) > 0) and (Pos(AStr[1], ' _-+=') > 0) do delete(AStr, 1,1);
  while (Length(AStr) > 0) and (Pos(AStr[Length(AStr)], ' _-+=') > 0) do SetLength(AStr, Length(AStr) - 1);
  Result := AStr;
end;

function WebSafeName(AStr: String; AMax: integer): String;
begin
  Result := lowercase(ReplaceAll(' ', '_', FileSafeName(AStr, AMax)));
end;

function LocateFile(AFileName: String; ARaise: boolean): String;
var
  AName : String;
  function SearchFile(APath : String) : String;
  var
     ASearch : TSearchRec;
  begin
    Result := '';
    APath := IncludeTrailingPathDelimiter(APath);
    if FindFirst(APath + '*', faAnyFile, ASearch) = 0 then
      repeat
        if (ASearch.Name = '.') or (ASearch.Name = '..') then
          Continue
        else if (ASearch.Attr and faDirectory = faDirectory) then
           Result := SearchFile(APath + ASearch.Name)
        else if (AName = Uppercase(ASearch.Name)) then
          Result := APath + ASearch.Name;
      until (Result <> '') or (FindNext(ASearch) <> 0);
    FindClose(ASearch);
  end;

begin
  AName := UpperCase(ExtractFileName(AFileName));
  Result := SearchFile(ExtractFilePath(ExpandFileName(AFileName)));
  if (Result = '') and ARaise then
    raise Exception.Create('unable to locate "' + AFileName + '" file');

end;

function SaveAsFile(AFileName: String; AValue: String; ARaise: boolean
  ): integer;
var
   T : Text;
begin
  System.Assign(T, AFileName);
  rewrite(T);
  WriteLn(T, AValue);
  Close(T);
  Result := 0;
end;

function LoadFromFile(AFileName: String; var AValue: String; ARaise: boolean
  ): integer;
var
   T : Text;
   X, S : String;
begin
  System.Assign(T, AFileName);
  Reset(T);
  X := '';
  AValue := X;
  while not EOF(T) do begin
    ReadLn(T, S);
    X := X + S + EOLn;
  end;
  Close(T);
  AValue := X;
  Result := 0;
end;

function WordCase(AStr: String): String;
var
   I, P : integer;
begin
  I := 1;
  while I <= Length(AStr) do begin
    if (I = 1) or (AStr[I - 1] = ' ') then begin
      P := I;
      While (P < Length(AStr)) and (
        InRange(Uppercase(AStr[P+1]), 'A', 'Z') or
        InRange(AStr[P+1], '0', '9') or
        (Pos(AStr[P+1], '_-+') > 0) ) do Inc(P);
      AStr[I] := CharOfStr(Uppercase(AStr[I]),1);
      I := P;
    end;
    Inc(I);
  end;
 Result := AStr;
end;

function TitleCase(AStr: String): String;
var
   I, P : integer;
   F : boolean;
begin
  I := 1;
  while I <= Length(AStr) do begin
    if (I = 1) or (AStr[I - 1] = ' ') then begin
      P := I;
      F := True;
      While (P < Length(AStr)) and (
        InRange(Uppercase(AStr[P+1]), 'A', 'Z') or
        InRange(AStr[P+1], '0', '9') or
        (Pos(AStr[P+1], '_-+') > 0) ) do Inc(P);
      if I > 1 then
        case lowercase(Copy(AStr, I, P - I + 1)) of
        'a', 'an', 'the'                     : begin F := False; end;
        'and', 'but', 'for', 'of', 'or'      : begin F := False; end;
        'at', 'by', 'to', 'from', 'in', 'on' : begin F := False; end;
        end;
      if F then
        AStr[I] := CharOfStr(Uppercase(AStr[I]),1)
      else begin
        Insert(lowercase(Copy(AStr, I, P - I + 1)), AStr, I);
        Delete(AStr, P + 1, P - I + 1);
      end;

      I := P;
    end;
    Inc(I);
  end;
 Result := AStr;
end;

function CharOfStr(AStr: String; Index: integer): Char;
begin
  Result := AStr[Index];
end;

function LastPos(ASubStr, AStr: String; AOrigin: integer): integer;
begin
  Result := -1;
  if (AOrigin < 0) or (AOrigin > Length(AStr)) then
    AOrigin := Length(AStr);
  while AOrigin > 0 do begin
    if Copy(AStr, AOrigin, Length(ASubStr)) = ASubStr then begin
      Result := AOrigin;
      Break;
    end;
    Dec(AOrigin);
  end;
end;

function WhenTrue(AState: boolean; ATrue: String; AFalse: String): String;
begin
  if AState then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AState: boolean; ATrue: integer; AFalse: integer): integer;
begin
  if AState then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AState: boolean; ATrue: pointer; AFalse: pointer): pointer;
begin
  if AState then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AStr: String; ATrue: String; AFalse: String): String;
begin
  if AStr <> '' then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AStr: String; ATrue: integer; AFalse: integer): integer;
begin
  if AStr <> '' then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AStr: String; ATrue: pointer; AFalse: pointer): pointer;
begin
  if AStr <> '' then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AInt: Integer; ATrue: String; AFalse: String): String;
begin
  if AInt <> 0 then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AInt: Integer; ATrue: integer; AFalse: integer): integer;
begin
  if AInt <> 0 then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(AInt: Integer; ATrue: pointer; AFalse: pointer): pointer;
begin
  if AInt <> 0 then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(APtr: Pointer; ATrue: String; AFalse: String): String;
begin
  if Assigned(APtr) then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(APtr: Pointer; ATrue: integer; AFalse: integer): integer;
begin
  if Assigned(APtr) then
    Result := ATrue
  else
    Result := AFalse;
end;

function WhenTrue(APtr: Pointer; ATrue: pointer; AFalse: pointer): pointer;
begin
  if Assigned(APtr) then
    Result := ATrue
  else
    Result := AFalse;
end;

function FirstOf(AStr: String): String;
begin
  if Length(AStr) = 0 then
    Result := ''
  else
    Result := AStr[1];
end;

function LastOf(AStr: String): String;
begin
  if Length(AStr) = 0 then
    Result := ''
  else
    Result := AStr[Length(AStr)];
end;

function StringofStrings(AStr: String; ACount: integer): String;
var
   R : String;
begin
  R := '';
  While ACount > 0 do begin
    R := R + AStr;
    Dec(ACount);
  end;
  Result := R;
end;

function TabExpand(AStr: String; AOffset, ATabValue: integer): String;
var
   I, X : integer;
begin
  if ATabValue < 0 then ATabValue := TAB_Default_Value;
  I := 1;
  while I <= Length(AStr) do begin
    if Copy(AStr, I, Length(TAB)) = TAB then begin
      X := ATabValue - ((I + AOffset) mod ATabValue);
      Insert(StringOfStrings(TAB_Fill_Value, X), AStr, I);
      Inc(I, X * Length(TAB_Fill_Value));
      Delete(AStr, I, Length(TAB));
    end else
      Inc(I);
  end;
  Result := AStr;
end;

function TabExpand(AStr: String; AOffset: integer): String;
begin
  Result := TabExpand(AStr, AOffset, TAB_Default_Value);
end;

function LTrim(AStr: String; AChars: String): String;
var
   I : integer;
begin
  I := 0;
  while (I + 1 <= Length(AStr)) and (Pos(AStr[I + 1], AChars) > 0) do Inc(I);
  if I > 0 then Delete(AStr, 1, I);
  Result := AStr;
end;

function RTrim(AStr: String; AChars: String): String;
var
   I : integer;
begin
  I := Length(AStr);
  while (I > 0) and (Pos(AStr[I], AChars) > 0) do Dec(I);
  SetLength(AStr, I);
  Result := AStr;
end;

function MatchLength(AStr, BStr: String): integer;
var
   I : integer;
begin
  Result := 0;
  for I := 1 to Length(AStr) do
    if (I > Length(BStr)) or (AStr[I] <> BStr[I]) then
      Break
    else
      Result := I;
end;

function MakeRelative(AOrigin, ADestination: String): String;
begin
  if Copy(AOrigin, 1,1) <> DirectorySeparator then
    AOrigin := DirectorySeparator + AOrigin;
  if Copy(ADestination, 1,1) <> DirectorySeparator then
    ADestination := DirectorySeparator + ADestination;
  Result := ExtractRelativePath(
    ExtractFilePath(AOrigin), ExtractFilePath(ADestination)
    ) + ExtractFileName(ADestination);
   // WriteLn(AOrigin, ' - ', ADestination, ' = ', Result);
end;

function Excise(var AStr : String; AFrom : String; ATo : String = '') : String;
var
  P, E, EL : integer;
begin
  P := Pos(AFrom, AStr);
  if P > 1 then begin
    EL := Length(ATo);
    if EL = 0 then begin
      E := 0;
      EL := 1;
    end else
       E := Pos(ATo, AStr, P + Length(AFrom));
    if E < 1 then E := Length(AStr) + 1;
    Result := Copy(AStr, P + Length(AFrom), E - P - Length(AFrom));
    Delete(AStr, P, E - P + Length(ATo));
  end else
    Result := '';
end;

function IsAlpha(AStr: String): boolean;
var
  I : integer;
begin
  AStr := Uppercase(AStr);
  Result := Length(AStr) > 0;
  for I := 1 to Length(AStr) do
    if not InRange(AStr[I], 'A', 'Z') then begin
      Result := False;
      Break;
    end;
end;

function IsHex(AStr: String): boolean;
var
  I : integer;
begin
   Result := False;
   AStr := Uppercase(AStr);
   I := Length(AStr);
   if Length(AStr) < 1 then Exit;
   if (Copy(AStr, 1, 2) = '0X') then
     Delete(AStr, 1,2)
   else
   if (Copy(AStr, 1, 1) = 'X') then
     Delete(AStr, 1, 1)
   else
   if (Copy(AStr, Length(AStr), 1) = 'H') then
     SetLength(AStr, Length(AStr) - 1);
   if (I = Length(AStr)) or (Length(AStr) = 0) then exit;
   if Length(AStr) mod 2 <> 0 then exit;
   for I := 1 to Length(AStr) do
     if not (InRange(AStr[I], '0', '9') or InRange(AStr[I], 'A', 'F')) then
       Exit;
   Result := True;
end;

function IsNumber(AStr: String): boolean;
var
  I : integer;
begin
  Result := Length(AStr) > 0;
  for I := 1 to Length(AStr) do
    if not InRange(AStr[I], '0', '9') then begin
      Result := False;
      Break;
    end;
end;

function Occurs(ASubStr, AStr: String): integer;
var
  P : integer;
begin
  Result := 0;
  P := 0;
  repeat
    P := Pos(ASubStr, AStr, P + 1);
    if P > 0 then begin
      Inc(Result);
      P := P + Length(ASubStr);
    end;
  until P < 1;

end;

function LineCount(AStr: String): integer;
begin
  Result := Occurs(CRLF, AStr);
  if (AStr <> '') and (Copy(AStr, Length(AStr) - Length(CRLF) + 1, Length(CRLF)) <> CRLF) then
    Inc(Result);
end;

function HasTrailing(ASubStr, AStr: String; CaseSpecific: boolean): boolean;
begin
  if CaseSpecific then
    Result := Copy(AStr, Length(AStr) - Length(ASubStr) + 1) = ASubStr
  else
    Result := Uppercase(Copy(AStr, Length(AStr) - Length(ASubStr) + 1)) = Uppercase(ASubStr);
end;

function ExcludeTrailing(ASubStr, AStr: String; CaseSpecific: boolean): String;
begin
  if HasTrailing(ASubStr, AStr, CaseSpecific) then
    Result := Copy(AStr, 1, Length(AStr) - Length(ASubStr))
  else
    Result := AStr;
end;

function IncludeTrailing(ASubStr, AStr: String; CaseSpecific: boolean): String;
begin
  if HasTrailing(ASubStr, AStr, CaseSpecific) then
    Result := AStr
  else
    Result := AStr + ASubStr;
end;

function HasLeading(ASubStr, AStr: String; CaseSpecific: boolean): boolean;
begin
  if CaseSpecific then
    Result := Copy(AStr, 1, Length(ASubStr)) = ASubStr
  else
    Result := Uppercase(Copy(AStr, 1, Length(ASubStr))) = Uppercase(ASubStr);
end;

function ExcludeLeading(ASubStr, AStr: String; CaseSpecific: boolean): String;
begin
  if HasLeading(ASubStr, AStr, CaseSpecific) then
    Result := Copy(AStr, Length(ASubStr) + 1)
  else
    Result := AStr;
end;

function IncludeLeading(ASubStr, AStr: String; CaseSpecific: boolean): String;
begin
  if HasLeading(ASubStr, AStr, CaseSpecific) then
    Result := AStr
  else
    Result := ASubStr + AStr;
end;

function StrToInt(AStr: String): integer;
var
 E : integer;
begin
  Val(AStr, Result, E);
  if E <> 0 then Result := 0;
end;

function PopCSV(var AStr: string): String;
var
 Quoting : boolean;
begin
  Result := '';
  Quoting := False;
  while (AStr <> '')  do begin
    if HasLeading('"""', AStr) then begin
      Result := Result + '"';
      Quoting := Not Quoting;
      Delete(AStr, 1, 3);
    end else
    if HasLeading('""', AStr) then begin
      Result := Result + '"';
      Delete(AStr, 1, 2);
    end else
    if HasLeading('"', AStr) then begin
      Delete(AStr, 1, 1);
      Quoting := Not Quoting;
    end else
    if (Not Quoting) and (HasLeading(',', AStr)) then begin
      Delete(AStr, 1, 1);
      Break;
    end else begin
      Result := Result + FirstOf(AStr);
      Delete(AStr,1,1);
    end;
  end;

end;

function GetCSV(AStr: String; AField: integer): String;
begin
  repeat
    Result := PopCSV(AStr);
    Dec(AField);
  until (AField + 1) <= 0 ;
end;

function LeftPad(AStr: String; AWidth: integer; ASubStr: String): String;
begin
  if ASubStr = '' then ASubStr := SPACE;
  While (Length(AStr) < AWidth) do begin
    AStr := ASubStr + AStr;
  end;
  Result := AStr;
end;

function RightPad(AStr: String; AWidth: integer; ASubStr: String): String;
begin
  if ASubStr = '' then ASubStr := SPACE;
  While (Length(AStr) < AWidth) do begin
    AStr := AStr + ASubStr;
  end;
  Result := AStr;
end;

function CenterPad(AStr: String; AWidth: integer; ASubStr: String): String;
begin
  if ASubStr = '' then ASubStr := SPACE;
  While (Length(AStr) < AWidth) do begin
    AStr := AStr + ASubStr;
    if (Length(AStr) < AWidth) then
      AStr := ASubStr + AStr;
  end;
  Result := AStr;
end;


end.