DominoArea.org [Archive]

Salut belle compagnie,

Avant de tirer ma révérence de développeur lotus notes, voilà une dernière astuce pour détacher les images visibles dans un RT. Ce code est adapté d'un code trouvé sur le web.

A bientôt !

Code : Tout sélectionner

'/**
   ' * Permet d'extraire du document des images "collées" dans un RT
   ' * @param    NotesDocument, le document à traiter
   ' * @return   integer
   ' */
Function ExportImgs(pDoc As NotesDocument) As Integer
   On Error GoTo HandleError
   
   ExportImgs = False

   Dim se As New NotesSession()
   Dim db As NotesDatabase
   Dim doc2 As NotesDocument
   Dim f As Integer, i As Integer
   Dim stream As NotesStream
   Dim mimeEntity As NotesMIMEEntity
   Dim mimeHeader As NotesMIMEHeader
   Dim img(1 To 3, 1 To 3) As String
   Dim exporter As NotesDXLExporter
   Dim dxl As String, dxlPicture As String, dxlPictureType As String, key As String
   Dim destinationPath As String, filename As String, directory As String
   Dim counter As Integer
   Dim p1 As Long, p2 As Long
   
   Set exporter = se.CreateDXLExporter()
   Set db = se.CurrentDatabase()
   
   exporter.ConvertNotesBitmapsToGIF = True
   
   REM GIFs
   img(1,1)="<gif>"
   img(1,2)="</gif>"
   img(1,3)="gif"
   
   REM gif
   img(2,1)="<gif originalformat='notesbitmap'>"
   img(2,2)="</gif>"
   img(2,3)="gif"
   
   REM JPEGs
   img(3,1)="<jpeg>"
   img(3,2)="</jpeg>"
   img(3,3)="jpg"
   
   REM Init du compteur
   counter = 0
   
   REM Folder to extract (c:\etc...)
   destinationPath = "c:\"
   
   REM Convert document into DXL
   dxl = exporter.Export(pDoc)   
   dxl = Replace(dxl, Chr(13), "")
   dxl = Replace(dxl, Chr(10), "")
   
   REM Extract picture data from DXL and write it into tempfile
   For i = 1 To 3
      key = img(i, 1)
      p1 = InStr(p1 + 10, dxl, key , 5)
      
      While p1 > 0
         If p1 > 0 Then
            p2 = InStr(p1, dxl, img(i, 2), 5)
            
            If p2 > 0 Then
               dxlPictureType = img(i, 3)
               dxlPicture = Mid(dxl, p1+Len(key), p2-p1-Len(key))
               
               REM Save DXL into tempfile
               f = FreeFile
               Open destinationPath & "Base64.tmp" For Output As f
               Print #f,  DXLPicture
               Close f
               
               REM Create a new Notes Document with embedded picture
               se.ConvertMIME = False
               
               Set Doc2 = New NotesDocument(db)
               Set MIMEEntity = doc2.CreateMIMEEntity
               Set stream = se.CreateStream
               
               If Not stream.Open(destinationPath & "Base64.tmp", "binary") Then GoTo skip
               If stream.Bytes = 0 Then GoTo skip
               
               Call MimeEntity.SetContentFromBytes(stream, "image/gif", ENC_BASE64)   
               Call stream.Close()
               
               REM Save embedded picture to file
               Set stream = se.CreateStream()
               
               filename = pDoc.NoteID & "_" & counter & "." &  dxlPictureType
               directory = destinationPath & filename
               
               REM Don't remove Resume Next
               On Error Resume Next
               Kill directory
               
               If Not stream.Open(directory, "binary") Then GoTo skip
               
               Set MIMEEntity = doc2.GetMIMEEntity
               
               Call MimeEntity.GetContentAsBytes(stream)
               Call stream.Close()
               
               counter = counter + 1
            End If
         End If
         
         p1 = InStr(p2 + 1, dxl, key , 5)
      Wend
   Next i
skip:
   se.ConvertMIME = True
   
   If Dir(destinationPath & "Base64.tmp", 0) <> "" Then
      Kill destinationPath & "Base64.tmp"
      Call stream.Close()
   End If
   
   ExportImgs = True
   Exit Function
HandleError:
   se.ConvertMIME = True
   
   If Dir(destinationPath & "Base64.tmp", 0) <> "" Then
      Kill destinationPath & "Base64.tmp"   
      Call stream.Close()
   End If
End Function