begin process at 2012 02 16 17:26:03
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Réseau & Internet

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

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


 Information sur la source

Note :
Aucune note
Catégorie :Réseau & Internet Niveau :Débutant Date de création :27/10/2002 Date de mise à jour :27/10/2002 11:36:45 Vu / téléchargé :2 557 / 283

Auteur : hvb

Ecrire un message privé
Site perso
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note


 Description

Un simple code pour recuperer le type d'un serveur http et le temps de reponse , et qui donc par la meme occasion montre comment jouer avec la reception de donnée spécifique par winsock.
C'est simple, mais ca peut servir.
Pour info, touts les serveurs ne renvoient pas toujours dans leurs headers leurs type, par exemple yahoo.fr , mais ce type d'exemple est rare (sur les quelques tests que j'ai fait) .
Et sur votre form, il faut 3 textbox nommées "Host" , "srvtype" et "anstime" , un controle winsock nommé ws et un command button "command1" .

Source

  • 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
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

 Conclusion

en esperant que ca puisse servir

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip Source avec une capture Source .NET (Dotnet) FOND DE FEUILLE ANIMÉ : DÉGRADÉ MOUVANT POUR ABOUT OU SPLASH...
Source avec Zip Source avec une capture Source .NET (Dotnet) FONT VIEWER : VISIONNEUSE DE POLICES SYSTEMES.
Source avec Zip Source avec une capture Source .NET (Dotnet) HBSNAPSHOTERV3.0 : GESTIONNAIRE DE CAPTURES D'ÉCRAN
Source avec Zip Source avec une capture Source .NET (Dotnet) JEU : PICROSS OU "PUZZLE JAPONAIS"
Source avec Zip Source .NET (Dotnet) [.NET2] COMPRESSION/DÉCOMPRESSION GZIP DE FICHIER GRÂCE À IO...

 Sources de la même categorie

Source avec Zip Source avec une capture GESTIONNAIRE DE TÉLÉCHARGEMENT, AVEC REPRISE ET MULTITHREADI... par Madx23
Source avec Zip Source avec une capture CONVERTIR DU TEXTE RTF EN CODE HTML ET VICE-VERSA par vicosta
Source avec Zip Source avec une capture DICTIONAIRE TEXT/AUDIO/VISUELLE ANGLAIS AVEC WEBBROWSER CONT... par majnounmajda
Source avec Zip Source .NET (Dotnet) NSLOOKUP EN VB.NET OU COMMENT FAIRE UNE REQÛETE DNS EN PRÉCI... par ShareVB
Source avec Zip Source avec une capture MINI SEVEUR HTTP AVEC INTERFACE GRAPHIQUE ET IMPLÉMENTATIONS... par lemout

Commentaires et avis

Commentaire de cosmic le 11/11/2002 23:54:23

Je trouve ta source interressente...
J'ai un peu de mal a la comprendre.

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,515 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales