FunctionsClass.pas

   1 unit FunctionsClass;
   2
   3 interface
   4
   5 uses
   6   ConstantsClass, TypesClass,
   7   SysUtils;
   8
   9   function AddressToString(Address: Pointer): String;
  10   function CartesianOfStrings(First: String; Second: TStrings): TStrings;
  11   function CodeToHexadecimal(Input: String): String;
  12   function ContainsCharacter(Input: String; Character: Char): Boolean;
  13   function CustomBCDToStr(Input: PChar; Size: Integer): String;
  14   function CustomDataToHex(Input: PChar; Size: Integer): String;
  15   function CustomFloatToStr(Input: PChar; Size: Integer): String;
  16   function CustomSIntToStr(Input: PChar; Size: Integer): String;
  17   function CustomUIntToStr(Input: PChar; Size: Integer): String;
  18   function EqualBeforeFirstParser(First, Second: String; Parser: Char): Boolean;
  19   function IsAddress(Input: String): Boolean;
  20   function IsHexaChar(Input: Char): Boolean;
  21   function FloatType(Input: PChar; Size: Integer): Integer;
  22   function IsPrefixOf(Prefix, OfWhat: String): Boolean;
  23   function MaxOf(First, Second: Integer): Integer;
  24   function MergeStringTStrings(First: String; Second: TStrings): TStrings;
  25   function MergeTLinesLine(First: TLines; Second: TLine): TLines;
  26   function MergeTStringsString(First: TStrings; Second: String): TStrings;
  27   function MinOf(First, Second: Integer): Integer;
  28   function MirrorString(Input: String): String;
  29   function NeutralizeDoubles(Input: String; Character: Char): String;
  30   function OmmitAfter(Input: String; Character, What: Char): String;
  31   function OmmitBefore(Input: String; Character, What: Char): String;
  32   function OmmitEverywhere(Input: String; Character, What: Char): String;
  33   function ParseAfterFirst(Input: String; Parser: Char): String;
  34   function ParseAfterLast(Input: String; Parser: Char): String;
  35   function ParseBeforeFirst(Input: String; Parser: Char): String;
  36   function ParseBeforeLast(Input: String; Parser: Char): String;
  37   function ParseFirst(var Input: String; Parser: Char): String;
  38   function ParseToStrings(Input: PChar; Parser: Char): TStrings;
  39   function RemoveCharacter(Input: String): String;
  40   function RemoveExactString(From: TStrings; What: String): TStrings;
  41   function RemovePrefix(Prefix, From: String): String;
  42   function ReplaceCharacters(Input: String; Find, Replace: Char): String;
  43   function SeparateFloat(Input: PChar; Size: Integer): TFloatRecord;
  44   function StringToAddress(Input: String; Offset: Integer = 0): Integer;
  45   function StringBefore(Input: String; Before: Integer): String;
  46   function StringCompare(First, Second: PChar; Size: Integer): Boolean;
  47   function TrimCharacter(Input: String; Character: Char): String;
  48   function TrimCharacterLeft(Input: String; Character: Char): String;
  49   function TrimCharacterRight(Input: String; Character: Char): String;
  50   function ToTLine(Line: String; Number: Integer): TLine;
  51   function UpperCase(Input: String): String;
  52   function ZeroPaddedInteger(Input: Integer; Padding: Integer = 0): String;
  53   procedure ConstantToFloat(Input: String; Result: PChar; Size: Integer);
  54   procedure CustomHexToData(Input: String; Data: PChar; Size: Integer);
  55   procedure CustomStrToBCD(Input: String; Result: PChar; Size: Integer);
  56   procedure CustomStrToFloat(Input: String; Result: PChar; Size: Integer);
  57   procedure CustomStrToSInt(Input: String; Result: PChar; Size: Integer);
  58   procedure CustomStrToUInt(Input: String; Result: PChar; Size: Integer);
  59   procedure LogClear;
  60   procedure LogSystemTime;
  61   procedure LogWrite(Log: String; Error: Boolean = False);
  62   procedure InitializeMemory(Input: PChar; Size: Integer; Character: Char);
  63
  64 var
  65   Log_OnClear: TLogClearEvent;
  66   Log_OnWrite: TLogWriteEvent;
  67   Log_Sender: TObject;
  68
  69
  70 implementation
  71
  72   function AddressToString(Address: Pointer): String;
  73   begin
  74     SetLength(Result, SizeOf(Pointer));
  75     PInteger(Result)^ := Integer(Address);
  76   end;
  77
  78   function CartesianOfStrings(First: String; Second: TStrings): TStrings;
  79   var
  80     i: Integer;
  81   begin
  82     SetLength(Result, 0);
  83     for i := 0 to (Length(Second) - 1) do
  84     begin
  85       SetLength(Result, Length(Result) + 1);
  86       Result[Length(Result) - 1] := First + Second[i];
  87     end;
  88   end;
  89
  90   function CodeToHexadecimal(Input: String): String;
  91   var
  92     i: Integer;
  93     lbyte: Byte;
  94   begin
  95     Result := '';
  96     if (Input = '') then Exit;
  97     for i := 1 to Length(Input) do
  98     begin
  99       lbyte := Ord(Input[i]);
 100       Result := Result + CHARS_HEXA[lbyte shr 4] + CHARS_HEXA[lbyte and $F];
 101     end;
 102   end;
 103
 104   function ContainsCharacter(Input: String; Character: Char): Boolean;
 105   var
 106     i: Integer;
 107   begin
 108     Result := False;
 109     if (Input = '') then Exit;
 110     for i := 1 to Length(Input) do
 111       if (Input[i] = Character) then
 112       begin
 113         Result := True;
 114         Break;
 115       end;
 116   end;
 117
 118   function CustomBCDToStr(Input: PChar; Size: Integer): String;
 119   var
 120     i: Integer;
 121     lbyte: Byte;
 122   begin
 123     Result := '';
 124     if not(Size = 10) then Exit;
 125     with PBCDRecord(Input)^ do
 126     begin
 127       if (Bytes[9] = $FF) and (Bytes[8] = $FF) and (Bytes[7] = $C0) then
 128       begin
 129         Result := DESC_NAN;
 130         Exit;
 131       end;
 132       for i := 8 downto 0 do
 133       begin
 134         lbyte := Bytes[i] shr 4;
 135         if not(lbyte = 0) then Result := Result + CHARS_HEXA[lbyte];
 136         lbyte := Bytes[i] and $F;
 137         if not(lbyte = 0) then Result := Result + CHARS_HEXA[lbyte];
 138       end;
 139       if (Result = '') then Result := CHARS_HEXA[0];
 140       if not(Bytes[9] and $80 = 0) then Result := '-' + Result;
 141     end;
 142   end;
 143
 144   function CustomDataToHex(Input: PChar; Size: Integer): String;
 145   var
 146     i: Integer;
 147     lbyte: Byte;
 148   begin
 149     Result := '';
 150     for i := (Size - 1) downto 0 do
 151     begin
 152       lbyte := Ord(Input[i]);
 153       Result := Result + CHARS_HEXA[lbyte shr 4] + CHARS_HEXA[lbyte and $F];
 154     end;
 155   end;
 156
 157   function CustomFloatToStr(Input: PChar; Size: Integer): String;
 158   var
 159     linput: TFloatRecord;
 160     lcmp: TSeparateConstants;
 161   begin
 162     case Size of
 163       4: lcmp := SEP_FP_4;
 164       8: lcmp := SEP_FP_8;
 165       10: lcmp := SEP_FP_10;
 166       else
 167         Exit;
 168     end;
 169     linput := SeparateFloat(Input, Size);
 170     with linput do
 171     begin
 172       if (Exponent = lcmp.ExponCmp) then
 173         if (Significand = lcmp.SigniCmp) then
 174         begin
 175           if Sign then Result := DESC_NEG_INF
 176           else Result := DESC_POS_INF;
 177         end
 178         else
 179         begin
 180           if (Significand and lcmp.SigniAnd = 0) then
 181             Result := DESC_NAN_S
 182           else
 183             Result := DESC_NAN_Q;
 184           Result := Result + DESC_NAN;
 185         end
 186       else
 187         case Size of
 188           4: Result := FloatToStr(PSingle(Input)^);
 189           8: Result := FloatToStr(PDouble(Input)^);
 190           10: Result := FloatToStr(PExtended(Input)^);
 191         end;
 192     end;
 193   end;
 194
 195   function CustomSIntToStr(Input: PChar; Size: Integer): String;
 196   begin
 197     Result := '';
 198     case Size of
 199       1: Result := IntToStr(PShortint(Input)^);
 200       2: Result := IntToStr(PSmallint(Input)^);
 201       4: Result := IntToStr(PInteger(Input)^);
 202       8: Result := IntToStr(PInt64(Input)^);
 203     end;
 204   end;
 205
 206   function CustomUIntToStr(Input: PChar; Size: Integer): String;
 207   begin
 208     Result := '';
 209     case Size of
 210       1: Result := IntToStr(PByte(Input)^);
 211       2: Result := IntToStr(PWord(Input)^);
 212       4: Result := IntToStr(PCardinal(Input)^);
 213       8: Result := IntToStr(PInt64(Input)^);
 214     end;
 215   end;
 216
 217   function EqualBeforeFirstParser(First, Second: String; Parser: Char): Boolean;
 218   begin
 219     if (ParseBeforeFirst(First, Parser) = ParseBeforeFirst(Second, Parser)) then
 220       Result := True
 221     else
 222       Result := False;
 223   end;
 224
 225   function IsAddress(Input: String): Boolean;
 226   var
 227     i: Integer;
 228   begin
 229     Result := False;
 230     Input := TrimCharacter(Input, ' ');
 231     if (Input = '') then Exit;
 232     if not(Input[1] in ['0'..'9', '+', '-']) then Exit;
 233     if (Input[1] in ['+', '-']) and (Length(Input) = 1) then Exit;
 234     for i := 2 to Length(Input) do
 235       if not(Input[i] in ['0'..'9']) then Exit;
 236     Result := True;
 237   end;
 238
 239   function IsHexaChar(Input: Char): Boolean;
 240   var
 241     i: Integer;
 242   begin
 243     Result := False;
 244     for i := 0 to (Length(CHARS_HEXA) - 1) do
 245       if (Input = CHARS_HEXA[i]) then
 246       begin
 247         Result := True;
 248         Exit;
 249       end;
 250   end;
 251
 252   function FloatType(Input: PChar; Size: Integer): Integer;
 253   var
 254     lresult: String;
 255   begin
 256     Result := 1;
 257     lresult := CustomFloatToStr(Input, Size);
 258     if (lresult = '0') then Result := 0
 259     else if (lresult = DESC_NEG_INF) or (lresult = DESC_POS_INF)
 260       or (lresult = DESC_QNAN) or (lresult = DESC_SNAN) then Result := -1;
 261   end;
 262
 263   function IsPrefixOf(Prefix, OfWhat: String): Boolean;
 264   var
 265     i: Integer;
 266   begin
 267     Result := False;
 268     if (Length(Prefix) > Length(OfWhat)) then Exit;
 269     for i := 1 to Length(Prefix) do
 270       if not(Prefix[i] = OfWhat[i]) then Exit;
 271     Result := True;
 272   end;
 273
 274   function MaxOf(First, Second: Integer): Integer;
 275   begin
 276     if (First > Second) then Result := First
 277     else Result := Second;
 278   end;
 279
 280   function MergeStringTStrings(First: String; Second: TStrings): TStrings;
 281   var
 282     i: Integer;
 283   begin
 284     SetLength(Result, Length(Second) + 1);
 285     Result[0] := First;
 286     for i := 0 to (Length(Second) - 1) do
 287       Result[i + 1] := Second[i];
 288   end;
 289
 290   function MergeTLinesLine(First: TLines; Second: TLine): TLines;
 291   var
 292     i: Integer;
 293   begin
 294     SetLength(Result, Length(First) + 1);
 295     Result[Length(First)] := Second;
 296     for i := 0 to (Length(First) - 1) do
 297       Result[i] := First[i];
 298   end;
 299
 300   function MergeTStringsString(First: TStrings; Second: String): TStrings;
 301   var
 302     i: Integer;
 303   begin
 304     SetLength(Result, Length(First) + 1);
 305     Result[Length(First)] := Second;
 306     for i := 0 to (Length(First) - 1) do
 307       Result[i] := First[i];
 308   end;
 309
 310   function MinOf(First, Second: Integer): Integer;
 311   begin
 312     if (First < Second) then Result := First
 313     else Result := Second;
 314   end;
 315
 316   function MirrorString(Input: String): String;
 317   var
 318     i: Integer;
 319   begin
 320     Result := '';
 321     if (Input = '') then Exit;
 322     for i := Length(Input) downto 1 do
 323       Result := Result + Input[i];
 324   end;
 325
 326   function NeutralizeDoubles(Input: String; Character: Char): String;
 327   begin
 328     Result := OmmitAfter(Input, Character, Character);
 329   end;
 330
 331   function OmmitAfter(Input: String; Character, What: Char): String;
 332   var
 333     i: Integer;
 334     llast: Char;
 335   begin
 336     Result := '';
 337     if (Input = '') then Exit;
 338     llast := Chr(Ord(Character) + 1);
 339     for i := 1 to Length(Input) do
 340       if not((llast = Character) and (Input[i] = What)) then
 341       begin
 342         Result := Result + Input[i];
 343         llast := Input[i];
 344       end;
 345   end;
 346
 347   function OmmitBefore(Input: String; Character, What: Char): String;
 348   var
 349     i: Integer;
 350     llast: Char;
 351   begin
 352     Result := '';
 353     if (Input = '') then Exit;
 354     llast := Chr(Ord(Character) + 1);
 355     for i := Length(Input) downto 1 do
 356       if not((llast = Character) and (Input[i] = What)) then
 357       begin
 358         Result := Result + Input[i];
 359         llast := Input[i];
 360       end;
 361     Result := MirrorString(Result);
 362   end;
 363
 364   function OmmitEverywhere(Input: String; Character, What: Char): String;
 365   begin
 366     Result := OmmitBefore(OmmitAfter(Input, Character, What), Character, What);
 367   end;
 368
 369   function ParseAfterFirst(Input: String; Parser: Char): String;
 370   var
 371     i, lpos: Integer;
 372   begin
 373     Result := '';
 374     if (Input = '') then Exit;
 375     for i := 1 to Length(Input) do
 376       if (Input[i] = Parser) then Break;
 377     lpos := i + 1;
 378     for i := lpos to Length(Input) do
 379       Result := Result + Input[i];
 380   end;
 381
 382   function ParseAfterLast(Input: String; Parser: Char): String;
 383   var
 384     i, lpos: Integer;
 385   begin
 386     Result := '';
 387     if (Input = '') then Exit;
 388     for i := Length(Input) downto 1 do
 389       if (Input[i] = Parser) then Break;
 390     lpos := i + 1;
 391     for i := lpos to Length(Input) do
 392       Result := Result + Input[i];
 393   end;
 394
 395   function ParseBeforeFirst(Input: String; Parser: Char): String;
 396   var
 397     i: Integer;
 398   begin
 399     Result := '';
 400     if (Input = '') then Exit;
 401     for i := 1 to Length(Input) do
 402       if (Input[i] = Parser) then Break
 403       else Result := Result + Input[i];
 404   end;
 405
 406   function ParseBeforeLast(Input: String; Parser: Char): String;
 407   var
 408     i, lpos: Integer;
 409   begin
 410     Result := '';
 411     if (Input = '') then Exit;
 412     for i := Length(Input) downto 1 do
 413       if (Input[i] = Parser) then Break;
 414     lpos := i - 1;
 415     for i := 1 to lpos do
 416       Result := Result + Input[i];
 417   end;
 418
 419   function ParseFirst(var Input: String; Parser: Char): String;
 420   begin
 421     Result := ParseAfterFirst(Input, Parser);
 422     Input := ParseBeforeFirst(Input, Parser);
 423   end;
 424
 425   function ParseToStrings(Input: PChar; Parser: Char): TStrings;
 426   var
 427     i: Integer;
 428     llast, lstring: PChar;
 429   begin
 430     SetLength(Result, 0);
 431     if (Length(Input) = 0) then Exit;
 432     i := 0;
 433     lstring := GetMemory(Length(Input) + 1);
 434     Move(Input^, lstring^, Length(Input) + 1);
 435     llast := lstring;
 436     while (i < Length(Input)) do
 437     begin
 438       if (Input[i] = Parser) then
 439       begin
 440         lstring[i] := #0;
 441         SetLength(Result, Length(Result) + 1);
 442         Result[Length(Result) - 1] := String(llast);
 443         llast := @lstring[i + 1];
 444       end;
 445       i := i + 1;
 446     end;
 447     SetLength(Result, Length(Result) + 1);
 448     Result[Length(Result) - 1] := String(llast);
 449     FreeMemory(lstring);
 450   end;
 451
 452   function RemoveCharacter(Input: String): String;
 453   begin
 454     Result := '';
 455     if (Input = '') then Exit;
 456     Result := Input;
 457     SetLength(Result, Length(Input) - 1);
 458   end;
 459
 460   function RemoveExactString(From: TStrings; What: String): TStrings;
 461   var
 462     i: Integer;
 463   begin
 464     SetLength(Result, 0);
 465     for i := 0 to (Length(From) - 1) do
 466       if not(From[i] = What) then
 467       begin
 468         SetLength(Result, Length(Result) + 1);
 469         Result[Length(Result) - 1] := From[i];
 470       end;
 471   end;
 472
 473   function RemovePrefix(Prefix, From: String): String;
 474   var
 475     i: Integer;
 476   begin
 477     Result := '';
 478     if not IsPrefixOf(Prefix, From) then Exit;
 479     for i := (Length(Prefix) + 1) to Length(From) do
 480       Result := Result + From[i];
 481   end;
 482
 483   function ReplaceCharacters(Input: String; Find, Replace: Char): String;
 484   var
 485     i: Integer;
 486   begin
 487     Result := '';
 488     if (Input = '') then Exit;
 489     for i := 1 to Length(Input) do
 490       if (Input[i] = Find) then
 491         Result := Result + Replace
 492       else
 493         Result := Result + Input[i];
 494   end;
 495
 496   function SeparateFloat(Input: PChar; Size: Integer): TFloatRecord;
 497   begin
 498     case Size of
 499       4:
 500       begin
 501         Result.Significand := PInteger(Input)^ and $7FFFFF;
 502         Result.Exponent := (PWord(Integer(Input) + 2)^ shr 7) and $FF;
 503         Result.Sign := not((PByte(Integer(Input) + 3)^ and $80) = 0);
 504       end;
 505       8:
 506       begin
 507         Result.Significand := PInt64(Input)^ and $FFFFFFFFFFFFF;
 508         Result.Exponent := (PWord(Integer(Input) + 6)^ shr 4) and $7FF;
 509         Result.Sign := not((PByte(Integer(Input) + 7)^ and $80) = 0);
 510       end;
 511       10:
 512       begin
 513         Result.Significand := PInt64(Input)^;
 514         Result.Exponent := PWord(Integer(Input) + 8)^ and $7FFF;
 515         Result.Sign := not((PByte(Integer(Input) + 9)^ and $80) = 0);
 516       end;
 517     end;
 518   end;
 519
 520   function StringToAddress(Input: String; Offset: Integer = 0): Integer;
 521   var
 522     i, lstart, lmul: Integer;
 523   begin
 524     Input := TrimCharacter(Input, ' ');
 525     lmul := 1;
 526     case Input[1] of
 527       '+':
 528         lstart := 2;
 529       '-':
 530       begin
 531         lstart := 2;
 532         lmul := -1;
 533       end;
 534       else
 535       begin
 536         lstart := 1;
 537         Offset := 0;
 538       end;
 539     end;
 540     Result := 0;
 541     for i := lstart to Length(Input) do
 542       Result := (10 * Result) + Ord(Input[i]) - Ord(CHARS_HEXA[0]);
 543     Result := (Result * lmul) + Offset;
 544   end;
 545
 546   function StringBefore(Input: String; Before: Integer): String;
 547   var
 548     i: Integer;
 549   begin
 550     Result := '';
 551     for i := 1 to Before do
 552       Result := Result + Input[i];
 553   end;
 554
 555   function StringCompare(First, Second: PChar; Size: Integer): Boolean;
 556   var
 557     i: Integer;
 558   begin
 559     Result := False;
 560     for i := 0 to (Size - 1) do
 561       if not(First[i] = Second[i]) then Exit;
 562     Result := True;
 563   end;
 564
 565   function TrimCharacter(Input: String; Character: Char): String;
 566   begin
 567     Result := TrimCharacterLeft(TrimCharacterRight(Input, Character), Character);
 568   end;
 569
 570   function TrimCharacterLeft(Input: String; Character: Char): String;
 571   var
 572     i, lstart: Integer;
 573   begin
 574     Result := '';
 575     if (Input = '') then Exit;
 576     for i := 1 to Length(Input) do
 577       if not(Input[i] = Character) then Break;
 578     lstart := i;
 579     for i := lstart to Length(Input) do
 580       Result := Result + Input[i];
 581   end;
 582
 583   function TrimCharacterRight(Input: String; Character: Char): String;
 584   var
 585     i, lend: Integer;
 586   begin
 587     Result := '';
 588     if (Input = '') then Exit;
 589     for i := Length(Input) downto 1 do
 590       if not(Input[i] = Character) then Break;
 591     lend := i;
 592     for i := 1 to lend do
 593       Result := Result + Input[i];
 594   end;
 595
 596   function ToTLine(Line: String; Number: Integer): TLine;
 597   begin
 598     Result.Line := Line;
 599     Result.Number := Number;
 600   end;
 601
 602   function UpperCase(Input: String): String;
 603   var
 604     i: Integer;
 605   begin
 606     Result := '';
 607     if (Input = '') then Exit;
 608     for i := 1 to Length(Input) do
 609       Result := Result + UpCase(Input[i]);
 610   end;
 611
 612   function ZeroPaddedInteger(Input, Padding: Integer): String;
 613   var
 614     i: Integer;
 615     lminus: Boolean;
 616   begin
 617     Result := '';
 618     if (Input < 0) then
 619     begin
 620       lminus := True;
 621       Input := -Input;
 622     end
 623     else lminus := False;
 624     while (Input > 0) do
 625     begin
 626       Result := Result + CHARS_HEXA[Input mod 10];
 627       Input := Input div 10;
 628     end;
 629     for i := Length(Result) to (Padding - 1) do
 630       Result := Result + CHARS_HEXA[0];
 631     if lminus then Result := Result + '-';
 632     Result := MirrorString(Result);
 633   end;
 634
 635   procedure ConstantToFloat(Input: String; Result: PChar; Size: Integer);
 636   begin
 637     if not(Length(Input) = Size) then Exit;
 638     Move(PChar(Input)[0], Result^, Size);
 639   end;
 640
 641   procedure CustomHexToData(Input: String; Data: PChar; Size: Integer);
 642   var
 643     i, j: Integer;
 644     lbyte: Byte;
 645   begin
 646     Input := UpperCase(TrimCharacter(Input, ' '));
 647     InitializeMemory(Data, Size, #0);
 648     if (Length(Input) > Size * 2) then Exit;
 649     j := (Size * 2) - Length(Input);
 650     for i := 1 to j do
 651       Input := CHARS_HEXA[0] + Input;
 652     Input := MirrorString(Input);
 653     for i := 1 to Length(Input) do
 654       if not IsHexaChar(Input[i]) then Exit;
 655     for i := 1 to Size do
 656     begin
 657       lbyte := 0;
 658       for j := 0 to (Length(CHARS_HEXA) - 1) do
 659         if (CHARS_HEXA[j] = Input[2 * i]) then
 660         begin
 661           lbyte := j;
 662           Break;
 663         end;
 664       lbyte := lbyte shl 4;
 665       for j := 0 to (Length(CHARS_HEXA) - 1) do
 666         if (CHARS_HEXA[j] = Input[(2 * i) - 1]) then
 667         begin
 668           lbyte := lbyte + j;
 669           Break;
 670         end;
 671       Data[i - 1] := Chr(lbyte);
 672     end;
 673   end;
 674
 675   procedure CustomStrToBCD(Input: String; Result: PChar; Size: Integer);
 676   var
 677     i: Integer;
 678     lint: Int64;
 679   begin
 680     if not(Size = 10) then Exit;
 681     InitializeMemory(Result, 10, #0);
 682     lint := StrToInt64Def(Input, 0);
 683     if (lint < -999999999999999999) then Exit;
 684     if (lint > 999999999999999999) then Exit;
 685     with PBCDRecord(Result)^ do
 686     begin
 687       if (lint < 0) then
 688       begin
 689         Bytes[9] := $80;
 690         lint := Abs(lint);
 691       end;
 692       i := 0;
 693       while (lint > 0) do
 694       begin
 695         Bytes[i] := (((lint mod 100) div 10) shl 4) + (lint mod 10);
 696         i := i + 1;
 697         lint := lint div 100;
 698       end;
 699     end;
 700   end;
 701
 702   procedure CustomStrToFloat(Input: String; Result: PChar; Size: Integer);
 703   var
 704     ltrans: TTranslateConstants;
 705   begin
 706     case Size of
 707       4: ltrans := TRANS_FP_4;
 708       8: ltrans := TRANS_FP_8;
 709       10: ltrans := TRANS_FP_10;
 710       else
 711         Exit;
 712     end;
 713     Input := UpperCase(TrimCharacter(Input, ' '));
 714     if (Input = '') then Exit;
 715     if (Input = DESC_NEG_INF) then
 716     begin
 717       ConstantToFloat(ltrans.NegInf, Result, Size);
 718       Exit;
 719     end;
 720     if (Input = DESC_POS_INF) or (Input = DESC_INF) then
 721     begin
 722       ConstantToFloat(ltrans.PosInf, Result, Size);
 723       Exit;
 724     end;
 725     if (Input = DESC_QNAN) or (Input = DESC_NAN) then
 726     begin
 727       ConstantToFloat(ltrans.QNaN, Result, Size);
 728       Exit;
 729     end;
 730     if (Input = DESC_SNAN) then
 731     begin
 732       ConstantToFloat(ltrans.SNaN, Result, Size);
 733       Exit;
 734     end;
 735     try
 736       case Size of
 737         4: PSingle(Result)^ := StrToFloat(Input);
 738         8: PDouble(Result)^ := StrToFloat(Input);
 739         10: PExtended(Result)^ := StrToFloat(Input);
 740       end;
 741     except
 742       on EConvertError do
 743         case Size of
 744           4: PSingle(Result)^ := 0;
 745           8: PDouble(Result)^ := 0;
 746           10: PExtended(Result)^ := 0;
 747         end;
 748     end;
 749   end;
 750
 751   procedure CustomStrToSInt(Input: String; Result: PChar; Size: Integer);
 752   var
 753     lint: Int64;
 754   begin
 755     lint := StrToInt64Def(Input, 0);
 756     case Size of
 757       1:
 758         if (lint > 127) or (lint < -128) then PShortint(Result)^ := 0
 759         else PShortInt(Result)^ := lint;
 760       2:
 761         if (lint > 32767) or (lint < -32768) then PSmallint(Result)^ := 0
 762         else PSmallInt(Result)^ := lint;
 763       4: PInteger(Result)^ := StrToIntDef(Input, 0);
 764       8: PInt64(Result)^ := lint;
 765     end;
 766   end;
 767
 768   procedure CustomStrToUInt(Input: String; Result: PChar; Size: Integer);
 769   var
 770     lint: Int64;
 771   begin
 772     lint := StrToInt64Def(Input, 0);
 773     case Size of
 774       1:
 775         if (lint > 255) or (lint < 0) then PShortint(Result)^ := 0
 776         else PShortInt(Result)^ := lint;
 777       2:
 778         if (lint > 65536) or (lint < 0) then PSmallint(Result)^ := 0
 779         else PSmallInt(Result)^ := lint;
 780       4:
 781         if (lint > 4294967295) or (lint < 0) then PInteger(Result)^ := 0
 782         else PInteger(Result)^ := lint;
 783       8:
 784         PInt64(Result)^ := lint;
 785     end;
 786   end;
 787
 788   procedure LogClear;
 789   begin
 790     if not(@Log_OnClear = nil) then Log_OnClear(Log_Sender);
 791   end;
 792
 793   procedure LogSystemTime;
 794   begin
 795     LogWrite('');
 796     LogWrite(APP_VERSION + ' [' + TimeToStr(Time) + ']');
 797   end;
 798
 799   procedure LogWrite(Log: String; Error: Boolean = False);
 800   begin
 801     if not(@Log_OnWrite = nil) then Log_OnWrite(Log_Sender, Log, Error);
 802   end;
 803
 804   procedure InitializeMemory(Input: PChar; Size: Integer; Character: Char);
 805   var
 806     i: Integer;
 807   begin
 808     for i := 0 to (Size - 1) do
 809       Input[i] := Character;
 810   end;
 811
 812 initialization
 813   DecimalSeparator := '.';
 814
 815 end.
 816