@UrlQueryString en Lotus Script

[abertisch]

Equivalent de @URLQueryString

Code : Tout sélectionner

Function URLQueryString(session As NotesSession, sParam As String) As Variant
   
   On Error Goto ErrorHandler
   
   Dim docContext As NotesDocument
   Dim vParams As Variant
   Dim listParams List As String
   Dim arrResult (0 To 1) As String
   Set docContext = session.DocumentContext
   
   vParams = Split(docContext.Query_String_Decoded(0),"&")
   If(sParam="") Then
      URLQueryString = vParams
   Else
      Forall p In vParams
         If(Instr(Cstr(p), "=") > 0) Then
            listParams(Strleft(p, "=")) = Strright(p, "=")
         Else
            listParams(p) = ""
         End If            
      End Forall
      If(Iselement(listParams(sParam))) Then
         arrResult(0) = listParams(sParam)
         URLQueryString = arrResult
      Else
         arrResult(0) = ""
         URLQueryString = arrResult
      End If   
   End If
   Exit Function
   
ErrorHandler:
   Messagebox "URLQueryString Erreur n° " & Cstr(Err()) & " ligne °" + Cstr(Erl())
   
End Function

[Michael DELIQUE]

une Autre Version

Code : Tout sélectionner

Function URLQueryString(wURL As String, wParam As String) As String
   
    'Extrait d'une URL (QueryString) le parametre voulu
  'wURL = URL à traiter, exemeple d'url => "HTTP://MonURL?Param1=Val1&PARAM2=Val2&param3=Val3..."
  'wParam = Param à extraire
   
      'Déclaration Variable
   Dim nbDebut As Integer
   Dim nbFin As Integer
   
   On Error Goto ErreurHandle
   
   If Trim(wURL) = "" Then
      URLQueryString = ""
      Exit Function
   Elseif Instr(wURL,"?") = 0 Then            'pas de parametre dans l'url
      URLQueryString = ""
      Exit Function
   End If
   
   If Trim(wParam) = "" Then
      If Instr(wURL,"&") = 0 Or Instr(wURL,"=") = 0 Then
       'si pas de & = alors l'info est passé sans parametre
      '   URLQueryString = Right(Trim(wURL),Len(Trim(wURL))-Instr(wURL,"?"))
         URLQueryString = Strrightback(wURL,"?")
         Exit Function
      Else
         URLQueryString = ""
         Exit Function
      End If
   Elseif Instr(Ucase(wURL),Ucase(Trim(wParam))) = 0 Then
       'le parametre n'est pas dans l'url
      URLQueryString = ""
      Exit Function
   End If
   
   
   If Right(Trim(wParam),1) = "=" Then
      nbDebut = Instr(1, Ucase(wURL), Ucase(wParam),0)-1
   Else
      nbDebut = Instr(1, Ucase(wURL), Ucase(wParam),0)
   End If
   
   If nbDebut = 0 Then
      URLQueryString = ""
   Else
      nbDebut = nbDebut + Len (wParam)
      nbFin = Instr ( nbDebut, wURL, "&" )
      If ( nbFin = 0 ) Then
         URLQueryString = Mid ( wURL,nbDebut+1, Len (wURL) - nbDebut)
      Else
         URLQueryString = Mid ( wURL,nbDebut+1, nbFin - nbDebut-1)
      End If     
   End If
   
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+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 Session = New NotesSession
   Call Error_LOG(Cstr(Session.Username),Cstr(Now),Structure_Log,Cstr(Getthreadinfo (1)),Cstr(Err),Cstr(Error),Cstr(Erl),Cstr(Getthreadinfo(10)))
   Resume Next
   URLQueryString = ""
   Exit Function
End Function

Code : Tout sélectionner

Function URLQueryStringAll(wURL As String) As Variant
   
       '   'Extrait d'une URL (QueryString) la liste des parametres et renvois un liste avec en tag le nom du parametres
 'wURL = URL à traiter, exemeple d'url => "HTTP://MonURL?Param1=Val1&PARAM2=Val2&aaaaaaa&param3=Val3..."
   
   'La fonction gère le cas ou le parametre est encadré de & et ne contient pas de balise &Param=
   
      'Déclaration Variable
   Dim QueryString As String
   Dim lstValue List As String
   Dim Param As String
   Dim EndParam As String
   Dim i As Integer
   Dim J As Integer
   Dim k As Integer
   
   On Error Goto ErreurHandle
   
      lstValue(0) =""
   
   If Trim(wURL) = "" Then
      URLQueryStringAll = ""
      Exit Function
   Elseif Instr(wURL,"&") = 0 Then       
        'pas de parametre dans l'url
      URLQueryStringALL = ""
      Exit Function
   End If
   
       'retire toute la partie url pour ne garder que le passage de parametre
   QueryString = Strright(wURL,"&")
   If Trim(QueryString) = "" Then
      URLQueryStringAll = ""
      Exit Function
   End If
   
   Erase lstValue
   
   J = 1
   k = 0
   Param = ""
   If Right(Trim(QueryString),1) <> "&" Then
      QueryString = QueryString+"&"
   End If         
   
   endParam = ""
   
   For i = 1 To Len(QueryString)
      Select Case Mid(QueryString,i,1)
      Case "="
         If Trim(Param) = "" Then
            Param = Ucase(Mid(QueryString,J,i-J))
         End If            
         J=i
      Case "&"
         If Trim(endParam) = "" Then
            If Trim(Param) <> "" Then
               lstValue(Param) =  (Mid(QueryString,J+1,i-J-1))
               J=i+1
               Param = ""
               endParam = ""
            Else
               endParam = "&"
            End If
            If Trim(endParam) = "&" Then
               lstValue(k) =  (Mid(QueryString,J+1,i-J-1))
               J=i+1
               k = k+1
               Param = ""
               endParam = ""
            End If
         End If   
      Case Else
          'on fait rien
      End Select
   Next
   
   QueryString = ""
   URLQueryStringAll = lstValue
   Erase lstValue
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur N° " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   URLQueryStringAll = ""
   Exit Function
End Function

[AlexandreV]

Une autre version light.

Code : Tout sélectionner

Function ExtractQS(QS As String, sCode As String) As String
   
   'Extrait une valeur de la querystring
   
   Dim sValue As String
   Dim index As Integer
   
   sValue = QS
   
   index = Instr(sValue, "&" + sCode + "=")
   If (index=0) Then
      sValue="_NONE"
   Else
      sValue= Mid$(sValue, index+Len( sCode )+2)
      index = Instr(sValue, "&")
      If (index > 0) Then
         sValue=Left$(sValue, index-1)
      End If
   End If   
   
   ExtractQS = sValue
   
End Function