Ajax en LotusScript

[Michael DELIQUE]

Code : Tout sélectionner

Function Ajax_LS(wUrl As String, wRequestType As String, wPost As String, wUnique As Integer) As String
   Dim XHRequest    As Variant
   Dim url As String
   
   On Error Goto ErreurHandle
   
   If Trim(wUrl) = "" Then
      Error 9999,"Url is empty"
      Exit Function
   End If
   
   url = Trim(wUrl)
   If wUnique = True Then
      If Instr(1, Url, "?") > 0 Then
         Url = Url + "&" + Format$(Now, "yyyymmddhhnnss")+Cstr(Rnd())+"&"
      Else
         Url = Url + "?" + Format$(Now, "yyyymmddhhnnss")+Cstr(Rnd())+"&"
      End If      
   End If
   
   Set XHRequest = CreateObject("Microsoft.XMLHTTP")
   
   Select Case Ucase(Trim(wRequestType))
      
   Case  "POST","P"
      XHRequest.open "POST", url, False, "", ""
      XHRequest.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
      XHRequest.send(wPost)
   Case "GET","G"
      XHRequest.open "GET", url, False, "", ""
      XHRequest.send("")
   Case ""
      Error 9999,"wRequestType is Empty"
      Exit Function
      
   Case Else
      Error 9999,"Bad Requeste Type : "+wRequestType
      Exit Function
      
   End Select

   If Trim(Cstr(XHRequest.status)) = "200" Then
      Ajax_LS = XHRequest.responseText
      Set XHRequest= Nothing      
   Else
      Error 9999,Trim(Cstr(XHRequest.status)) +" : "+Trim(Cstr(XHRequest.statusText))
      Exit Function
   End If
   
   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 XHRequest= Nothing   
   Ajax_LS = ""
   Exit Function
End Function