Page 1 sur 1
Générer l'URL web (HTTP) d'un document
Publié:
20 Juin 2006 à 10:01par Michael DELIQUE
- Code : Tout sélectionner
Public Function HttpURL_LS(wDoc As NotesDocument,wServer As String, wnbUNID As Integer, wnbLocal As Integer) As String
'wnbUNID = true passe l'id de replique au lieux du pathfile de la base
'wnbLocal = true autorise la creation si la base est en local
'Déclaration Variable
Dim DBURL As NotesDatabase
Dim nmServer As NotesName
Dim Server As String
On Error Goto ErreurHandle
HttpURL_LS = ""
If wDoc Is Nothing Then
Error 9999,"wDoc is nothing"
Exit Function
End If
Set DBURL = wDoc.ParentDatabase
If DBExists_LS(DBURL) = False Then
Error 9999, "DBURL is Nothing"
Exit Function
End If
If Trim(wServer) = "" Then
If wnbLocal = False Then
If Trim(DBURL.Server) = "" Then
Error 9999,"DBUrl is local"
Exit Function
End If
End If
End If
If Trim(wServer) = "" Then
If Trim(DBURL.Server) = "" Then
Server = "127.0.0.1"
Else
Set nmServer = New NotesName(DBURL.Server)
Server = nmServer.Common
Set nmServer = Nothing
End If
Else
Set nmServer = New NotesName(Trim(wServer))
Server = nmServer.Common
Set nmServer = Nothing
End If
If wnbUNID = True Then
HttpURL_LS = "http://"+ Server +"/"+DBURL.filepath+"/0/"+ wDoc.Universalid +"?opendocument"
Else
HttpURL_LS= "http://"+ Server +"/__"+Cstr(DBURL.ReplicaID)+".NSF/0/"+ wDoc.Universalid +"?opendocument"
End If
Set DBURL = Nothing
Server = ""
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
HttpURL_LS = ""
Exit Function
End Function
- Code : Tout sélectionner
Public Function DBExists_LS(wdb As NotesDatabase) As Integer
'teste si une base de donnée est accéssible
' renvoi true si elle est accéssible
' renvoi false si elle n'est pas accessible
On Error Goto ErreurDBExists_LS
'teste si la variable est renseigné
If wDB Is Nothing Then
DBExists_LS = False
Exit Function
Else
'teste si la base est ouverte
If wDB.IsOpen = True Then
'teste si la base existe réelement il faut que la date de crétation existe ainsi que l'id de réplique
If Trim(Cstr(wDB.Created)) = "" Or Trim(Cstr(wDB.ReplicaID)) = "" Then
DBExists_LS = False
Exit Function
End If
Else
DBExists_LS = False
Exit Function
End If
End If
DBExists_LS = True
Exit Function
ErreurDBExists_LS:
Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
DBExists_LS = False
Exit Function
End Function