| 0,0 → 1,903 |
|---|
| {Copyright: Hagen Reddmann HaReddmann at T-Online dot de |
| Author: Hagen Reddmann |
| Version: 5.1, Delphi Encryption Compendium |
| Delphi 5-7, BCB 3-4, designed and testet under D5 |
| Description: Format Konvertion Utilitys for the DEC Packages |
| known Problems: none |
| Remarks: freeware, but this Copyright must be included |
| add about 10Kb code if all TFormats used |
| designed to made universal code, not very fast implementations |
| use lookup tables and formats can contains special chars |
| |
| * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS |
| * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
| * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE |
| * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR |
| * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF |
| * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR |
| * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
| * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE |
| * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, |
| * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| } |
| |
| unit DECFmt; |
| |
| interface |
| |
| uses Windows, SysUtils, Classes, DECUtil; |
| |
| {$I VER.INC} |
| |
| type |
| TDECFormat = class; |
| |
| TFormat_Copy = class; // copy input to output, it's the Default Format, eg FormaClass = nil |
| TFormat_HEX = class; // HEXadecimal in UpperCase |
| TFormat_HEXL = class; // HEXadecimal in Lowercase |
| TFormat_MIME32 = class; // MIME like format for Base 32 |
| TFormat_MIME64 = class; // MIME Base 64 format |
| TFormat_PGP = class; // PGP's MIME Base 64 with PGP's Checksums |
| TFormat_UU = class; // Unix UU Base 64 |
| TFormat_XX = class; // Unix XX base 64 |
| TFormat_ESCAPE = class; // Escaped Strings |
| |
| TDECFormatClass = class of TDECFormat; |
| |
| TDECFormat = class(TDECObject) // for binary one to one convert = fmtCOPY |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; virtual; abstract; |
| class function DoDecode(const Value; Size: Integer): Binary; virtual; abstract; |
| class function DoIsValid(const Value; Size: Integer): Boolean; virtual; abstract; |
| public |
| class function Encode(const Value: Binary): Binary; overload; |
| class function Encode(const Value; Size: Integer): Binary; overload; |
| class function Decode(const Value: Binary): Binary; overload; |
| class function Decode(const Value; Size: Integer): Binary; overload; |
| class function IsValid(const Value: Binary): Boolean; overload; |
| class function IsValid(const Value; Size: Integer): Boolean; overload; |
| end; |
| |
| TFormat_Copy = class(TDECFormat) |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| class function DoIsValid(const Value; Size: Integer): Boolean; override; |
| end; |
| |
| TFormat_HEX = class(TDECFormat) // Hexadecimal = fmtHEX |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| class function DoIsValid(const Value; Size: Integer): Boolean; override; |
| public |
| class function CharTable: PChar; virtual; |
| end; |
| |
| TFormat_HEXL = class(TFormat_HEX) // Hexadecimal lowercase = fmtHEXL |
| public |
| class function CharTable: PChar; override; |
| end; |
| |
| TFormat_MIME32 = class(TFormat_HEX) // MIME Base 32 = fmtMIME32 |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| public |
| class function CharTable: PChar; override; |
| end; |
| |
| TFormat_MIME64 = class(TFormat_HEX) // MIME Base 64 = fmtMIME64 |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| public |
| class function CharTable: PChar; override; |
| end; |
| |
| TFormat_PGP = class(TFormat_MIME64) |
| protected |
| class function DoExtractCRC(const Value; var Size: Integer): LongWord; |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| end; |
| |
| TFormat_UU = class(TDECFormat) // UU Encode = fmtUU |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| class function DoIsValid(const Value; Size: Integer): Boolean; override; |
| public |
| class function CharTable: PChar; virtual; |
| end; |
| |
| TFormat_XX = class(TFormat_UU) // XX Encode = fmtXX |
| public |
| class function CharTable: PChar; override; |
| end; |
| |
| TFormat_ESCAPE = class(TDECFormat) |
| protected |
| class function DoEncode(const Value; Size: Integer): Binary; override; |
| class function DoDecode(const Value; Size: Integer): Binary; override; |
| end; |
| |
| function ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass; |
| function FormatByName(const Name: String): TDECFormatClass; |
| function FormatByIdentity(Identity: LongWord): TDECFormatClass; |
| // insert #13#10 Chars in Blocks from BlockSize |
| function InsertCR(const Value: String; BlockSize: Integer): String; |
| // delete all #13 and #10 Chars |
| function DeleteCR(const Value: String): String; |
| // format any String to a Block |
| function InsertBlocks(const Value, BlockStart, BlockEnd: String; BlockSize: Integer): String; |
| // remove any Block format |
| function RemoveBlocks(const Value, BlockStart, BlockEnd: String): String; |
| |
| var |
| PGPCharsPerLine: Integer = 80; |
| |
| implementation |
| |
| uses CRC; |
| |
| resourcestring |
| sStringFormatExists = 'String format "%d" not exists.'; |
| sInvalidStringFormat = 'Input is not an valid %s Format.'; |
| sInvalidFormatString = 'Input can not be convert to %s Format.'; |
| sFormatNotRegistered = 'String format not registered.'; |
| |
| function ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass; |
| begin |
| if FormatClass <> nil then Result := FormatClass |
| else Result := TFormat_Copy; |
| end; |
| |
| function FormatByName(const Name: String): TDECFormatClass; |
| begin |
| Result := TDECFormatClass(DECClassByName(Name, TDECFormat)); |
| end; |
| |
| function FormatByIdentity(Identity: LongWord): TDECFormatClass; |
| begin |
| Result := TDECFormatClass(DECClassByIdentity(Identity, TDECFormat)); |
| end; |
| |
| class function TDECFormat.Encode(const Value: Binary): Binary; |
| begin |
| Result := DoEncode(Value[1], Length(Value)); |
| end; |
| |
| class function TDECFormat.Encode(const Value; Size: Integer): Binary; |
| begin |
| Result := DoEncode(Value, Size); |
| end; |
| |
| class function TDECFormat.Decode(const Value: Binary): Binary; |
| begin |
| Result := DoDecode(Value[1], Length(Value)); |
| end; |
| |
| class function TDECFormat.Decode(const Value; Size: Integer): Binary; |
| begin |
| Result := DoDecode(Value, Size); |
| end; |
| |
| class function TDECFormat.IsValid(const Value: Binary): Boolean; |
| begin |
| Result := DoIsValid(Value[1], Length(Value)); |
| end; |
| |
| class function TDECFormat.IsValid(const Value; Size: Integer): Boolean; |
| begin |
| Result := DoIsValid(Value, Size); |
| end; |
| |
| // .TFormat_Copy |
| class function TFormat_Copy.DoEncode(const Value; Size: Integer): Binary; |
| begin |
| SetLength(Result, Size); |
| Move(Value, Result[1], Size); |
| end; |
| |
| class function TFormat_Copy.DoDecode(const Value; Size: Integer): Binary; |
| begin |
| SetLength(Result, Size); |
| Move(Value, Result[1], Size); |
| end; |
| |
| class function TFormat_Copy.DoIsValid(const Value; Size: Integer): Boolean; |
| begin |
| Result := Size >= 0; |
| end; |
| |
| function TableFind(Value: Char; Table: PChar; Len: Integer): Integer; assembler; |
| asm // Utility for TStringFormat_XXXXX |
| PUSH EDI |
| MOV EDI,EDX |
| REPNE SCASB |
| MOV EAX,0 |
| JNE @@1 |
| MOV EAX,EDI |
| SUB EAX,EDX |
| @@1: DEC EAX |
| POP EDI |
| end; |
| |
| class function TFormat_HEX.DoEncode(const Value; Size: Integer): Binary; |
| var |
| S: PByte; |
| D,T: PChar; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size * 2); |
| T := CharTable; |
| D := PChar(Result); |
| S := PByte(@Value); |
| while Size > 0 do |
| begin |
| D[0] := T[S^ shr 4]; |
| D[1] := T[S^ and $F]; |
| Inc(D, 2); |
| Inc(S); |
| Dec(Size); |
| end; |
| end; |
| |
| class function TFormat_HEX.DoDecode(const Value; Size: Integer): Binary; |
| var |
| S: PChar; |
| D: PByte; |
| T: PChar; |
| I,P: Integer; |
| HasIdent: Boolean; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size div 2 +1); |
| T := CharTable; |
| D := PByte(Result); |
| S := PChar(@Value); |
| I := 0; |
| HasIdent := False; |
| while Size > 0 do |
| begin |
| P := TableFind(S^, T, 18); |
| if P < 0 then P := TableFind(UpCase(S^), T, 16); |
| if P < 0 then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassname(Self)]); |
| Inc(S); |
| if P >= 0 then |
| if P > 16 then |
| begin |
| if not HasIdent then |
| begin |
| HasIdent := True; |
| I := 0; |
| D := PByte(Result); |
| end; |
| end else |
| begin |
| if Odd(I) then |
| begin |
| D^ := D^ or P; |
| Inc(D); |
| end else D^ := P shl 4; |
| Inc(I); |
| end; |
| Dec(Size); |
| end; |
| SetLength(Result, PChar(D) - PChar(Result)); |
| end; |
| |
| class function TFormat_HEX.DoIsValid(const Value; Size: Integer): Boolean; |
| var |
| S,T: PChar; |
| L: Integer; |
| begin |
| Result := True; |
| T := CharTable; |
| L := StrLen(T); |
| S := PChar(@Value); |
| while Result and (Size > 0) do |
| if TableFind(S^, T, L) >= 0 then |
| begin |
| Dec(Size); |
| Inc(S); |
| end else Result := False; |
| end; |
| |
| class function TFormat_HEX.CharTable: PChar; assembler; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET |
| @@1: DB '0123456789ABCDEF' // Table must be >= 18 Chars |
| DB 'X$ abcdefhHx()[]{},;:-_/\*+"''',9,10,13,0 |
| end; |
| |
| class function TFormat_HEXL.CharTable: PChar; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET |
| @@1: DB '0123456789abcdef' // Table must be >= 18 Chars |
| DB 'X$ ABCDEFhHx()[]{},;:-_/\*+"''',9,10,13,0 |
| end; |
| |
| class function TFormat_MIME32.DoEncode(const Value; Size: Integer): Binary; |
| var |
| S: PByteArray; |
| D,T: PChar; |
| I: Integer; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| Size := Size * 8; |
| SetLength(Result, Size div 5 + 5); |
| D := PChar(Result); |
| T := CharTable; |
| S := PByteArray(@Value); |
| I := 0; |
| while I < Size do |
| begin |
| D^ := T[PWord(@S[I shr 3])^ shr (I and $7) and $1F]; |
| Inc(D); |
| Inc(I, 5); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| class function TFormat_MIME32.DoDecode(const Value; Size: Integer): Binary; |
| var |
| S,T,D: PChar; |
| I,V: Integer; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| T := CharTable; |
| SetLength(Result, Size * 5 div 8); |
| D := PChar(Result); |
| FillChar(D^, Length(Result), 0); |
| S := PChar(@Value); |
| Size := Size * 5; |
| I := 0; |
| while I < Size do |
| begin |
| V := TableFind(S^, T, 32); |
| if V < 0 then V := TableFind(UpCase(S^), T, 32); |
| if V >= 0 then |
| begin |
| PWord(@D[I shr 3])^ := PWord(@D[I shr 3])^ or (V shl (I and $7)); |
| Inc(I, 5); |
| end else Dec(Size, 5); |
| Inc(S); |
| end; |
| SetLength(Result, Size div 8); |
| end; |
| |
| class function TFormat_MIME32.CharTable: PChar; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET // must be >= 32 Chars |
| @@1: DB 'abcdefghijklnpqrstuwxyz123456789' |
| DB ' =$()[]{},;:-_\*"''',9,10,13,0 // special and skipped chars |
| end; |
| |
| class function TFormat_MIME64.DoEncode(const Value; Size: Integer): Binary; |
| var |
| B: Cardinal; |
| I: Integer; |
| D,T: PChar; |
| S: PByteArray; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size * 4 div 3 + 4); |
| D := PChar(Result); |
| T := CharTable; |
| S := PByteArray(@Value); |
| while Size >= 3 do |
| begin |
| Dec(Size, 3); |
| B := S[0] shl 16 or S[1] shl 8 or S[2]; |
| D[0] := T[B shr 18 and $3F]; |
| D[1] := T[B shr 12 and $3F]; |
| D[2] := T[B shr 6 and $3F]; |
| D[3] := T[B and $3F]; |
| Inc(D, 4); |
| S := @S[3]; |
| end; |
| while Size > 0 do |
| begin |
| B := 0; |
| for I := 0 to 2 do |
| begin |
| B := B shl 8; |
| if Size > 0 then |
| begin |
| B := B or S[0]; |
| S := @S[1]; |
| end; |
| Dec(Size); |
| end; |
| for I := 3 downto 0 do |
| begin |
| if Size < 0 then |
| begin |
| D[I] := T[64]; |
| Inc(Size); |
| end else D[I] := T[B and $3F]; |
| B := B shr 6; |
| end; |
| Inc(D, 4); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| class function TFormat_MIME64.DoDecode(const Value; Size: Integer): Binary; |
| var |
| B: Cardinal; |
| J,I: Integer; |
| S,D,L,T: PChar; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size); |
| Move(Value, PChar(Result)^, Size); |
| T := CharTable; |
| D := PChar(Result); |
| S := D; |
| L := S + Size; |
| J := 0; |
| while S < L do |
| begin |
| B := 0; |
| J := 4; |
| while (J > 0) and (S < L) do |
| begin |
| I := TableFind(S^, T, 65); |
| Inc(S); |
| if I >= 0 then |
| if I < 64 then |
| begin |
| B := B shl 6 or Byte(I); |
| Dec(J); |
| end else L := S; |
| end; |
| if J > 0 then |
| if J >= 4 then |
| begin |
| J := 0; |
| Break; |
| end else B := B shl (6 * J); |
| I := 2; |
| while I >= 0 do |
| begin |
| D[I] := Char(B); |
| B := B shr 8; |
| Dec(I); |
| end; |
| Inc(D, 3); |
| end; |
| SetLength(Result, D - PChar(Result) - J); |
| end; |
| |
| class function TFormat_MIME64.CharTable: PChar; assembler; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET // must be >= 65 Chars |
| @@1: DB 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=' |
| DB ' $()[]{},;:-_\*"''',9,10,13,0 // special and skipped chars |
| end; |
| |
| class function TFormat_PGP.DoExtractCRC(const Value; var Size: Integer): LongWord; |
| var |
| L: PChar; |
| C: Char; |
| R: String; |
| begin |
| Result := $FFFFFFFF; |
| C := CharTable[64]; // get padding char, per default '=' |
| L := PChar(@Value) + Size; |
| while L <> PChar(@Value) do |
| if L^ = C then Break else Dec(L); // scan reverse for padding char |
| if L - PChar(@Value) >= Size - 5 then // remaining chars must be > 4 ,i.e. '=XQRT' |
| try |
| Inc(L); |
| R := inherited DoDecode(L^, Size - (L - PChar(@Value))); |
| if Length(R) >= 3 then |
| begin |
| Result := 0; |
| Move(PChar(R)^, Result, 3); |
| Size := L - PChar(@Value); |
| end; |
| except |
| end; |
| end; |
| |
| class function TFormat_PGP.DoEncode(const Value; Size: Integer): Binary; |
| var |
| CRC: LongWord; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| Result := InsertCR(inherited DoEncode(Value, Size), PGPCharsPerLine); // 80 chars per line |
| CRC := CRCCalc(CRC_24, Value, Size); // calculate 24Bit Checksum |
| SwapBytes(CRC, 3); // PGP use Big Endian |
| if Result[Length(Result)] <> #10 then Result := Result + #13#10; // insert CR iff needed, CRC must be in next line |
| Result := Result + '=' + inherited DoEncode(CRC, 3); // append CRC |
| end; |
| |
| class function TFormat_PGP.DoDecode(const Value; Size: Integer): Binary; |
| var |
| CRC: LongWord; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| CRC := DoExtractCRC(Value, Size); |
| Result := inherited DoDecode(Value, Size); |
| if CRC <> $FFFFFFFF then // iff CRC found check it |
| begin |
| SwapBytes(CRC, 3); |
| if CRC <> CRCCalc(CRC_24, PChar(Result)^, Length(Result)) then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassname(Self)]); |
| end; |
| end; |
| |
| class function TFormat_UU.DoEncode(const Value; Size: Integer): Binary; |
| var |
| S,T,D: PChar; |
| L,I: Integer; |
| B: Cardinal; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size * 4 div 3 + Size div 45 + 10); |
| D := PChar(Result); |
| T := CharTable; |
| S := PChar(@Value); |
| while Size > 0 do |
| begin |
| L := Size; |
| if L > 45 then L := 45; |
| Dec(Size, L); |
| D^ := T[L]; |
| while L > 0 do |
| begin |
| B := 0; |
| for I := 0 to 2 do |
| begin |
| B := B shl 8; |
| if L > 0 then |
| begin |
| B := B or Byte(S^); |
| Inc(S); |
| end; |
| Dec(L); |
| end; |
| for I := 4 downto 1 do |
| begin |
| D[I] := T[B and $3F]; |
| B := B shr 6; |
| end; |
| Inc(D, 4); |
| end; |
| Inc(D); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| class function TFormat_UU.DoDecode(const Value; Size: Integer): Binary; |
| var |
| T,D,L,S: PChar; |
| I,E: Integer; |
| B: Cardinal; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size); |
| S := PChar(@Value); |
| L := S + Size; |
| D := PChar(Result); |
| T := CharTable; |
| repeat |
| Size := TableFind(S^, T, 64); |
| if (Size < 0) or (Size > 45) then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]); |
| Inc(S); |
| while Size > 0 do |
| begin |
| B := 0; |
| I := 4; |
| while (I > 0) and (S <= L) do |
| begin |
| E := TableFind(S^, T, 64); |
| if E >= 0 then |
| begin |
| B := B shl 6 or Byte(E); |
| Dec(I); |
| end; |
| Inc(S); |
| end; |
| I := 2; |
| repeat |
| D[I] := Char(B); |
| B := B shr 8; |
| Dec(I); |
| until I < 0; |
| if Size > 3 then Inc(D, 3) else Inc(D, Size); |
| Dec(Size, 3); |
| end; |
| until S >= L; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| class function TFormat_UU.DoIsValid(const Value; Size: Integer): Boolean; |
| var |
| S,T: PChar; |
| L,I,P: Integer; |
| begin |
| Result := False; |
| T := CharTable; |
| L := StrLen(T); |
| S := PChar(@Value); |
| P := 0; |
| while Size > 0 do |
| begin |
| I := TableFind(S^, T, L); |
| if I >= 0 then |
| begin |
| Dec(Size); |
| Inc(S); |
| if P = 0 then |
| begin |
| if I > 45 then Exit; |
| P := (I * 4 + 2) div 3; |
| end else |
| if I < 64 then Dec(P); |
| end else Exit; |
| end; |
| if P <> 0 then Exit; |
| Result := True; |
| end; |
| |
| class function TFormat_UU.CharTable: PChar; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET // must be >= 64 Chars |
| @@1: DB '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' |
| DB ' ',9,10,13,0 |
| end; |
| |
| class function TFormat_XX.CharTable: PChar; |
| asm |
| MOV EAX,OFFSET @@1 |
| RET |
| @@1: DB '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' |
| DB ' "()[]''',9,10,13,0 |
| end; |
| |
| const |
| ESCAPE_CodesL: PChar = 'abtnvfr'; |
| ESCAPE_CodesU: PChar = 'ABTNVFR'; |
| |
| class function TFormat_ESCAPE.DoDecode(const Value; Size: Integer): Binary; |
| var |
| D,S,T: PChar; |
| I: Integer; |
| begin |
| Result := ''; |
| if Size <= 0 then Exit; |
| SetLength(Result, Size); |
| D := PChar(Result); |
| S := PChar(@Value); |
| T := S + Size; |
| while S < T do |
| begin |
| if S^ = '\' then |
| begin |
| Inc(S); |
| if S > T then Break; |
| if UpCase(S^) = 'X' then |
| begin |
| if S + 2 > T then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]); |
| I := TableFind(UpCase(S[1]), TFormat_HEX.CharTable, 16); |
| if I < 0 then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]); |
| D^ := Char(I shl 4); |
| I := TableFind(UpCase(S[2]), TFormat_HEX.CharTable, 16); |
| if I < 0 then |
| raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]); |
| D^ := Char(Byte(D^) or I); |
| Inc(S, 2); |
| end else |
| begin |
| I := TableFind(UpCase(S^), ESCAPE_CodesU, 7); |
| if I >= 0 then D^ := Char(I + 7) |
| else D^ := S^; |
| end; |
| end else D^ := S^; |
| Inc(D); |
| Inc(S); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| class function TFormat_ESCAPE.DoEncode(const Value; Size: Integer): Binary; |
| var |
| S: PByte; |
| D,T: PChar; |
| I: Integer; |
| begin |
| Result := ''; |
| if Size = 0 then Exit; |
| SetLength(Result, Size + 8); |
| I := Size; |
| D := PChar(Result); |
| S := PByte(@Value); |
| T := TFormat_HEX.CharTable; |
| while Size > 0 do |
| begin |
| if I <= 0 then |
| begin |
| I := D - PChar(Result); |
| SetLength(Result, I + Size + 8); |
| D := PChar(Result) + I; |
| I := Size; |
| end; |
| if (S^ < 32) {or (S^ > $7F)} then |
| if (S^ >= 7) and (S^ <= 13) then |
| begin |
| D[0] := '\'; |
| D[1] := ESCAPE_CodesL[S^ - 7]; |
| Inc(D, 2); |
| Dec(I, 2); |
| end else |
| begin |
| D[0] := '\'; |
| D[1] := 'x'; |
| D[2] := T[S^ shr 4]; |
| D[3] := T[S^ and $F]; |
| Inc(D, 4); |
| Dec(I, 4); |
| end |
| else |
| if S^ = Ord('\') then |
| begin |
| D[0] := '\'; |
| D[1] := '\'; |
| Inc(D, 2); |
| Dec(I, 2); |
| end else |
| if S^ = Ord('"') then |
| begin |
| D[0] := '\'; |
| D[1] := '"'; |
| Inc(D, 2); |
| Dec(I, 2); |
| end else |
| begin |
| D^ := Char(S^); |
| Inc(D); |
| Dec(I); |
| end; |
| Dec(Size); |
| Inc(S); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| function InsertCR(const Value: String; BlockSize: Integer): String; |
| var |
| I: Integer; |
| S,D: PChar; |
| begin |
| if (BlockSize <= 0) or (Length(Value) <= BlockSize) then |
| begin |
| Result := Value; |
| Exit; |
| end; |
| I := Length(Value); |
| SetLength(Result, I + I * 2 div BlockSize + 2); |
| S := PChar(Value); |
| D := PChar(Result); |
| repeat |
| Move(S^, D^, BlockSize); |
| Inc(S, BlockSize); |
| Inc(D, BlockSize); |
| D^ := #13; Inc(D); |
| D^ := #10; Inc(D); |
| Dec(I, BlockSize); |
| until I < BlockSize; |
| Move(S^, D^, I); |
| Inc(D, I); |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| function DeleteCR(const Value: String): String; |
| var |
| S,D: PChar; |
| I: Integer; |
| begin |
| I := Length(Value); |
| SetLength(Result, I); |
| D := PChar(Result); |
| S := PChar(Value); |
| while I > 0 do |
| begin |
| if (S^ <> #10) and (S^ <> #13) then |
| begin |
| D^ := S^; |
| Inc(D); |
| end; |
| Inc(S); |
| Dec(I); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| function InsertBlocks(const Value, BlockStart, BlockEnd: String; BlockSize: Integer): String; |
| var |
| I,LS,LE: Integer; |
| D,S: PChar; |
| begin |
| if (BlockSize <= 0) or (Length(Value) <= BlockSize) then |
| begin |
| Result := Value; |
| Exit; |
| end; |
| I := Length(Value); |
| LS := Length(BlockStart); |
| LE := Length(BlockEnd); |
| SetLength(Result, I + (I div BlockSize + 1) * (LS + LE)); |
| S := PChar(Value); |
| D := PChar(Result); |
| repeat |
| Move(PChar(BlockStart)^, D^, LS); Inc(D, LS); |
| Move(S^, D^, BlockSize); Inc(D, BlockSize); |
| Move(PChar(BlockEnd)^, D^, LE); Inc(D, LE); |
| Dec(I, BlockSize); |
| Inc(S, BlockSize); |
| until I < BlockSize; |
| if I > 0 then |
| begin |
| Move(PChar(BlockStart)^, D^, LS); Inc(D, LS); |
| Move(S^, D^, I); Inc(D, I); |
| Move(PChar(BlockEnd)^, D^, LE); Inc(D, LE); |
| end; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| function RemoveBlocks(const Value, BlockStart, BlockEnd: String): String; |
| var |
| LS,LE: Integer; |
| S,D,L,K: PChar; |
| begin |
| SetLength(Result, Length(Value)); |
| LS := Length(BlockStart); |
| LE := Length(BlockEnd); |
| D := PChar(Result); |
| S := PChar(Value); |
| L := S + Length(Value); |
| repeat |
| if S > L then Break; |
| if LS > 0 then |
| begin |
| S := StrPos(S, PChar(BlockStart)); |
| if S = nil then Break; |
| Inc(S, LS); |
| if S > L then Break; |
| end; |
| K := StrPos(S, PChar(BlockEnd)); |
| if K = nil then K := L; |
| Move(S^, D^, K - S); |
| Inc(D, K - S); |
| S := K + LE; |
| until S >= L; |
| SetLength(Result, D - PChar(Result)); |
| end; |
| |
| end. |
| |