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