邮件解码.txt

邮件解码函数

function ToString(const Value : string): string; 
var 
 x, y, n, l: Integer; 
 data : array[0..3] of Byte; 
 TableVal : string; 
begin 
 TableVal := 
   #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40 
   +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C 
   +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03 
   +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F 
   +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40 
   +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 
   +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D 
   +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40; 

  SetLength(Result, Length(Value)); 
  x := 1; 
  l := 1; 
  while x < Length(Value) do 
  begin 
     for This := 0 to 3 do 
     begin 
        if x > Length(Value) then 
           data[n] := 64 
        else 
        begin 
           y := Ord(Value[x]); 
           if (y < 33) or (y > 127) then 
              data[n] := 64 
           else 
              data[n] := Ord(TableVal[y - 32]); 
        end; 
        Inc(x); 
     end; 
     Result[l] := Char((data[0] and $3F) shl 2 + (data[1] and $30) shr 4); 
     Inc(l); 
     if data[2] <> 64 then 
     begin 
        Result[l] := Char((data[1] and $0F) shl 4 + (data[2] and $3C) shr 2); 
        Inc(l); 
        if data[3] <> 64 then 
        begin 
           Result[l] := Char((data[2] and $03) shl 6 + (data[3] and $3F)); 
           Inc(l); 
        end; 
     end; 
  end; 
  Dec(l); 
  SetLength(Result, l); 
end; 

function GetTitle(const Value: string): string; 
var 
 TTPos: integer; 
begin 
  Result := Value; 
  if Copy(Value, 1, 2) <> '=?' then exit; 
  TTPos := Pos('?B?', Value); 
  Inc(TTPos, 3); 
  Result := Copy(Value, TTPos, Length(Value) - TTPos - 1); 
  Result := ToString(Result); 
end;