[zzz0001]

Подскажите,пожалуйста,чем бы кодировать в base64 ?
чтобы файл нормально приаттачить к письму

[mav_c]

Сообщение от zzz0001

Подскажите,пожалуйста,чем бы кодировать в base64 ?
чтобы файл нормально приаттачить к письму

А ты как шлёшь файл.
Я шлю индями они сами кодят

[4kusNick]

http://www.google.com/codesearch?hl=...B8%D1%81%D0%BA

[darksoftware]

Код:

 (***              BASE64 by Alexander Myasnikov                         ***)
 (***    Based on ideas from base64 functions by some authors     ***)
 (***              Web: www.darksoftware.narod.ru           ***)

unit base64;

{$R-}
{$Q-}


interface

uses Classes, SysUtils;

procedure Base64EncodeFile(fn: string; tofn: string);
function Base64DecodeFile(fn: string; topath: string): boolean;



implementation


const
  b64alphabet: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  pad: PChar = '====';

var
  dectable: array [0..255] of
  byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54,
    55, 56, 57, 58, 59, 60, 61, 255, 255, 255, 255, 255, 255, 255,
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
    19, 20, 21, 22, 23, 24, 25, 255, 255, 255, 255, 255, 255, 26, 27,
    28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43,
    44, 45, 46, 47, 48, 49, 50, 51, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
    255, 255, 255, 255, 255, 255, 255, 255, 255);



function PosEx(const SubStr, S: string; Offset: cardinal = 1): integer;
var
  I, X: integer;
  Len, LenSubStr: integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
    begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
      begin
      if S[i] = SubStr[1] then
        begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
          begin
          Result := I;
          exit;
          end;
        end;
      Inc(I);
      end;
    Result := 0;
    end;
end;


procedure Base64EncodeFile(fn: string; tofn: string);

  function EncodeChunk(chunk: pbytearray; length: integer): string;
  var
    W, I: longword;
  begin
    W := 0;
    for i := 0 to length - 1 do
      Inc(W, (Chunk^[i]) shl ((2 - i) * 8));
    Result := b64alphabet[(W shr 18) and $3f] + b64alphabet[(W shr 12) and $3f] +
      b64alphabet[(W shr 06) and $3f] + b64alphabet[(W shr 00) and $3f];
    if length <> 3 then
      Result := Copy(Result, 0, length + 1) + Copy(pad, 0, 3 - length);
  end;

var
  hFile, hOut, ByteCount, Idx: longword;
  base64String, Head: string;
  Buf:  array[0..56] of byte;
  Left: longint;

begin

  hFile := FileOpen(Fn, fmOpenRead);
  hOut  := FileCreate(tofn, fmOpenRead);


  Head := 'MIME-Version: 1.0' + #13#10;

  FileWrite(hOut, Head[1], Length(Head));

  Head := Format('Content-Type: application/octet-stream; name="%s"',
    [ExtractFileName(fn)]) + #13#10;
  FileWrite(hOut, Head[1], Length(Head));

  Head := 'Content-Transfer-Encoding: base64' + #13#10;
  FileWrite(hOut, Head[1], Length(Head));
  Head := Format('Content-Disposition: attachment; filename="%s"',
    [ExtractFileName(fn)]) + #13#10#13#10;

  FileWrite(hOut, Head[1], Length(Head));

  FillChar(Buf, SizeOf(Buf), #0);

  repeat
    ByteCount := FileRead(hFile, Buf, 57);
    Left := ByteCount;

    base64String := '';

    idx := 0;

    repeat

      if left >= 3 then
        base64String := base64String + EncodeChunk(@Buf[idx], 3)
      else
        base64String := base64String + EncodeChunk(@Buf[idx], left);

      Inc(idx, 3);
      Dec(left, 3);


    until left <= 0;


    Head := base64String + #13#10;

    FileWrite(hOut, Head[1], Length(Head));

  until ByteCount < 57;


  FileClose(hOut);
  FileClose(hFile);
end;



function Base64DecodeFile(fn: string; topath: string): boolean;

  function DecodeChunk(const Chunk: string; Data: PByteArray): longword;
  var
    W: longword;
    i: byte;
  begin
    FillChar(Data^, 3, 0);
    W := 0;
    Result := 3;
    for i := 1 to 4 do
      if dectable[byte(Chunk[i])] <> 255 then
        W := W + word((dectable[byte(Chunk[i])])) shl ((4 - i) * 6)
      else
        Dec(Result);
    for i := 1 to 3 do
      Data^[i - 1] := (W shr ((3 - i) * 8) and $ff);
  end;

var
  Read, i, ll, max, start: longword;
  Txt: TFileStream;
  s: string;
  SBuf: array[0..65535] of char;
  Buf: array[0..3] of byte;
  Large: array[0..65535] of byte;
  hOut: TFileStream;
  idx, deco: integer;
begin

  Result := True;

  Txt := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);

  idx := 0;


  FillChar(SBuf, 4098, 0);

  Txt.Read(Sbuf, 4096);
  start := Pos(#13#10#13#10, Sbuf) + 3;

  if AnsiPos('base64', AnsiLowerCase(SBuf)) = 0 then
    begin
    Txt.Destroy;
    Result := False;
    Exit;
    end;

  i := AnsiPos('filename=', AnsiLowerCase(Sbuf));
  i := PosEx('"', Sbuf, i + 1);

  topath := SysUtils.IncludeTrailingBackslash(topath) +
    trim(copy(Sbuf, i + 1, PosEx('"', Sbuf, i + 2) - (i + 1)));


  txt.Seek(start, 0);

  FillChar(SBuf, 128, 0);

  Txt.Read(Sbuf, 100);
  ll  := Pos(#13#10, Sbuf) - 1;
  max := ll * 100 + 2 * 100;


  txt.Seek(start, 0);


  hOut := TFileStream.Create(topath, fmCreate);


  repeat
    s := '';
    Read := Txt.Read(Sbuf, max);
    for i := 0 to Read - 1 do
      if SBuf[i] > #13 then
        s := s + SBuf[i];

    while Length(s) > 0 do
      begin
      deco := DecodeChunk(Copy(s, 0, 4), @Buf);
      Move(buf, large[idx], deco);
      Delete(s, 1, 4);
      if idx < 65528 then
        Inc(idx, deco)
      else
        begin
        hOut.WriteBuffer(Large, idx + deco);
        idx := 0;
        end;

      end;



  until Read < max;

  if idx <> 0 then
    hOut.Write(Large, idx);

  txt.Destroy;
  hOut.Destroy;
end;

end.