Cet article décrit une méthode de module de Visual Basic6.0, qui utilise XMLHTTP pour implémenter les fonctions Post et Get. Bien qu'il s'agisse d'un code ancien, il peut remplacer le contrôle Inet pour réaliser la communication de données. Cela vaut la peine d’en tirer des leçons.
Le code du module principal est le suivant :
'================================================== = ========='| Nom du module | XMLHTTP'| Remplacer le contrôle Inet pour réaliser la communication des données'==================== === ===================================Public Enum DataEnum ResponseText = 1 ResponseBody = 2End Enum Fonction publique GetData (ParVal Url As String, ByVal DataStic As DataEnum) As Variant On Error GoTo ERR: Dim XMLHTTP As Object Dim DataS As String Dim DataB() As Byte Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "get", Url, True XMLHTTP .send While XMLHTTP.ReadyState <> 4 DoEvents Wend '-------------------------------------- ------- La fonction renvoie Select Case DataStic Case ResponseText '-------------------------------- Renvoie directement la chaîne DataS = XMLHTTP.ResponseText GetData = DataS Case ResponseBody '-- ------------------------------- Renvoie directement le binaire DataB = XMLHTTP.ResponseBody GetData = DataB Case ResponseBody + ResponseText '--- - -------------------------- Conversion binaire en chaîne [essayer lorsque la chaîne renvoyée directement est tronquée] DataS = BytesToStr(XMLHTTP.ResponseBody) GetData = DataS Case Else '--------------------------------Retour invalide GetData = "" Fin Sélectionner '----------------------------------------Libérer l'espace Définir XMLHTTP = Rien Quitter FunctionERR : GetData = ""End Function Public Function PostData (ByVal StrUrl As String, ByVal StrData As String, ByVal DataStic As DataEnum) As Variant On Error GoTo ERR: Dim XMLHTTP As Object Dim DataS As String Dim DataB() As Ensemble d'octets XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "POST", StrUrl, True XMLHTTP.setRequestHeader "Content-Length", Len(PostData) XMLHTTP.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded" XMLHTTP.send (StrData) Do Jusqu'à XMLHTTP.ReadyState = 4 DoEvents Loop '--------------------------------La fonction renvoie Select Case DataStic Case ResponseText '----------------------------- Renvoie directement la chaîne DataS = XMLHTTP.ResponseText PostData = DataS Case ResponseBody '-- --- ---------------------------- Renvoie directement le binaire DataB = XMLHTTP.ResponseBody PostData = DataB Case ResponseBody + ResponseText '---- -- --------------------- Conversion binaire en chaîne [essayer lorsque la chaîne renvoyée directement est tronquée] DataS = BytesToStr(XMLHTTP.ResponseBody) PostData = DataS Case Else '- -------------------------------Retour PostData non valide = "" Fin Sélectionner '------------------------------------Libérer de l'espace Définir XMLHTTP = Rien Quitter FunctionERR : PostData = ""Fin Function Function BytesToStr(ByVal vIn) As String strReturn = "" Pour i = 1 To LenB(vIn) ThisCharCode = AscB(MidB(vIn, i, 1)) If ThisCharCode < &H80 Then strReturn = strReturn & Chr(ThisCharCode) Sinon NextCharCode = AscB(MidB(vIn, i + 1, 1)) strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) i = i + 1 End If Next BytesToStr = strReturnEnd Fonction