把导入的图片还原为图片文件

Sub Initialize()
Dim s As New NotesSession
Dim db As NotesDatabase
Set db = s.Currentdatabase
'Set db = New NotesDatabase( "YourServer/svr/somewhere", "database.nsf")

Call ExtractImageResources( db, "J:\temp" )

End Sub
Sub ExtractImageResources(db As NotesDatabase, DestinationDirectory As String)
' =========================================================
' Extracts all GIF and JPG image resource file to <DestinationDirectory>
' DestinationDirectory must exist.
' This code creates 1 tempfile in dest. directory.
' =========================================================
Dim session As New NotesSession
Dim DestinationDir As String
Dim debug As Integer
Dim nc As NotesNoteCollection
Dim exporter As NotesDXLExporter
Dim stream As NotesStream
Dim DXLTempfile As String
Dim inputStream As NotesStream
Dim domParser As NotesDOMParser
Dim RootNode As NotesDOMDocumentNode
Dim n1 As Integer
Dim i As Integer

Dim ImageResource_Nodes As NotesDOMNodeList
Dim MyNode As NotesDOMElementNode
Dim TempNode As NotesDOMElementNode
Dim TempChildNode As NotesDOMNode
Dim MyNodeList As NotesDOMNodeList
Dim attr As NotesDOMAttributeNode
Dim IRFilename As String
Dim MimeEntity As NotesMIMEEntity
Dim outStream As NotesStream
Dim doc As NotesDocument

On Error GoTo err1
debug = 1 ' set to 0 for no debg output
DestinationDir = Trim$(DestinationDirectory)
If Right$( DestinationDir, 1)<>"\" Then DestinationDir = DestinationDir+"\"

' ====================================================
' Define tempfiles - if you manage to make the DXL export/import
' work without tempfiles, let me know !
' =====================================================
DXLTempfile = DestinationDir & "tmp_fileresources.dxl"

' ========================
' Create DXL export stream
' ========================
On Error Resume Next
Kill( DXLTempfile)
On Error GoTo err1
Set stream = session.CreateStream
If Not stream.Open( DXLTempfile,"UTF-8") Then
MessageBox "Cannot create " & DXLTempfile,, "Error"
Exit Sub
End If
Call stream.Truncate

' ===============================
' Build collection of design elements
' ===============================
If debug = 1 Then Print "Building design note document collection"

' ================================
' Export DesignNoteCollection as DXL
' ================================
If debug = 1 Then Print "Exporting image resources to " & DXLTempfile
'Set exporter = session.CreateDXLExporter(nc, stream)
Dim docExport As NotesDocument
Set docExport = db.Getdocumentbyunid("047D60B5DA6AAE384825776800317812")
Set exporter = session.CreateDXLExporter(docExport, stream)
Call exporter.Process
Call stream.Close

' =========================
' Import DXL for parsing
' =========================
If debug = 1 Then Print "Creating DXL import stream from " & DXLTempfile
Set inputStream = session.CreateStream
Call inputStream.Open ( DXLTempfile ,"UTF-8")

' =========================
' Parse DXL
' =========================
Print "Parsing DXL"
Set domParser=session.CreateDOMParser(inputStream)
domParser.Process
' =======================
' Get the root node
' ======================
Set rootNode = domParser.Document
' =========================
' Get all ImageResourceNodes
' =========================
'Set ImageResource_Nodes = RootNode.GetElementsByTagName( "imageresource" )
Set ImageResource_Nodes = RootNode.GetElementsByTagName( "jpeg" )
If debug=1 Then Print "Found " & ImageResource_Nodes.NumberOfEntries & " image resources"
If ImageResource_Nodes.NumberOfEntries=0 Then
Print "No <imageresource> node found - exiting"
GoTo finish
End If

' =============================================
' Browse all <imageresource> nodes and extract images
' from <gif> / <jpeg> child nodes
' =============================================


IRFilename = "DLTitle.jpg"

Set TempNode = ImageResource_Nodes.GetItem(1)
Set TempChildNode = TempNode.firstchild
' TempChild.NodeValue contains the base64 encoded image data

' Create output stream / file
If debug=1 Then Print "Create output file " & DestinationDir & IRFilename
Set outStream = session.CreateStream
On Error Resume Next
Kill (DestinationDir & IRFilename)
On Error GoTo err1
Call outStream.Open( DestinationDir & IRFilename, "binary")

' Create Input Stream and write Base64 data to stream
Set stream = session.CreateStream
MsgBox CStr(TempChildNode.NodeValue)
Call stream.WriteText(TempChildNode.NodeValue)

' Decode base64 and write to outstream / file
If debug=1 Then Print "Decoding Base64 to binary"
Set doc = New NotesDocument(session.CurrentDatabase )
Set MimeEntity = doc.CreateMIMEEntity
Call MimeEntity.SetContentFromBytes(stream,"", ENC_BASE64)
Call MimeEntity.GetContentAsBytes(outStream, True)
Call MimeEntity.DEcodeContent()
Call outstream.Close
Call stream.close

Call inputstream.close

finish:
If debug=1 Then Print "Removing tempfiles"
On Error Resume Next
Kill(DXLTempfile)
On Error GoTo err1
Print
Exit Sub

err1:
Print Error$ & " in line " & Erl
MessageBox Error$ & " in line " & Erl
Exit Sub
End Sub