Извлечь In-line Image из письма

  • Автор темы Lit
  • Дата начала
Статус
Закрыто для дальнейших ответов.
L
#1
Приветствую всех!
Возникла такая проблема: не могу извлечь in-line image из письма. Вложения (как EmbeddedObjects) извлекаются, а in-line image - нет, хоть ты тресни!

В письме есть внедренная картинка, не вложение, а именно inline.

Сначала получаю документ, затем GetFirstItem("Body"), узнаю тип (RICHTEXT), но EmbeddedObjects - пуст!
Где хранится in-line image?
Как к нему достучаться???

Спасибо заранее!
 
O

Odyssey

#3
Делал такое. Неделю убил
Задача на самом деле нетривиальная и без сохранения на диск не решается.
 

Omh

Lotus team
04.07.2007
2 210
1
#4
Науськай DXLExporter на документ, в получившемся XML увидишь все картинки/аттачменты закодированиые в Base64. Декодируй и всё.
 
O

Odyssey

#5
<!--QuoteBegin-Omh+4:07:2007, 10:37 -->
<span class="vbquote">(Omh @ 4:07:2007, 10:37 )</span><!--QuoteEBegin-->закодированиые в Base64. Декодируй и всё.
[snapback]71284" rel="nofollow" target="_blank[/snapback]​
[/quote]
ага. только функцию декодирования придется самому найти
 

Omh

Lotus team
04.07.2007
2 210
1
#6
Можно через MIME (на форуме Intertrust поищи), можно через найденную на просторах интернета LS библиотеку (меделнно), можно через внешнюю утилитку.
 
L
#7
Попробуй через notesDocument.EmbeddedObjects
Так я же говорю, что EmbeddedObjects - пуст, а картинка имеется (не как вложение, а как внедренная картинка, in-line image)

Делал такое. Неделю убил
Задача на самом деле нетривиальная и без сохранения на диск не решается.
Поделитесь, пожалуйста, своим решением.
 

Omh

Lotus team
04.07.2007
2 210
1
#8
Для: Lit
Ты через EmbeddedObjects не достучишься до вложенного изображения.
Бери DXLexporter, экспортируй документ, а дальше сам всё увидишь.
 
O

Odyssey

#9
<!--QuoteBegin-Lit+13:07:2007, 18:21 -->
<span class="vbquote">(Lit @ 13:07:2007, 18:21 )</span><!--QuoteEBegin-->Поделитесь, пожалуйста, своим решением.
[snapback]72266" rel="nofollow" target="_blank[/snapback]​
[/quote]
оно не совсем моё, собрал по кусочкаам на просторах интернета...

щас выложу, только лишнее вычищу :)
 
O

Odyssey

#10
млин, питалово вырубалось в очередной раз :)

надеюсь лишних переменных не поудалял.....

Код:
Sub Click(Source As Button)

Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
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 doc=ws.CurrentDocument.Document 	' current document
tempdir$=Environ("TEMP")
tempdir$=tempdir$ & "\"
' выгружаем xml 
Set exporter = session.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
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
 
D

Domino6

#11
В настройках клиента поставь опцию "Показывать инлайны как атачи" и далее работай с атачами
 
S

Sandr

#12
Смотря что нужно сделать с картинкой. Если ее просто куда то вставить нужно, то я делал так, не очень красиво, так как юзеру приходится наблюдать всякие перемигивания, но работает:

Call Doc.ReplaceItemValue ("Form" , "PictOnly") 'PictOnly - это форма, на которой есть только нужный нам РТитем

Set UIDoc = w.EditDocument (False , Doc , True) 'открываем док на редактирование
Call UIDoc.SelectAll 'Выделяем все что есть на форме (а это только нужный нам РТитем)
Call UIDoc.Copy 'получаем картинку в память
Call UIDoc.Close

А дальше вставляем куда надо...
 
Статус
Закрыто для дальнейших ответов.