The following functions will help you convert image files attached in documents into image resources in the same database. Probable you may have to remove fragments that you dont want to use.
'**************************************************************
'@Purpose : To process file attachments and
' convert the same into image resources in the current database
'**************************************************************
Private Function ProcessAttachments(imageName As String,flag As String,imagePath As String) As Boolean
'mark the flow of control getting inside the current function
ProcessAttachments=False
'declare variables and objects necessary for further manipulations
Dim session As New notessession
Dim tempFolderPath As String
Dim directory As String
Dim db As NotesDatabase
Dim tempDoc As NotesDocument
Dim entity As NotesMimeEntity
Dim imageSize As Long
'handle errors in case of abrupt termination
On Error Goto processAttErrHandler
'set the handle of the current database
Set db = session.CurrentDatabase
directory = tempFolderPath
'create a temporary document to contain the mime entity of the images
Set tempDoc = db.CreateDocument
If Not( CreateMIMEEntity(imagePath, tempDoc, entity, imageSize)) Then
Exit Function
End If
'create a dxl file of the created mime type
If Not CreateDXLFile( imagePath, entity, imageSize) Then
Exit Function
End If
'import the created dxl file as image resource
If Not ImportDXLFile( imagePath, db) Then
Exit Function
End If
'destroy the file created in the temporary folder
Kill imagePath
'mark the flow of control getting out of the current function
ProcessAttachments=True
Exit Function
'log the errors that resulted in abrupt termination
processAttErrHandler:
Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***" _
& Cstr(Err) & "*** in Method ""ProcessAttachments"" in script Library ""lsLookAndFeel"""
Exit Function
End Function
'****************************************************************
'@Created : 2008/09/12
'@Purpose : To create a dxl file that resembles the dxl of design elements in Image resources
' provided the mime type of an image file
'****************************************************************
Private Function CreateDXLFile( imagePath As String, entity As NotesMimeEntity, imageSize As Long)
'mark the flow of control getting inside the current function
CreateDXLFile=False
'declare all variables and objects necessary for furhter manipulation
Dim session As New notessession
Dim stream As NotesStream
Dim directory As String
Dim imageName As String
'initiation
'handle errors in case of abrupt termination
On Error Goto errHandler
If Instr(imagePath, "\") <> 0 Then
directory = Strleftback(imagePath, "\") & "\"
imageName = Strrightback(imagePath, "\")
Else
directory = Strleftback(imagePath, "/") & "/"
imageName = Strrightback(imagePath, "/")
End If
'create a stream
Set stream = session.CreateStream
If Not stream.Open(directory & Strleftback(imageName, ".") & ".dxl", "ISO-8859-1") Then
Error 1405, "Cannot create file " & directory & Strleftback(imageName, ".") & ".dxl on the server."
End If
Call stream.WriteText({})
Call stream.WriteText({
Call stream.WriteText({ noreplace='true' publicaccess='false' designerversion='7'>})
If Right(Lcase(imageName), 4) = ".gif" Then
Call stream.WriteText({})
Call stream.WriteText(entity.ContentAsText)
Call stream.WriteText({})
Else
Call stream.WriteText({})
Call stream.WriteText(entity.ContentAsText)
Call stream.WriteText({})
End If
Call stream.WriteText({- })
Call stream.WriteText(Cstr(imageSize) & { })
Call stream.WriteText({- })
If Right(Lcase(imageName), 4) = ".gif" Then
Call stream.WriteText({image/gif})
Else
Call stream.WriteText({image/jpeg})
End If
Call stream.WriteText({ })
Call stream.WriteText({- })
Call stream.WriteText(Format$(Now, "YYYYMMDD") & "T" & Format$(Now, "HHMMSS") & ",00-00")
Call stream.WriteText({ })
Call stream.WriteText({})
Call stream.Close
'mark the flow of control movingout of the current function
CreateDXLFile=True
Exit Function
'log the error that resulted in abrupt termination
errHandler:
Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***" _
& Cstr(Err) & "*** in Method ""CreateDXLFile"" in script Library ""lsLookAndFeel"""
Exit Function
End Function
'****************************************************************
'@Created : 2008/09/12
'@Purpose : To create mime content of an image file
'****************************************************************
Function CreateMIMEEntity( imagePath As String, tempDoc As NotesDocument, entity As NotesMimeEntity, imageSize As Long)As Boolean
'mark the flow of control getting inside the current function
CreateMIMEEntity=False
'declare variables and objects necessary for further manipulation
Dim session As New notessession
Dim stream As NotesStream
'initiation
'handler errors in case of abrupt termination
On Error Goto mimeErrHandler
'create a stream object
Set stream = session.CreateStream
If Not stream.Open(imagePath) Then
Error 1404, "Cannot open file " & imagePath & " for processing."
Exit Function
End If
imageSize = stream.Bytes
Call tempDoc.ReplaceItemValue("Form", "Temporary Document")
Set entity = tempDoc.CreateMIMEEntity
If Right(Lcase(imagePath), 4) = ".gif" Then
Call entity.SetContentFromBytes(stream, "image/gif", ENC_NONE)
Else
Call entity.SetContentFromBytes(stream, "image/jpeg", ENC_NONE)
End If
Call entity.EncodeContent(ENC_BASE64)
Call stream.Close
'mark the flow of control moving out of the current function
CreateMIMEEntity=True
Exit Function
mimeErrHandler:
Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***" _
& Cstr(Err) & "*** in Method ""CreateMIMEEntity"" in script Library ""lsLookAndFeel"""
Exit Function
End Function
'****************************************************************
'@Created : 2008/09/12
'@Purpose : To import a dxl file in to the current database
'****************************************************************
Private Function ImportDXLFile( imagePath As String, db As NotesDatabase) As Boolean
'mark the flow of control getting inside the current function
ImportDXLFile=False
'declaring variables and objects necessary for further manipulation
Dim session As New notessession
Dim stream As NotesStream
Dim importer As NotesDXLImporter
Dim dxlPath As String
'initiation
'handle errors in case of abrupt termination
On Error Goto errHandler
dxlPath = Strleftback(imagePath, ".") & ".dxl"
Set stream = session.CreateStream
If Not stream.Open(dxlPath, "ISO-8859-1") Then
Error 1406, "Cannot open file " & dxlPath & " after it was created."
End If
Set importer = session.CreateDXLImporter(stream, db)
importer.ReplaceDBProperties = False
importer.ReplicaRequiredForReplaceOrUpdate = False
importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_CREATE
Call importer.Process
Call stream.Close
'mark the flow of control movingout of the current function
ImportDXLFile=True
Exit Function
'log the errors that resulted in abrupt termination
errHandler:
Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***" _
& Cstr(Err) & "*** in Method ""ImportDXLFile"" in script Library ""lsLookAndFeel"""
Exit Function
End Function