Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1130 connectés 

  FORUM HardWare.fr
  Programmation
  Delphi/Pascal

  Extraire le fax d'un mail

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Extraire le fax d'un mail

n°1509710
chrisledev​eloppeur
Posté le 01-02-2007 à 17:15:54  profilanswer
 

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 :
  1. unit Unit1;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComObj, ActiveX, ShlObj;
  9. type
  10.   // Form that acts as IDropTarget
  11.   TForm1         =  class(TForm, IDropTarget)
  12.     procedure    FormCreate(Sender: TObject);
  13.     procedure    FormClose(Sender: TObject; var Action: TCloseAction);
  14.   private
  15.      // Private declarations
  16.      function    SaveAsStg(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  17.      function    SaveAsStm(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  18.      function    SaveAsMem(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  19.   protected
  20.      // Protected declarations
  21.      function    DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  22.      function    DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; reintroduce; stdcall;
  23.      function    DragLeave: HResult; stdcall;
  24.      function    Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  25.   public
  26.      // Public declarations
  28.   end;
  30. // Acceptable format types
  31. const
  32.   CF_Acceptable:          Array [0..1] of String =   ('RenPrivateMessages',
  33.                                                       'Internet Message (rfc822/rfc1522)');
  35. // Predefined clipboard formats
  36. const
  37.   CF_PredfinedFormats:    Array [1..15] of String =  ('Text',
  38.                                                       'Bitmap',
  39.                                                       'MetaFile',
  40.                                                       'SYLK',
  41.                                                       'DIF',
  42.                                                       'TIFF',
  43.                                                       'OemText',
  44.                                                       'DIB',
  45.                                                       'Palette',
  46.                                                       'Pen Data',
  47.                                                       'RIFF',
  48.                                                       'Wave',
  49.                                                       'Unicode Text',
  50.                                                       'Enhanced Metafile',
  51.                                                       'HDrop');
  53. var
  54.   Form1:         TForm1;
  56. implementation
  57. {$R *.DFM}
  59. function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
  60. var  pEFETC:     IEnumFORMATETC;
  61.      FmtETC:     tagFORMATETC;
  62.      lpszFormat: Array [0..255] of Char;
  63.      szFormat:   String;
  64.      dwAllow:    Integer;
  65.      dwfetch:    Integer;
  66.      bAllow:     Boolean;
  67. begin
  69.   // Clear the format string
  70.   szFormat:='';
  72.   // Determine if we want to support the drop of this type
  73.   bAllow:=False;
  74.   if (dataObj.EnumFormatEtc(DATADIR_GET, pEFETC) = S_OK) then
  75.   begin
  76.      // Start the fetch enumeration
  77.      while (pEFETC.Next(1, FmtETC, @dwfetch) = S_OK) do
  78.      begin
  79.         // Attempt to get the clipboard format name
  80.         if (FmtETC.cfFormat in [1..15]) then
  81.            szFormat:=CF_PredfinedFormats[FmtETC.cfFormat]
  82.         else if (GetClipboardFormatName(FmtETC.cfFormat, lpszFormat, SizeOf(lpszFormat)) > 0) then
  83.            szFormat:=lpszFormat
  84.         else
  85.            szFormat:=IntToStr(FmtETC.cfFormat);
  86.         // Compare formats
  87.         for dwAllow:=0 to High(CF_Acceptable) do
  88.         begin
  89.            if (CompareText(CF_Acceptable[dwAllow], szFormat) = 0) then
  90.            begin
  91.               bAllow:=True;
  92.               if bAllow then break;
  93.            end;
  94.         end;
  95.         if bAllow then break;
  96.      end;
  97.      // Release the enumerator
  98.      pEFETC:=nil;
  99.   end;
  101.   // Should we allow the enter?
  102.   result:=NOERROR;
  103.   if not(bAllow) then dwEffect:=DROPEFFECT_NONE;
  105. end;
  107. function TForm1.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
  108. begin
  110.   // Allow the drag over
  111.   result:=NOERROR;
  113. end;
  115. function TForm1.DragLeave: HResult;
  116. begin
  118.   // Allow the drag leave
  119.   result:=NOERROR;
  121. end;
  123. function TForm1.SaveAsStg(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  124. var  medium:     TStgMedium;
  125.      pvStg:      IStorage;
  126. begin
  128.   // Set default result
  129.   result:=False;
  131.   // Set tymed
  132.   fmt.tymed:=TYMED_ISTORAGE;
  134.   // Get the data
  135.   if (dataObj.GetData(fmt, medium) = S_OK) then
  136.   begin
  137.      // Create storage file
  138.      if (StgCreateDocfile(PWideChar(WideString(FileNameBase+'.msg')),
  139.         STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE , 0, pvStg) = S_OK) then
  140.      begin
  141.         // Copy from the dropped storage
  142.         result:=(IStorage(medium.stg).CopyTo(0, nil, nil, pvStg) = S_OK);
  143.         // Release the storage interface
  144.         pvStg:=nil;
  145.      end;
  146.      // We are responsible for releasing the storage medium
  147.      IStorage(medium.stg):=nil;
  148.   end;
  150. end;
  152. function TForm1.SaveAsStm(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  153. var  msStream:   TMemoryStream;
  154.      pvStm:      IStream;
  155.      medium:     TStgMedium;
  156.      stat:       TStatStg;
  157.      dwSize:     Integer;
  158. begin
  160.   // Set default result
  161.   result:=False;
  163.   // Set tymed
  164.   fmt.tymed:=TYMED_ISTREAM;
  166.   // Get the data
  167.   if (dataObj.GetData(fmt, medium) = S_OK) then
  168.   begin
  169.      // Get the stream
  170.      pvStm:=IStream(medium.stm);
  171.      // Stat to get the size
  172.      if (pvStm.Stat(stat, STATFLAG_NONAME) = S_OK) then
  173.      begin
  174.         // Create memory stream for output
  175.         msStream:=TMemoryStream.Create;
  176.         msStream.Size:=stat.cbSize;
  177.         if (IStream(medium.stm).Read(msStream.Memory, stat.cbSize, @dwSize) = S_OK) then
  178.         begin
  179.            msStream.Size:=dwSize;
  180.            msStream.Position:=0;
  181.            msStream.SaveToFile(FileNameBase+'.eml');
  182.            result:=True;
  183.         end;
  184.         msStream.Free;
  185.      end;
  186.      // Release the stream interface
  187.      IStream(medium.stm):=nil;
  188.   end;
  190. end;
  192. function TForm1.SaveAsMem(FileNameBase: String; dataObj: IDataObject; fmt: tagFORMATETC): Boolean;
  193. var  msStream:   TMemoryStream;
  194.      medium:     TStgMedium;
  195.      stat:       TStatStg;
  196.      lpMem:      Pointer;
  197.      dwSize:     Integer;
  198. begin
  200.   // Set default result
  201.   result:=False;
  203.   // Set tymed
  204.   fmt.tymed:=TYMED_HGLOBAL;
  206.   // Get the data
  207.   if (dataObj.GetData(fmt, medium) = S_OK) then
  208.   begin
  209.      // Get the memory and lock it
  210.      lpMem:=GlobalLock(medium.hGlobal);
  211.      // Create memory stream for output
  212.      msStream:=TMemoryStream.Create;
  213.      msStream.Write(lpMem^, GlobalSize(medium.hGlobal));
  214.      msStream.SaveToFile(FileNameBase+'.eml');
  215.      result:=True;
  216.      msStream.Free;
  217.      // Unlock and free the memory
  218.      GlobalUnlock(medium.hGlobal);
  219.      GlobalFree(medium.hGlobal);
  220.   end;
  222. end;
  224. function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
  225. var  pEFETC:     IEnumFORMATETC;
  226.      FmtETC:     tagFORMATETC;
  227.      msStream:   TMemoryStream;
  228.      cfEml:      Integer;
  229.      cfFile:     Integer;
  230.      pvStg:      IStorage;
  231.      medium:     TStgMedium;
  232.      bHandle:    Boolean;
  233.      dwFetch:    Integer;
  234.      i64Size:    Int64;
  235.      i64Move:    Int64;
  236. begin
  238.   // Set result
  239.   result:=NOERROR;
  241.   // Enumerate until we get are able to save the contents
  242.   bHandle:=False;
  243.   cfFile:=RegisterClipboardFormat(CFSTR_FILECONTENTS);
  244.   cfEml:=RegisterClipboardFormat('Internet Message (rfc822/rfc1522)');
  245.   if (dataObj.EnumFormatEtc(DATADIR_GET, pEFETC) = S_OK) then
  246.   begin
  247.      // Start the fetch enumeration
  248.      while (pEFETC.Next(1, FmtETC, @dwfetch) = S_OK) do
  249.      begin
  250.         // Check file contents
  251.         if (FmtETC.cfFormat = cfFile) then
  252.         begin
  253.            // Try as storage first, then stream
  254.            if ((FmtETC.cfFormat and TYMED_ISTORAGE) = TYMED_ISTORAGE) then
  255.            begin
  256.               if SaveAsStg('Test', dataObj, FmtEtc) then break;
  257.            end;
  258.            if ((FmtETC.cfFormat and TYMED_ISTREAM) = TYMED_ISTREAM) then
  259.            begin
  260.               if SaveAsStm('Test', dataObj, FmtEtc) then break;
  261.            end;
  262.         end
  263.         // Check for eml
  264.         else if (FmtETC.cfFormat = cfEml) then
  265.         begin
  266.            if SaveAsMem('Test', dataObj, FmtEtc) then break;
  267.         end;
  268.      end;
  269.   end;
  271. end;
  273. procedure TForm1.FormCreate(Sender: TObject);
  274. begin
  276.   // Register the form as a drop target
  277.   RegisterDragDrop(Handle, Self);
  279. end;
  281. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  282. begin
  284.   // Revoke the form as a drop target
  285.   RevokeDragDrop(Handle);
  287. end;
  289. initialization
  291.   // Initialize ole
  292.   OleInitialize(nil);
  294. finalization
  296.   // Uninitialize ole
  297.   OleUninitialize;
  299. 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.

mood
Publicité
Posté le 01-02-2007 à 17:15:54  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Delphi/Pascal

  Extraire le fax d'un mail

 

Sujets relatifs
Utilisation de SQL MailFonction Mail (erreur...)
COMMENT faire pour que mon MAIL ne soit pas considéré comme un SPAM ?proteger un mail de contact sur son site web ?
[Javamail] Comment extraire les PJ de type mail ?fonction mail () Cc et Bc
extraire des mots en fonction de leur mise en forme[Résolu] Envoyer par mail le résultat d'un formulaire fait en html
Question mail() à 2 sous 
Plus de sujets relatifs à : Extraire le fax d'un mail

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.118 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR