RECHERCHE ET TEST MODEMS

'################################################################
'#                                                              #
'#                     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

Télécharger le zip