whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

16 Visitors Online


 
...decode TNEF MIME attachments?
Autor: Markus Schäning
Homepage: http://www.palanet.de
[ Print tip ]  

Tip Rating (13):  
     


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.


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners