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

Тема в разделе "Lotus - Программирование", создана пользователем Lit, 28 июн 2007.

Статус темы:
Закрыта.
  1. Lit

    Lit Гость

    Приветствую всех!
    Возникла такая проблема: не могу извлечь in-line image из письма. Вложения (как EmbeddedObjects) извлекаются, а in-line image - нет, хоть ты тресни!

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

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

    Спасибо заранее!
     
  2. Medevic

    Medevic Что это ? :)
    Lotus team

    Регистрация:
    10 дек 2004
    Сообщения:
    3.346
    Симпатии:
    2
    Попробуй через notesDocument.EmbeddedObjects
     
  3. Odyssey

    Odyssey Гость

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

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    Науськай DXLExporter на документ, в получившемся XML увидишь все картинки/аттачменты закодированиые в Base64. Декодируй и всё.
     
  5. Odyssey

    Odyssey Гость

    <!--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]
    ага. только функцию декодирования придется самому найти
     
  6. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    Можно через MIME (на форуме Intertrust поищи), можно через найденную на просторах интернета LS библиотеку (меделнно), можно через внешнюю утилитку.
     
  7. Lit

    Lit Гость

    Так я же говорю, что EmbeddedObjects - пуст, а картинка имеется (не как вложение, а как внедренная картинка, in-line image)

    Поделитесь, пожалуйста, своим решением.
     
  8. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    Для: Lit
    Ты через EmbeddedObjects не достучишься до вложенного изображения.
    Бери DXLexporter, экспортируй документ, а дальше сам всё увидишь.
     
  9. Odyssey

    Odyssey Гость

    <!--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]
    оно не совсем моё, собрал по кусочкаам на просторах интернета...

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

    Odyssey Гость

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

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

    Код (Text):
     
    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
    а вот собственно декодирование найденное в дебрях инета (работает правда жутко медленно, если кто оптимизирует....)

    Код (Text):
    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
     
  11. Domino6

    Domino6 Гость

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

    Sandr Гость

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

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

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

    А дальше вставляем куда надо...
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей