Extraire le fax d'un mail

Marsh Posté le 01-02-2007 à 17:15:54

Bonjour, je réalise une appli qui lorsque l'on y glisse un mail n'importe où dans sa fiche , enregistre ce mail en fichier eml dans un répertoire, ses pièces jointes comprises. le problème reste que je souhaite filtrer les fax reçus par mail vers un traitement spécial pour n'enregistrer que le fichier TIF associé au fax joint dans le mail. Je ne parviens pas à dissocier les fichiers TIF des fichiers joints en général, tous associés au même type de format presse papier. En effet, le cformat retourné est toujours le même nombre, quelquesoit la pièce jointe.
Voici un code général dont je me suis inspiré pour récupérer le mail et son contenu droppé:

Code :

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComObj, ActiveX, ShlObj;
type
// Form that acts as IDropTarget
TForm1 = class(TForm, IDropTarget)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
// Private declarations
function SaveAsStg(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
function SaveAsStm(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
function SaveAsMem(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
protected
// Protected declarations
function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; reintroduce; stdcall;
function DragLeave: HResult; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
public
// Public declarations
end;
// Acceptable format types
const
CF_Acceptable: Array [0..1] of String = ('RenPrivateMessages',
'Internet Message (rfc822/rfc1522)');
// Predefined clipboard formats
const
CF_PredfinedFormats: Array [1..15] of String = ('Text',
'Bitmap',
'MetaFile',
'SYLK',
'DIF',
'TIFF',
'OemText',
'DIB',
'Palette',
'Pen Data',
'RIFF',
'Wave',
'Unicode Text',
'Enhanced Metafile',
'HDrop');
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
var pEFETC: IEnumFORMATETC;
FmtETC: tagFORMATETC;
lpszFormat: Array [0..255] of Char;
szFormat: String;
dwAllow: Integer;
dwfetch: Integer;
bAllow: Boolean;
begin
// Clear the format string
szFormat:='';
// Determine if we want to support the drop of this type
bAllow:=False;
if (dataObj.EnumFormatEtc(DATADIR_GET, pEFETC) = S_OK) then
begin
// Start the fetch enumeration
while (pEFETC.Next(1, FmtETC, @dwfetch) = S_OK) do
begin
// Attempt to get the clipboard format name
if (FmtETC.cfFormat in [1..15]) then
szFormat:=CF_PredfinedFormats[FmtETC.cfFormat]
else if (GetClipboardFormatName(FmtETC.cfFormat, lpszFormat, SizeOf(lpszFormat)) > 0) then
szFormat:=lpszFormat
else
szFormat:=IntToStr(FmtETC.cfFormat);
// Compare formats
for dwAllow:=0 to High(CF_Acceptable) do
begin
if (CompareText(CF_Acceptable[dwAllow], szFormat) = 0) then
begin
bAllow:=True;
if bAllow then break;
end;
end;
if bAllow then break;
end;
// Release the enumerator
pEFETC:=nil;
end;
// Should we allow the enter?
result:=NOERROR;
if not(bAllow) then dwEffect:=DROPEFFECT_NONE;
end;
function TForm1.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
begin
// Allow the drag over
result:=NOERROR;
end;
function TForm1.DragLeave: HResult;
begin
// Allow the drag leave
result:=NOERROR;
end;
function TForm1.SaveAsStg(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
var medium: TStgMedium;
pvStg: IStorage;
begin
// Set default result
result:=False;
// Set tymed
fmt.tymed:=TYMED_ISTORAGE;
// Get the data
if (dataObj.GetData(fmt, medium) = S_OK) then
begin
// Create storage file
if (StgCreateDocfile(PWideChar(WideString(FileNameBase+'.msg')),
STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE , 0, pvStg) = S_OK) then
begin
// Copy from the dropped storage
result:=(IStorage(medium.stg).CopyTo(0, nil, nil, pvStg) = S_OK);
// Release the storage interface
pvStg:=nil;
end;
// We are responsible for releasing the storage medium
IStorage(medium.stg):=nil;
end;
end;
function TForm1.SaveAsStm(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
var msStream: TMemoryStream;
pvStm: IStream;
medium: TStgMedium;
stat: TStatStg;
dwSize: Integer;
begin
// Set default result
result:=False;
// Set tymed
fmt.tymed:=TYMED_ISTREAM;
// Get the data
if (dataObj.GetData(fmt, medium) = S_OK) then
begin
// Get the stream
pvStm:=IStream(medium.stm);
// Stat to get the size
if (pvStm.Stat(stat, STATFLAG_NONAME) = S_OK) then
begin
// Create memory stream for output
msStream:=TMemoryStream.Create;
msStream.Size:=stat.cbSize;
if (IStream(medium.stm).Read(msStream.Memory, stat.cbSize, @dwSize) = S_OK) then
begin
msStream.Size:=dwSize;
msStream.Position:=0;
msStream.SaveToFile(FileNameBase+'.eml');
result:=True;
end;
msStream.Free;
end;
// Release the stream interface
IStream(medium.stm):=nil;
end;
end;
function TForm1.SaveAsMem(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
var msStream: TMemoryStream;
medium: TStgMedium;
stat: TStatStg;
lpMem: Pointer;
dwSize: Integer;
begin
// Set default result
result:=False;
// Set tymed
fmt.tymed:=TYMED_HGLOBAL;
// Get the data
if (dataObj.GetData(fmt, medium) = S_OK) then
begin
// Get the memory and lock it
lpMem:=GlobalLock(medium.hGlobal);
// Create memory stream for output
msStream:=TMemoryStream.Create;
msStream.Write(lpMem^, GlobalSize(medium.hGlobal));
msStream.SaveToFile(FileNameBase+'.eml');
result:=True;
msStream.Free;
// Unlock and free the memory
GlobalUnlock(medium.hGlobal);
GlobalFree(medium.hGlobal);
end;
end;
function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
var pEFETC: IEnumFORMATETC;
FmtETC: tagFORMATETC;
msStream: TMemoryStream;
cfEml: Integer;
cfFile: Integer;
pvStg: IStorage;
medium: TStgMedium;
bHandle: Boolean;
dwFetch: Integer;
i64Size: Int64;
i64Move: Int64;
begin
// Set result
result:=NOERROR;
// Enumerate until we get are able to save the contents
bHandle:=False;
cfFile:=RegisterClipboardFormat(CFSTR_FILECONTENTS);
cfEml:=RegisterClipboardFormat('Internet Message (rfc822/rfc1522)');
if (dataObj.EnumFormatEtc(DATADIR_GET, pEFETC) = S_OK) then
begin
// Start the fetch enumeration
while (pEFETC.Next(1, FmtETC, @dwfetch) = S_OK) do
begin
// Check file contents
if (FmtETC.cfFormat = cfFile) then
begin
// Try as storage first, then stream
if ((FmtETC.cfFormat and TYMED_ISTORAGE) = TYMED_ISTORAGE) then
begin
if SaveAsStg('Test', dataObj, FmtEtc) then break;
end;
if ((FmtETC.cfFormat and TYMED_ISTREAM) = TYMED_ISTREAM) then
begin
if SaveAsStm('Test', dataObj, FmtEtc) then break;
end;
end
// Check for eml
else if (FmtETC.cfFormat = cfEml) then
begin
if SaveAsMem('Test', dataObj, FmtEtc) then break;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Register the form as a drop target
RegisterDragDrop(Handle, Self);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Revoke the form as a drop target
RevokeDragDrop(Handle);
end;
initialization
// Initialize ole
OleInitialize(nil);
finalization
// Uninitialize ole
OleUninitialize;
end.

J'ai eu l'idée également de sauvegarder d'abord tout le mail puis de l'ouvrir en faisant l'extraction du TIF avant sa suppression. Traitement de bidouille je sais. Mais de toute façon, je n'ai pas trouvé le composant standard permettant de lire un fichier EML local (sans passer par un client server de mail). L'idée serait de partir d'un chargement dans un memorystream mais aprés je ne sais pas comment faire pour l'associer à par exemple un MailMessage me permettant de lire le EML. Avez-vous une idée sur soit la solution d'extraire le TIF d'un EML local, soit de directement détecté un TIF en pièce jointe du mail droppé? Merci.

Marsh Posté le 01-02-2007 à 17:15:54

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed

Name *

Email *

URL

Message *