Subversion Repositories oidplus

Rev

Rev 750 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit VTSFUNCS;
  2.  
  3. (************************************************)
  4. (* VTSFUNCS.PAS                                 *)
  5. (* Author:   Daniel Marschall                   *)
  6. (* Revision: 2022-10-11                         *)
  7. (* License:  Apache 2.0                         *)
  8. (* This file contains:                          *)
  9. (* - Various functions                          *)
  10. (************************************************)
  11.  
  12. interface
  13.  
  14. function Max(a, b: integer): integer;
  15. function Min(a, b: integer): integer;
  16.  
  17. function CompareEqualLengthString(a, b: string): integer;
  18. function CompareNumericString(a, b: string): integer;
  19.  
  20. procedure Beep;
  21.  
  22. function Trim(s: string): string;
  23. function TrimLineToWidth(s: string; width: integer): string;
  24. function ZeroPad(i: LongInt; n: integer): string;
  25. function LeftPadStr(s: string; n: integer; ch: char): string;
  26. function RightPadStr(s: string; n: integer; ch: char): string;
  27. function RepeatStr(ch: char; n: integer): string;
  28.  
  29. function DeleteFile(filename: string): boolean;
  30. function FileExists(filename: string): boolean;
  31.  
  32. function StripLeadingZeros(s: string): string;
  33. function IsPositiveIntegerOrZero(s: string): boolean;
  34. function IsBase36String(s: string): boolean;
  35. function TryStrToInt(s: string; var i: LongInt): boolean;
  36. function StrToInt(s: string): LongInt;
  37. function IntToStr(Value: LongInt): string;
  38.  
  39. function StringReplace(s, search, replace: string): string;
  40.  
  41. function LastCharPos(const S: string; const Chr: char): integer;
  42. function LowerCase(s: string): string;
  43. function UpperCase(s: string): string;
  44. function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
  45.  
  46. implementation
  47.  
  48. uses
  49.   Crt;
  50.  
  51. function Max(a, b: integer): integer;
  52. begin
  53.   if a > b then
  54.     Max := a
  55.   else
  56.     Max := b;
  57. end;
  58.  
  59. function Min(a, b: integer): integer;
  60. begin
  61.   if a < b then
  62.     Min := a
  63.   else
  64.     Min := b;
  65. end;
  66.  
  67. function CompareEqualLengthString(a, b: string): integer;
  68. var
  69.   ao, bo, i: integer;
  70. begin
  71.   CompareEqualLengthString := 0;
  72.   for i := 1 to Length(a) do
  73.   begin
  74.     ao := Ord(a[i]);
  75.     bo := Ord(b[i]);
  76.     if ao > bo then
  77.     begin
  78.       CompareEqualLengthString := 1;
  79.       break;
  80.     end;
  81.     if ao < bo then
  82.     begin
  83.       CompareEqualLengthString := -1;
  84.       break;
  85.     end;
  86.   end;
  87. end;
  88.  
  89. function CompareNumericString(a, b: string): integer;
  90. var
  91.   EqualLength: integer;
  92. begin
  93.   EqualLength := Max(Length(a), Length(b));
  94.   a := LeftPadStr(a, EqualLength, '0');
  95.   b := LeftPadStr(b, EqualLength, '0');
  96.   CompareNumericString := CompareEqualLengthString(a, b);
  97. end;
  98.  
  99. procedure Beep;
  100. begin
  101.   Sound(220); (*220Hz*)
  102.   Delay(200); (*200ms*)
  103.   NoSound;
  104. end;
  105.  
  106. function Trim(s: string): string;
  107. begin
  108.   while Length(s) > 0 do
  109.   begin
  110.     if s[1] in [#9,#10,#13,' '] then
  111.       Delete(s,1,1)
  112.     else
  113.       break;
  114.   end;
  115.   while Length(s) > 0 do
  116.   begin
  117.     if s[Length(s)] in [#9,#10,#13,' '] then
  118.       Delete(s,Length(s),1)
  119.     else
  120.       break;
  121.   end;
  122.   Trim := s;
  123. end;
  124.  
  125. function TrimLineToWidth(s: string; width: integer): string;
  126. begin
  127.   if Length(s) > width then
  128.   begin
  129.     s := Copy(s, 1, width-3) + '...';
  130.   end;
  131.   TrimLineToWidth := s;
  132. end;
  133.  
  134. function ZeroPad(i: LongInt; n: integer): string;
  135. var
  136.   s: string;
  137. begin
  138.   s := IntToStr(i);
  139.   ZeroPad := LeftPadStr(s, n, '0');
  140. end;
  141.  
  142. function LeftPadStr(s: string; n: integer; ch: char): string;
  143. begin
  144.   while Length(s) < n do
  145.   begin
  146.     s := ch + s;
  147.   end;
  148.   LeftPadStr := s;
  149. end;
  150.  
  151. function RightPadStr(s: string; n: integer; ch: char): string;
  152. begin
  153.   while Length(s) < n do
  154.   begin
  155.     s := s + ch;
  156.   end;
  157.   RightPadStr := s;
  158. end;
  159.  
  160. function RepeatStr(ch: char; n: integer): string;
  161. var
  162.   i: integer;
  163.   res: string;
  164. begin
  165.   res := '';
  166.   for i := 1 to n do
  167.   begin
  168.     res := res + ch;
  169.   end;
  170.   RepeatStr := res;
  171. end;
  172.  
  173. function DeleteFile(filename: string): boolean;
  174. var
  175.   F:  file;
  176.   Ch: Char;
  177. begin
  178.   Assign(F, filename);
  179.   {$I-}
  180.   Reset(F);
  181.   {$I+}
  182.   if IOResult <> 0 then
  183.   begin
  184.     DeleteFile := false; (* cannot find file *)
  185.   end
  186.   else
  187.   begin
  188.     Close(F);
  189.     {$I-}
  190.     Erase(F);
  191.     {$I+}
  192.     DeleteFile := IOResult = 0;
  193.   end;
  194. end;
  195.  
  196. function FileExists(filename: string): boolean;
  197. var
  198.   F: Text;
  199. begin
  200.   Assign(F, filename);
  201.   {$I-}
  202.   Reset(F);
  203.   {$I+}
  204.   if IoResult = 0 then
  205.   begin
  206.     Close(F);
  207.     FileExists := true;
  208.   end
  209.   else
  210.   begin
  211.     FileExists := false;
  212.   end;
  213. end;
  214.  
  215. function StripLeadingZeros(s: string): string;
  216. begin
  217.   while (s <> '0') and (Copy(s,1,1) = '0') do
  218.     Delete(s,1,1);
  219.  
  220.   StripLeadingZeros := s;
  221. end;
  222.  
  223. function IsPositiveIntegerOrZero(s: string): boolean;
  224. var
  225.   i: integer;
  226. begin
  227.   IsPositiveIntegerOrZero := false;
  228.  
  229.   if Length(s) = 0 then exit;
  230.   (*if (s[1] = '0') and (s <> '0') then exit;*)
  231.   for i := 1 to Length(s) do
  232.   begin
  233.     if not (s[i] in ['0'..'9']) then exit;
  234.   end;
  235.  
  236.   IsPositiveIntegerOrZero := true;
  237. end;
  238.  
  239. function IsBase36String(s: string): boolean;
  240. var
  241.   i: integer;
  242. begin
  243.   IsBase36String := false;
  244.  
  245.   if Length(s) = 0 then exit;
  246.   (*if (s[1] = '0') and (s <> '0') then exit;*)
  247.   for i := 1 to Length(s) do
  248.   begin
  249.     if not (s[i] in ['0'..'9', 'A'..'Z']) then exit;
  250.   end;
  251.  
  252.   IsBase36String := true;
  253. end;
  254.  
  255. function TryStrToInt(s: string; var i: LongInt): boolean;
  256. begin
  257.   if IsPositiveIntegerOrZero(s) then
  258.   begin
  259.     TryStrToInt := true;
  260.     i := StrToInt(s);
  261.   end
  262.   else
  263.   begin
  264.     TryStrToInt := false;
  265.   end;
  266. end;
  267.  
  268. function StrToInt(s: string): LongInt;
  269. var
  270.   i, Error: Integer;
  271. begin
  272.   Val(s, i, Error);
  273.   StrToInt := i;
  274. end;
  275.  
  276. function IntToStr(Value: LongInt): string;
  277. var
  278.   s: string;
  279. begin
  280.   Str(Value, s);
  281.   IntToStr := s;
  282. end;
  283.  
  284. function StringReplace(s, search, replace: string): string;
  285. var
  286.   i: integer;
  287.   output: string;
  288. begin
  289.   if s = '' then
  290.   begin
  291.     StringReplace := '';
  292.     Exit;
  293.   end;
  294.   if search = '' then
  295.   begin
  296.     StringReplace := s;
  297.     exit; (* invalid arg *)
  298.   end;
  299.  
  300.   output := '';
  301.   while s <> '' do
  302.   begin
  303.     if Copy(s, 1, Length(search)) = search then
  304.     begin
  305.       output := output + replace;
  306.       Delete(s, 1, Length(search));
  307.     end
  308.     else
  309.     begin
  310.       output := output + Copy(s, 1, 1);
  311.       Delete(s, 1, 1);
  312.     end;
  313.   end;
  314.  
  315.   StringReplace := output;
  316. end;
  317.  
  318. function LastCharPos(const S: string; const Chr: char): integer;
  319. var
  320.   i: Integer;
  321. begin
  322.   for i := length(S) downto 1 do
  323.   begin
  324.     if S[i] = Chr then
  325.     begin
  326.       LastCharPos := i;
  327.       Exit;
  328.     end;
  329.   end;
  330.   LastCharPos := 0;
  331.   Exit;
  332. end;
  333.  
  334. function LowerCase(s: string): string;
  335. var
  336.   res: string;
  337.   i: integer;
  338. begin
  339.   res := '';
  340.   for i := 1 to Length(s) do
  341.   begin
  342.     if s[i] in ['A'..'Z'] then
  343.     begin
  344.       res := res + Chr(Ord('a')+(Ord(s[i])-Ord('A')));
  345.     end
  346.     else
  347.     begin
  348.       res := res + s[i];
  349.     end;
  350.   end;
  351.   LowerCase := res;
  352. end;
  353.  
  354. function UpperCase(s: string): string;
  355. var
  356.   res: string;
  357.   i: integer;
  358. begin
  359.   res := '';
  360.   for i := 1 to Length(s) do
  361.   begin
  362.     if s[i] in ['a'..'z'] then
  363.     begin
  364.       res := res + Chr(Ord('A')+(Ord(s[i])-Ord('a')));
  365.     end
  366.     else
  367.     begin
  368.       res := res + s[i];
  369.     end;
  370.   end;
  371.   UpperCase := res;
  372. end;
  373.  
  374. function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
  375. var
  376.   i: Integer;
  377.   frombase_str: string;
  378.   tobase_str: string;
  379.   len: Integer;
  380.   number: string;
  381.   divide: Integer;
  382.   newlen: Integer;
  383.   res: string;
  384. begin
  385.   frombase_str := '';
  386.   for i := 0 to frombase-1 do
  387.   begin
  388.     if i < 10 then
  389.       frombase_str := frombase_str + IntToStr(i)
  390.     else
  391.       frombase_str := frombase_str + Chr(Ord('A') + (i-10));
  392.   end;
  393.  
  394.   tobase_str := '';
  395.   for i := 0 to tobase-1 do
  396.   begin
  397.     if i < 10 then
  398.       tobase_str := tobase_str + IntToStr(i)
  399.     else
  400.       tobase_str := tobase_str + Chr(Ord('A') + (i-10));
  401.   end;
  402.  
  403.   len := Length(numstring);
  404.   base_convert_bigint := '';
  405.   number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
  406.   for i := 0 to len-1 do
  407.   begin
  408.     number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);
  409.   end;
  410.   res := '';
  411.   repeat (* Loop until whole number is converted *)
  412.     divide := 0;
  413.     newlen := 0;
  414.     for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *)
  415.     begin
  416.       divide := divide * frombase + Ord(number[i+1]);
  417.       if (divide >= tobase) then
  418.       begin
  419.         number[newlen+1] := Chr(divide div tobase);
  420.         Inc(newlen);
  421.         divide := divide mod tobase;
  422.       end
  423.       else if newlen > 0 then
  424.       begin
  425.         number[newlen+1] := #0;
  426.         Inc(newlen);
  427.       end;
  428.     end;
  429.     len := newlen;
  430.     res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)
  431.   until newlen = 0;
  432.   base_convert_bigint := res;
  433. end;
  434.  
  435. end.
  436.