DominoArea.org [Archive]

Code : Tout sélectionner

Public Function AgentUNID(wAgent As NotesAgent)
   On Error Goto ErrorHandle
   
   AgentUNID = ""
   
   If wAgent Is Nothing Then
      Error 9999,"wAgent is Nothing"
      Exit Function
   End If
   
   AgentUNID = Strleft(Strright(Ucase(wAgent.NotesURL),"NSF/"),"?OPENAGENT")
   
   Exit Function
ErrorHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   AgentUNID = ""
   Exit Function
End Function

Jérôme Deniau a écrit:Chacun sa version
http://www-10.lotus.com/ldd/nd6forum.ns ... enDocument
(JYR): http://www-10.lotus.com/ldd/nd6forum.ns ... 0,notesurl

A mon avis il est plus fiable de passer par l'api C car NotesURL ne concerne que le protocole Notes

Style de la fonction de notes

Declare Function NIFFindDesignNote Lib "nnotes.dll" (Byval dbHandle As Long, Byval Name As String, Byval Class As Integer, retNoteID as Long) as integer

adapter le nnotes.dll pour mac et linux bien sûr....

Code : Tout sélectionner

Function AgentUNID_API(wAgent As NotesAgent) As String
   
   'récupere l'ID de l'agent passé en parametre
   
   Dim DBCible As NotesDatabase
   Const NOTE_CLASS_FILTER = &H0200   
   Dim Space1024 As String
   Dim nbHandleDB As Long
   Dim nbAgentID As Long
   Dim nbPseudo As Integer
   Dim ti As String
   Dim NameAgent As String
   
%REM
Declare Private Function NIFFindDesignNote Lib "NNOTES" Alias "NIFFindDesignNote" ( Byval hDB As Long, Byval S As String, Byval C As Integer, N As Long) As Integer
Declare Private Function NSFDbClose Lib "NNOTES" Alias "NSFDbClose" ( Byval DbHandle As Long) As Integer
Declare Private Function OSPathNetConstruct Lib "NNOTES" Alias "OSPathNetConstruct" ( Byval NullPort As Long, Byval Server As String, Byval FIle As String, Byval PathNet As String) As Integer
Declare Private Function NSFDbOpen Lib "NNOTES" Alias "NSFDbOpen" ( Byval PathName As String, DbHandle As Long) As Integer
%END REM
   
   On Error Goto ErreurHandle
   
   AgentUNID_API = ""
   
   If wAgent Is Nothing Then
      Error 9999,"wAgent is Nothing"
      Exit Function
   End If
   
   Set DBCible = wAgent.Parent
   Space1024 = Space(1024)
   
   OSPathNetConstruct 0, DBCible.Server, DBCible.FilePath, Space1024
   NSFDbOpen Space1024, nbHandleDB
   If nbHandleDB = 0 Then
      Error  9999, "Can not open Database : " +DBCible.FilePath
   End If
   Set DBCible = Nothing
   
   NameAgent = Trim(Cstr(wAgent.Name))
   
   nbPseudo = Instr(NameAgent, "|")
   
   If nbPseudo > 0 Then
      NameAgent = Trim$(Left$(NameAgent, nbPseudo - 1))
   End If
   
   NIFFindDesignNote nbHandleDB, NameAgent, NOTE_CLASS_FILTER, nbAgentID
   
   If nbAgentID = 0 Then
      Error 9999, "Can not find Agent : " + NameAgent
   End If
   
   NSFDbClose nbHandleDB
   
   AgentUNID_API =Hex$(nbAgentID)
   
   Exit Function
ErreurHandle:
      Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set DBCible = Nothing
   If nbHandleDB > 0 Then
      NSFDbClose nbHandleDB
   End If
   AgentUNID_API = ""
   Exit Function
End Function

Code : Tout sélectionner

retString = GetScriptElementList(dbUser)
      
              '** if we were able to open the database and we got the list of
              '** agent notes, output information about the agents to the file
      If (retString = "") And (dbUser.IsOpen) Then
         Forall noteid In agentList
                            '** try to open each agent as a regular NotesDocument,
                            '** so we can read the fields
            Set doc = dbUser.GetDocumentByID(noteid)


etc.....



Function GetScriptElementList (db As NotesDatabase) As String
       '** Get all the agents and script libraries in this database, and store
       '** their NoteIDs in a global list called agentList (so we can step
       '** through the list later and look at the documents). I used a global
       '** list because sometimes lists would get corrupted if you passed
       '** them as parameters in older versions of Notes (the problem was
       '** fixed in 5.08 or something), and a list was a lot easier to manage
       '** in this case than an array.
       '**
       '** Sorry about all the goto statements -- it was just easier to write it
       '** that way than to either create a lot of If-Then nestings, or duplicate
       '** a lot of the code that releases handles and frees memory.
       '**
       '** version 1.0
       '** Julian Robichaux -- http://www.nsftools.com
   
   Dim hDb As Long
   Dim hIDTable As Long
   Dim pathName As String*256
   Dim startDate As Double, endDate As Double
   Dim noteID As Long
   Dim firstFlag As Integer
   Dim result As Integer
   
       '** clear the global list of agents and script libraries
   Erase agentList
   
       '** create a proper network path name with OSPathNetConstruct
   Call OSPathNetConstruct(0, db.Server, db.FilePath, pathName)
   
       '** open the database and get a handle with NSFDbOpen
   result = NSFDbOpen(pathName, hDb)
   If result <> 0 Then
      GetScriptElementList = "Cannot open database " & db.FilePath & " on server " & db.Server & _
      ". Error was " & Cstr(result) & ": " & GetAPIError( result )
      Goto endOfFunction
   End If
   
       '** get the ID table of the database, with all of the design elements that are either agents
       '** or script libraries (use TIMEDATE_MINIMUM to get all but the deleted items)
   Call TimeConstant(TIMEDATE_MINIMUM, startDate)
   result = NSFDbGetModifiedNoteTable(hDb, NOTE_CLASS_FILTER Or NOTE_CLASS_PRIVATE, _
   startDate, endDate, hIDTable)
   If result <> 0 Then
      GetScriptElementList = "Cannot open ID Table on " & db.FilePath & " on server " & db.Server & _
      ". Error was " & Cstr(result) & ": " & GetAPIError( result )
      Goto closeDb
   End If
   
       '** make sure we got some IDs returned to us (if not, just exit)
   If (IDEntries(hIDTable) = 0) Then
      Goto freeIDTable
   End If
   
       '** get the IDs in the table
   firstFlag = True
   Do While IDScan(hIDTable, firstFlag, noteID) > 0
      agentList(noteID) = ConvertNoteID(noteID)
      firstFlag = False
   Loop
   
   
freeIDTable:
       '** free the memory used when we grabbed the ID table
   Call OsMemFree(hIDTable)              ' should possibly use IDDestroyTable instead?
   
closeDb:
       '** close the database with NSFDbClose
   Call NSFDbClose(hDb)
   
endOfFunction:
   Exit Function
   
End Function