Mega Code Archive
How to decode TNEF MIME attachments
<![CDATA[
Title: How to decode TNEF MIME attachments
program TNEFDecode;
{$APPTYPE CONSOLE}
uses
sysutils,
classes;
const
attAttachData: array [0..3] of Byte = ($0F, $80, $06, $00);
attAttachTitle: array [0..3] of Byte = ($10, $80, $01, $00);
var
FFileName: string;
FSourceFileStream: TFileStream;
FCurrentStreamPos: Integer;
FAttTitles: TStringList;
i: Integer;
procedure Init;
begin
FAttTitles := TStringList.Create;
FFileName := ParamStr(1);
if not (FileExists(FFileName)) then Halt;
FSourceFileStream := TFileStream.Create(FFileName, fmOpenRead);
FCurrentStreamPos := 0;
end;
function GotoAttPos(InfoTyp: array of Byte): Boolean;
var
Match: array [0..3] of Byte;
begin
Result := False;
FSourceFileStream.Position := 0;
with FSourceFileStream do
begin
repeat
Inc(FCurrentStreamPos);
Seek(FCurrentStreamPos, soFromBeginning);
read(Match[0], SizeOf(Match[0]));
read(Match[1], SizeOf(Match[1]));
read(Match[2], SizeOf(Match[2]));
read(Match[3], SizeOf(Match[3]));
Result := ((Match[0] = InfoTyp[0]) and
(Match[1] = InfoTyp[1]) and
(Match[2] = InfoTyp[2]) and
(Match[3] = InfoTyp[3]));
if Result then Break;
until FCurrentStreamPos = Size;
end;
end;
function CountAtt: Integer;
begin
FCurrentStreamPos := 0;
Result := -1;
repeat
Inc(Result);
until not GotoAttPos(attAttachData);
FCurrentStreamPos := 0;
end;
function GetAttTitles: TStringList;
var
Size, i: Integer;
Zeichen: Byte;
sl: TStringList;
begin
sl := TStringList.Create;
sl.Clear;
FCurrentStreamPos := 0;
repeat
Inc(FCurrentStreamPos);
GotoAttPos(attAttachTitle);
FSourceFileStream.read(Size, SizeOf(Size));
FFileName := '';
SetLength(FFileName, Size);
FSourceFileStream.read(FFileName[1], Size);
sl.Add(FFileName);
until FCurrentStreamPos = FSourceFileStream.Size;
Result := sl;
end;
procedure SaveAttFile(FileName: string);
var
FDestFileStream: TFilestream;
Size: Integer;
i: Integer;
begin
FDestFileStream := TFileStream.Create(FileName, fmCreate);
GotoattPos(attAttachData);
FSourceFileStream.read(Size, SizeOf(Size));
FDestFileStream.CopyFrom(FSourceFileStream, Size);
FDestFileStream.Free;
end;
begin
Init;
if CountAtt = 0 then Halt;
FAttTitles := GetAttTitles;
FCurrentStreamPos := 0;
for i := 0 to CountAtt - 1 do
begin
WriteLn('Ereuge ' + FAttTitles[i]);
SaveAttFile(FAttTitles[i]);
end;
end.
]]>