当前位置: 代码迷 >> Lotus >> 怎么读取Lotus RTF域中的图片
  详细解决方案

怎么读取Lotus RTF域中的图片

热度:256   发布时间:2016-05-05 07:19:52.0
如何读取Lotus RTF域中的图片
我对Lotus不熟,最近做一个lotus数据迁移的项目
使用com组件来读取lotus中的信息,读取附件那些都没有问题,但是最近在读取RTF域的时候,发现不知道怎么把正文中的图片读取出来。RichTextItem对象返回的只有文本信息。
还望高手们不吝赐教!

------解决方案--------------------
如果是CS的话,可以用如下方法,尝试一下。
VBScript code
首先写一个函数,如下:Function   ExportPictures(doc   As   NotesDocument,   path   As   String)   As   Variant     '   ==================================================================     '   Exports   GIF   and   JPG   images   from   a   notes   document   into   given   destinationPath     '   Picture's   filename   is   path\<docid>_<number>.<extension>     '   Tempfile   used   is   path\Base64.tmp   which   is   deleted   after   export     '   Returns   a   list   of   strings   containing   filenames   of   exported   pictures   (if   any)     '   Base64   conversion   is   performed   with   Notes   internal   MIME   functions,   therefore       '   a   tempdoc   is   created   but   not   saved     '   ==================================================================     '   by   Guido   Purper   August   2005     '   ==================================================================      Dim   session   As   New   NotesSession       Dim   thisDB   As   NotesDatabase       Dim   doc2   As   NotesDocument       Dim   filename   As   String       Dim   f   As   Integer       Dim   counter   As   Integer       Dim   destinationPath   As   String       Dim   stream   As   NotesStream       Dim   mimeEntity   As   NotesMIMEEntity       Dim   mimeHeader   As   NotesMimeHeader       Dim   fileList   List   As   String       Dim   k(1   To   3,   1   To   3)   As   String       Dim   i   As   Integer       Dim   exporter   As   NotesDXLExporter       Dim   dxl   As   String       Dim   dxlPicture   As   String       Dim   dxlPictureType   As   String       Dim   key   As   String       Dim   p1   As   Long       Dim   p2   As   Long           On   Error   Goto   err1           Set   thisDB   =   session.CurrentDatabase       Set   exporter   =   session.CreateDXLExporter       exporter.ConvertNotesBitmapsToGIF   =   True         '   ================================     '   Initialize   some   variables     '   ================================       ExportPictures=""       Erase   FileList     '   ===   Key   for   imported   GIFs   ===       K(1,1)="<gif>" '   key   tag   in   dxl   stream       K(1,2)="</gif>" '   closing   tag   in   dxl   stream       K(1,3)="gif" '   file   extension     '   ===   Key   for   any   picture   converted   into   gif   ===       K(2,1)="<gif   originalformat='notesbitmap'>" '   key   tag   in   dxl   stream       K(2,2)="</gif>" '   closing   tag   in   dxl   stream       K(2,3)="gif" '   file   extension     '   ===   Key   for   JPEGs   ===       K(3,1)="<jpeg>" '   key   tag   in   dxl   stream       K(3,2)="</jpeg>" '   closing   tag   in   dxl   stream       K(3,3)="jpg" '   file   extension             '   ================================     '   Make   sure   destination   path   ends   with   a   \     '   ================================       If   Right$(path,1)="\"   Then           destinationPath=path       Else           destinationpath=path   &   "\"       End   If             '   ===========================================     '   Convert   document   into   DXL     '   ===========================================       dxl   =   exporter.Export(doc)     '   ---===   for   debugging   ===---     '   Print   "path="   &destinationPath     '   f   =   Freefile     '   Print   "Debug   output   to   "   &   destinationPath   &   "debug.dxl.txt"     '   Open   destinationPath   &   "debug.dxl.txt"   For   Output   As   f     '   Print   #f,     DXL     '   Close   f         '   =========================================     '   Remove   CRs   and   LFs   from   DXL     '   =========================================       dxl   =     Replace(dxl,   Chr$(13),   "")       dxl   =   Replace(dxl,   Chr$(10),   "")         '   ===========================================     '   Extract   picture   data   from   DXL   and   write   it   into   tempfile     '   ===========================================       For   i=1   To   3           key   =   K(i,1)           p1   =   Instr(p1+10,   dxl,   key   ,   5)           While   p1>0                 If   p1   >0   Then                   p2   =Instr(p1,   dxl,   k(i,2),   5)                   If   p2>0   Then                       dxlPictureType   =   K(i,3)                       dxlPicture   =   Mid$(dxl,   p1+Len(key),   p2-p1-Len(key))                         '   =====================     '   Save   DXL   into   tempfile     '   =====================                       f   =   Freefile                       Open   destinationPath   &   "Base64.tmp"   For   Output   As   f                       Print   #f,     DXLPicture                       Close   f                         '   ===========================================     '   Create   a   new   Notes   Document   with   embedded   picture     '   ===========================================                       session.ConvertMIME   =   False                         Set   Doc2   =   New   NotesDocument(ThisDB)                       Set   MIMEEntity=   doc2.CreateMIMEEntity                       Set   stream   =   session.CreateStream                       If   Not   stream.Open(path   &   "Base64.tmp"   , "binary")   Then                           Messagebox   "ExportPictures():   Open   tempfile   failed"                           Goto   MyExit                       End   If                       If   stream.Bytes   =   0   Then                           Messagebox   "ExportPictures():   Tempfile   is   empty"                           Goto   MyExit                       End   If                       Call   MimeEntity.SetContentFromBytes(stream,   "image/gif",   ENC_BASE64)                       Call   stream.Close                         '   =======================================     '     Save   embedded   picture   to   file     '   =======================================                       Set   stream   =   session.CreateStream                       filename   =   destinationPath   &   doc.NoteID   &   "_"   &   counter   &   "."   &     dxlPictureType                       On   Error   Resume   Next                       Kill   filename                       On   Error   Goto   err1                       If   Not   stream.Open(   filename,   "binary")   Then                           Messagebox   "ExportPictures():   Cannot   write   picture   "   &   filename                           Goto   MyExit                       End   If                       Set   MIMEEntity   =   doc2.GetMIMEEntity                       Call   MimeEntity.GetContentAsBytes(stream)                       Call   stream.Close()                       FileList(counter)   =   filename                       counter=counter+1                                       End   If '   p2>0               End   If 'p1>0               p1   =   Instr(p2+1,   dxl,   key   ,   5)           Wend       Next   i       MyExit:       session.ConvertMIME   =   True   '   Restore   conversion       On   Error   Resume   Next       Kill   path   &   "Base64.tmp"       Call   stream.Close()       On   Error   Goto   err1       ExportPictures   =   FileList       Exit   Function           err1:       Print     "ExportPictures():   "   &   Error$   &   "   in   line   "   &Erl       Messagebox     "ExportPictures():   "   &   Error$   &   "   in   line   "   &Erl       session.ConvertMIME   =   True       On   Error   Resume   Next       Kill   path   &   "Base64.tmp"       Call   stream.Close()       On   Error   Goto   0       Exit   Function       End   Function 在具体的位置调用,比如:Sub Initialize    On Error Goto er    Dim session As New notessession    Dim   doc   As   notesdocument       Set doc=session.Documentcontext    Call ExportPictures(doc,"c:\dxl\")        Exit Suber:    Msgbox "错误行:"+Cstr(Erl())End Sub 如果是附加的图片附件,只需要使用extractembeddobject方法就行。
  相关解决方案