Битное кодирование/декодирование I
Привожу нетестированный код. Автор: 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;beginFillChar(Base64,SizeOf(Base64),255);J:=0;for I:=65 to 90 dobeginBase64[I]:=J;Inc(J);end;for I:=97 to 122 dobeginBase64[I]:=J;Inc(J);end;for I:=48 to 57 dobeginBase64[I]:=J;Inc(J);end;Base64[43]:=J; Inc(J);Base64[47]:=J; Inc(J);if ParamCount=0 thenbeginWriteLn('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 thenbeginWriteLn('Ошибка считывания ',S);Halt(1);end;if ParamCount>=2 thenS:=ParamStr(2)elsebegin write('Расположение:'); ReadLn(S); end;assign(F,S);{$I-} rewrite(F,1); {$I+}if IOResult<>0 thenbeginWriteLn('Ошибка создания ',S);Halt(1);end;while not eof(T) dobeginReadLn(T,S);if (S<>'') and (pos(' ',S)=0) and (S[1]>=#43) and (S[1]<=#122) and(Base64[byte(S[1])]<>255) thenbeginFillChar(Decode,SizeOf(Decode),0);DShift:=0;J:=0; Shift2:=1;Size:=255;B:=0;for I:=1 to Length(S) dobegincase S[I] of#43..#122:B1:=Base64[Ord(S[I])];elseB1:=255;end;if B1=255 thenif S[I]='=' thenbeginB1:=0; if Size=255 then Size:=J;endelseWriteLn('Ошибка символа:',S[I],' (',Ord(S[I]),')');if DShift and 7=0 thenbeginDecode[J]:=byte(B1 shl 2);DShift:=2;endelsebeginDecode[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. |
