в Lotus Notes R5, выгрузить фотографии не получилось ... нашел версию 6 и пробую выгружать через DXLExporter
все картинки выгружаются нормально
, кроме jpg ... если в поле 1 картинка, то выгружается нормально, если больше то функция виснит ...
Код агента на LotusScript:
Sub Initialize
' в предстовлении выбираем один документ
Dim ss As NotesSession
Dim ws As NotesUIWorkspace
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim doc As NotesDocument
Dim xl As Variant
Dim xlW As Variant
Dim strFile As String
Dim path As String
Dim rtitem As Variant
Dim object As NotesEmbeddedObject
Dim sizeInBytes As Long
Dim objectName As String
Dim counter As Integer
Dim outline As NotesOutline
Dim oe As NotesOutlineEntry
Dim exporter As NotesDXLExporter
Dim out As String
Dim filenum As Integer
Dim p1 As Long
Dim p2 As Long
Dim cnt As Integer
Set ss = New NotesSession
Set ws = New NotesUIWorkspace
Set db = ss.CurrentDatabase
Set docs = db.UnprocessedDocuments
Set doc = docs.GetFirstDocument()
For i = 1 To docs.Count
'Mkdir "r:\F\" & i
'path = "r:\F\" & i + "\"
'' Set doc=ws.CurrentDocument.Document ' current document
'tempdir$=Environ("TEMP")
'tempdir$=tempdir$ & "\"
tempdir$="r:\F" & "\"
' выгружаем xml
Set exporter = ss.CreateDXLExporter
exporter.ConvertNotesBitmapsToGIF = True
out = exporter.Export(doc)
filenum = Freefile
Open tempdir$ & "out.xml" For Output As filenum
Print #filenum, out
Close filenum
' выгружаем картинки
' gif
p1=1
While p1>0
p2=0
p1 = Instr(p1+10, out, "<gif>", 5)
If p1>0 Then p2 =Instr(p1, out, "</gif>", 5)
If p2>0 Then
Print "Exporting"
filenum = Freefile
filepath$ = tempdir$ & cnt & ".gif"
Open filepath$ For Output As filenum
Print #filenum, Base64Decode(Mid$(out, p1+5, p2-p1-5))
Close filenum
cnt = cnt + 1
End If
Wend
' 'Notes bitmap
p1=1
While p1>0
p2=0
p1 = Instr(p1+10, out, "originalformat='notesbitmap'>", 5)
If p1>0 Then p2 =Instr(p1, out, "</gif>", 5)
If p2>0 Then
Print "Exporting"
filenum = Freefile
filepath$ = tempdir$ & cnt & ".gif"
Open filepath$ For Output As filenum
Print #filenum, Base64Decode(Mid$(out, p1+30, p2-p1-30))
Close filenum
cnt = cnt + 1
End If
Wend
' jpeg
p1=1
While p1>0
p2=0
p1 = Instr(p1+10, out, "<jpeg>", 5)
If p1>0 Then p2 =Instr(p1, out, "</jpeg>", 5)
If p2>0 Then
Print "Exporting"
filenum = Freefile
filepath$ = tempdir$ & cnt & ".jpg"
Open filepath$ For Output As filenum
Print #filenum, Base64Decode(Mid$(out, p1+6, p2-p1-6))
Close filenum
cnt = cnt + 1
End If
Wend
Next
End Sub
а вот собственно декодирование найденное в дебрях инета (работает правда жутко медленно, если кто оптимизирует....)
Function Base64Decode( base64String_o) As String
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
Dim Base64String
Dim i As Long
Dim s As String
Dim eval As Variant
'remove white spaces, If any
' Print "Base64: Removing Whitespaces #13 "
base64String = base64String_o
' Print "Base64: Removing Whitespaces #13 "
base64String = Replace(base64String, Chr$(13), "")
' Print "Base64: Removing Whitespaces #10 "
base64String = Replace(base64String, Chr$(10), "")
' Print "Base64: Removing Whitespaces #9 "
base64String = Replace(base64String, Chr$(9), "")
' Print "Base64: Removing Whitespaces #32 "
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Messagebox "Bad string length must be a multiple of 4"
Exit Function
End If
' Now decode each group:
Print "Base64: Converting... "
For groupBegin = 1 To dataLength Step 4
' If groupBegin Mod 25 =0 Then Print "Base64: Converting "+Cstr( groupBegin )
' Each data group encodes up To 3 actual bytes.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' Convert each character into 6 bits of data, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = Instr(Base64, thisChar) - 1
End If
If thisData = -1 Then
Messagebox " Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
'Hex splits the long To 6 groups with 4 bits
nGroup = Hex(nGroup)
'Add leading zeros
nGroup = String(6 - Len(nGroup), "0") & nGroup
'Convert the 3 byte hex integer (6 chars) To 3 characters
pOut = Chr(Cbyte("&H" & Mid(nGroup, 1, 2))) + _
Chr(Cbyte("&H" & Mid(nGroup, 3, 2))) + _
Chr(Cbyte("&H" & Mid(nGroup, 5, 2)))
'add numDataBytes characters To out string
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function
