Rev 750 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
733 | daniel-mar | 1 | unit VTSFUNCS; |
2 | |||
3 | (************************************************) |
||
4 | (* VTSFUNCS.PAS *) |
||
5 | (* Author: Daniel Marschall *) |
||
995 | daniel-mar | 6 | (* Revision: 2022-10-11 *) |
733 | daniel-mar | 7 | (* License: Apache 2.0 *) |
8 | (* This file contains: *) |
||
9 | (* - Various functions *) |
||
10 | (************************************************) |
||
11 | |||
12 | interface |
||
13 | |||
739 | daniel-mar | 14 | function Max(a, b: integer): integer; |
15 | function Min(a, b: integer): integer; |
||
16 | |||
733 | daniel-mar | 17 | function CompareEqualLengthString(a, b: string): integer; |
18 | function CompareNumericString(a, b: string): integer; |
||
739 | daniel-mar | 19 | |
733 | daniel-mar | 20 | procedure Beep; |
739 | daniel-mar | 21 | |
733 | daniel-mar | 22 | function Trim(s: string): string; |
740 | daniel-mar | 23 | function TrimLineToWidth(s: string; width: integer): string; |
733 | daniel-mar | 24 | function ZeroPad(i: LongInt; n: integer): string; |
739 | daniel-mar | 25 | function LeftPadStr(s: string; n: integer; ch: char): string; |
26 | function RightPadStr(s: string; n: integer; ch: char): string; |
||
740 | daniel-mar | 27 | function RepeatStr(ch: char; n: integer): string; |
739 | daniel-mar | 28 | |
29 | function DeleteFile(filename: string): boolean; |
||
733 | daniel-mar | 30 | function FileExists(filename: string): boolean; |
739 | daniel-mar | 31 | |
749 | daniel-mar | 32 | function StripLeadingZeros(s: string): string; |
747 | daniel-mar | 33 | function IsPositiveIntegerOrZero(s: string): boolean; |
749 | daniel-mar | 34 | function IsBase36String(s: string): boolean; |
995 | daniel-mar | 35 | function TryStrToInt(s: string; var i: LongInt): boolean; |
36 | function StrToInt(s: string): LongInt; |
||
37 | function IntToStr(Value: LongInt): string; |
||
733 | daniel-mar | 38 | |
747 | daniel-mar | 39 | function StringReplace(s, search, replace: string): string; |
40 | |||
748 | daniel-mar | 41 | function LastCharPos(const S: string; const Chr: char): integer; |
42 | function LowerCase(s: string): string; |
||
750 | daniel-mar | 43 | function UpperCase(s: string): string; |
748 | daniel-mar | 44 | function base_convert_bigint(numstring: string; frombase, tobase: integer): string; |
45 | |||
733 | daniel-mar | 46 | implementation |
47 | |||
48 | uses |
||
49 | Crt; |
||
50 | |||
739 | daniel-mar | 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 | |||
733 | daniel-mar | 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 |
||
739 | daniel-mar | 91 | EqualLength: integer; |
733 | daniel-mar | 92 | begin |
739 | daniel-mar | 93 | EqualLength := Max(Length(a), Length(b)); |
94 | a := LeftPadStr(a, EqualLength, '0'); |
||
95 | b := LeftPadStr(b, EqualLength, '0'); |
||
96 | CompareNumericString := CompareEqualLengthString(a, b); |
||
733 | daniel-mar | 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 | |||
740 | daniel-mar | 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 | |||
739 | daniel-mar | 134 | function ZeroPad(i: LongInt; n: integer): string; |
733 | daniel-mar | 135 | var |
739 | daniel-mar | 136 | s: string; |
733 | daniel-mar | 137 | begin |
739 | daniel-mar | 138 | s := IntToStr(i); |
139 | ZeroPad := LeftPadStr(s, n, '0'); |
||
140 | end; |
||
733 | daniel-mar | 141 | |
739 | daniel-mar | 142 | function LeftPadStr(s: string; n: integer; ch: char): string; |
143 | begin |
||
144 | while Length(s) < n do |
||
733 | daniel-mar | 145 | begin |
739 | daniel-mar | 146 | s := ch + s; |
733 | daniel-mar | 147 | end; |
739 | daniel-mar | 148 | LeftPadStr := s; |
733 | daniel-mar | 149 | end; |
150 | |||
739 | daniel-mar | 151 | function RightPadStr(s: string; n: integer; ch: char): string; |
733 | daniel-mar | 152 | begin |
153 | while Length(s) < n do |
||
154 | begin |
||
739 | daniel-mar | 155 | s := s + ch; |
733 | daniel-mar | 156 | end; |
739 | daniel-mar | 157 | RightPadStr := s; |
733 | daniel-mar | 158 | end; |
159 | |||
740 | daniel-mar | 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 | |||
739 | daniel-mar | 173 | function DeleteFile(filename: string): boolean; |
733 | daniel-mar | 174 | var |
739 | daniel-mar | 175 | F: file; |
176 | Ch: Char; |
||
733 | daniel-mar | 177 | begin |
739 | daniel-mar | 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; |
||
733 | daniel-mar | 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+} |
||
740 | daniel-mar | 204 | if IoResult = 0 then |
205 | begin |
||
206 | Close(F); |
||
207 | FileExists := true; |
||
208 | end |
||
209 | else |
||
210 | begin |
||
211 | FileExists := false; |
||
212 | end; |
||
733 | daniel-mar | 213 | end; |
214 | |||
749 | daniel-mar | 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 | |||
747 | daniel-mar | 223 | function IsPositiveIntegerOrZero(s: string): boolean; |
739 | daniel-mar | 224 | var |
225 | i: integer; |
||
226 | begin |
||
747 | daniel-mar | 227 | IsPositiveIntegerOrZero := false; |
739 | daniel-mar | 228 | |
229 | if Length(s) = 0 then exit; |
||
749 | daniel-mar | 230 | (*if (s[1] = '0') and (s <> '0') then exit;*) |
739 | daniel-mar | 231 | for i := 1 to Length(s) do |
232 | begin |
||
233 | if not (s[i] in ['0'..'9']) then exit; |
||
234 | end; |
||
235 | |||
747 | daniel-mar | 236 | IsPositiveIntegerOrZero := true; |
739 | daniel-mar | 237 | end; |
238 | |||
749 | daniel-mar | 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 | |||
995 | daniel-mar | 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; |
||
733 | daniel-mar | 269 | var |
270 | i, Error: Integer; |
||
271 | begin |
||
272 | Val(s, i, Error); |
||
273 | StrToInt := i; |
||
274 | end; |
||
275 | |||
995 | daniel-mar | 276 | function IntToStr(Value: LongInt): string; |
733 | daniel-mar | 277 | var |
278 | s: string; |
||
279 | begin |
||
280 | Str(Value, s); |
||
281 | IntToStr := s; |
||
282 | end; |
||
283 | |||
747 | daniel-mar | 284 | function StringReplace(s, search, replace: string): string; |
285 | var |
||
286 | i: integer; |
||
287 | output: string; |
||
288 | begin |
||
748 | daniel-mar | 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; |
||
747 | daniel-mar | 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 | |||
748 | daniel-mar | 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 | |||
750 | daniel-mar | 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 | |||
748 | daniel-mar | 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; |
||
749 | daniel-mar | 430 | res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *) |
748 | daniel-mar | 431 | until newlen = 0; |
432 | base_convert_bigint := res; |
||
433 | end; |
||
434 | |||
733 | daniel-mar | 435 | end. |