title image


Smiley Oooops ...
Danke für den Hinweis !



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%, |

|+ strFile$ + ||

Close fileNum%

If uidoc.CurrentFieldmailField$ 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%,"" + descrLink$ + ""

Close fileNum%

If uidoc.CurrentFieldmailField$ 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("a") And 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



jo@chim
IBM Certified Advanced Application Developer - Lotus Notes and Domino 7


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: