Привожу нетестированный код. Автор: Arne de Bruijn.
{ 64-битное декодирование файлов } { Arne de Bruijn } uses dos; var
Base64:array[43..122] of byte;var
T:text; Chars:set of char; S:string; K,I,J:word; Buf:pointer; DShift:integer; F:file; B,B1:byte; Decode:array[0..63] of byte; Shift2:byte; Size,W:word;begin FillChar(Base64,SizeOf(Base64),255); J:=0; for I:=65 to 90 do begin Base64[I]:=J; Inc(J); end; for I:=97 to 122 do begin Base64[I]:=J; Inc(J); end; for I:=48 to 57 do begin Base64[I]:=J; Inc(J); end; Base64[43]:=J; Inc(J); Base64[47]:=J; Inc(J); if ParamCount=0 then begin WriteLn('UNBASE64 <mime-файл> [<выходной файл>]'); Halt(1); end; S:=ParamStr(1); assign(T,S); GetMem(Buf,32768); SetTextBuf(T,Buf^,32768); {$I-} reset(T); {$I+} if IOResult<>0 then begin WriteLn('Ошибка считывания ',S); Halt(1); end; if ParamCount>=2 then S:=ParamStr(2) else begin write('Расположение:'); ReadLn(S); end; assign(F,S); {$I-} rewrite(F,1); {$I+} if IOResult<>0 then begin WriteLn('Ошибка создания ',S); Halt(1); end; while not eof(T) do begin ReadLn(T,S); if (S<>'') and (pos(' ',S)=0) and (S[1]>=#43) and (S[1]<=#122) and (Base64[byte(S[1])]<>255) then begin FillChar(Decode,SizeOf(Decode),0); DShift:=0; J:=0; Shift2:=1; Size:=255; B:=0; for I:=1 to Length(S) do begin case S[I] of #43..#122:B1:=Base64[Ord(S[I])]; else B1:=255; end; if B1=255 then if S[I]='=' then begin B1:=0; if Size=255 then Size:=J; end else WriteLn('Ошибка символа:',S[I],' (',Ord(S[I]),')'); if DShift and 7=0 then begin Decode[J]:=byte(B1 shl 2); DShift:=2; end else begin Decode[J]:=Decode[J] or Hi(word(B1) shl (DShift+2)); Decode[J+1]:=Lo(word(B1) shl (DShift+2)); Inc(J); Inc(DShift,2); end; end; if Size=255 then Size:=J; BlockWrite(F,Decode,Size); end; end; Close(F); close(T);end.
