Форум программистов [Powered by Invision Power Board]

Код

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.