精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● 群件>>开发>>API调用>>如何用程序读取rtf域中文档链接的内容

主题:如何用程序读取rtf域中文档链接的内容
发信人: kamkam(KK)
整理人: kamkam(2002-05-04 21:55:45), 站内信件
问题是:我在rtf域中用程序(后者手工)appenddoclink将一个文档链接添加进去,现在想重新用程序,找到链接对应的文档,在lotusscript中没有相应的解决办法,用下面的api可以解决,但初步测试结果,无法处理中文数据库名。下面是原文照转的,自己稍微修改,就得到想要的结果了

%rem
RE: Creating a LinkHotspot in script
Posted by Rod Whiteley on 5.Feb.02 at 08:05 using Lotus Notes
Category: Domino Designer -- LotusScriptRelease: All ReleasesPlatform: All Platforms 
Here is a demo using LotusScript to call C API functions. Sub DisplayLinks looks at a named Rich Text item in a NotesDocument, and displays information about all the links it finds there. It's OK if the Rich Text is stored in multiple items with the same name. 

This demo has some limitations. It only finds one type of link hotspot, but it is the type that is usually present. It only works on Windows, but it's possible to adapt it for other platforms (except perhaps OS/400, which might require extra coding). It has almost no error checking, and has not been very well tested. 

To understand how the code works, you'll need the C API. To adapt it for your own purposes, I recommend NotesPeek for looking at the structure of Rich Text, and ZapNotes for restarting Notes when you crash it by doing bad things with handles. Both are in the Sandbox.
%end rem

Const APIModule = "NNOTES"  ' Windows/32 only
Const ERR_ITEM_NOT_FOUND = &H0222

Type BlockID
       hPool As Long
       Block As Integer
End Type

Type APIItem
       Item As BlockID
       Filler As Integer
       Value As BlockID
       Size As Long
End Type

Type NoteLink
       File(1) As Long  ' replica ID
       View(3) As Long  ' UNID
       Note(3) As Long  ' UNID
End Type

Declare Function NSFDbOpen Lib APIModule Alias "NSFDbOpen" _
(  Byval PathName As String, DbHandle As Long) As Integer
Declare Function NSFDbClose Lib APIModule Alias "NSFDbClose" _
(  Byval DbHandle As Long) As Integer

Declare Function NSFItemInfo Lib APIModule Alias "NSFItemInfo" _
(  Byval hNT As Long, Byval N As String, Byval nN As Integer, iB As BlockID, D As Integer, vB As BlockID, nV As Long) As Integer
Declare Function NSFItemInfoNext Lib APIModule Alias "NSFItemInfoNext" _
(  Byval hNT As Long, Byval pB As Currency, Byval N As String, Byval nN As Integer _
,  iB As BlockID, D As Integer, vB As BlockID, nV As Long) As Integer

Declare Function NSFNoteOpen Lib APIModule Alias "NSFNoteOpen" _
(  Byval DbHandle As Long, Byval NoteID As Long, Byval F As Integer, hNT As Long) As Integer
Declare Function NSFNoteClose Lib APIModule Alias "NSFNoteClose" _
(  Byval hNT As Long) As Integer

Declare Private Function OSMemAlloc Lib APIModule Alias "OSMemAlloc" _
(  Byval T As Integer, Byval S As Long, hM As Long) As Integer
Declare Private Function OSMemFree Lib APIModule Alias "OSMemFree" _
(  Byval hM As Long) As Integer
Declare Function OSLoadString Lib APIModule Alias "OSLoadString" _
(  Byval hMod As Long, Byval Status As Integer, Byval Buffer As String, Byval BufLen As Integer) As Integer
Declare Function OSLockObject Lib APIModule Alias "OSLockObject" _
(  Byval H As Long) As Long
Declare Sub OSUnlockObject Lib APIModule Alias "OSUnlockObject" _
(  Byval H As Long)
Declare Function OSPathNetConstruct Lib APIModule Alias "OSPathNetConstruct" _
(  Byval NullPort As Long, Byval Server As String, Byval FIle As String, Byval PathNet As String) As Integer

Declare Sub NEMDisplayError Lib "NNOTESWS" Alias "NEMDisplayError" _
(  Byval E As Long)

Declare Private Sub Peek Lib "MSVCRT" Alias "memcpy" _
(  D As Any, Byval P As Long, Byval N As Long)
Declare Private Sub Poke Lib "MSVCRT" Alias "memcpy" _
(  Byval P As Long, D As Any, Byval N As Long)
Declare Private Sub PeekString Lib "MSVCRT" Alias "memcpy" _
(  Byval S As String, Byval P As Long, Byval N As Long)
Declare Private Sub PokeString Lib "MSVCRT" Alias "memcpy" _
(  Byval P As Long, Byval S As String, Byval N As Long)
Declare Private Sub CopyMem Lib "MSVCRT" Alias "memcpy" _
(  Byval D As Long, Byval S As Long, Byval N As Long)
Declare Private Sub CopyLS Lib "MSVCRT" Alias "memcpy" _
(  D As Any, S As Any, Byval N As Long)

Sub DisplayLinks(doc As NotesDocument, item$)
       ' construct the full path...
       db$ = Space(1024)
       With doc.ParentDatabase
              OSPathNetConstruct 0, .Server, .FilePath, db$
       End With
       
       ' open the database...
       Dim hDB As Long
       NSFDbOpen db$, hDB
       If hDB = 0 Then Exit Sub
       
       ' open the note...
       Dim hNT As Long
       NSFNoteOpen hDB, Clng("&H" & doc.NoteID), 0, hNT
       If hNT = 0 Then
              NSFDbClose hDB
              Exit Sub
       End If
       
       ' read the $Links data into an array...
       Dim Link() As NoteLink
       Dim iB As BlockID, vB As BlockID
       NSFItemInfo hNT, "$LINKS", 6, iB, dt%, vB, nv&
       If vB.hPool = 0 Then  ' no links
              NSFNoteClose hNT
              NSFDbClose hDB
              Exit Sub
       Else
              pp& = OSLockObject(vB.hPool) + vB.Block
              Peek n%, pp& + 2, 2
              Redim Link(n% - 1)
              Peek Link(0).File(0), pp& + 4, n% * 40
              OSUnlockObject vB.hPool
       End If
       
       ' read all the Rich Text item info into an array...
       Redim A(0) As APIItem
       m% = 0  ' counter
       tt& = 0  ' total bytes
       NSFItemInfo hNT, item$, Len(item$), A(m%).Item, dt%, A(m%).Value, A(m%).Size
       While Not A(m%).Size = 0
              tt& = tt& + A(m%).Size
              m% = m% + 1
              Redim Preserve A(m%)
              ItemInfoNext hNT, A(m% - 1).Item, item$, Len(item$), A(m%).Item, dt%, A(m%).Value, A(m%).Size
       Wend
       m% = m% - 1
       
       ' copy the actual Rich Text into a memory block...
       Dim hM As Long
       OSMemAlloc 0, tt&, hM
       pm& = OSLockObject(hM)
       pp& = pm&
       For i% = 0 To m%
              Dim aa As APIItem
              aa = A(i%)
              na& = aa.Size - 2
              pv& = OSLockObject(aa.Value.hPool) + aa.Value.Block + 2
              CopyMem pp&, pv&, na&
              OSUnlockObject aa.Value.hPool 
              pp& = pp& + na&
       Next
       
       ' scan the Rich Text for composite data records...
       Do
              GetCD pm&, tt&, toff&, tlen&, sig%
              If sig% = 145 Then  ' CDLINK2
                     Peek clength%, pm& + toff& + 2, 2
                     Peek cindex%, pm& + toff& + 4, 2
                     s% = clength% - 6
                     t$ = Space(s%)
                     PeekString t$, pm& + toff& + 6, s%
                     p% = Instr(t$, Chr$(0))
                     comment$ = Left$(t$, p% - 1)
                     t$ = Mid$(t$, p% + 1)
                     p% = Instr(t$, Chr$(0))
                     hint$ = Left$(t$, p% - 1)
                     t$ = Mid$(t$, p% + 1)
                     p% = Instr(t$, Chr$(0))
                     anchor$ = Left$(t$, p% - 1)
                     dbID$ = ReplicaID(Link(cindex%))
                     vwID$ = ViewUNID(Link(cindex%))
                     docID$ = DocumentUNID(Link(cindex%))
                     Messagebox "CDLINK2 at &H" & Hex$(toff&) & " length: &H" & Hex$(clength%) & " index: " & Cstr(cindex%) _
                     & Chr$(10) & comment$ _
                     & Chr$(10) & "Replica: " & dbID$ _
                     & Chr$(10) & "View: " & vwID$ _
                     & Chr$(10) & "Note: " & docID$ _
                     & Chr$(10) & "Anchor: " & anchor$ _
                     & Chr$(10) & "Server hint: " & hint$
              End If
       Loop Until sig% = 0
       
       ' clean up...
       OSUnlockObject hM
       OSMemFree hM
       
       NSFNoteClose hNT
       NSFDbClose hDB
End Sub

Function DocumentUNID(L As NoteLink) As String
       DocumentUNID = "OF" & LongHex(L.Note(1)) & ":" & LongHex(L.Note(0)) _
       & "-ON" & LongHex(L.Note(3)) & ":" & LongHex(L.Note(2))
End Function

Sub GetCD(pointer As Long, length As Long, cdoffset As Long, cdlength As Long, cdsig As Integer)
       Static R As Long
       
       Do
              Peek i%, pointer + R, 2
              cdsig% = i% And &HFF
              cdlength = (i% And &HFF00) / 256
              If cdlength = -1 Then
                     cdlength = 0
                     Peek cdlength, pointer + R + 2, 2
              Elseif cdlength = 0 Then
                     Peek cdlength, pointer + R + 2, 4
              End If
              cdoffset = R
              If cdsig% = 0 Then R = R + 1 Else R = R + cdlength
       Loop Until R >= length Or Not cdsig% = 0
       
       If R >= length Then
              cdoffset = 0
              cdlength = 0
              cdsig% = 0
              R = 0
       End If
End Sub

Private Sub ItemInfoNext(hNT&, pB As BlockID, N$, nN%, iB As BlockID, D%, vB As BlockID, nV&)
       Dim pBc As Currency
       Dim Z(1) As Long
       Z(1) = 0
       CopyLS pBc, Z(0), 8
       CopyLS pBc, pB.hPool, 6
       st% = NSFItemInfoNext(hNT&, pBc, N$, nN%, iB, D%, vB, nV&)
       If Not st% = 0 And Not st% = ERR_ITEM_NOT_FOUND Then Error 1000, "API error &H" & Hex$(st%)
End Sub

Function LongHex(N As Long) As String
       LongHex = Right$(String$(7, "0") & Hex$(N), 8)
End Function

Function ReplicaID(L As NoteLink) As String
       ReplicaID = LongHex(L.File(1)) & ":" & LongHex(L.File(0))
End Function

Function ViewUNID(L As NoteLink) As String
       ViewUNID = "OF" & LongHex(L.View(1)) & ":" & LongHex(L.View(0)) _
       & "-ON" & LongHex(L.View(3)) & ":" & LongHex(L.View(2))
End Function


【 在 dingxiang 的大作中提到:】 
搞定了。可以支持中文! 
Declare Function NSFDbOpen Lib APIModule Alias "NSFDbOpen" _  
(  Byval PathName As Lmbcs  String, DbHandle As Long) As Integer 

[关闭][返回]