Tips (1541)

Tip Bewertung (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.