Subversion Repositories oidplus

Rev

Rev 747 | Rev 749 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 747 Rev 748
Line 1... Line 1...
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-16                         *)
 6 
(* Revision: 2022-02-19                         *)
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 
 
Line 33... Line 33...
33 
function StrToInt(s: string): Integer;
 33 
function StrToInt(s: string): Integer;
34 
function IntToStr(Value: Integer): string;
 34 
function IntToStr(Value: Integer): string;
35 
 
 35 
 
36 
function StringReplace(s, search, replace: string): string;
 36 
function StringReplace(s, search, replace: string): string;
37 
 
 37 
 
- 
 
 38 
function LastCharPos(const S: string; const Chr: char): integer;
- 
 
 39 
function LowerCase(s: string): string;
- 
 
 40 
function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
- 
 
 41 
 
38 
implementation
 42 
implementation
39 
 
 43 
 
40 
uses
 44 
uses
41 
  Crt;
 45 
  Crt;
42 
 
 46 
 
Line 239... Line 243...
239 
function StringReplace(s, search, replace: string): string;
 243 
function StringReplace(s, search, replace: string): string;
240 
var
 244 
var
241 
  i: integer;
 245 
  i: integer;
242 
  output: string;
 246 
  output: string;
243 
begin
 247 
begin
244 
  if s = '' then exit;
 248 
  if s = '' then
- 
 
 249 
  begin
- 
 
 250 
    StringReplace := '';
- 
 
 251 
    Exit;
- 
 
 252 
  end;
- 
 
 253 
  if search = '' then
- 
 
 254 
  begin
- 
 
 255 
    StringReplace := s;
245 
  if search = '' then exit; (* invalid arg *)
 256 
    exit; (* invalid arg *)
- 
 
 257 
  end;
246 
 
 258 
 
247 
  output := '';
 259 
  output := '';
248 
  while s <> '' do
 260 
  while s <> '' do
249 
  begin
 261 
  begin
250 
    if Copy(s, 1, Length(search)) = search then
 262 
    if Copy(s, 1, Length(search)) = search then
Line 260... Line 272...
260 
  end;
 272 
  end;
261 
 
 273 
 
262 
  StringReplace := output;
 274 
  StringReplace := output;
263 
end;
 275 
end;
264 
 
 276 
 
- 
 
 277 
function LastCharPos(const S: string; const Chr: char): integer;
- 
 
 278 
var
- 
 
 279 
  i: Integer;
- 
 
 280 
begin
- 
 
 281 
  for i := length(S) downto 1 do
- 
 
 282 
  begin
- 
 
 283 
    if S[i] = Chr then
- 
 
 284 
    begin
- 
 
 285 
      LastCharPos := i;
- 
 
 286 
      Exit;
- 
 
 287 
    end;
- 
 
 288 
  end;
- 
 
 289 
  LastCharPos := 0;
- 
 
 290 
  Exit;
- 
 
 291 
end;
- 
 
 292 
 
- 
 
 293 
function LowerCase(s: string): string;
- 
 
 294 
var
- 
 
 295 
  res: string;
- 
 
 296 
  i: integer;
- 
 
 297 
begin
- 
 
 298 
  res := '';
- 
 
 299 
  for i := 1 to Length(s) do
- 
 
 300 
  begin
- 
 
 301 
    if s[i] in ['A'..'Z'] then
- 
 
 302 
    begin
- 
 
 303 
      res := res + Chr(Ord('a')+(Ord(s[i])-Ord('A')));
- 
 
 304 
    end
- 
 
 305 
    else
- 
 
 306 
    begin
- 
 
 307 
      res := res + s[i];
- 
 
 308 
    end;
- 
 
 309 
  end;
- 
 
 310 
  LowerCase := res;
- 
 
 311 
end;
- 
 
 312 
 
- 
 
 313 
function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
- 
 
 314 
var
- 
 
 315 
  i: Integer;
- 
 
 316 
  frombase_str: string;
- 
 
 317 
  tobase_str: string;
- 
 
 318 
  len: Integer;
- 
 
 319 
  number: string;
- 
 
 320 
  divide: Integer;
- 
 
 321 
  newlen: Integer;
- 
 
 322 
  res: string;
- 
 
 323 
begin
- 
 
 324 
  frombase_str := '';
- 
 
 325 
  for i := 0 to frombase-1 do
- 
 
 326 
  begin
- 
 
 327 
    if i < 10 then
- 
 
 328 
      frombase_str := frombase_str + IntToStr(i)
- 
 
 329 
    else
- 
 
 330 
      frombase_str := frombase_str + Chr(Ord('A') + (i-10));
- 
 
 331 
  end;
- 
 
 332 
 
- 
 
 333 
  tobase_str := '';
- 
 
 334 
  for i := 0 to tobase-1 do
- 
 
 335 
  begin
- 
 
 336 
    if i < 10 then
- 
 
 337 
      tobase_str := tobase_str + IntToStr(i)
- 
 
 338 
    else
- 
 
 339 
      tobase_str := tobase_str + Chr(Ord('A') + (i-10));
- 
 
 340 
  end;
- 
 
 341 
 
- 
 
 342 
  len := Length(numstring);
- 
 
 343 
  base_convert_bigint := '';
- 
 
 344 
  number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
- 
 
 345 
  for i := 0 to len-1 do
- 
 
 346 
  begin
- 
 
 347 
    number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);
- 
 
 348 
  end;
- 
 
 349 
  res := '';
- 
 
 350 
  repeat (* Loop until whole number is converted *)
- 
 
 351 
    divide := 0;
- 
 
 352 
    newlen := 0;
- 
 
 353 
    for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *)
- 
 
 354 
    begin
- 
 
 355 
      divide := divide * frombase + Ord(number[i+1]);
- 
 
 356 
      if (divide >= tobase) then
- 
 
 357 
      begin
- 
 
 358 
        number[newlen+1] := Chr(divide div tobase);
- 
 
 359 
        Inc(newlen);
- 
 
 360 
        divide := divide mod tobase;
- 
 
 361 
      end
- 
 
 362 
      else if newlen > 0 then
- 
 
 363 
      begin
- 
 
 364 
        number[newlen+1] := #0;
- 
 
 365 
        Inc(newlen);
- 
 
 366 
      end;
- 
 
 367 
    end;
- 
 
 368 
    len := newlen;
- 
 
 369 
    res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *)
- 
 
 370 
  until newlen = 0;
- 
 
 371 
  base_convert_bigint := res;
- 
 
 372 
end;
- 
 
 373 
 
265 
end.
 374 
end.