发信人: 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 |
|