Accueil > > > RECHERCHE ET TEST MODEMS
RECHERCHE ET TEST MODEMS
Information sur la source
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
- '################################################################
- '# #
- '# 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
'################################################################
'# #
'# 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)
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|