RÉCUPERER LE TYPE D'UN SERVEUR HTTP VIA WINSOCK

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim answert As Long
Dim hblisten As Boolean
Dim buffer As String

Private Sub Command1_Click()
buffer = ""
hblisten = True
If Host.Text <> "" Then
ws.Close
ws.Connect "" & Host.Text & "", 80
answert = GetTickCount
Else
MsgBox "Vous n'avez pas entré de serveur", vbCritical
End If
End Sub


Private Sub ws_connect()
If hblisten = True Then
ws.SendData "GET http://" & Host.Text & "/ HTTP/1.0" & vbCrLf & _
            "Host: " & Host.Text & "" & vbCrLf & vbCrLf
End If
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
ws.GetData data
buffer = buffer & data
If hblisten = True Then
 If hb_str_in_str(buffer, "Server: ", vbCrLf) <> "" Then
  srvtype.Text = hb_str_in_str(buffer, "Server: ", vbCrLf)
  anstime.Text = "réponse du serveur en " & CDec((GetTickCount - answert) / 1000) & " secondes"
    ws.Close
  hblisten = false
  Else
  srvtype.Text = "Can't get server type"
  anstime.Text = "réponse du serveur en " & CDec((GetTickCount - answert) / 1000) & " secondes"
    ws.Close
  hblisten = false
 End If

End If
 End Sub
 
 Public Function hb_str_in_str(source As String, stravant As String, strapres As String)
If InStr(1, source, stravant) > 0 Then
If InStr((InStr(1, source, stravant)), source, strapres) > 0 Then
If Mid(source, (InStr(1, source, stravant) + Len(stravant)), InStr((InStr(1, source, stravant) + Len(stravant)), source, strapres) - (InStr(1, source, stravant) + Len(stravant))) <> "" Then
hb_str_in_str = Mid(source, (InStr(1, source, stravant) + Len(stravant)), InStr((InStr(1, source, stravant) + Len(stravant)), source, strapres) - (InStr(1, source, stravant) + Len(stravant)))
End If
End If
End If
End Function

Télécharger le zip