Option Public
%REM
setFileLink()
Dateiverknüpfung mit Prüfung auf gültigen Pfad im Frontend per Lotus Script
setWebLink("www.MeineRessource.de")
Hotspot-Erstellung auf Web-Ressource im Frontend per Lotus Script
1. Code als LS-Library "FileLinker" in der Mail-DB speichern
2. Im Mailformular (Memo) per
Use "FileLinker"
einbinden.
By jo@chim 2003 - gullugullu@gmx.net
Modified by stoeps 21.1.03
Modified by jo@chim 22.1.03
have fun ! don't remove this disclaimer if you publish the code
%END REM
Public Const mailField$="Body" 'Name des RT-Feldes
Public Const dlgTitle$="Dateiverknüpfung setzen" 'Titel der Dateiauswahldialogbox
Public Const errTitle$="Datei kann nicht verknüpft werden" 'Titel der Fehlermeldungsbox
Public Const strLink$="Klicken Sie hier, um die Ressource zu öffnen" 'Text des Hotspots
'Diverse Fehlermeldungen für die Dateiverknüpfung - bitte melden, falls ich welche vergessen habe:;)
Public Const errMsg0$="Allgemeiner Fehler"
Public Const errMsg1$="Ungültiges Laufwerk"
Public Const errMsg2$="Netzwerk nicht verfügbar"
Public Const errMsg3$="Kritischer Fehler"
Public Const errMsg4$="More Data"
Public Const errMsg5$="Funktion nicht unterstützt"
Public Const errMsg6$="Kein Netzwerk verfügbar oder ungültiger Pfad"
Public Const errMsg7$="Kein Netzwerk installiert"
Public Const errMsg8$=|Sie haben ein lokales Laufwerk ausgewählt
oder sind nicht mit dem Netzwerk verbunden|
Declare Function NEMGetFile Lib "NNOTESWS" Alias "NEMGetFile" _
( Z As Integer, Byval N As Lmbcs String, Byval F As Lmbcs String, Byval T As Lmbcs String ) As Integer
Dim UNC As String * 512
Declare Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" _
(Byval lpszLocalName As String, _
Byval lpszRemoteName As String, _
cbRemoteName As Long) As Long
Sub setFileLink()
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
n$ = String$(1024, " ")
ret% = NEMGetFile( 0, n$,"" , dlgTitle$)
If ret% = 0 Then Exit Sub
strFile$ = Fulltrim(n$)
If Mid$(strFile$,2,1)=":" Then strFile$=Fulltrim(GetUNCPath(Left$(strFile$,2)))+Right$(strFile$,Len(strFile$)-2)
If Left$(strFile$,2)<>"\\" Then Exit Sub
tmpStrFile$=Escape(strFile$)
Set uidoc = ws.CurrentDocument
fileNum% = Freefile()
tmpFile$ = Environ$("temp")+"\~tmpFile.htm"
Open tmpFile$ For Output As fileNum%
Print #fileNum%, |<html><meta http-equiv="content-type" content="text/html" charset="iso-8859-1">
<a href="file:///| +tmpstrFile$ + |" >|+ strFile$ + |</a></html>|
Close fileNum%
If uidoc.CurrentField<>mailField$ Then uidoc.GotoField( mailField$ )
Call uidoc.Import("HTML File",tmpFile$)
End Sub
Sub setWeblink(strFile$)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
descrLink$=strLink$
' oder descrLink$=strFile$ falls der Link erscheinen soll
Set uidoc = ws.CurrentDocument
fileNum% = Freefile()
tmpFile$ = Environ$("temp")+"\~tmpFile.htm"
Open tmpFile$ For Output As fileNum%
Print #fileNum%,"<html><a href=""http:\\" + strFile$ + """>" + descrLink$ + "</a></html>"
Close fileNum%
If uidoc.CurrentField<>mailField$ Then uidoc.GotoField( mailField$ )
Call uidoc.Import("HTML File",tmpFile$)
End Sub
Public Function GetUNCPath(strDriveLetter As String) As String
On Error Goto GetUNCPath_Err
Dim lngReturn As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName= strDriveLetter
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName)
Select Case lngReturn
Case 1200&
msg$ = errmsg1$
Case 1201&
msg$ = errmsg2$
Case 1208&
msg$ = errmsg3$
Case 234
msg$ = errmsg4$
Case 50&
msg$ = errmsg5$
Case 1203&
msg$ = errmsg6
Case 1222&
msg$ = errmsg7$
Case 2250&
msg$ = errmsg8$
Case 0
End Select
If Len(msg$) Then
Msgbox msg$,16,errTitle$
Else
GetUNCPath = Left$(lpszRemoteName, cbRemoteName)
End If
GetUNCPath_End:
Exit Function
GetUNCPath_Err:
Msgbox errmsg0$,16,errTitle$
Resume GetUNCPath_End
End Function
Function Escape(s As String) As String
%REM
Code kopiert von openntf.org Projekt codebin:
Brief Description: LotusScript version of JavaScript's escape function
Rating: Not Rated Yet
Contributor: John Smart
Category: Lotusscript
Type: String functions
Notes Version: R5.x, R6.x
Last Modified: 20 Aug 2002
Encodes a string to the "x-www-form-urlencoded" form, enhanced with the UTF-8-in-URL proposal. This is the official
standard to encode URL's to support any possible character set (all Unicode characters).
Angepaßt am 21.1.03 C. Stoettner
%END REM
Dim result As String
Dim i As Integer
Dim c As Long
For i = 1 To Len(s)
c = Uni(Mid$(s, i, 1))
If c = Uni(" ") Then
result = result + "%20"
Elseif (c>=Uni("A") And c<=Uni("Z")) Or (c>=Uni("a") And c<=Uni("z")) Or (c>=Uni("0") And c<=Uni("9")) Then
result = result + Uchr(c)
Elseif c = Uni("ä") Then
result = result + "%E4"
Elseif c = Uni("ö") Then
result = result + "%F6"
Elseif c = Uni("ü") Then
result = result + "%FC"
Elseif c = Uni("Ä") Then
result = result + "%C4"
Elseif c = Uni("Ö") Then
result = result + "%D6"
Elseif c = Uni("Ü") Then
result = result + "%DC"
Elseif c = Uni("ß") Then
result = result + "%DF"
Else
result = result + Uchr(c)
End If
Next
Escape = result
End Function