Recherche et test modems

Télécharger le projet
Commenter

Description

Recherche et test le(s) modem(s) sur port com. Vérifie également qu'il est bien raccordé à la prise téléphonique

Necessite les composants : MSComm et MSFlexGrid

Placer : 2 boutons (quitter_btn et test_btn), 2 label (test_lbl, diagnostic_statut), 1 MSFlexGrid (diagnostic_table), 1 timer (test_timer) et 1 MSComm (MSComm1)...... le plus simple est de passer par le zip......

Source / Exemple : 


'################################################################
'#                                                              #
'#                     TEST ET VERIFS MODEM                     #
'#                                                              #
'################################################################
'#                                                              #
'# Permet de chercher les modems raccordé au port com de l'ordi #
'# Verifie leur fonctionnement, et leur raccordement à la ligne #
'# Donne aussi la réf du modem                                  #
'#                                                              #
'# Par : vichamp (vichamp@noos.fr)                    30/07/02  #
'#                                                              #
'# nésitez pas a m'envoyer toutes vos remarques... je sais      #
'# l'hortographe..................                              #
'################################################################
'

Private Sub Form_Load()
Me.Visible = True
'mise en place de la table de diag
diagnostic_table.ColWidth(0) = 800
diagnostic_table.ColWidth(1) = 2000
diagnostic_table.ColWidth(2) = 5000
diagnostic_table.ColWidth(3) = 800
diagnostic_table.ColWidth(4) = 2000
diagnostic_table.ColAlignment(0) = 4
diagnostic_table.ColAlignment(1) = 4
diagnostic_table.ColAlignment(2) = 4
diagnostic_table.ColAlignment(3) = 4
diagnostic_table.ColAlignment(4) = 4
End Sub

Private Sub test_modem()
Dim modem_etat, modem_model, modem_ligne, modem_ligne_test As String
Dim system_ok, erreur As Integer
Dim coul_good, coul_bad As Double
coul_good = &H0 'couleur du text des test reussi et pas bon
coul_bad = &H808080
diagnostic_table.Clear
diagnostic_table.Visible = True

system_ok = 0 'passe à 2 si il y a un modem correctement branché
              'passe à 1 si le modem ne peut pas acceder à la ligne

modem_ligne_test = "ATDT" & "00123456789" & Chr(13) 'numero a la con pour voir le modem peut composé
                                                    'Rajouter le préfix de sortie dans le cas de standart téléphonique

'Entete de la grille
diagnostic_table.Row = 0
diagnostic_table.Col = 0
diagnostic_table.CellFontBold = True
diagnostic_table.Text = "Port"
diagnostic_table.Col = 1
diagnostic_table.CellFontBold = True
diagnostic_table.Text = "Etat"
diagnostic_table.Col = 2
diagnostic_table.CellFontBold = True
diagnostic_table.CellAlignment = 4
diagnostic_table.Text = "Modem"
diagnostic_table.Col = 3
diagnostic_table.CellFontBold = True
diagnostic_table.Text = "Etat"
diagnostic_table.Col = 4
diagnostic_table.CellFontBold = True
diagnostic_table.Text = "Ligne"

test_timer.Interval = 500 'temp maxi des tests

'
'Boucle des test port par port
'POUR RAJOUTER DES PORTS : il suffit de rajouter des ligne a la grille et d'augmenter la boucle
'
For port_com = 1 To 4
    diagnostic_table.Row = port_com
    diagnostic_table.Col = 0
    diagnostic_table.CellFontBold = True
    diagnostic_table.Text = "COM" & port_com 'affiche le port tester
    
    diagnostic_statut.Caption = "Test d'accès au port de communication " & port_com
    MSComm1.CommPort = port_com
    erreur = 0
    
    'test du port
    diagnostic_table.Col = 1
    diagnostic_table.Font.Bold = False
    On Error Resume Next
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    MSComm1.PortOpen = True
    If Err Then 'si le porr ne peut pas etre ouvert
        diagnostic_table.CellForeColor = coul_bad
        diagnostic_table.Text = "Utilisé ou inexistant " 'si il y a une erreur sur le port, passe direct au prochain port à tester
    Else 'si pas d'erreur
        diagnostic_table.CellForeColor = coul_good
        diagnostic_table.Text = "Disponible"
        MSComm1.PortOpen = True
        
        'test de réponse d'un modem
        diagnostic_statut.Caption = "Attente de réponse d'un modem sur COM" & port_com
        MSComm1.Output = "atE1" & Chr(13)
        diagnostic_table.Col = 3
        modem_etat = ""
        test_lbl.Caption = "0"
        test_timer.Enabled = True
        While Val(test_lbl.Caption) = 0 'attent une réponse du modem, au pire le timer stop le test
            If MSComm1.InBufferCount > 0 Then
                modem_etat = modem_etat & MSComm1.Input
                test_lbl.Caption = 1
            End If
            DoEvents
        Wend
        test_timer.Enabled = False
        If modem_etat = "" Or InStr(1, etat_modem, "OK") <> 0 Then  'si pas de modem
            diagnostic_table.CellForeColor = coul_bad
            diagnostic_table.Text = "NC"
            diagnostic_table.Col = 2
            diagnostic_table.CellForeColor = coul_bad
            diagnostic_table.Text = "Aucun modem opérationnel détecté"
        Else 'Si modem il y a
            diagnostic_table.CellForeColor = coul_good
            diagnostic_table.Text = "OK" 'affiche ok pour l'etat du modem
      
            'recupere la ref du modem
            diagnostic_statut.Caption = "Demande du modèle du modem sur COM" & port_com
            diagnostic_table.Col = 2
            diagnostic_table.CellForeColor = coul_good
            MSComm1.Output = "atI4" & Chr(13)
            modem_model = ""
            test_lbl.Caption = "0"
            test_timer.Enabled = True
            While Val(test_lbl.Caption) = 0
                If MSComm1.InBufferCount > 0 Then
                    modem_model = modem_model & MSComm1.Input
                    test_lbl.Caption = 1
                End If
                DoEvents
            Wend
            test_timer.Enabled = False
            modem_model = Right(modem_model, Len(modem_model) - 7)
            modem_model = Left(modem_model, Len(modem_model) - 6)
            If modem_model <> "" Then diagnostic_table.Text = modem_model Else diagnostic_table.Text = "Modèle inconnu"
        
            'tente de prende la ligne
            diagnostic_statut.Caption = "Test de la ligne téléphonique du modem sur COM" & port_com
            diagnostic_table.Col = 4
            MSComm1.Output = modem_ligne_test
            modem_ligne = ""
            test_lbl.Caption = "0"
            test_timer.Interval = 10000 'temp maxi de reponse du modem augmenter a 1sec
            test_timer.Enabled = True
            While Val(test_lbl.Caption) = 0
                If MSComm1.InBufferCount > 0 Then modem_ligne = modem_ligne & MSComm1.Input
                DoEvents
            Wend
            test_timer.Enabled = False
            If InStr(1, modem_ligne, "NO DIALTONE") <> 0 Then 'si pas de tonalité
                diagnostic_table.CellForeColor = coul_bad
                diagnostic_table.Text = "pas de tonalité"
                If system_ok < 2 Then system_ok = 1
            Else
                If InStr(1, modem_ligne, "NO CARRIER") <> 0 Then 'si pas de porteuse
                    diagnostic_table.CellForeColor = coul_bad
                    diagnostic_table.Text = "pas de porteuse"
                    If system_ok < 2 Then system_ok = 1
                Else
                    diagnostic_table.CellForeColor = coul_good 'si tout est bon
                    diagnostic_table.Text = "Ok"
                    system_ok = 2
                End If
            End If
        End If
        MSComm1.PortOpen = False 'referme le port
    End If
Next port_com
diagnostic_statut.Caption = "Tests terminé"
'If system_ok = 2 Then
'    MsgBox ("Votre system est correctement configuré pour accèder à internet")
'Else
'    If system_ok = 1 Then
'        MsgBox ("Un modem opérationnel à été detecter, mais il ne peut pas accèder à la ligne téléphonique" & Chr(13) & Chr(13) & "Veuillez vérifier son raccordement et recommencer")
'    Else 'system_ok = 0
'        MsgBox ("Aucun modem n'a été détecter sur votre ordinateur..." & Chr(13) & Chr(13) & "Essayer de fermer toutes les applications ouvertes et recommencer")
'    End If
'End If
        
End Sub

Private Sub Quitter_btn_Click()
End
End Sub

Private Sub test_btn_Click()
test_btn.Enabled = False
Call test_modem
test_btn.Enabled = True
End Sub

Private Sub test_timer_Timer()
test_lbl.Caption = "1"
test_timer.Enabled = False
End Sub

Conclusion :


Ceci est ma premiere contribution sur vbfrance, j'espere qu'elle servira...
Je me suis inspiré de pas de source du site pour la faire...

Je suis ouvert à toute les remarques et critiques... n'ésitez pas à me les envoyer (vichamp@noos.fr)
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.