|
-- 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):
|