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 CustomDataToHex(Input: PChar; Size: Integer): String;
  14   function CustomFloatToStr(Input: PChar; Size: Integer): String;
  15   function EqualBeforeFirstParser(First, Second: String; Parser: Char): Boolean;
  16   function IsAddress(Input: String): Boolean;
  17   function IsHexaChar(Input: Char): Boolean;
  18   function FloatType(Input: PChar; Size: Integer): Integer;
  19   function IsPrefixOf(Prefix, OfWhat: String): Boolean;
  20   function MaxOf(First, Second: Integer): Integer;
  21   function MergeStringTStrings(First: String; Second: TStrings): TStrings;
  22   function MergeTStringsString(First: TStrings; Second: String): TStrings;
  23   function MinOf(First, Second: Integer): Integer;
  24   function MirrorString(Input: String): String;
  25   function NeutralizeDoubles(Input: String; Character: Char): String;
  26   function OmmitAfter(Input: String; Character, What: Char): String;
  27   function OmmitBefore(Input: String; Character, What: Char): String;
  28   function OmmitEverywhere(Input: String; Character, What: Char): String;
  29   function ParseAfterFirst(Input: String; Parser: Char): String;
  30   function ParseAfterLast(Input: String; Parser: Char): String;
  31   function ParseBeforeFirst(Input: String; Parser: Char): String;
  32   function ParseBeforeLast(Input: String; Parser: Char): String;
  33   function ParseFirst(var Input: String; Parser: Char): String;
  34   function ParseToStrings(Input: PChar; Parser: Char): TStrings;
  35   function RemoveCharacter(Input: String): String;
  36   function RemoveExactString(From: TStrings; What: String): TStrings;
  37   function RemovePrefix(Prefix, From: String): String;
  38   function ReplaceCharacters(Input: String; Find, Replace: Char): String;
  39   function SeparateFloat(Input: PChar; Size: Integer): TFloatRecord;
  40   function StringToAddress(Input: String; Offset: Integer = 0): Integer;
  41   function StringBefore(Input: String; Before: Integer): String;
  42   function StringCompare(First, Second: PChar; Size: Integer): Boolean;
  43   function TrimCharacter(Input: String; Character: Char): String;
  44   function TrimCharacterLeft(Input: String; Character: Char): String;
  45   function TrimCharacterRight(Input: String; Character: Char): String;
  46   function UpperCase(Input: String): String;
  47   function ZeroPaddedInteger(Input: Integer; Padding: Integer = 0): String;
  48   procedure CustomHexToData(Input: String; Data: PChar; Size: Integer);
  49   procedure CustomStrToFloat(Input: String; Result: PChar; Size: Integer);
  50
  51 implementation
  52
  53   function AddressToString(Address: Pointer): String;
  54   begin
  55     SetLength(Result, SizeOf(Pointer));
  56     PInteger(Result)^ := Integer(Address);
  57   end;
  58
  59   function CartesianOfStrings(First: String; Second: TStrings): TStrings;
  60   var
  61     i: Integer;
  62   begin
  63     SetLength(Result, 0);
  64     for i := 0 to (Length(Second) - 1) do
  65     begin
  66       SetLength(Result, Length(Result) + 1);
  67       Result[Length(Result) - 1] := First + Second[i];
  68     end;
  69   end;
  70
  71   function CodeToHexadecimal(Input: String): String;
  72   var
  73     i: Integer;
  74     lbyte: Byte;
  75   begin
  76     Result := '';
  77     if (Input = '') then Exit;
  78     for i := 1 to Length(Input) do
  79     begin
  80       lbyte := Ord(Input[i]);
  81       Result := Result + CHARS_HEXA[lbyte shr 4] + CHARS_HEXA[lbyte and $F];
  82     end;
  83   end;
  84
  85   function ContainsCharacter(Input: String; Character: Char): Boolean;
  86   var
  87     i: Integer;
  88   begin
  89     Result := False;
  90     if (Input = '') then Exit;
  91     for i := 1 to Length(Input) do
  92       if (Input[i] = Character) then
  93       begin
  94         Result := True;
  95         Break;
  96       end;
  97   end;
  98
  99   function CustomDataToHex(Input: PChar; Size: Integer): String;
 100   var
 101     i: Integer;
 102     lbyte: Byte;
 103   begin
 104     Result := '';
 105     for i := (Size - 1) downto 0 do
 106     begin
 107       lbyte := Ord(Input[i]);
 108       Result := Result + CHARS_HEXA[lbyte shr 4] + CHARS_HEXA[lbyte and $F];
 109     end;
 110   end;
 111
 112   function CustomFloatToStr(Input: PChar; Size: Integer): String;
 113   var
 114     linput: TFloatRecord;
 115     lcmp: TSeparateConstants;
 116   begin
 117     case Size of
 118       4: lcmp := SEP_FP_4;
 119       8: lcmp := SEP_FP_8;
 120       10: lcmp := SEP_FP_10;
 121       else
 122         Exit;
 123     end;
 124     linput := SeparateFloat(Input, Size);
 125     with linput do
 126     begin
 127       if (Exponent = lcmp.ExponCmp) then
 128         if (Significand = lcmp.SigniCmp) then
 129         begin
 130           if Sign then Result := DESC_NEG_INF
 131           else Result := DESC_POS_INF;
 132         end
 133         else
 134         begin
 135           if (Significand and lcmp.SigniAnd = 0) then
 136             Result := DESC_NAN_S
 137           else
 138             Result := DESC_NAN_Q;
 139           Result := Result + DESC_NAN;
 140         end
 141       else
 142         case Size of
 143           4: Result := FloatToStr(PSingle(Input)^);
 144           8: Result := FloatToStr(PDouble(Input)^);
 145           10: Result := FloatToStr(PExtended(Input)^);
 146         end;
 147     end;
 148   end;
 149
 150   function EqualBeforeFirstParser(First, Second: String; Parser: Char): Boolean;
 151   begin
 152     if (ParseBeforeFirst(First, Parser) = ParseBeforeFirst(Second, Parser)) then
 153       Result := True
 154     else
 155       Result := False;
 156   end;
 157
 158   function IsAddress(Input: String): Boolean;
 159   var
 160     i: Integer;
 161   begin
 162     Result := False;
 163     Input := TrimCharacter(Input, ' ');
 164     if (Input = '') then Exit;
 165     if not(Input[1] in ['0'..'9', '+', '-']) then Exit;
 166     if (Input[1] in ['+', '-']) and (Length(Input) = 1) then Exit;
 167     for i := 2 to Length(Input) do
 168       if not(Input[i] in ['0'..'9']) then Exit;
 169     Result := True;
 170   end;
 171
 172   function IsHexaChar(Input: Char): Boolean;
 173   var
 174     i: Integer;
 175   begin
 176     Result := False;
 177     for i := 0 to (Length(CHARS_HEXA) - 1) do
 178       if (Input = CHARS_HEXA[i]) then
 179       begin
 180         Result := True;
 181         Exit;
 182       end;
 183   end;
 184
 185   function FloatType(Input: PChar; Size: Integer): Integer;
 186   var
 187     lresult: String;
 188   begin
 189     Result := 1;
 190     lresult := CustomFloatToStr(Input, Size);
 191     if (lresult = '0') then Result := 0
 192     else if (lresult = DESC_NEG_INF) or (lresult = DESC_POS_INF)
 193       or (lresult = DESC_QNAN) or (lresult = DESC_SNAN) then Result := -1;
 194   end;
 195
 196   function IsPrefixOf(Prefix, OfWhat: String): Boolean;
 197   var
 198     i: Integer;
 199   begin
 200     Result := False;
 201     if (Length(Prefix) > Length(OfWhat)) then Exit;
 202     for i := 1 to Length(Prefix) do
 203       if not(Prefix[i] = OfWhat[i]) then Exit;
 204     Result := True;
 205   end;
 206
 207   function MaxOf(First, Second: Integer): Integer;
 208   begin
 209     if (First > Second) then Result := First
 210     else Result := Second;
 211   end;
 212
 213   function MergeStringTStrings(First: String; Second: TStrings): TStrings;
 214   var
 215     i: Integer;
 216   begin
 217     SetLength(Result, Length(Second) + 1);
 218     Result[0] := First;
 219     for i := 0 to (Length(Second) - 1) do
 220       Result[i + 1] := Second[i];
 221   end;
 222
 223   function MergeTStringsString(First: TStrings; Second: String): TStrings;
 224   var
 225     i: Integer;
 226   begin
 227     SetLength(Result, Length(First) + 1);
 228     Result[Length(First)] := Second;
 229     for i := 0 to (Length(First) - 1) do
 230       Result[i] := First[i];
 231   end;
 232
 233   function MinOf(First, Second: Integer): Integer;
 234   begin
 235     if (First < Second) then Result := First
 236     else Result := Second;
 237   end;
 238
 239   function MirrorString(Input: String): String;
 240   var
 241     i: Integer;
 242   begin
 243     Result := '';
 244     if (Input = '') then Exit;
 245     for i := Length(Input) downto 1 do
 246       Result := Result + Input[i];
 247   end;
 248
 249   function NeutralizeDoubles(Input: String; Character: Char): String;
 250   begin
 251     Result := OmmitAfter(Input, Character, Character);
 252   end;
 253
 254   function OmmitAfter(Input: String; Character, What: Char): String;
 255   var
 256     i: Integer;
 257     llast: Char;
 258   begin
 259     Result := '';
 260     if (Input = '') then Exit;
 261     llast := Chr(Ord(Character) + 1);
 262     for i := 1 to Length(Input) do
 263       if not((llast = Character) and (Input[i] = What)) then
 264       begin
 265         Result := Result + Input[i];
 266         llast := Input[i];
 267       end;
 268   end;
 269
 270   function OmmitBefore(Input: String; Character, What: Char): String;
 271   var
 272     i: Integer;
 273     llast: Char;
 274   begin
 275     Result := '';
 276     if (Input = '') then Exit;
 277     llast := Chr(Ord(Character) + 1);
 278     for i := Length(Input) downto 1 do
 279       if not((llast = Character) and (Input[i] = What)) then
 280       begin
 281         Result := Result + Input[i];
 282         llast := Input[i];
 283       end;
 284     Result := MirrorString(Result);
 285   end;
 286
 287   function OmmitEverywhere(Input: String; Character, What: Char): String;
 288   begin
 289     Result := OmmitBefore(OmmitAfter(Input, Character, What), Character, What);
 290   end;
 291
 292   function ParseAfterFirst(Input: String; Parser: Char): String;
 293   var
 294     i, lpos: Integer;
 295   begin
 296     Result := '';
 297     if (Input = '') then Exit;
 298     for i := 1 to Length(Input) do
 299       if (Input[i] = Parser) then Break;
 300     lpos := i + 1;
 301     for i := lpos to Length(Input) do
 302       Result := Result + Input[i];
 303   end;
 304
 305   function ParseAfterLast(Input: String; Parser: Char): String;
 306   var
 307     i, lpos: Integer;
 308   begin
 309     Result := '';
 310     if (Input = '') then Exit;
 311     for i := Length(Input) downto 1 do
 312       if (Input[i] = Parser) then Break;
 313     lpos := i + 1;
 314     for i := lpos to Length(Input) do
 315       Result := Result + Input[i];
 316   end;
 317
 318   function ParseBeforeFirst(Input: String; Parser: Char): String;
 319   var
 320     i: Integer;
 321   begin
 322     Result := '';
 323     if (Input = '') then Exit;
 324     for i := 1 to Length(Input) do
 325       if (Input[i] = Parser) then Break
 326       else Result := Result + Input[i];
 327   end;
 328
 329   function ParseBeforeLast(Input: String; Parser: Char): String;
 330   var
 331     i, lpos: Integer;
 332   begin
 333     Result := '';
 334     if (Input = '') then Exit;
 335     for i := Length(Input) downto 1 do
 336       if (Input[i] = Parser) then Break;
 337     lpos := i - 1;
 338     for i := 1 to lpos do
 339       Result := Result + Input[i];
 340   end;
 341
 342   function ParseFirst(var Input: String; Parser: Char): String;
 343   begin
 344     Result := ParseAfterFirst(Input, Parser);
 345     Input := ParseBeforeFirst(Input, Parser);
 346   end;
 347
 348   function ParseToStrings(Input: PChar; Parser: Char): TStrings;
 349   var
 350     i: Integer;
 351     llast, lstring: PChar;
 352   begin
 353     SetLength(Result, 0);
 354     if (Length(Input) = 0) then Exit;
 355     i := 0;
 356     lstring := GetMemory(Length(Input) + 1);
 357     Move(Input^, lstring^, Length(Input) + 1);
 358     llast := lstring;
 359     while (i < Length(Input)) do
 360     begin
 361       if (Input[i] = Parser) then
 362       begin
 363         lstring[i] := #0;
 364         SetLength(Result, Length(Result) + 1);
 365         Result[Length(Result) - 1] := String(llast);
 366         llast := @lstring[i + 1];
 367       end;
 368       i := i + 1;
 369     end;
 370     SetLength(Result, Length(Result) + 1);
 371     Result[Length(Result) - 1] := String(llast);
 372     FreeMemory(lstring);
 373   end;
 374
 375   function RemoveCharacter(Input: String): String;
 376   begin
 377     Result := '';
 378     if (Input = '') then Exit;
 379     Result := Input;
 380     SetLength(Result, Length(Input) - 1);
 381   end;
 382
 383   function RemoveExactString(From: TStrings; What: String): TStrings;
 384   var
 385     i: Integer;
 386   begin
 387     SetLength(Result, 0);
 388     for i := 0 to (Length(From) - 1) do
 389       if not(From[i] = What) then
 390       begin
 391         SetLength(Result, Length(Result) + 1);
 392         Result[Length(Result) - 1] := From[i];
 393       end;
 394   end;
 395
 396   function RemovePrefix(Prefix, From: String): String;
 397   var
 398     i: Integer;
 399   begin
 400     Result := '';
 401     if not IsPrefixOf(Prefix, From) then Exit;
 402     for i := (Length(Prefix) + 1) to Length(From) do
 403       Result := Result + From[i];
 404   end;
 405
 406   function ReplaceCharacters(Input: String; Find, Replace: Char): String;
 407   var
 408     i: Integer;
 409   begin
 410     Result := '';
 411     if (Input = '') then Exit;
 412     for i := 1 to Length(Input) do
 413       if (Input[i] = Find) then
 414         Result := Result + Replace
 415       else
 416         Result := Result + Input[i];
 417   end;
 418
 419   function SeparateFloat(Input: PChar; Size: Integer): TFloatRecord;
 420   begin
 421     case Size of
 422       4:
 423       begin
 424         Result.Significand := PInteger(Input)^ and $7FFFFF;
 425         Result.Exponent := (PWord(Integer(Input) + 2)^ shr 7) and $FF;
 426         Result.Sign := not((PByte(Integer(Input) + 3)^ and $80) = 0);
 427       end;
 428       8:
 429       begin
 430         Result.Significand := PInt64(Input)^ and $FFFFFFFFFFFFF;
 431         Result.Exponent := (PWord(Integer(Input) + 6)^ shr 4) and $7FF;
 432         Result.Sign := not((PByte(Integer(Input) + 7)^ and $80) = 0);
 433       end;
 434       10:
 435       begin
 436         Result.Significand := PInt64(Input)^;
 437         Result.Exponent := PWord(Integer(Input) + 8)^ and $7FFF;
 438         Result.Sign := not((PByte(Integer(Input) + 9)^ and $80) = 0);
 439       end;
 440     end;
 441   end;
 442
 443   function StringToAddress(Input: String; Offset: Integer = 0): Integer;
 444   var
 445     i, lstart, lmul: Integer;
 446   begin
 447     Input := TrimCharacter(Input, ' ');
 448     lmul := 1;
 449     case Input[1] of
 450       '+':
 451         lstart := 2;
 452       '-':
 453       begin
 454         lstart := 2;
 455         lmul := -1;
 456       end;
 457       else
 458       begin
 459         lstart := 1;
 460         Offset := 0;
 461       end;
 462     end;
 463     Result := 0;
 464     for i := lstart to Length(Input) do
 465       Result := (10 * Result) + Ord(Input[i]) - Ord(CHARS_HEXA[0]);
 466     Result := (Result * lmul) + Offset;
 467   end;
 468
 469   function StringBefore(Input: String; Before: Integer): String;
 470   var
 471     i: Integer;
 472   begin
 473     Result := '';
 474     for i := 1 to Before do
 475       Result := Result + Input[i];
 476   end;
 477
 478   function StringCompare(First, Second: PChar; Size: Integer): Boolean;
 479   var
 480     i: Integer;
 481   begin
 482     Result := False;
 483     for i := 0 to (Size - 1) do
 484       if not(First[i] = Second[i]) then Exit;
 485     Result := True;
 486   end;
 487
 488   function TrimCharacter(Input: String; Character: Char): String;
 489   begin
 490     Result := TrimCharacterLeft(TrimCharacterRight(Input, Character), Character);
 491   end;
 492
 493   function TrimCharacterLeft(Input: String; Character: Char): String;
 494   var
 495     i, lstart: Integer;
 496   begin
 497     Result := '';
 498     if (Input = '') then Exit;
 499     for i := 1 to Length(Input) do
 500       if not(Input[i] = Character) then Break;
 501     lstart := i;
 502     for i := lstart to Length(Input) do
 503       Result := Result + Input[i];
 504   end;
 505
 506   function TrimCharacterRight(Input: String; Character: Char): String;
 507   var
 508     i, lend: Integer;
 509   begin
 510     Result := '';
 511     if (Input = '') then Exit;
 512     for i := Length(Input) downto 1 do
 513       if not(Input[i] = Character) then Break;
 514     lend := i;
 515     for i := 1 to lend do
 516       Result := Result + Input[i];
 517   end;
 518
 519   function UpperCase(Input: String): String;
 520   var
 521     i: Integer;
 522   begin
 523     Result := '';
 524     if (Input = '') then Exit;
 525     for i := 1 to Length(Input) do
 526       Result := Result + UpCase(Input[i]);
 527   end;
 528
 529   function ZeroPaddedInteger(Input, Padding: Integer): String;
 530   var
 531     i: Integer;
 532     lminus: Boolean;
 533   begin
 534     Result := '';
 535     if (Input < 0) then
 536     begin
 537       lminus := True;
 538       Input := -Input;
 539     end
 540     else lminus := False;
 541     while (Input > 0) do
 542     begin
 543       Result := Result + CHARS_HEXA[Input mod 10];
 544       Input := Input div 10;
 545     end;
 546     for i := Length(Result) to (Padding - 1) do
 547       Result := Result + CHARS_HEXA[0];
 548     if lminus then Result := Result + '-';
 549     Result := MirrorString(Result);
 550   end;
 551
 552   procedure ConstantToFloat(Input: String; Result: PChar; Size: Integer);
 553   begin
 554     if not(Length(Input) = Size) then Exit;
 555     Move(PChar(Input)[0], Result^, Size);
 556   end;
 557
 558   procedure CustomHexToData(Input: String; Data: PChar; Size: Integer);
 559   var
 560     i, j: Integer;
 561     lbyte: Byte;
 562   begin
 563     Input := MirrorString(UpperCase(TrimCharacter(Input, ' ')));
 564     if not(Length(Input) = Size * 2) then Exit;
 565     for i := 1 to Length(Input) do
 566       if not IsHexaChar(Input[i]) then Exit;
 567     for i := 1 to Size do
 568     begin
 569       lbyte := 0;
 570       for j := 0 to (Length(CHARS_HEXA) - 1) do
 571         if (CHARS_HEXA[j] = Input[2 * i]) then
 572         begin
 573           lbyte := j;
 574           Break;
 575         end;
 576       lbyte := lbyte shl 4;
 577       for j := 0 to (Length(CHARS_HEXA) - 1) do
 578         if (CHARS_HEXA[j] = Input[(2 * i) - 1]) then
 579         begin
 580           lbyte := lbyte + j;
 581           Break;
 582         end;
 583       Data[i - 1] := Chr(lbyte);
 584     end;
 585   end;
 586
 587   procedure CustomStrToFloat(Input: String; Result: PChar; Size: Integer);
 588   var
 589     ltrans: TTranslateConstants;
 590   begin
 591     case Size of
 592       4: ltrans := TRANS_FP_4;
 593       8: ltrans := TRANS_FP_8;
 594       10: ltrans := TRANS_FP_10;
 595       else
 596         Exit;
 597     end;
 598     Input := UpperCase(TrimCharacter(Input, ' '));
 599     if (Input = '') then Exit;
 600     if (Input = DESC_NEG_INF) then
 601     begin
 602       ConstantToFloat(ltrans.NegInf, Result, Size);
 603       Exit;
 604     end;
 605     if (Input = DESC_POS_INF) or (Input = DESC_INF) then
 606     begin
 607       ConstantToFloat(ltrans.PosInf, Result, Size);
 608       Exit;
 609     end;
 610     if (Input = DESC_QNAN) or (Input = DESC_NAN) then
 611     begin
 612       ConstantToFloat(ltrans.QNaN, Result, Size);
 613       Exit;
 614     end;
 615     if (Input = DESC_SNAN) then
 616     begin
 617       ConstantToFloat(ltrans.SNaN, Result, Size);
 618       Exit;
 619     end;
 620     try
 621       case Size of
 622         4: PSingle(Result)^ := StrToFloat(Input);
 623         8: PDouble(Result)^ := StrToFloat(Input);
 624         10: PExtended(Result)^ := StrToFloat(Input);
 625       end;
 626     except
 627       on EConvertError do
 628         case Size of
 629           4: PSingle(Result)^ := 0;
 630           8: PDouble(Result)^ := 0;
 631           10: PExtended(Result)^ := 0;
 632         end;
 633     end;
 634   end;
 635
 636 initialization
 637   DecimalSeparator := '.';
 638
 639 end.
 640