WebSVN – oidplus – Diff – /trunk_dos/VTSFUNCS.PAS

 unit VTSFUNCS;
 (************************************************)
 (* VTSFUNCS.PAS                                 *)
 (* Author:   Daniel Marschall                   *)
-(* Revision: 2022-02-16                         *)
+(* Revision: 2022-02-19                         *)
 (* License:  Apache 2.0                         *)
 (* This file contains:                          *)
 (* - Various functions                          *)
 (************************************************)
 interface
 function Max(a, b: integer): integer;
 function Min(a, b: integer): integer;
 function CompareEqualLengthString(a, b: string): integer;
 function CompareNumericString(a, b: string): integer;
 procedure Beep;
 function Trim(s: string): string;
 function TrimLineToWidth(s: string; width: integer): string;
 function ZeroPad(i: LongInt; n: integer): string;
 function LeftPadStr(s: string; n: integer; ch: char): string;
 function RightPadStr(s: string; n: integer; ch: char): string;
 function RepeatStr(ch: char; n: integer): string;
 function DeleteFile(filename: string): boolean;
 function FileExists(filename: string): boolean;
 function IsPositiveIntegerOrZero(s: string): boolean;
 function StrToInt(s: string): Integer;
 function IntToStr(Value: Integer): string;
 function StringReplace(s, search, replace: string): string;
+function LastCharPos(const S: string; const Chr: char): integer;
+function LowerCase(s: string): string;
+function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
 implementation
 uses
   Crt;
 function Max(a, b: integer): integer;
 begin
   if a > b then
     Max := a
   else
     Max := b;
 end;
 function Min(a, b: integer): integer;
 begin
   if a < b then
     Min := a
   else
     Min := b;
 end;
 function CompareEqualLengthString(a, b: string): integer;
 var
   ao, bo, i: integer;
 begin
   CompareEqualLengthString := 0;
   for i := 1 to Length(a) do
   begin
     ao := Ord(a[i]);
     bo := Ord(b[i]);
     if ao > bo then
     begin
       CompareEqualLengthString := 1;
       break;
     end;
     if ao < bo then
     begin
       CompareEqualLengthString := -1;
       break;
     end;
   end;
 end;
 function CompareNumericString(a, b: string): integer;
 var
   EqualLength: integer;
 begin
   EqualLength := Max(Length(a), Length(b));
   a := LeftPadStr(a, EqualLength, '0');
   b := LeftPadStr(b, EqualLength, '0');
   CompareNumericString := CompareEqualLengthString(a, b);
 end;
 procedure Beep;
 begin
   Sound(220); (*220Hz*)
   Delay(200); (*200ms*)
   NoSound;
 end;
 function Trim(s: string): string;
 begin
   while Length(s) > 0 do
   begin
     if s[1] in [#9,#10,#13,' '] then
       Delete(s,1,1)
     else
       break;
   end;
   while Length(s) > 0 do
   begin
     if s[Length(s)] in [#9,#10,#13,' '] then
       Delete(s,Length(s),1)
     else
       break;
   end;
   Trim := s;
 end;
 function TrimLineToWidth(s: string; width: integer): string;
 begin
   if Length(s) > width then
   begin
     s := Copy(s, 1, width-3) + '...';
   end;
   TrimLineToWidth := s;
 end;
 function ZeroPad(i: LongInt; n: integer): string;
 var
   s: string;
 begin
   s := IntToStr(i);
   ZeroPad := LeftPadStr(s, n, '0');
 end;
 function LeftPadStr(s: string; n: integer; ch: char): string;
 begin
   while Length(s) < n do
   begin
     s := ch + s;
   end;
   LeftPadStr := s;
 end;
 function RightPadStr(s: string; n: integer; ch: char): string;
 begin
   while Length(s) < n do
   begin
     s := s + ch;
   end;
   RightPadStr := s;
 end;
 function RepeatStr(ch: char; n: integer): string;
 var
   i: integer;
   res: string;
 begin
   res := '';
   for i := 1 to n do
   begin
     res := res + ch;
   end;
   RepeatStr := res;
 end;
 function DeleteFile(filename: string): boolean;
 var
   F:  file;
   Ch: Char;
 begin
   Assign(F, filename);
   {$I-}
   Reset(F);
   {$I+}
   if IOResult <> 0 then
   begin
     DeleteFile := false; (* cannot find file *)
   end
   else
   begin
     Close(F);
     {$I-}
     Erase(F);
     {$I+}
     DeleteFile := IOResult = 0;
   end;
 end;
 function FileExists(filename: string): boolean;
 var
   F: Text;
 begin
   Assign(F, filename);
   {$I-}
   Reset(F);
   {$I+}
   if IoResult = 0 then
   begin
     Close(F);
     FileExists := true;
   end
   else
   begin
     FileExists := false;
   end;
 end;
 function IsPositiveIntegerOrZero(s: string): boolean;
 var
   i: integer;
 begin
   IsPositiveIntegerOrZero := false;
   if Length(s) = 0 then exit;
   if (s[1] = '0') and (s <> '0') then exit;
   for i := 1 to Length(s) do
   begin
     if not (s[i] in ['0'..'9']) then exit;
   end;
   IsPositiveIntegerOrZero := true;
 end;
 function StrToInt(s: string): Integer;
 var
   i, Error: Integer;
 begin
   Val(s, i, Error);
   StrToInt := i;
 end;
 function IntToStr(Value: Integer): string;
 var
   s: string;
 begin
   Str(Value, s);
   IntToStr := s;
 end;
 function StringReplace(s, search, replace: string): string;
 var
   i: integer;
   output: string;
 begin
-  if s = '' then exit;
+  if s = '' then
+  begin
+    StringReplace := '';
+    Exit;
+  end;
+  if search = '' then
+  begin
+    StringReplace := s;
-  if search = '' then exit; (* invalid arg *)
+    exit; (* invalid arg *)
+  end;
   output := '';
   while s <> '' do
   begin
     if Copy(s, 1, Length(search)) = search then
     begin
       output := output + replace;
       Delete(s, 1, Length(search));
     end
     else
     begin
       output := output + Copy(s, 1, 1);
       Delete(s, 1, 1);
     end;
   end;
   StringReplace := output;
 end;
+function LastCharPos(const S: string; const Chr: char): integer;
+var
+  i: Integer;
+begin
+  for i := length(S) downto 1 do
+  begin
+    if S[i] = Chr then
+    begin
+      LastCharPos := i;
+      Exit;
+    end;
+  end;
+  LastCharPos := 0;
+  Exit;
+end;
+function LowerCase(s: string): string;
+var
+  res: string;
+  i: integer;
+begin
+  res := '';
+  for i := 1 to Length(s) do
+  begin
+    if s[i] in ['A'..'Z'] then
+    begin
+      res := res + Chr(Ord('a')+(Ord(s[i])-Ord('A')));
+    end
+    else
+    begin
+      res := res + s[i];
+    end;
+  end;
+  LowerCase := res;
+end;
+function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
+var
+  i: Integer;
+  frombase_str: string;
+  tobase_str: string;
+  len: Integer;
+  number: string;
+  divide: Integer;
+  newlen: Integer;
+  res: string;
+begin
+  frombase_str := '';
+  for i := 0 to frombase-1 do
+  begin
+    if i < 10 then
+      frombase_str := frombase_str + IntToStr(i)
+    else
+      frombase_str := frombase_str + Chr(Ord('A') + (i-10));
+  end;
+  tobase_str := '';
+  for i := 0 to tobase-1 do
+  begin
+    if i < 10 then
+      tobase_str := tobase_str + IntToStr(i)
+    else
+      tobase_str := tobase_str + Chr(Ord('A') + (i-10));
+  end;
+  len := Length(numstring);
+  base_convert_bigint := '';
+  number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
+  for i := 0 to len-1 do
+  begin
+    number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);
+  end;
+  res := '';
+  repeat (* Loop until whole number is converted *)
+    divide := 0;
+    newlen := 0;
+    for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *)
+    begin
+      divide := divide * frombase + Ord(number[i+1]);
+      if (divide >= tobase) then
+      begin
+        number[newlen+1] := Chr(divide div tobase);
+        Inc(newlen);
+        divide := divide mod tobase;
+      end
+      else if newlen > 0 then
+      begin
+        number[newlen+1] := #0;
+        Inc(newlen);
+      end;
+    end;
+    len := newlen;
+    res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *)
+  until newlen = 0;
+  base_convert_bigint := res;
+end;
 end.

Subversion Repositories oidplus

oidplus/trunk_dos/VTSFUNCS.PAS – Rev 747 → 748