Гляжу я, тут не очень актифный форум\\
Ну да ладно.. Вот, может кому и понадобится
| Код |
unit Base64;
{
Base64 convert function library
Delphi Base64 Convert Functions
Copyright (c) 2004 Zinkevich Viktor
You can use this module for various
purposes (comercial as well).
}
interface
uses Windows, Classes, Registry, SysUtils;
type
TMIMETypes = class(TObject)
private
list: TStringList;
protected
public
constructor Create;
destructor Destroy; override;
function GetContentType(Ext: string): string;
published
end;
procedure ConvertToBase64(inp, outp: TStream);
procedure ConvertFromBase64(inp, outp: TStream);
implementation
procedure ConvertFromBase64(inp, outp: TStream);
var
int, i, ns: integer;
buf: array [0..3] of Byte;
ot: array [0..2] of Byte;
decode: array [Byte] of Byte;
code: PChar;
begin
code:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
for i:=0 to 63 do
decode[Byte(code[i])] := i;
inp.Position := 0;
ns := (inp.Size div 78)*2; // 76 + 2 (#10#13)
int := (inp.Size - ns) div 4;
for i:=0 to int - 2 do
begin
inp.ReadBuffer(buf[0],2);
if (buf[0] = 13) and ((buf[1] = 10)) then
begin
inp.ReadBuffer(buf[0],4);
end
else
inp.ReadBuffer(buf[2],2);
ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
ot[2] := ((decode[buf[2]] and 3) shl 6) or (decode[buf[3]] and 63);
outp.WriteBuffer(ot[0],3);
end;
inp.ReadBuffer(buf[0],4);
if (buf[2] = Byte('=')) and (buf[3] = Byte('=')) then
begin
ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
outp.WriteBuffer(ot[0],1);
end;
if (buf[2] <> Byte('=')) and (buf[3] = Byte('=')) then
begin
ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
outp.WriteBuffer(ot[0],2);
end;
if (buf[2] <> Byte('=')) and (buf[3] <> Byte('=')) then
begin
ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
ot[2] := ((decode[buf[2]] and 3) shl 6) or (decode[buf[3]] and 63);
outp.WriteBuffer(ot[0],3);
end;
end;
procedure ConvertToBase64(inp, outp: TStream);
var
rem, int, i: integer;
buf: array [0..2] of Byte;
ot: array [0..3] of Char;
endl : PChar;
code: PChar;
begin
code:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
inp.Position := 0;
endl := #13#10;
rem := inp.Size mod 3;
int := inp.Size div 3;
for i:=0 to int - 1 do
begin
inp.ReadBuffer(buf[0],3);
ot[0] := code[((buf[0] and 254) shr 2)];
ot[1] := code[(((buf[0] and 3) shl 4) or ((buf[1] and 240) shr 4))];
ot[2] := code[(((buf[1] and 15) shl 2) or ((buf[2] and 192) shr 6))];
ot[3] := code[(buf[2] and 63)];
outp.WriteBuffer(ot[0],4);
// 76 / 4 = 19
if (i <> 0) and (((i+1) mod 19) = 0) then
outp.WriteBuffer(endl^,2);
end;
inp.ReadBuffer(buf[0],rem);
if rem = 1 then
begin
ot[0] := code[((buf[0] and 254) shr 2)];
ot[1] := code[(((buf[0] and 3) shl 4))];
ot[2] := '=';
ot[3] := '=';
end;
if rem = 2 then
begin
ot[0] := code[((buf[0] and 254) shr 2)];
ot[1] := code[(((buf[0] and 3) shl 4) or ((buf[1] and 240) shr 4))];
ot[2] := code[(((buf[1] and 15) shl 2))];
ot[3] := '=';
end;
if rem <> 0 then
outp.WriteBuffer(ot[0],4);
end;
{ TMIMETypes }
constructor TMIMETypes.Create;
var
reg: TRegistry;
st: TStringList;
i: Integer;
ex: string;
begin
list := TStringList.Create;
st := TStringList.Create;
reg := TRegistry.Create;
reg.RootKey := HKEY_CLASSES_ROOT;
reg.OpenKeyReadOnly('\MIME\Database\Content Type');
reg.GetKeyNames(st);
reg.CloseKey;
for i:=0 to st.Count-1 do
begin
if reg.OpenKeyReadOnly('\MIME\Database\Content Type\'+st.Strings[i]) then
begin
ex := AnsiLowerCase(reg.ReadString('Extension'));
list.Values[ex] := st.Strings[i];
reg.CloseKey;
end;
end;
reg.CloseKey;
st.Free;
end;
destructor TMIMETypes.Destroy;
begin
list.Free;
inherited;
end;
function TMIMETypes.GetContentType(Ext: string): string;
begin
Result := list.Values[AnsiLowerCase(Ext)];
end;
end.
|
|
)