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


unit VTSFUNCS;
 
(************************************************)
(* VTSFUNCS.PAS                                 *)
(* Author:   Daniel Marschall                   *)
(* Revision: 2022-02-22                         *)
(* 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 StripLeadingZeros(s: string): string;
function IsPositiveIntegerOrZero(s: string): boolean;
function IsBase36String(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 UpperCase(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 StripLeadingZeros(s: string): string;
begin
  while (s <> '0') and (Copy(s,1,1) = '0') do
    Delete(s,1,1);
 
  StripLeadingZeros := s;
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 IsBase36String(s: string): boolean;
var
  i: integer;
begin
  IsBase36String := 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', 'A'..'Z']) then exit;
  end;
 
  IsBase36String := 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
  begin
    StringReplace := '';
    Exit;
  end;
  if search = '' then
  begin
    StringReplace := s;
    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 UpperCase(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;
  UpperCase := 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 mod tobase" (i.e. the new character) *)
  until newlen = 0;
  base_convert_bigint := res;
end;
 
end.
 

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

Subversion Repositories oidplus

oidplus/trunk_dos/VTSFUNCS.PAS – Rev 749 → 750