Unit email_code;
InterfaceUses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Const cBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 / ='; Function QuotedPrintableEncode (mSource: String): String; Function QuotedPrintableDecode (mCode: String): String; Function base64encode (msource: boolean = true): string; function base64decode (mcode: string): string; function gettitle (const value: string): String;
IMPLEMentation
Uses Tg;
Function QuoteDPrintableEncode (Msource: String): String; Var i, J: Integer; Begin Result: = '; J: = 0; for i: = 1 to length (msource) do beg IF msource [i] in [# 32 .. # 127, # 13, # 10] - ['='] THEN BEGIN RESULT: = Result Msource [i]; inc (j); end else begin result: = results '=' INTOHEX (ORD) Msource [i]), 2); INC (J, 3); End; IF msource [i] in [# 13, # 10] THEN J: = 0; if j> = 70 The begin Result: = Result # 13 # 10; j: = 0; end; end; end; {quotedprintableEncode}
Function QuoteDPrintableDecode (McODe: String): String; Var i, J, L: Integer; Begin Result: = '; J: = 0; McOde: = AdjustLineBreaks (McODE); l: = Length (McODE); i: = 1; while i <= l do begin if mcode [i] = '=' Then Begin Result: = Result CHR (STRTOINTDEF ('$' COPY (McODE, I 1, 2), 0)); Inc J, 3); INC (I, 3); ELSE IF McODE [I] in [# 13, # 10] THEN BEGIN IF J <70 Then Result: = Result Mcode [i]; if Mcode [i] = # 10 THEN J: = 0; INC (i); END ELSE BEGIN Result: = Result Mcode [I]; Inc (J); Inc (i); end; end; end; {quotedprintabledecode}
Function Base64encode (Msource: String; Maddline: Boolean = true): String; Var i, j: integer; s: string; begin result: = '; j: = 0; for i: = 0 to length (msource) DIV 3 - 1 DO Begin S: = COPY (Msource, I * 3 1, 3); Result: = Result CBase64 [ORD (S [1]) SHR 2 1]; Result: = Result CBase64 [(( ORD (S [1]) and $ 03) SHL 4) (ORD (S [2]) SHR 4) 1]; Result: = Result CBase64 [((ORD (S [2]) and $ 0f) SHL 2) (ORD (S [3]) SHR 6) 1]; Result: = Result CBase64 [ORD (S [3]) and $ 3F 1]; if Maddline The Begin Inc (J, 4); IF J> = 76 THEN Begin Result: = Result # 13 # 10; j: = 0; end; end; end;: = length (msource) Div 3; s: = Copy (Msource, i * 3 1 , 3); Case Length (s) of 1: Begin Result: = Result CBase64 [ORD (S [1]) SHR 2 1]; Result: = Result CBase64 [(ORD (S [1]) and $ 03 ) SHL 4 1]; Result: = Result CBase64 [65]; Result: = Result CBase64 [65]; end; 2: Begin Result: = Result CBase64 [ORD (S [1]) SHR 2 1]; Result: = Result CBase64 [((ORD (S [1]) and $ 03) SHL 4) (ORD (S [2] ) SHR 4) 1]; Result: = Result CBase64 [(ORD (S [2]) and $ 0f) SHL 2 1]; Result: = Result CBase64 [65]; End; end; end; { Base64encode}
Function Base64Decode (mcode: string): String; Var i, l: integer; s: string; begin result: = '; l: = length (mcode); i: = 1; While i <= l do begin if Pos (McODe [I], CBase64> 0 THEN BEGIN S: = Copy (McODE, I, 4); IF (Length (s) = 4) The begin Result: = Result CHR ((S [1], CBASE64) - 1) SHL 2 (POS (S [2], CBase64) - 1) SHR 4); IF S [3] <> CBase64 [65] THEN Begin Result: = Result CHR ((((SOS [2], CBASE64) - 1) AND $ 0F) SHL 4 (POS (S [3], CBase64) - 1) SHR 2); IF S [4] <> cbase64 [65] Then Result: = Result CHR ((((S [3], CBase64) - 1) and $ 03) SHL 6 (POS (S [4], CBase64) - 1)); end; end; inc; 4); ELSE INC (I); end; end; {base64decode} Function Find (Substr, str: string; isend: boolean = false): integer; var i: integer; begin result: = 0; if isend dam for i: = Length H (STR) DOWNTO 0 DO if Copy (STR, I, Length (Substr)) = Substr Then Begin Result: = I; Break; End; Else for i: = 0 to Length (Str) DO if Copy (Str, I, Length (SUBST)) = Substr Then Begin Result: = I; Break; End;
END;
Function GetTitle (const value: string): string; var tempstr, sstr, estr: string; begin sstr: = copy (value, 1, pOS ('=?', Value) - 1); tempstr: = Copy (VALUE, POS ('=?', Value) 2, Length (value)); estr: = COPY (Tempstr, Find ('? =', Tempstr, true) 2, Length (Tempstr)); tempstr: = Copy Tempstr, 1, Find ('? =', TEMPSTR, TRUE) - 1); if POS ('? B?', Tempstr)> 0 THEN BEGIN TEMPSTR: = COPY (Tempstr, POS ('? B?', Tempstr 3, Length (Tempstr)); Tempstr: = Base64Decode (Tempstr); Result: = SSTR TEMPSTR ESTR; EXIT; ELSE IF POS ('? B?', Tempstr)> 0 THEN BEGIN TEMPSTR: = COPY (Tempstr, POS ('? B?', Tempstr) 3, Length (Tempstr)); Tempstr: = Base64Decode (Tempstr); Result: = SSTR TEMPSTR ESTR; EXIT; END; if Pos ('? Q? ', Tempstr)> 0 THEN Begin Tempstr: = COPY (Tempstr, POS ('? Q? ', Tempstr) 3, Length (Tempstr)); Tempstr: = quotedableDecode (Tempstr); Result: = SSTR TEMPSTR ESTR EXIT; ELSE IF POS ('? Q?', TEM PSTR)> 0 THEN Begin Tempstr: = COPY (Tempstr, POS ('? q?', tempstr) 3, Length (Tempstr)); Tempstr: = quotedPrintableDecode (Tempstr); Result: = SSTR TEMPSTR ESTR; EXIT; End; Result: = Value;
End; =============================================================================================================================================================== ==================================================== Indy has Base64 with codecs The example can be used directly as follows ..caption: = base64decode (idMessage.from.text); caption: = base64decode (idMessage.subject.text); The following is written by INDY9, using inde / encodermime decoding ..
/ / -------------------------------------------------------------------------------------------- ------------------------------ // Base64Decode // --------------- -------------------------------------------------- ------------- Function TMAINFORM.BASE64DECode (STRINPUT: STRING): String; VarstrDecode: String; Posstart: Integer; Posnd: Integer; BeginWhile Pos ('=? GB2312? B?', LowerCase (STRINPUT)> 0 dobegintryposstart: = POS ('=? GB2312? B?', LowerCase (STRINPUT)); Posnd: = POS ('? =', LowerCase (strDecode: = strDecode Copy (STRINPUT , 1, POSSTART-1) IDDemime.Decodestring (Strinput, Posstart 11, Posnd-Posstart-11)); STRINPUT: = Copy (Strinput, Posnd 2, Length (Strinput) -posend-1); FinallyApplication .ProcessMessages; End; end; strdecode: = strdecode strINput; result: = strdecode;
/ / -------------------------------------------------------------------------------------------- ------------------------------ // Base64encode // --------------- -------------------------------------------------- ------------- Function TMAINFORM.BASE64ENCODE (STRINPUT: STRING): String; Varstrencode: String; Beginstrencode: = Idenmime.Encodestring (Strinput); result: = streencode; end; // - -------------------------------------------------- ------------------------- ps.iddemime is IDDecodermimeidenmime is ideencodermime
If WHILE POS ('=? GB2312? B?', Lowercase (STRINPUT))> 0 do is while pos ('=? GB2312? Q?', LowerCase (STRINPUT))> 0 do, turn IDDecodermime to IDEncodermime for change IdeEncoderquotedPrintable
Try
