You are here:
//nefzger.at/~SoffyT/encoderdecoder.html
//nefzger.at/~SoffyT/encoderdecoder.html
|
|
-- gh (-G-enerate -H-tml) v1.91 -- Copyright (c) 2002, 2005 SoffyT & MNe -- [ Abstrakt | Über Kodierungen | Das Programm 'ed' | Download | Kontakt ] Der Compilerlauf: ~~ ~~ brcc32 ed.verinfo.rc -foed.verinfo.res ~~ dcc32 -B -CC -GD -H -W -$A+ -$B- -$C- -$D- -$L- -$Y- -$H+ -$I- -$J- -$O+ -$Q- -$R- -$T- -$U+ -$W- -$X+ -$Z4 ed.dpr ~~ Borland Delphi Version 13.0 Copyright (c) 1983,99 Inprise Corporation O:\Marcus\mne_Testverzeichnis\core_utilities\CmdLine_Utilities.pas(182) O:\Marcus\mne_Testverzeichnis\core_utilities\Misc_Utilities.pas(1054) O:\Marcus\mne_Testverzeichnis\core_utilities\String_Utilities.pas(121) O:\Marcus\mne_Testverzeichnis\core_classes\Defs.pas(110) O:\Marcus\mne_Testverzeichnis\core_classes\EncoderDecoder.pas(1159) ed.dpr(249) 2881 Zeilen, 0.39 Sekunden, 67648 Bytes Code, 4281 Bytes Daten. Der Quelltext der Projektdatei ('ed.dpr', 16.960 Byte):
(*
* .
* Module name: ed.dpr; Module type: Delphi (console) project; Language: Object pascal; .
* Original developed with: Delphi 5 Enterprise; Portability: most likely down to Delphi 2; .
* .
* Author: ~SoffyT (web:<http://www.nefzger.at/~SoffyT/>; mailto:<MissyQueen@nefzger.at>) .
* File created: Fri., 01.11.2002; Last modified: Thu., 07.10.2004 .
* .
* Bug report: Report all bugs, wishes, suggestions etc. to <BugReport@nefzger.at>. .
* .
* Purpose: .
* ---------- .
* Console wrapper for EncoderDecoder.pas .
* .
*)
{$APPTYPE Console}
program
EncDec; // AKA 'ed' or 'ed.dpr' .
uses
Windows,
SysUtils,
CmdLine_Utilities in '..\core_utilities\CmdLine_Utilities.pas',
Misc_Utilities in '..\core_utilities\Misc_Utilities.pas',
String_Utilities in '..\core_utilities\String_Utilities.pas',
Defs in '..\core_classes\Defs.pas',
EncoderDecoder in '..\core_classes\EncoderDecoder.pas';
// -- Programm- & Versions-Info ------------------------------- .
{$R 'ed.verinfo.res'} // generiert mit VerGen.exe Copyright (c) 2002, 2004 ~MNe :-) .
var
Program_name : String;
CmdLine_ok : Integer;
// ------------------------------------------------------------ .
{$I 'ed.clipboard.inc'}
var
ed_A : TEncoderDecoder_Action; // Aktion: Encode / Decode ? .
ed_C : TEncoderDecoder_Coding; // Kodierung: Base64 / UU / XX ? .
F_in : String; // Input Dateiname .
F_out : String; // Output Dateiname .
F_dout : Boolean; // Output Datei(name) löschen, wenn vorhanden .
ed : TEncoderDecoder; // Arbeitsklasse .
ed_erg : Integer; // Ergebnis der geforderten Operation .
ed_size : Integer;
// ============================================================================ .
begin try
// Vorspann .
Program_name := appGetApplicationFileName();
CmdLine_ok := GetFirstInvalidSwitch(
CheckCmdLineSwitches( // Kommandozeile auswerten #1, "Lang-Form" .. .
['version','history',
'quiet',
'encode','decode',
'base64','uu','uuspace','xx',
'input-file','output-file',
'force'],
['-'],
[False,False,
False,
False,False,
False,False,False,False,
True,True,
False],
True),
CheckCmdLineSwitches( // Kommandozeile auswerten #2, "Kurz-Form" .. .
['v','h',
'q',
'e','d',
'b','u','u2','x',
'i','o',
'f'],
['-','/'],
[False,False,
False,
False,False,
False,False,False,False,
True,True,
False]
{,False}));
WriteLn;
WriteLn(Program_name,' -- ',resGetXVersionInfo(),', ',resGetXReleaseInfo(),', ',
resGetXDateTimeInfo());
Writeln(StringOfChar(' ',Length(Program_name)),' -- ',resGetXCopyrightInfo());
WriteLn(StringOfChar(' ',Length(Program_name)),' -- ','(dbg) OS: ',
sysGetWin32Version().w32ComposedName,'; CmdLineCnt: ',ParamCount(),'; CmdLineErg: ',
CmdLine_ok);
// Kommandozeile auswerten .
WriteLn;
// Parameter für 'Aktion' (Enkodieren | Dekodieren) auswerten ... .
if ((CmdLineSwitch('e',['-','/'],False) > 0) or
(CmdLineSwitch('encode',['-'],False,True) > 0)) then
ed_A := eda_ENCODE
else if ((CmdLineSwitch('d',['-','/'],False) > 0) or
(CmdLineSwitch('decode',['-'],False,True) > 0)) then
ed_A := eda_DECODE
else
ed_A := eda_NONE;
// Parameter für 'Modus' (Base64 | UU | UUSpace | XX) auswerten ... .
if ((CmdLineSwitch('b',['-','/'],False) > 0) or
(CmdLineSwitch('base64',['-'],False,True) > 0)) then
ed_C := edc_BASE64
else if ((CmdLineSwitch('u',['-','/'],False) > 0) or
(CmdLineSwitch('uu',['-'],False,True) > 0)) then
ed_C := edc_UU
else if ((CmdLineSwitch('u2',['-','/'],False) > 0) or
(CmdLineSwitch('uuspace',['-'],False,True) > 0)) then
ed_c := edc_UUSPACE
else if ((CmdLineSwitch('x',['-','/'],False) > 0) or
(CmdLineSwitch('xx',['-'],False,True) > 0)) then
ed_C := edc_XX
else
ed_C := edc_NONE;
// Parameter -i | --input-file: input file name | RESERVED_CLIPBOARD .
F_in := ParamBySwitch('i',['-','/'],True);
if (F_in = '') then // Parameter nicht gefunden oder kein Wert; lange Version versuchen .
F_in := ParamBySwitch('input-file',['-'],True,True);
if ((F_in = '') and (ed_A = eda_DECODE)) then // immer noch kein Wert? .
F_in := RESERVED_CLIPBOARD; // wenn *eda_DECODE* auf 'Clipboard' setzen .
// Parameter --o | --output-file: output file name | RESERVED_CLIPBOARD .
F_out := ParamBySwitch('o',['-','/'],True);
if (F_out = '') then // Parameter nicht gefunden oder kein Wert; lange Version versuchen .
F_out := ParamBySwitch('output-file',['-'],True,True);
if ((F_out = '') and (ed_A = eda_ENCODE)) then // immer noch kein Wert? .
F_out := RESERVED_CLIPBOARD; // wenn *eda_ENCODE* auf 'Clibboard' setzen .
// Flag für 'Ausgabedatei überschreiben, wenn diese existiert' .
F_dout := ((CmdLineSwitch('f',['-','/'],False) > 0) or
(CmdLineSwitch('force',['-'],False,True) > 0));
// Parameter prüfen & Programm durchführen .. .
if (CmdLine_ok = CMDLINE_VALID) and
((ParamCount = 1) and ((CmdLineSwitch('v',['-','/'],False) > 0) or
(CmdLineSwitch('version',['-'],False,True) > 0))) then begin
// Parameter '--version': keine weiteren Informationen anzeigen .. .
;
end else if (CmdLine_ok = CMDLINE_VALID) and
((ParamCount = 1) and ((CmdLineSwitch('h',['-','/'],False) > 0) or
(CmdLineSwitch('history',['-'],False,True) > 0))) then begin
// Parameter '--history': (als Resource gelinkte) History anzeigen .. .
WriteLn(resGetXHistoryInfo());
end else if (CmdLine_ok = CMDLINE_VALID) and
((ParamCount = 4) or ((ParamCount = 5) and F_dout)) and
((ed_A <> eda_NONE) and (ed_C <> edc_NONE) and
(F_in <> '') and (F_out <> '')) then begin
// Kommandozeile sieht richtig aus für die "normale" Benutzung .. .
if (FileExists(F_in)) or
((ed_A = eda_DECODE) and (LowerCase(F_in) = RESERVED_CLIPBOARD)) then begin
if (ed_C = edc_BASE64) then
ed := TBase64EncoderDecoder.Create() // bei Base64: keine weiteren Optionen .
else if ((ed_C = edc_UU) or (ed_C = edc_UUSPACE)) then begin
TUUEncoderDecoder.SetUUSpaceCoding(ed_C = edc_UUSPACE);
ed := TUUEncoderDecoder.Create();
TUUEncoderDecoder(ed).FileMode := 644; // <- "Just in case": bei Aktion "decode" .
TUUEncoderDecoder(ed).FileName := F_in; // werden diese aus der Datei-Info gesetzt .
end else if (ed_C = edc_XX) then begin
ed := TXXEncoderDecoder.Create();
TXXEncoderDecoder(ed).FileMode := 644; // <- "Just in case": bei Aktion "decode" .
TXXEncoderDecoder(ed).FileName := F_in; // werden diese aus der Datei-Info gesetzt .
end else
ed := NIL;
if (ed <> NIL) then begin
ed_size := 0;
if (ed_A = eda_ENCODE) then begin
ed_erg := ed.LoadFileData(F_in);
if (ed_erg >= ERROR_SUCCESS) then begin
WriteLn('Data loaded. Guessing encoded file size: ',
fmtFormatNumber((1.0*ed.GuessEncodedSize),0),' octets.');
ed_erg := ed.Encode();
if (ed_erg >= ERROR_SUCCESS) then begin
ed_size := ed.Result; // # Bytes merken .
if (LowerCase(F_out) = RESERVED_CLIPBOARD) then
ed_erg := ed.SaveTextData() // <- to the clipboard .
else begin
if ((FileExists(F_out)) and (F_dout)) then
helperSafeDeleteFile(F_out);
ed_erg := ed.SaveTextData(F_out); // <- to file 'F_out' .
end;
end;
end;
if (ed_erg >= ERROR_SUCCESS) then
WriteLn('Success: Encoded ''',F_in,''' to ''',F_out,''', ',
fmtFormatNumber((1.0*ed_size),0),' octets written.')
else
WriteLn('Failure: ',TEncoderDecoder.ErrorCodeToStr(ed_erg),'.');
end else if (ed_A = eda_DECODE) then begin
if (LowerCase(F_in) = RESERVED_CLIPBOARD) then
ed_erg := ed.LoadTextData() // <- from the clipboard .
else
ed_erg := ed.LoadTextData(F_in); // <- from file 'F_in' .
if (ed_erg >= ERROR_SUCCESS) then begin
WriteLn('Data loaded. Guessing decoded file size: ',
fmtFormatNumber((1.0*ed.GuessDecodedSize),0),' bytes.');
Write(' Guessing coding type (will *NOT* override switch): ');
if (LowerCase(F_in) = RESERVED_CLIPBOARD) then // <- from the clipboard .
WriteLn('Sorry! This function has no clipoard support!')
else
case ed.GuessEncoding(F_in) of // <- from file 'F_in' .
edc_BASE64 : WriteLn('base64');
edc_UU : WriteLn('uu');
edc_UUSPACE : WriteLn('uuspace');
edc_XX : WriteLn('xx');
else WriteLn('can''t determine.');
end;
ed_erg := ed.Decode();
if (ed_erg >= ERROR_SUCCESS) then begin
ed_size := ed.Result; // # Bytes merken .
if ((FileExists(F_out)) and (F_dout)) then
helperSafeDeleteFile(F_out);
ed_erg := ed.SaveFileData(F_out);
end;
end;
if (ed_erg >= ERROR_SUCCESS) then
WriteLn('Success: Decoded ''',F_in,''' to ''',F_out,''', ',
fmtFormatNumber((1.0*ed_size),0),' bytes written.')
else
WriteLn('Failure: ',TEncoderDecoder.ErrorCodeToStr(ed_erg),'.');
end else
WriteLn('Failure: internal failure.');
FreeAndNil(ed);
end else
WriteLn('Failure: internal failure.');
end else
WriteLn('Failure: "',F_in,'" can not be found.');
end else begin
// Ungültigen Parameter / Schalter gefunden? -> Ausgabe desjenigen welchen .. .
if ((CmdLine_ok <> CMDLINE_VALID) or
(ParamCount() > 0)) then begin
if (CmdLine_ok <> CMDLINE_VALID) then
WriteLn('Sorry! Unknown switch: ','''',ParamStr(CmdLine_ok),'''','.')
else
WriteLn('Sorry! Unknown or unsupported parameter: ',
'''',ParamStr(ParamCount()),'''','.');
WriteLn;
end;
// Angegebene Kommandozeile war wohl niX .. Usage-Meldung ausgeben .. .
WriteLn('Usage: ',Program_name,' [[-e|--encode]|[-d|--decode]] [[-b|--bas' +
'e64]|[-u|--uu]|[-u2|--uuspace]|[-x|x-xx]] [-i|--input-file[<InputFile' +
'>]] [-o|--output-file[<OutputFile>]] {-f|--force} | {-h|--history}');
WriteLn;
writeln(' e.g.: ',Program_name,' -e -b -iFoo.jpg -oBar.txt');
writeln(' = ',Program_name,' --encode --base64 --input-fileFoo.jpg --' +
'output-fileBar.txt');
WriteLn(' (this will encodcode ''Foo.jpg'' to ''Bar.txt'' using ' +
'base64 coding)');
WriteLn;
writeLn(' e.g.: ',Program_name,' -d -u -iBar.uue -oFoo.bin');
writeLn(' = ',Program_name,' --decode --uu --input-fileBar.uue --outp' +
'ut-fileFoo.bin');
WriteLn(' (this will decode ''Foo.bin'' from ''Bar.uue'' using U' +
'U coding)');
WriteLn;
WriteLn(' -e, /e, --encode Encode input file to output file (tha' +
't is: bin -> text).');
WriteLn(' -d, /d, --decode Decode input file to output file (tha' +
't is: text -> bin).');
WriteLn(' -b, /b, --base64 Use BASE64 for encoding/ decoding (oc' +
'curence: very common).');
WriteLn(' -u, /u, --uu Use UU for encoding/ decoding (occure' +
'nce: rare).');
WriteLn(' -u2, /u2, --uuspace Use UU-Space for encoding/ decoding (' +
'occurence: more rare).');
WriteLn(' -x, /x, --xx Use XX for encoding/ decoding (occure' +
'ce: very rare).');
WriteLn(' -i, /i, --input-file Name of input file.');
WriteLn(' -o, /o, --output-file Name of output file.');
WriteLn(' -f, /f, --force Force overwriting output file.');
WriteLn(' -v, /v, --version Display version number only.');
WriteLn(' -h, /h, --history Display program & version history.');
WriteLn(' -q, /q, --quiet Quiet: no additional output. (Unimple' +
'mented by now.)');
WriteLn;
WriteLn('Hint(s): Parameters enclosed in ''[]'' are mandatory; parameters' +
' enclosed in ''{}'' are optional; parameters seperated by ''|'' exclu' +
'de each other; ''<..>'' within a parameter means that *you* have to s' +
'upply additional information.');
WriteLn;
WriteLn('Note(s): If <OutputFile> exists, the program will fail, as it wi' +
'll *NOT* overwrite existing files. Use {--force} to indicate that you' +
' know what you are doing and to override this behavior (e.g. for use ' +
'in a batch).');
WriteLn;
WriteLn('Clipboard support: if mode is --encode, then --output-file may b' +
'e ''$clpbrd$''; if mode is --decode, then --input-file may be ''$clpb' +
'rd$''; in either case, the program will write/ read the (text) data t' +
'o/ from the windows clipboard, respectively.');
WriteLn;
WriteLn('Bug report: Pls. report all bug(s) and/ or wishes, suggestions e' +
'tc. to <BugReport@nefzger.at>, including the module name (which is: ''',
Program_name,''') and module version (which is: ''',resGetXVersionInfo(),
'''). Thank you.');
end;
Halt(0); // Normales Programmende .
except
on e: Exception do begin
WriteLn(' Fatal: Exception: ','''',e.Message,'''','; pls. contact the pro' +
'grammer: <BugReport@nefzger.at>.');
Halt(1); // Abnormales Programmende: irgendwo wurde (intern) eine Exception geworfen .. .
end;
end; {try} end. // {begin} .
Der Quelltext der Klasse TEncoderDecoder ('encoderdecoder.pas', 74.546 Byte):
(*
* .
* Module name: EncoderDecoder.pas; Module type: Delphi unit; Language: Object pascal; .
* Original developed with: Delphi 5 Enterprise; Portability: most likely down to Delphi 2; .
* .
* Author: Marcus F. Nefzger AKA MNe (web:<http://www.nefzger.at/>; mailto:<MNe@nefzger.at>) .
* File created: Fri., 01.11.2002; Last modified: Thu., 03.07.2003 .
* .
* Bug report: Report all bugs, wishes, suggestions etc. to <BugReport@nefzger.at>. .
* .
* Purpose: .
* ---------- .
* Provides classes for encoding binary data in such a way that they can be transmitted .
* savely over a character-only network transmission (e.g. via the mail service) and can be .
* decoded to it's original form. .
* .
* Implemented classes: .
* ---------------------- .
* TEncoderDecoder { = class (TObject) } .. (abstract basis class ~ do not instance) .
* TEncoderDecoder2 { = class (TObject) } .. (abstract basis class ~ do not instance) .
* TBase64EncoderDecoder { = class (TEncoderDecoder) } .. Base64 Encoder/ Decoder .
* TUUEncoderDecoder { = class (TEncoderDecoder2) } .. UU Encoder/ Decoder .
* TXXEncoderDecoder { = class (TEncoderDecoder2) } .. XX Encoder/ Decoder .
* .
*)
unit
EncoderDecoder;
// ---------- .
interface
// ---------- .
uses
Classes,
Defs;
(*
* Die nachfolgenden beiden 'Flags' werden intern nicht verwendet .
* und sind hauptsächlich zur Verwendung in einem Programm gedacht, .
* in welchem die EncoderDecoder-Klassen Verwendung finden. .
*)
type
TEncoderDecoder_Action
= (eda_NONE, // nicht zugewiesen .
eda_ENCODE, // Kodieren (Binär -> Text) .
eda_DECODE); // Dekodieren (Text -> Binär .
TEncoderDecoder_Coding
= (edc_NONE, // nicht zugewiesen .
edc_BASE64, // Base64 Kodierung .
edc_UU, // UU Kodierung .
edc_UUSPACE, // UU-Space Kodierung .
edc_XX); // XX Kodierung .
const
CODE_BITS = 6; // Abbildung ist (3*8) Bit auf (4*6) Bit .
CODE_BYTE_MASK = ((1 shl CODE_BITS)-1); // die zugehörige Bitmaske .
MAX_CODE_VALUE = CODE_BYTE_MASK; // --"-- ditto, nur unter anderem Namen bekannt .
type
PByteToCharTable = ^TByteToCharTable;
TByteToCharTable = packed array [0..MAX_CODE_VALUE] of Char;
PCharToByteTable = ^TCharToByteTable;
TCharToByteTable = packed array [Char] of Byte;
type
PLineSourceTable = ^TLineSourceTable;
TLineSourceTable = packed array [Byte] of Byte;
PLineResultTable = ^TLineResultTable; // Sehen zwar irgenwie alle ziemlich gleich aus, .
TLineResultTable = packed array [Byte] of Char; // aber bei DER strengen Typenprüfung :-) .
type
TEncoderDecoder = class
{ Private-Deklarationen }
private
FResult: Integer;
FFile: TStream;
FText: TStrings;
function EncodeLine (const AFrom: PLineSourceTable; const AFromSize: Integer;
const ATable: TByteToCharTable; const ATo: PLineResultTable): Integer;
function DecodeLine (const AFrom: String; const AFromSize: Integer;
const ATable: TCharToByteTable; const ATo: PLineResultTable): Integer;
procedure SetFileData (const AFileData: TStream);
procedure SetTextData (const ATextData: TStrings);
function GetResultAsStr ({keine Parameter}): String;
{ Protected-Deklarationen }
protected
(*
* Binär -> Text, d.h. FFile -> FText .
*)
function GetEncodedSize ({keine Parameter}): Integer; virtual; abstract;
function DoEncode ({keine Parameter}): Integer; virtual; abstract;
(*
* Text -> Binär, d.h. FText -> FFile .
*)
function GetDecodedSize ({keine Parameter}): Integer; virtual; abstract;
function DoDecode ({keine Parameter}): Integer; virtual; abstract;
{ Public-Deklarationen }
public
constructor Create ({keine Parameter}); overload;
constructor Create (AFileData: TStream); overload;
constructor Create (ATextData: TStrings); overload;
destructor Destroy ({keine Parameter}); override;
// Encoder-Funktionen .
function LoadFileData (const AFileName: String): Integer;
function SaveTextData ({keine Parameter}): Integer; overload;
function SaveTextData (const AFileName: String): Integer; overload;
function Encode ({keine Parameter}): Integer;
function EncodeFromFile (const AFileName: String): Integer;
function EncodeFromStream (const AFileData: TStream): Integer;
// Decoder-Funktionen .
function LoadTextData ({keine Parameter}): Integer; overload;
function LoadTextData (const AFileName: String): Integer; overload;
function SaveFileData (const AFileName: String): Integer;
function Decode ({keine Parameter}): Integer;
function DecodeFromFile (const AFileName: String): Integer;
function DecodeFromStrings (const ATextData: TStrings): Integer;
// Properties .
property Result: Integer read FResult;
property ResultAsStr: String read GetResultAsStr;
property FileData: TStream read FFile write SetFileData;
property TextData: TStrings read FText write SetTextData;
property GuessEncodedSize: Integer read GetEncodedSize;
property GuessDecodedSize: Integer read GetDecodedSize;
class function ErrorCodeToStr (const AErrorCode: Integer): String;
class function GuessEncoding (const ATextData: TStrings): TEncoderDecoder_Coding; overload;
class function GuessEncoding (const AFileName: String): TEncoderDecoder_Coding; overload;
{ Published-Deklarationen }
published
end;
type
TEncoderDecoder2 = class (TEncoderDecoder)
{ Private-Deklarationen }
private
FFileMode: Integer;
FFileName: String;
{ Protected-Deklarationen }
protected
function GetEncodedSize ({keine Parameter}): Integer; override; abstract;
function DoEncode ({keine Parameter}): Integer; override; abstract;
function GetDecodedSize ({keine Parameter}): Integer; override; abstract;
function DoDecode ({keine Parameter}): Integer; override; abstract;
{ Public-Deklarationen }
public
constructor Create ({keine Parameter});
property FileMode: Integer read FFileMode write FFileMode;
property FileName: String read FFileName write FFileName;
{ Published-Deklarationen }
published
end;
(*
* .
* ============================================================================ .
* === TBase64EncoderDecoder === .
* ============================================================================ .
* .
*)
type
TBase64EncoderDecoder = class (TEncoderDecoder)
{ Private-Deklarationen }
private
{ Protected-Deklarationen }
protected
function GetEncodedSize ({keine Parameter}): Integer; override;
function DoEncode ({keine Parameter}): Integer; override;
function GetDecodedSize ({keine Parameter}): Integer; override;
function DoDecode ({keine Parameter}): Integer; override;
{ Public-Deklarationen }
public
{ Published-Deklarationen }
published
end;
(*
* .
* ============================================================================ .
* === TUUEncoderDecoder === .
* ============================================================================ .
* .
*)
type
TUUEncoderDecoder = class (TEncoderDecoder2)
{ Private-Deklarationen }
private
{ Protected-Deklarationen }
protected
function GetEncodedSize ({keine Parameter}): Integer; override;
function DoEncode ({keine Parameter}): Integer; override;
function GetDecodedSize ({keine Parameter}): Integer; override;
function DoDecode ({keine Parameter}): Integer; override;
{ Public-Deklarationen }
public
{ Published-Deklarationen }
class function SetUUSpaceCoding (const ASpaceCoding: Boolean): Boolean;
published
end;
(*
* .
* ============================================================================ .
* === TXXEncoderDecoder === .
* ============================================================================ .
* .
*)
type
TXXEncoderDecoder = class (TEncoderDecoder2)
{ Private-Deklarationen }
private
{ Protected-Deklarationen }
protected
function GetEncodedSize ({keine Parameter}): Integer; override;
function DoEncode ({keine Parameter}): Integer; override;
function GetDecodedSize ({keine Parameter}): Integer; override;
function DoDecode ({keine Parameter}): Integer; override;
{ Public-Deklarationen }
public
{ Published-Deklarationen }
published
end;
(*
* Fehlerbehandlung: Fehler-Nummern & -Erklärungen .
*)
const // Encoder ~ Konstante .
ERROR_ENC_ENCODELINE_FAILED = -(ENCODERDECODER_ERROR_BASE + $01);
ERROR_ENC_FILE_DOES_EXIST = -(ENCODERDECODER_ERROR_BASE + $02);
ERROR_ENC_FILE_NOT_FOUND = -(ENCODERDECODER_ERROR_BASE + $03);
ERROR_ENC_ILLEGAL_EOF = -(ENCODERDECODER_ERROR_BASE + $04);
ERROR_ENC_LOADFILE_FAILED = -(ENCODERDECODER_ERROR_BASE + $05);
ERROR_ENC_NO_INPUT = -(ENCODERDECODER_ERROR_BASE + $06);
ERROR_ENC_SAVECLPBRD_FAILED = -(ENCODERDECODER_ERROR_BASE + $07);
ERROR_ENC_SAVEFILE_FAILED = -(ENCODERDECODER_ERROR_BASE + $08);
ERROR_ENC_UNKNOWN_ERROR = -(ENCODERDECODER_ERROR_BASE + $09);
resourcestring // Encoder ~ Resourcestrings .
sERROR_ENC_ENCODELINE_FAILED = 'Fatal: Internal failure in .EncodeLine()';
sERROR_ENC_FILE_DOES_EXIST = 'Saving data from encoder output stream <FTex' +
't> failed: File does exist';
sERROR_ENC_FILE_NOT_FOUND = 'Loading data to encoder input stream <FFile>' +
' failed: File does not exist';
sERROR_ENC_ILLEGAL_EOF = 'Fatal: Illegal EOF in encoder input stream <' +
'FFile>';
sERROR_ENC_LOADFILE_FAILED = 'Loading data to encoder input stream <FFile>' +
' failed: Internal failure';
sERROR_ENC_NO_INPUT = 'The encoder input stream <FFile> is empty';
sERROR_ENC_SAVECLPBRD_FAILED = 'Saving data from encoder output stream <FTex' +
't> to the clipboard failed: Internal failure';
sERROR_ENC_SAVEFILE_FAILED = 'Saving data from encoder output stream <FTex' +
't> failed: Internal failure';
sERROR_ENC_UNKNOWN_ERROR = 'Unknown error while encoding stream';
const // Decoder ~ Konstante .
ERROR_DEC_DECODELINE_FAILED = -(ENCODERDECODER_ERROR_BASE + $11);
ERROR_DEC_FILE_DOES_EXIST = -(ENCODERDECODER_ERROR_BASE + $12);
ERROR_DEC_CLPBRD_EMPTY = -(ENCODERDECODER_ERROR_BASE + $13);
ERROR_DEC_FILE_NOT_FOUND = -(ENCODERDECODER_ERROR_BASE + $14);
ERROR_DEC_ILLEGAL_CODE = -(ENCODERDECODER_ERROR_BASE + $15);
ERROR_DEC_ILLEGAL_EOF = -(ENCODERDECODER_ERROR_BASE + $16);
ERROR_DEC_LOADCLPBRD_FAILED = -(ENCODERDECODER_ERROR_BASE + $17);
ERROR_DEC_LOADFILE_FAILED = -(ENCODERDECODER_ERROR_BASE + $18);
ERROR_DEC_NO_INPUT = -(ENCODERDECODER_ERROR_BASE + $19);
ERROR_DEC_SAVEFILE_FAILED = -(ENCODERDECODER_ERROR_BASE + $1A);
ERROR_DEC_UNKNOWN_ERROR = -(ENCODERDECODER_ERROR_BASE + $1B);
resourcestring // Decoder ~ Resourcestrings .
sERROR_DEC_DECODELINE_FAILED = 'Fatal: Internal failure in .DecodeLine()';
sERROR_DEC_FILE_DOES_EXIST = 'Saving data from decoder output stream <FFil' +
'e> failed: File does exist';
sERROR_DEC_CLPBRD_EMPTY = 'Loading data to decoder input stream <FText>' +
' from the clipboard failed: Clipboard is e' +
'mpty or clipboard content is not CF_TEXT';
sERROR_DEC_FILE_NOT_FOUND = 'Loading data to decoder input stream <FText>' +
' failed: File does not exist';
sERROR_DEC_ILLEGAL_CODE = 'Fatal: Illegal code value in decoder input s' +
'tream <FText>';
sERROR_DEC_ILLEGAL_EOF = 'Fatal: Illegal EOF in decoder input stream <' +
'FText>';
sERROR_DEC_LOADCLPBRD_FAILED = 'Loading data to decoder input stream <FText>' +
' from the clipboard failed: Internal failu' +
're';
sERROR_DEC_LOADFILE_FAILED = 'Loading data to decoder input stream <FText>' +
' failed: Internal failure';
sERROR_DEC_NO_INPUT = 'The decoder input stream <FText> is empty';
sERROR_DEC_SAVEFILE_FAILED = 'Saving data from decoder output stream <FFil' +
'e> failed: Internal failure';
sERROR_DEC_UNKNOWN_ERROR = 'Unknown error while decoding stream';
const
// TResolverMap = packed array [0..0] of TResolverRec; .
ResolverMap : packed array [0..20] of TResolverRec
= ((Code: ERROR_ENC_ENCODELINE_FAILED; Desc: @sERROR_ENC_ENCODELINE_FAILED),
(Code: ERROR_ENC_FILE_DOES_EXIST ; Desc: @sERROR_ENC_FILE_DOES_EXIST ),
(Code: ERROR_ENC_FILE_NOT_FOUND ; Desc: @sERROR_ENC_FILE_NOT_FOUND ),
(Code: ERROR_ENC_ILLEGAL_EOF ; Desc: @sERROR_ENC_ILLEGAL_EOF ),
(Code: ERROR_ENC_LOADFILE_FAILED ; Desc: @sERROR_ENC_LOADFILE_FAILED ),
(Code: ERROR_ENC_NO_INPUT ; Desc: @sERROR_ENC_NO_INPUT ),
(Code: ERROR_ENC_SAVECLPBRD_FAILED; Desc: @sERROR_ENC_SAVECLPBRD_FAILED),
(Code: ERROR_ENC_SAVEFILE_FAILED ; Desc: @sERROR_ENC_SAVEFILE_FAILED ),
(Code: ERROR_ENC_UNKNOWN_ERROR ; Desc: @sERROR_ENC_UNKNOWN_ERROR ),
(Code: ERROR_DEC_DECODELINE_FAILED; Desc: @sERROR_DEC_DECODELINE_FAILED),
(Code: ERROR_DEC_FILE_DOES_EXIST ; Desc: @sERROR_DEC_FILE_DOES_EXIST ),
(Code: ERROR_DEC_CLPBRD_EMPTY ; Desc: @sERROR_DEC_CLPBRD_EMPTY ),
(Code: ERROR_DEC_FILE_NOT_FOUND ; Desc: @sERROR_DEC_FILE_NOT_FOUND ),
(Code: ERROR_DEC_ILLEGAL_CODE ; Desc: @sERROR_DEC_ILLEGAL_CODE ),
(Code: ERROR_DEC_ILLEGAL_EOF ; Desc: @sERROR_DEC_ILLEGAL_EOF ),
(Code: ERROR_DEC_LOADCLPBRD_FAILED; Desc: @sERROR_DEC_LOADCLPBRD_FAILED),
(Code: ERROR_DEC_LOADFILE_FAILED ; Desc: @sERROR_DEC_LOADFILE_FAILED ),
(Code: ERROR_DEC_NO_INPUT ; Desc: @sERROR_DEC_NO_INPUT ),
(Code: ERROR_DEC_SAVEFILE_FAILED ; Desc: @sERROR_DEC_SAVEFILE_FAILED ),
(Code: ERROR_DEC_UNKNOWN_ERROR ; Desc: @sERROR_DEC_UNKNOWN_ERROR ),
(Code: ERROR_UNDEFINED ; Desc: @sERROR_UNDEFINED ));
// --------------- .
implementation
// --------------- .
uses
SysUtils,
Math,
Misc_Utilities,
String_Utilities;
(*
* .
* ============================================================================ .
* === TEncoderDecoder === .
* ============================================================================ .
* .
*)
// ---------------------------------------------------------------------------- .
// Kodiert eine Datenzeile: .
// <AFrom> .. Pointer auf Daten. .
// <AFromSize> .. Menge der Daten (in Byte), auf die <AFrom> zeigt. .
// <ATable> .. Code-Tabelle, die für alle Werte 0 .. 63 ein ein- .
// deutiges ("druckbares") Zeichen definiert. .
// <ATo> .. Pointer auf Zielbuffer, max. 256 Zeichen. .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.EncodeLine (const AFrom: PLineSourceTable;
const AFromSize: Integer;
const ATable: TByteToCharTable;
const ATo: PLineResultTable): Integer;
const
INIT_F3 = $FF;
var
i, j: Integer;
field: packed array [0..3] of Byte; // Slot #3 ist unbenutzt .
tupel: Cardinal absolute field; // <tupel> "überdeckt" sich mit <field> .
begin
Result := 0;
// Kodierung ist 3 -> 4, d.h. aus 3 Byte zu 8 Bit werden 4 Byte zu 6 Bit .
// .
// Encoder: Interpretation der "3-Byte-Chunks": .
// 1 Byte -> 'XX--'; 2 Byte -> 'XXX-'; 3 Byte -> 'XXXX' .
i := 1;
field[3] := INIT_F3;
while (i <= AFromSize) do begin
tupel := (tupel and $FF000000);
j := (1 + (AFromSize - i)); // verbleibender Rest .
if (j < 1) then begin
Result := ERROR_ENC_ILLEGAL_EOF;
Break;
end else if (j = 1) then begin // 1 Byte Rest? .
field[2] := AFrom^[i-1]; // dieses 1 Byte lesen .
// 1 Byte ergibt 2 Code-Byte .
ATo^[Result ] := ATable[((tupel shr 18) and CODE_BYTE_MASK)];
ATo^[Result+1] := ATable[((tupel shr 12) and CODE_BYTE_MASK)];
Inc(Result,2); // 2 Code-Byte mehr .
end else if (j = 2) then begin // 2 Byte Rest? .
field[2] := AFrom^[i-1]; // diese 2 Byte lesen .
field[1] := AFrom^[i ]; // 2 Byte ergeben 3 Code-Byte .
ATo^[Result ] := ATable[((tupel shr 18) and CODE_BYTE_MASK)];
ATo^[Result+1] := ATable[((tupel shr 12) and CODE_BYTE_MASK)];
ATo^[Result+2] := ATable[((tupel shr 6) and CODE_BYTE_MASK)];
Inc(Result,3); // 3 Code-Byte mehr .
end else { if (j >= 3) then } begin // 3 (oder mehr) Byte Rest ... .
field[2] := AFrom^[i-1]; // genau 3 Byte lesen .
field[1] := AFrom^[i ];
field[0] := AFrom^[i+1]; // 3 Byte ergeben 4 Code-Byte .
ATo^[Result ] := ATable[((tupel shr 18) and CODE_BYTE_MASK)];
ATo^[Result+1] := ATable[((tupel shr 12) and CODE_BYTE_MASK)];
ATo^[Result+2] := ATable[((tupel shr 6) and CODE_BYTE_MASK)];
ATo^[Result+3] := ATable[( tupel and CODE_BYTE_MASK)];
Inc(Result,4); // 4 Code-Byte mehr .
end;
Inc(i,3); // für (j <= 3) folgt sofortiger Abbruch; sonst weiter .
end;
if (field[3] <> INIT_F3) then
Result := ERROR_ENC_ENCODELINE_FAILED;
end;
// ---------------------------------------------------------------------------- .
// De-Kodiert eine Datenzeile: .
// <AFrom> .. String mit einer kodierten Datenzeile. .
// <AFromSize> .. Menge der Daten (in Byte), die in <AFrom> enthalten sind. .
// <ATable> .. Code-Tabelle, die für jedes mögliche ("druckbare") .
// Zeichen einen eindeutigen Binärwert definiert. .
// <ATo> .. Pointer auf Zielbuffer, max. 256 Zeichen. .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.DecodeLine (const AFrom: String;
const AFromSize: Integer;
const ATable: TCharToByteTable;
const ATo: PLineResultTable): Integer;
const
INIT_F3 = #$FF;
var
i, j: Integer;
tupel: Cardinal;
field: packed array [0..3] of Char absolute tupel; // <field> "überdeckt" sich mit <tupel>; .
// Slot #3 ist unbenutzt .
begin
Result := 0;
// De-Kodierung ist 4 -> 3, d.h. aus 4 Byte zu 6 Bit werden 3 Byte zu 8 Bit .
// .
// Decoder: Interpretation der "4-Character-Chunks": .
// 'XX==' -> 1 Byte; 'XXX=' -> 2 Byte; 'XXXX' -> 3 Byte .
i := 1;
while (i <= AFromSize) do begin
if (ATable[AFrom[i]] > CODE_BYTE_MASK) then begin
Result := ERROR_DEC_ILLEGAL_CODE;
Break;
end;
Inc(i);
end;
if (Result = 0) then begin
i := 1;
field[3] := INIT_F3;
while (i <= AFromSize) do begin
tupel := (tupel and $FF000000);
j := (1 + (AFromSize - i));
if (j < 2) then begin
Result := ERROR_DEC_ILLEGAL_EOF;
Break;
end else if (j = 2) then begin
tupel := tupel or
((Cardinal(ATable[AFrom[i ]]) shl 18) or
(Cardinal(ATable[AFrom[i+1]]) shl 12));
ATo^[Result ] := field[2];
Inc(Result);
end else if (j = 3) then begin
tupel := tupel or
((Cardinal(ATable[AFrom[i ]]) shl 18) or
(Cardinal(ATable[AFrom[i+1]]) shl 12) or
(Cardinal(ATable[AFrom[i+2]]) shl 6));
ATo^[Result ] := field[2];
ATo^[Result+1] := field[1];
Inc(Result,2);
end else { if (j >= 4) then } begin
tupel := tupel or
((Cardinal(ATable[AFrom[i ]]) shl 18) or
(Cardinal(ATable[AFrom[i+1]]) shl 12) or
(Cardinal(ATable[AFrom[i+2]]) shl 6) or
Cardinal(ATable[AFrom[i+3]]) );
ATo^[Result ] := field[2];
ATo^[Result+1] := field[1];
ATo^[Result+2] := field[0];
Inc(Result,3);
end;
Inc(i,4); // für (j <= 4) folgt sofortiger Abbruch; sonst weiter .
end;
if (field[3] <> INIT_F3) then
Result := ERROR_DEC_DECODELINE_FAILED;
end;
end;
// ---------------------------------------------------------------------------- .
// Binäre Daten werden "as-is" übernommen. .
// ---------------------------------------------------------------------------- .
procedure TEncoderDecoder.SetFileData (const AFileData: TStream);
begin
if (AFileData <> NIL) then
FFile.CopyFrom(AFileData,0);
end;
// ---------------------------------------------------------------------------- .
// Kodierte (Text-) Daten werden _NICHT_ "as-is" übernommen: .
// .) Zeilenumbruch wird auf Standard-CRLF-Umbruch angepasst .
// .) Leerzeilen werden über den gesamten Text entfernt .
// ---------------------------------------------------------------------------- .
procedure TEncoderDecoder.SetTextData (const ATextData: TStrings);
begin
if (ATextData <> NIL) then begin
FText.Text := Trim(AdjustLineBreaks(ATextData.Text));
while (Pos((CRLF+CRLF),FText.Text) > 0) do
FText.Text := StringReplace(FText.Text,(CRLF+CRLF),CRLF,[rfReplaceAll]);
end;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.GetResultAsStr (): String;
begin
Result := ErrorCodeToStr(FResult);
end;
// ---------------------------------------------------------------------------- .
constructor TEncoderDecoder.Create ();
begin
inherited;
FFile := TMemoryStream.Create();
FText := TStringList.Create();
end;
// ---------------------------------------------------------------------------- .
constructor TEncoderDecoder.Create (AFileData: TStream);
begin
Create();
FResult := EncodeFromStream(AFileData);
end;
// ---------------------------------------------------------------------------- .
constructor TEncoderDecoder.Create (ATextData: TStrings);
begin
Create();
FResult := DecodeFromStrings(ATextData);
end;
// ---------------------------------------------------------------------------- .
destructor TEncoderDecoder.Destroy ();
begin
FreeAndNil(FText);
FreeAndNil(FFile);
inherited;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.LoadFileData (const AFileName: String): Integer;
begin
if (FileExists(AFileName)) then begin
try
(FFile as TMemoryStream).LoadFromFile(AFileName);
FResult := ERROR_SUCCESS;
except
on e: Exception do begin
FResult := ERROR_ENC_LOADFILE_FAILED;
sysShowErrMsg(e.Message);
end;
end;
end else
FResult := ERROR_ENC_FILE_NOT_FOUND;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
// <FText>.Text -> Windows Clipboard .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.SaveTextData (): Integer;
begin
if (clpbrdCopyTextToClipboard(FText.Text)) then
FResult := ERROR_SUCCESS
else
FResult := ERROR_ENC_SAVECLPBRD_FAILED;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
// <FText.Text> -> File <AFileName> .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.SaveTextData (const AFileName: String): Integer;
begin
if not(FileExists(AFileName)) then begin
try
FText.SaveToFile(AFileName);
FResult := ERROR_SUCCESS;
except
on e: Exception do begin
FResult := ERROR_ENC_SAVEFILE_FAILED;
sysShowErrMsg(e.Message);
end;
end;
end else
FResult := ERROR_ENC_FILE_DOES_EXIST;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.Encode (): Integer;
begin
FResult := DoEncode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.EncodeFromFile (const AFileName: String): Integer;
begin
FResult := LoadFileData(AFileName);
if (FResult = ERROR_SUCCESS) then
FResult := DoEncode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.EncodeFromStream (const AFileData: TStream): Integer;
begin
SetFileData(AFileData);
FResult := DoEncode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
// Windows Clipboard -> <FText>.Text -- via .SetTextData() .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.LoadTextData (): Integer;
var
text: String;
temp: TStringList;
begin
text := clpbrdPasteTextFromClipboard();
if (text <> '') then begin
try
temp := TStringList.Create();
try
temp.SetText(PChar(text));
SetTextData(temp);
FResult := ERROR_SUCCESS;
finally
FreeAndNil(temp);
end;
except
on e: Exception do begin
FResult := ERROR_DEC_LOADCLPBRD_FAILED;
sysShowErrMsg(e.Message);
end;
end;
end else
FResult := ERROR_DEC_CLPBRD_EMPTY;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
// File <AFileName> -> <FText>.Text -- via .SetTextData() .
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.LoadTextData (const AFileName: String): Integer;
var
temp: TStringList;
begin
if (FileExists(AFileName)) then begin
try
temp := TStringList.Create();
try
temp.LoadFromFile(AFileName);
SetTextData(temp);
FResult := ERROR_SUCCESS;
finally
FreeAndNil(temp);
end;
except
on e: Exception do begin
FResult := ERROR_DEC_LOADFILE_FAILED;
sysShowErrMsg(e.Message);
end;
end;
end else
FResult := ERROR_DEC_FILE_NOT_FOUND;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.SaveFileData (const AFileName: String): Integer;
begin
if not(FileExists(AFileName)) then begin
try
(FFile as TMemoryStream).SaveToFile(AFileName);
FResult := ERROR_SUCCESS;
except
on e: Exception do begin
FResult := ERROR_DEC_SAVEFILE_FAILED;
sysShowErrMsg(e.Message);
end;
end;
end else
FResult := ERROR_DEC_FILE_DOES_EXIST;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.Decode (): Integer;
begin
FResult := DoDecode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.DecodeFromFile (const AFileName: String): Integer;
begin
FResult := LoadTextData(AFileName);
if (FResult = 0) then
FResult := DoDecode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TEncoderDecoder.DecodeFromStrings (const ATextData: TStrings): Integer;
begin
SetTextData(ATextData);
FResult := DoDecode();
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
constructor TEncoderDecoder2.Create ();
begin
inherited;
FFileMode := 0;
FFileName := '';
end;
(*
* .
* ============================================================================ .
* === TBase64EncoderDecoder === .
* ============================================================================ .
* .
*)
const
Base64_ChunkSize = 57;
Base64_EncodeTable : TByteToCharTable
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
Base64_DecodeTable : TCharToByteTable;
// ---------------------------------------------------------------------------- .
function TBase64EncoderDecoder.GetEncodedSize (): Integer;
var
ref_size : Integer;
begin
if (FFile.Size > 0) then begin
// Prolog .
;
// Konvertierte Daten .
if ((FFile.Size mod 3) = 0) then
ref_size := FFile.Size
else
ref_size := (3*((FFile.Size div 3)+1));
FResult := Round((4/3)*ref_size)+ // aus 3 Byte werden 4 Code-Byte .
(Length(CRLF)*(ref_size div Base64_ChunkSize)); // Anzahl der Zeilenumbrüche .
if ((ref_size mod Base64_ChunkSize) <> 0) then
Inc(FResult,Length(CRLF));
// Epilog .
;
end else
// Fehler ~ keine Daten verfügbar .
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TBase64EncoderDecoder.DoEncode (): Integer;
var
pBuf: packed array [1..Base64_ChunkSize] of Byte;
pBuf_size: Integer;
pResult: TLineResultTable;
pResult_size: Integer;
begin
if (FFile.Size > 0) then begin
FText.BeginUpdate();
try
try
FResult := 0;
FFile.Position := 0;
FText.Clear();
FillChar(pBuf,Base64_ChunkSize,0);
repeat
pBuf_size := FFile.Read(pBuf,Base64_ChunkSize);
if (pBuf_size > 0) then begin
FillChar(pResult,SizeOf(pResult),#0);
pResult_size := EncodeLine(@pBuf,pBuf_size,
Base64_EncodeTable,@pResult);
if (pResult_size > 0) then begin
if (pBuf_size < Base64_ChunkSize) then begin
case (pBuf_size mod 3) of
0: // Codefolge 'XXXX' .
FText.Add(StrPas(pResult));
1: begin
FText.Add(StrPas(pResult)+'=='); // Codefolge 'XX--' .
Inc(FResult,2);
end;
2: begin
FText.Add(StrPas(pResult)+'='); // Codefolge 'XXX-' .
Inc(FResult,1);
end;
end;
end else
FText.Add(StrPas(pResult));
Inc(FResult,(pResult_size+Length(CRLF))); // Code-Folge + Zeilenumbruch .
end else begin
if (pResult_size = 0) then // Das darf nicht passieren :-( .
FResult := ERROR_ENC_UNKNOWN_ERROR // Unbekannter Fehler .
else
FResult := pResult_size; // Definierter Fehler .
Break;
end;
end else
// FFile-Stream aufgebraucht, fertig ... .
Break;
until (False);
except
on e: Exception do begin
FResult := ERROR_ENC_UNKNOWN_ERROR; // Unbekannter Fehler .
sysShowErrMsg(e.Message);
end;
end;
finally
FText.EndUpdate();
end;
end else
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TBase64EncoderDecoder.GetDecodedSize (): Integer;
var
i, j: Integer;
begin
if (FText.Count > 0) then begin
FResult := 0;
for i := 0 to (FText.Count-1) do
FResult := (FResult+Round((3/4)*Length(FText[i])));
j := Pos('=',FText[(FText.Count-1)]);
if (j > 0) then
if (j = Length(FText[(FText.Count-1)])) then
Dec(FResult) // 'XXX=' .. 1 Byte weniger .
else
Dec(FResult,2); // 'XX==' .. 2 Byte weniger .
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TBase64EncoderDecoder.DoDecode (): Integer;
var
i, j: Integer;
s: String;
pResult: TLineResultTable;
pResult_size: Integer;
begin
if (FText.Count > 0) then begin
FResult := 0;
(FFile as TMemoryStream).Clear();
for i := 0 to (FText.Count-1) do begin
s := FText[i];
j := Pos('=',s);
if (j = 0) then
pResult_size := DecodeLine(s,Length(s),
Base64_DecodeTable,@pResult)
else
pResult_size := DecodeLine(Copy(s,1,(j-1)),(j-1),
Base64_DecodeTable,@pResult);
if (pResult_size > 0) then begin
FFile.Write(pResult,pResult_size);
Inc(FResult,pResult_size);
end else begin
if (pResult_size = 0) then
FResult := ERROR_DEC_UNKNOWN_ERROR
else
FResult := pResult_size;
Break;
end;
end;
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
(*
* .
* ============================================================================ .
* === TUUEncoderDecoder === .
* ============================================================================ .
* .
*)
// Standard-UU-Kodierung .
const
UU_ChunkSize = 45;
UU_EncodeTable : TByteToCharTable
= '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
var
UU_DecodeTable : TCharToByteTable;
// "Space"-UU-Kodierung .
const
UUSpace_ChunkSize = 45;
UUSpace_EncodeTable : TByteToCharTable
= ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
var
UUSpace_DecodeTable : TCharToByteTable;
// UU-Koding kennt 2 unterschiedliche Tabellen: UU-Space und UU-` .
var
UU_UseSpaceCoding : Boolean;
const
UU_EncodeTables : array [Boolean] of PByteToCharTable
= (@UU_EncodeTable,@UUSpace_EncodeTable);
UU_DecodeTables : array [Boolean] of PCharToByteTable
= (@UU_DecodeTable,@UUSpace_DecodeTable);
// ---------------------------------------------------------------------------- .
function TUUEncoderDecoder.GetEncodedSize (): Integer;
var
s: String;
begin
if (FFile.Size > 0) then begin
// Prolog .
s := 'begin';
if (FFileMode = 0) then
s := Format('%s %d',[s,644])
else
s := Format('%s %d',[s,FFileMode]);
if (FFileName = '') then
s := Format('%s %p',[s,(FFile as TMemoryStream).Memory])
else
s := Format('%s %s',[s,FFileName]);
FResult := (Length(s)+Length(CRLF));
// Konvertierte Daten .
// aus 3 Byte werden 4 Code-Byte .
Inc(FResult,(Round((4/3)*UU_ChunkSize*(FFile.Size div UU_ChunkSize ))+
// Anzahl der (Längen-Info + Zeilenumbruch) .
((1+Length(CRLF))*(FFile.Size div UU_ChunkSize))));
if ((FFile.Size mod 3) <> 0) then
Inc(FResult,(3-(FFile.Size mod 3)));
if ((FFile.Size mod UU_ChunkSize) <> 0) then
// zzgl. (Längen-Info + Zeilenumbruch) + Rest der Daten .
Inc(FResult,(1+Length(CRLF)+Ceil((4/3)*(FFile.Size mod UU_ChunkSize))));
// Epilog .
s := UU_EncodeTables[UU_UseSpaceCoding]^[0];
Inc(FResult,(Length(s)+Length(CRLF)));
s := 'end';
Inc(FResult,(Length(s)+Length(CRLF)));
end else
// Fehler ~ keine Daten verfügbar .
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TUUEncoderDecoder.DoEncode (): Integer;
var
pBuf: packed array [1..UU_ChunkSize] of Byte;
pBuf_size: Integer;
pResult: TLineResultTable;
pResult_size: Integer;
s: String;
begin
if (FFile.Size > 0) then begin
if (FFileMode = 0) then
FFileMode := 644;
if (FFileName = '') then
FFileName := Format('%p',[(FFile as TMemoryStream).Memory]);
FText.BeginUpdate();
try
try
FResult := 0;
FFile.Position := 0;
FText.Clear();
s := Format('begin %d %s',[FFileMode,FFileName]);
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
repeat
FillChar(pBuf,UU_ChunkSize,0);
pBuf_size := FFile.Read(pBuf,UU_ChunkSize);
if (pBuf_size > 0) then begin
FillChar(pResult,SizeOf(pResult),#0);
if (pBuf_size < 3) then
pResult_size := EncodeLine(@pBuf,3,
UU_EncodeTables[UU_UseSpaceCoding]^,@pResult)
else
pResult_size := EncodeLine(@pBuf,pBuf_size,
UU_EncodeTables[UU_UseSpaceCoding]^,@pResult);
if (pResult_size > 0) then begin
s := (UU_EncodeTables[UU_UseSpaceCoding]^[pBuf_size]+StrPas(pResult));
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
end else begin
if (pResult_size = 0) then // Das darf nicht passieren :-( .
FResult := ERROR_ENC_UNKNOWN_ERROR // Unbekannter Fehler .
else
FResult := pResult_size; // Definierter Fehler .
Break;
end;
end else
// FFile-Stream aufgebraucht, fertig ... .
Break;
until (False);
s := UU_EncodeTables[UU_UseSpaceCoding]^[0];
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
s := 'end';
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
except
on e: Exception do begin
FResult := ERROR_ENC_UNKNOWN_ERROR; // Unbekannter Fehler .
sysShowErrMsg(e.Message);
end;
end;
finally
FText.EndUpdate();
end;
end else
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TUUEncoderDecoder.GetDecodedSize (): Integer;
var
i: Integer;
s: String;
begin
if (FText.Count > 0) then begin
FResult := 0;
for i := 1 to ((FText.Count-1)-1) do begin
s := FText[i];
if (UU_DecodeTables[UU_UseSpaceCoding]^[s[1]] = 0) then
Continue;
Inc(FResult,UU_DecodeTables[UU_UseSpaceCoding]^[s[1]]);
end;
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TUUEncoderDecoder.DoDecode (): Integer;
var
i: Integer;
s: String;
pResult: TLineResultTable;
pResult_size: Integer;
begin
if (FText.Count > 0) then begin
FResult := 0;
(FFile as TMemoryStream).Clear();
s := FText[0];
if (AnsiLowerCase(GetNthStringDelimitedBy(1,s,[' '])) <> 'begin') then
{falscher Prolog};
FFileMode := StrToIntDef(GetNthStringDelimitedBy(2,FText[0],[' ']),644);
FFileName := GetNthStringDelimitedBy(3,FText[0],[' ']);
for i := 1 to ((FText.Count-1)-1) do begin
s := FText[i];
if (UU_DecodeTables[UU_UseSpaceCoding]^[s[1]] = 0) then
Continue;
pResult_size := DecodeLine(Copy(s,2,(Length(s)-1)),(Length(s)-1),
UU_DecodeTables[UU_UseSpaceCoding]^,@pResult);
// <pResult_size> ist bei dieser Kodierung eigentlich nicht mehr als ein Flag; .
// (= Ergebnis der Funktion DecodeLine()); die Größe der (nach der Dekodierung .
// gültigen) Daten ergibt sich aus s[1]. .
if (pResult_size > 0) then begin
if (pResult_size <> UU_DecodeTables[UU_UseSpaceCoding]^[s[1]]) then
{?falsche Größenangabe?};
FFile.Write(pResult,UU_DecodeTables[UU_UseSpaceCoding]^[s[1]]);
Inc(FResult,UU_DecodeTables[UU_UseSpaceCoding]^[s[1]]);
end else begin
if (pResult_size = 0) then
FResult := ERROR_DEC_UNKNOWN_ERROR
else
FResult := pResult_size;
Break;
end;
end;
if (AnsiLowerCase(FText[(FText.Count-1)]) <> 'end') then
{falscher Epilog};
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
(*
* .
* ============================================================================ .
* === TXXEncoderDecoder === .
* ============================================================================ .
* .
*)
const
XX_ChunkSize = 45;
XX_EncodeTable : TByteToCharTable
= '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var
XX_DecodeTable : TCharToByteTable;
// ---------------------------------------------------------------------------- .
function TXXEncoderDecoder.GetEncodedSize (): Integer;
var
s: String;
begin
if (FFile.Size > 0) then begin
// Prolog .
s := 'begin';
if (FFileMode = 0) then
s := Format('%s %d',[s,644])
else
s := Format('%s %d',[s,FFileMode]);
if (FFileName = '') then
s := Format('%s %p',[s,(FFile as TMemoryStream).Memory])
else
s := Format('%s %s',[s,FFileName]);
FResult := (Length(s)+Length(CRLF));
// Konvertierte Daten .
// aus 3 Byte werden 4 Code-Byte .
Inc(FResult,(Round((4/3)*XX_ChunkSize*(FFile.Size div XX_ChunkSize ))+
// Anzahl der (Längen-Info + Zeilenumbruch) .
((1+Length(CRLF))*(FFile.Size div XX_ChunkSize))));
if ((FFile.Size mod 3) <> 0) then
Inc(FResult,(3-(FFile.Size mod 3)));
if ((FFile.Size mod XX_ChunkSize) <> 0) then
// zzgl. (Längen-Info + Zeilenumbruch) + Rest der Daten .
Inc(FResult,(1+Length(CRLF)+Ceil((4/3)*(FFile.Size mod XX_ChunkSize))));
// Epilog .
s := XX_EncodeTable[0];
Inc(FResult,(Length(s)+Length(CRLF)));
s := 'end';
Inc(FResult,(Length(s)+Length(CRLF)));
end else
// Fehler ~ keine Daten verfügbar .
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TXXEncoderDecoder.DoEncode (): Integer;
var
pBuf: packed array [1..XX_ChunkSize] of Byte;
pBuf_size: Integer;
pResult: TLineResultTable;
pResult_size: Integer;
s: String;
begin
if (FFile.Size > 0) then begin
if (FFileMode = 0) then
FFileMode := 644;
if (FFileName = '') then
FFileName := Format('%p',[(FFile as TMemoryStream).Memory]);
FText.BeginUpdate();
try
try
FResult := 0;
FFile.Position := 0;
FText.Clear();
s := Format('begin %d %s',[FFileMode,FFileName]);
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
repeat
FillChar(pBuf,XX_ChunkSize,0);
pBuf_size := FFile.Read(pBuf,XX_ChunkSize);
if (pBuf_size > 0) then begin
FillChar(pResult,SizeOf(pResult),#0);
if (pBuf_size < 3) then
pResult_size := EncodeLine(@pBuf,3,
XX_EncodeTable,@pResult)
else
pResult_size := EncodeLine(@pBuf,pBuf_size,
XX_EncodeTable,@pResult);
if (pResult_size > 0) then begin
s := (XX_EncodeTable[pBuf_size]+StrPas(pResult));
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
end else begin
if (pResult_size = 0) then // Das darf nicht passieren :-( .
FResult := ERROR_ENC_UNKNOWN_ERROR // Unbekannter Fehler .
else
FResult := pResult_size; // Definierter Fehler .
Break;
end;
end else
// FFile-Stream aufgebraucht, fertig ... .
Break;
until (False);
s := XX_EncodeTable[0];
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
s := 'end';
FText.Add(s);
Inc(FResult,(Length(s)+Length(CRLF)));
except
on e: Exception do begin
FResult := ERROR_ENC_UNKNOWN_ERROR; // Unbekannter Fehler .
sysShowErrMsg(e.Message);
end;
end;
finally
FText.EndUpdate();
end;
end else
FResult := ERROR_ENC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TXXEncoderDecoder.GetDecodedSize (): Integer;
var
i: Integer;
s: String;
begin
if (FText.Count > 0) then begin
FResult := 0;
for i := 1 to ((FText.Count-1)-1) do begin
s := FText[i];
if (XX_DecodeTable[s[1]] = 0) then
Continue;
Inc(FResult,XX_DecodeTable[s[1]]);
end;
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
// ---------------------------------------------------------------------------- .
function TXXEncoderDecoder.DoDecode (): Integer;
var
i: Integer;
s: String;
pResult: TLineResultTable;
pResult_size: Integer;
begin
if (FText.Count > 0) then begin
FResult := 0;
(FFile as TMemoryStream).Clear();
s := FText[0];
if (AnsiLowerCase(GetNthStringDelimitedBy(1,s,[' '])) <> 'begin') then
{falscher Prolog};
FFileMode := StrToIntDef(GetNthStringDelimitedBy(2,FText[0],[' ']),644);
FFileName := GetNthStringDelimitedBy(3,FText[0],[' ']);
for i := 1 to ((FText.Count-1)-1) do begin
s := FText[i];
if (XX_DecodeTable[s[1]] = 0) then
Continue;
pResult_size := DecodeLine(Copy(s,2,(Length(s)-1)),(Length(s)-1),
XX_DecodeTable,@pResult);
// <pResult_size> ist bei dieser Kodierung eigentlich nicht mehr als ein Flag; .
// (= Ergebnis der Funktion DecodeLine()); die Größe der (nach der Dekodierung .
// gültigen) Daten ergibt sich aus s[1]. .
if (pResult_size > 0) then begin
if (pResult_size <> XX_DecodeTable[s[1]]) then
{?falsche Größenangabe?};
FFile.Write(pResult,XX_DecodeTable[s[1]]);
Inc(FResult,XX_DecodeTable[s[1]]);
end else begin
if (pResult_size = 0) then
FResult := ERROR_DEC_UNKNOWN_ERROR
else
FResult := pResult_size;
Break;
end;
end;
if (AnsiLowerCase(FText[(FText.Count-1)]) <> 'end') then
{falscher Epilog};
end else
FResult := ERROR_DEC_NO_INPUT;
Result := FResult;
end;
(*
* .
* ============================================================================ .
* === TBinHexEncoderDecoder === .
* ============================================================================ .
* .
*)
(*
// "BinHex 4.0" Hqx7 "RFC 1741"
const
BinHex_ChunkSize = 0;
BinHex_EncodeTable: TByteToCharTable
= '!"#$%&''()*+,-012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr';
*)
(*
* .
* ============================================================================ .
* === Klassenfunktionen von TEncoderDecoder === .
* ============================================================================ .
* .
*)
// ---------------------------------------------------------------------------- .
class function TEncoderDecoder.ErrorCodeToStr (const AErrorCode: Integer): String;
begin
Result := ResolveErrorCode('EncoderDecoder.pas',ResolverMap,AErrorCode,
@sENCODERDECODER_ERROR_BASE);
end;
// ---------------------------------------------------------------------------- .
var
ABS_MIN_CHAR : Char;
ABS_MAX_CHAR : Char;
{ .
base64: .
<base64-coding does not support a header ..> .
R0lGODdhIANYAvcAAP///+Xl5fr638zMzJkAmf8AAMgAAAAA/wAAyAAAAAAAAAAAAAAAAAAAAAAA .
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA .
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA .
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAgA1gC .
AAj/AAMIHEhQYIKDBwgeWJiw4MCDDiNKnEiR4MEEFS8C2HhR48aPIEOCREASgciTB0+qXAkyJUuQ .
BDy+bJlA5MWKOHNO7BiA58ObOncCDZoRY8SFRH0StQhxqcOhBZU6ndqz6U+jBQfIpDmz60uXHwdU .
xUp1wACOW23W9Mq2Ldq1KKFSHTv36c2OVnXelVs0b129CAs2FEr2b1C/Ejt+xOv2Y0mTX+E2Vgk2 .
cuWukhcjNpwUb2GDmzuHnroZKVLAn53yVb15NWeKfvFG1HoZ7WS3l2mPxnn2bWaav28LB5AWeGqq .
rlkblZpTaXK7dF/jlHoa9nHpUZ8zlZwyuNeSM2sP/7dt2fvK2tqxEx6dN/1V6a4HD+772j39q9fV .
R82+PHFx4uNhlpt9DvVG3H9vBaigeADolh9pu6HG1FLMpTcUgZxdxNB81um3k3KaKdbYY5EpGBKD .
IZpH2W8RevjXXqg9SOF11XFoV4szyrieZzq66J9BEukWl4ks5RadTmb5VqSKRFp23nMYgobjfRBe .
lxxizPlYFUOdadncajIxNhmJTzZJ3oooonnilF4eJluM8D0oH5cRZWlYlFJKiaeLWLUo5JpMLpiZ .
g0im+GSgZsZlnp349bjdnXgymmedx+2JHJs/tXmjZ/6FeOBtZKKU6KeHIsqVcZrGWZWbmBYV1Jw3 .
8v/Z6qqNptrchBX9Cdyoa4akW04Giqgor7gtCiVEkc4aq2gPZmmnpZc6mmmqPNJKKVyegUrSeaOq .
GBOCK6olra0d9iRhfZZyCO2X0mKprI9NuSesZsR6iipFwYILbr1qqURouXuuOym7OkLFKaXkSioU .
.
uu: .
begin 644 TestFiles\Phorusgasse_6.gif .
M1TE&.#=A(`-8`O<``/___^7EY?KZW\S,S)D`F?\``,@`````_P``R``````` .
M```````````````````````````````````````````````````````````` .
M```````````````````````````````````````````````````````````` .
M`````````````````````"'Y!```````+``````@`U@"``C_``,('$A08(*# .
M!P@>6)BPX,"##B-*G$B1X,$$%2\"V'A1X\:/($."1$`2@<B3!T^J7`DR)4N0 .
M!#R^;)E`Y,6*.'-.[!B`Y\.;.G<"#9H18\2%1'T2M0AQJ<.A!94ZG=JSZ4^C .
M!0?(I#FSZTN7'P=4Q4IUP`".6VW6],JV+=JU**%2'3OWZ<V.5G7>E5LT;UV] .
M"`LV%$KV;U"_$CM^Q.OV8TF37^$V5@DV<N6NDA<C-IP4;V&#FSN'GKH9*5+` .
MGYWR5;UY-6>*?O%&U'H9[62WEVF/QGGV;6::OV\+!Y`6>&JJKED;E9I3:7*[ .
M=%_CE'H:]G'I49\SE9PRN->2,VL/_[=MV?O*VMJQ$QZ=-_U5Z:X'#^[[VCW] .
MJ]?51\V^/'%QXN-AEIM]#O5&W']O!:B@>`#HEA]INZ'&U%+,I3<4@9Q=Q-!\ .
MUNFWDW*:*=;88Y$I&!*#(9I'V6\1>OC77J@]2.%UU7%H5XLSRKB>9SJZZ)]! .
M$ND6EXDLY1:=3F;Y5J2*1%IVWG,8@H;C?1!>EQQBS/E8%4.=:=G<:C(Q-AF) .
M3S9)WHHHHGGBE%X>)EN,\#TH'Y<196E8E%)*B:>+6+4HY)I,+IB9@TBF^&2@ .
M9L9EGIWX];C=G7@RFF>=Q^V)')L_M7FC9_Z%>.!M9**4Z*>'(LJ5<9K&696; .
.
uu-space: .
begin 644 TestFiles\Phorusgasse_6.gif .
M1TE&.#=A( -8 O< /___^7EY?KZW\S,S)D F?\ ,@ _P R .
M .
M .
M "'Y! + @ U@" C_ ,('$A08(*# .
M!P@>6)BPX,"##B-*G$B1X,$$%2\"V'A1X\:/($."1$ 2@<B3!T^J7 DR)4N0 .
M!#R^;)E Y,6*.'-.[!B Y\.;.G<"#9H18\2%1'T2M0AQJ<.A!94ZG=JSZ4^C .
M!0?(I#FSZTN7'P=4Q4IUP ".6VW6],JV+=JU**%2'3OWZ<V.5G7>E5LT;UV] .
M" LV%$KV;U"_$CM^Q.OV8TF37^$V5@DV<N6NDA<C-IP4;V&#FSN'GKH9*5+ .
MGYWR5;UY-6>*?O%&U'H9[62WEVF/QGGV;6::OV\+!Y 6>&JJKED;E9I3:7*[ .
M=%_CE'H:]G'I49\SE9PRN->2,VL/_[=MV?O*VMJQ$QZ=-_U5Z:X'#^[[VCW] .
MJ]?51\V^/'%QXN-AEIM]#O5&W']O!:B@> #HEA]INZ'&U%+,I3<4@9Q=Q-!\ .
MUNFWDW*:*=;88Y$I&!*#(9I'V6\1>OC77J@]2.%UU7%H5XLSRKB>9SJZZ)]! .
M$ND6EXDLY1:=3F;Y5J2*1%IVWG,8@H;C?1!>EQQBS/E8%4.=:=G<:C(Q-AF) .
M3S9)WHHHHGGBE%X>)EN,\#TH'Y<196E8E%)*B:>+6+4HY)I,+IB9@TBF^&2@ .
M9L9EGIWX];C=G7@RFF>=Q^V)')L_M7FC9_Z%>.!M9**4Z*>'(LJ5<9K&696; .
.
xx: .
begin 644 TestFiles\Phorusgasse_6.gif .
hFoZ4C1RV6+BM+jQ++DzzzyLZtTfurwnAn7Y+aTw++AU+++++zk++m+++++++ .
h++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .
h++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .
h+++++++++++++++++++++05t-+++++++9++++++U+pU0++Xz++A652VEM681 .
h-kUSK7WksA011WB8b2WFsA223Gw0q5VFswOD62C0F2+GUQWH-oyeL+Ym7IiE .
h-1myP7Z+tAK8C5BCv-W+twCPCbQ01NcFMwG3F5oGhEVleQCV-NIubRenuIyX .
h-ET6d1anuoiL5kRIlIdpk+0CKqrKxAeq9Rep883G5HjruQqCJbLSZJgoPpqx .
h0+gq32fqPp0z2XhylCjqMoaHLy2qJUYqQiKiYVQXBdkIPq41ani5bfcN8J9+ .
hbtrmJPptBKS8Tj34p5cNvKGrZqaDlbbqPKOOjqw9-t+KS4eefZYPZNdHOL8v .
hR3zXZ5cOxb5dINwnZNkmiBSGAqgDzvRhqTj8qhel2luRBzpJuOs51yvvqXrx .
hexTJFwqyD53lsiBVZdhx1jJ4r5xj-OWUS+1cZVxdiu54p39AdHQIUNlRlB-w .
hpiarYr8O8RPMMt2d4-816Nd5qKwFSjXLLeUxGC3ppL3cJsgnmfWSNneuu7x- .
h2iYKZsYgtFORHaPtJeG8F3dqrbAMUcPXTF-SZllWnDZM3ICRORbQOX6lBVa7 .
hHnN7rccccbbWZ3sS7ZiAw1oc5tQFNKZMZ378WOS9K9Ict7dA9dWNUoWay4GU .
hNgNZbdrsxPXRbLUmaaSRlyq757gzhLaXNzu3SC-hN88Iu8S56geJQNf4KNKP .
}
// ---------------------------------------------------------------------------- .
class function TEncoderDecoder.GuessEncoding (const ATextData: TStrings): TEncoderDecoder_Coding;
var
i: Integer;
has_header, has_footer: Boolean; // base64 vs. uu | uuspace | xx .
contains_lowercase, // base64 | xx vs. uu | uuspace .
contains_slash, contains_minus, // base64 vs. xx .
contains_hyphen, contains_space: Boolean; // uu vs. uuspace .
begin
// base64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; .
// xx = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; .
// uu = '`!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'; .
// uuspace = ' !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'; .
Result := edc_NONE;
// Header: 'begin' -- uu | uuspace | xx .
has_header := False;
for i := 0 to (ATextData.Count-1) do
if (AnsiLowerCase(GetNthStringDelimitedBy(1,ATextData[i],[' '])) = 'begin') then begin
has_header := True;
ATextData.Delete(i);
Break;
end;
// Footer: 'end' -- uu | uusapce | xx .
has_footer := False;
for i := 0 to (ATextData.Count-1) do
if (AnsiLowerCase(GetNthStringDelimitedBy(1,ATextData[i],[' '])) = 'end') then begin
has_footer := True;
ATextData.Delete(i);
Break;
end;
// Auch Kleinbuchstaben im Stream: base64 | xx .
contains_lowercase := False;
for i := 1 to Length(ATextData.Text) do
if (ATextData.Text[i] in ['a'..'z']) then begin
contains_lowercase := True;
Break;
end;
// (base64 | xx): wenn '/' vorhanden, dann base64 .
contains_slash := False;
for i := 1 to Length(ATextData.Text) do
if (ATextData.Text[i] = '/') then begin
contains_slash := True;
Break;
end;
// (base64 | xx): wenn '-' vorhanden, dann xx .
contains_minus := False;
for i := 1 to Length(ATextData.Text) do
if (ATextData.Text[i] = '-') then begin
contains_minus := True;
Break;
end;
// (uu | uuspace): wenn '`' vorhanden, dann uu .
contains_hyphen := False;
for i := 1 to Length(ATextData.Text) do
if (ATextData.Text[i] = '`') then begin
contains_hyphen := True;
Break;
end;
// (uu | uuspace): wenn ' ' vorhanden, dann uuspace .
contains_space := False;
for i := 1 to Length(ATextData.Text) do
if (ATextData.Text[i] = ' ') then begin
contains_space := True;
Break;
end;
// Auswertung der festgestellten Flags .
if (contains_lowercase) then begin
// Kann nur mehr base64 | xx sein .. .
if ((contains_slash) and (contains_minus)) then
Result := edc_NONE
else if (contains_slash) then
Result := edc_BASE64
else if (contains_minus) then
Result := edc_XX
else if not((has_header) or (has_footer)) then
Result := edc_BASE64
else
Result := edc_XX;
end else begin
// Kann nur mehr uu | uuspace sein .. .
if ((contains_hyphen) and (contains_space)) then
Result := edc_NONE
else if (contains_hyphen) then
Result := edc_UU
else if (contains_space) then
Result := edc_UUSPACE;
end;
end;
// ---------------------------------------------------------------------------- .
class function TEncoderDecoder.GuessEncoding (const AFileName: String): TEncoderDecoder_Coding;
const
MAX_GUESSBUFFER_SIZE = (4*1024);
var
temp: TStringList;
f: TextFile;
s: String;
begin
if (FileExists(AFileName)) then begin
try
temp := TStringList.Create();
try
AssignFile(f,AFileName);
Reset(f);
// So lange Strings (hoffentlich Strings!) lesen, bis entweder EOF oder der .
// Buffer mit (mehr oder weniger) ca. 4 kB Daten gefüllt ist. .
// Base64: 4096/((57*(4/3))+2) == ca. 52 Code-Zeilen .
// UU/XX : 4096/((45*(4/3))+2) == ca. 66 Code-Zeilen .
// BinHex: ??? .
while (not(Eof(f)) and (Length(temp.Text) <= MAX_GUESSBUFFER_SIZE)) do begin
ReadLn(f,s);
if (s <> '') then
temp.Add(s);
end;
CloseFile(f);
Result := GuessEncoding(temp);
finally
FreeAndNil(temp);
end;
except
on e: Exception do begin
Result := edc_NONE;
sysShowErrMsg(e.Message);
end;
end;
end else
Result := edc_NONE;
end;
// ---------------------------------------------------------------------------- .
class function TUUEncoderDecoder.SetUUSpaceCoding (const ASpaceCoding: Boolean): Boolean;
begin
Result := UU_UseSpaceCoding;
UU_UseSpaceCoding := ASpaceCoding;
end;
(*
* .
* ============================================================================ .
* === Initialisierung der Unit === .
* ============================================================================ .
* .
*)
var
i : Integer;
// --------------- .
initialization
// --------------- .
begin
// Initialisierung -- Start. .
ABS_MIN_CHAR := #255;
ABS_MAX_CHAR := #0;
(*
* Tabelle "Base64_DecodeTable" aus Tabelle "Base64_EncodeTable" aufbauen ... .
*)
FillChar(Base64_DecodeTable,SizeOf(Base64_DecodeTable),$FF); // $FF = Byte(-1)
for i := 0 to MAX_CODE_VALUE do begin
Base64_DecodeTable[ Base64_EncodeTable[i] ] := Byte(i);
if (Base64_EncodeTable[i] < ABS_MIN_CHAR) then
ABS_MIN_CHAR := Base64_EncodeTable[i];
if (Base64_EncodeTable[i] > ABS_MAX_CHAR) then
ABS_MAX_CHAR := Base64_EncodeTable[i];
end;
(*
* Tabelle "UU_DecodeTable" aus Tabelle "UU_EncodeTable" aufbauen ... .
*)
UU_UseSpaceCoding := False;
FillChar(UU_DecodeTable,SizeOf(UU_DecodeTable),$FF); // $FF = Byte(-1)
for i := 0 to MAX_CODE_VALUE do // Standard-UU-Kodierung .
UU_DecodeTable[ UU_EncodeTable[i] ] := Byte(i);
FillChar(UUSpace_DecodeTable,SizeOf(UUSpace_DecodeTable),$FF); // $FF = Byte(-1)
for i := 0 to MAX_CODE_VALUE do // "Space"-UU-Kodierung .
UUSpace_DecodeTable[ UUSpace_EncodeTable[i] ] := Byte(i);
(*
* Tabelle "XX_DecodeTable" aus Tabelle "XX_EncodeTable" aufbauen ... .
*)
FillChar(XX_DecodeTable,SizeOf(XX_DecodeTable),$FF); // $FF = Byte(-1)
for i := 0 to MAX_CODE_VALUE do begin
XX_DecodeTable[ XX_EncodeTable[i] ] := Byte(i);
if (XX_EncodeTable[i] < ABS_MIN_CHAR) then
ABS_MIN_CHAR := XX_EncodeTable[i];
if (XX_EncodeTable[i] > ABS_MAX_CHAR) then
ABS_MAX_CHAR := XX_EncodeTable[i];
end;
// Initialisierung -- Ende. .
end;
end.
Die ausführbare Datei -- auf Wunsch inklusive komplettem Quelltext -- steht in der Download-Sektion als ZIP-Archiv zur Verfügung. Folgende Dateien stehen zum Download zur Verfügung:
Zusätzliche Informationen:
Web- & Mail-Adresse(n):
| ||||||||||||||||||
Erstellt & gewartet von: Marcus F. Nefzger -- [ (2**5) == (18,31,14) ].
