MakeURLHotspot

[Stephane Maillard]

[syntax="ls"]Const wAPIModule = "NNOTES" ' Windows/32

Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( Byval P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( Byval hDB As Long) As Integer
Declare Private Function NSFItemAppend Lib wAPIModule Alias "NSFItemAppend" _
( Byval hNT As Long, Byval F As Integer, Byval N As String, Byval nN As Integer _
, Byval T As Integer, Byval V As Long, Byval nV As Long) As Integer
Declare Private Function NSFNoteOpen Lib wAPIModule Alias "NSFNoteOpen" _
( Byval hDB As Long, Byval NoteID As Long, Byval F As Integer, hNT As Long) As Integer
Declare Private Function NSFNoteClose Lib wAPIModule Alias "NSFNoteClose" _
( Byval hNT As Long) As Integer
Declare Private Function NSFNoteUpdate Lib wAPIModule Alias "NSFNoteUpdate" _
( Byval hNT As Long, Byval F As Integer) As Integer
Declare Private Function OSLockObject Lib wAPIModule Alias "OSLockObject" _
( Byval H As Long) As Long
Declare Private Sub OSUnlockObject Lib wAPIModule Alias "OSUnlockObject" _
( Byval H As Long)
Declare Private Function OSMemAlloc Lib wAPIModule Alias "OSMemAlloc" _
( Byval T As Integer, Byval S As Long, hM As Long) As Integer
Declare Private Function OSMemFree Lib wAPIModule Alias "OSMemFree" _
( Byval hM As Long) As Integer
Declare Private Function OSPathNetConstruct Lib wAPIModule 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 Poke Lib "MSVCRT" Alias "memcpy" _
( Byval P As Long, S As Any, Byval N As Long)

Sub MakeURLHotspot(doc As NotesDocument, item$, text$, URL$)

font& = &H0A040401 ' 10 pt, blue, underline, Default Sans

nURL% = Len(URL$)
alignURL% = nURL% Mod 2

nText% = Len(text$)
alignText% = nText% Mod 2

If doc.IsNewNote Then doc.Save True, False

With doc.ParentDatabase
pn$ = Space(1024)
OSPathNetConstruct 0, .Server, .FilePath, pn$
End With

Dim hDB As Long
NSFDbOpen pn$, hDB
If hDB = 0 Then Exit Sub

Dim hNT As Long
NSFNoteOpen hDB, Clng("&H" & doc.NoteID), 0, hNT
If hNT = 0 Then
NSFDbClose hDB
Exit Sub
End If

Dim hM As Long
OSMemAlloc 0, 256 + nText% + 2 * nURL%, hM
p& = OSLockObject(hM)
p0& = p& ' remember start

PokeWord p&, &HFF82 ' CDPabDefinition
PokeWord p&, &H0052 ' length
PokeWord p&, 1 ' ID
PokeWord p&, 0 ' justify
PokeWord p&, 0 ' line spacing
PokeWord p&, 0 ' para spacing above
PokeWord p&, 1 ' para spacing below
PokeWord p&, 1440 ' left margn
PokeWord p&, 0 ' right margn
PokeWord p&, 1440 ' 1st line margn
PokeWord p&, 0 ' tab count
For i% = 1 To 20
PokeWord p&, 0 ' tabs
Next
PokeWord p&, &H0100 ' flags
PokeLong p&, 0 ' tab flags
PokeWord p&, &H0494 ' flags2
PokeWord p&, 1440
PokeWord p&, 9
PokeWord p&, 1440
PokeWord p&, 9
PokeLong p&, 0

PokeWord p&, &H0483 ' CDPabReference
PokeWord p&, 1 ' ID

PokeWord p&, &HFF85 ' CDText
PokeWord p&, 8 ' length: no text
PokeLong p&, font&

PokeWord p&, &H06DD ' CDBegin
PokeWord p&, 0 ' version
PokeWord p&, &HFFAD ' sig: CDHotspot

PokeWord p&, &HFF7E ' CDHotspotBegin V5
PokeWord p&, 12 ' length
PokeWord p&, &H20 ' type: RC link
PokeLong p&, 8 ' flags: no border
PokeWord p&, 0 ' data length

PokeWord p&, &HFFF6 ' CDResource
PokeWord p&, 26 + nURL% ' length
PokeLong p&, 0 ' flags
PokeWord p&, 1 ' type: URL
PokeWord p&, 0 ' class
PokeWord p&, nURL%
PokeWord p&, 0 ' n/a
PokeWord p&, 0 ' n/a
PokeLong p&, 0 ' unused
PokeLong p&, 0 ' unused
PokeString p&, URL$
If alignURL% = 1 Then PokeByte p&, 0 ' align

PokeWord p&, &HFFAD ' CDHotspotBegin V4
PokeWord p&, 13 + nURL% ' length
PokeWord p&, 11 ' type: hotlink
PokeLong p&, &H1008 ' flags: no border, INotes
PokeWord p&, nURL% + alignURL%
PokeString p&, URL$
If alignURL% = 1 Then PokeByte p&, 0 Else PokeWord p&, 0 ' align

PokeWord p&, &H06DD ' CDBegin
PokeWord p&, 0 ' version
PokeWord p&, &HFF85 ' sig: CDText

PokeWord p&, &HFF85 ' CDText
PokeWord p&, 8 + nText% ' length
PokeLong p&, font&
PokeString p&, text$
If alignText% = 1 Then PokeByte p&, 0 ' align

PokeWord p&, &H08D2 ' CDColor
PokeWord p&, 9 ' flags: system, RGB
PokeLong p&, &H00FF0000 ' RGB: blue

PokeWord p&, &H06DE ' CDEnd
PokeWord p&, 0 ' version
PokeWord p&, &HFF85 ' sig: CDText

PokeWord p&, &H02AE ' CDHotSpotEnd R4

PokeWord p&, &H06DE ' CDEnd
PokeWord p&, 0 ' version
PokeWord p&, &H00AE ' sig: CDHotSpotEnd R4

PokeWord p&, &HFF85 ' CDText
PokeWord p&, 8 ' length: no text
PokeLong p&, font&

s% = NSFItemAppend(hNT, 0, item$, Len(item$), 1, p0&, p& - p0&)
If Not s% = 0 Then NEMDisplayError s%

OSUnlockObject hM
OSMemFree hM

s% = NSFNoteUpdate(hNT, 0)
If Not s% = 0 Then NEMDisplayError s%

NSFDbClose hDB
End Sub

Sub PokeByte(p&, b%)
Poke p&, b%, 1
p& = p& + 1
End Sub

Sub PokeWord(p&, w%)
Poke p&, w%, 2
p& = p& + 2
End Sub

Sub PokeLong(p&, v&)
Poke p&, v&, 4
p& = p& + 4
End Sub

Sub PokeString(p&, s$)
For i% = 1 To Len(s$)
Poke p&, Asc(Mid$(s$, i%, 1)), 1
p& = p& + 1
Next
End Sub[/syntax]

[oguruma]

on voit les anciens du Basic sur TRS 80/Amiga/Dragon 32/Victor S1/TO 7/MO 5 et j'en passe....

Les peek et poke permettant de faire l'assembleur avec un usr(0) au final...