Téléphoner à partir d'un modem en vb

Télécharger le projet
Commenter

Description

La première mise à disposition de ce source fut rejetée :
Source supprimée

Désolé, cette source a été supprimée pour les raisons suivantes :
- Soit ce n'etait pas une source
- Soit ce n'etait qu'une publicité
- Soit le zip ne comportait qu'un fichier .exe
- Soit le zip contenait un virus
- Soit cette source n'etait pas "correcte" Virus, Hack, Piratage etc...
- Soit cette source a été postée en double
Ou pour une autre bonne raison dans ce genre.

ALORS QUE RIEN DE TOUT CELA NE CORRESPOND..
Je tente une seconde fois

Source / Exemple : 


Private Sub DialButton_Click()
On Error GoTo TraiteErreur
Select Case DialButton.BackColor
    Case &HC0FFC0
        If IsNull(Data1.Recordset.Fields("Tel")) = False Or Len((Data1.Recordset.Fields("Tel"))) > 9 Then
            DialButton.BackColor = &HFF&
            MSComm1.PortOpen = True
            ' Envoie la commande Attention au modem.
            
            MSComm1.Output = "AT &F E0 H0 Q0 V1 &D2" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT X4" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT #CLS=8 #VLS=4 #VRN=0" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATM2" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATDT" & Data1.Recordset.Fields("Tel") & ";" & vbCrLf ' Vérifie que
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                    If InStr(Buffer$, "NO DIALTONE") Then
                        Erreur 18
                        GoTo Coupe
                    End If
                
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT #CLS=8 #VLS=6 #VTD=3F,3F,3F" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATA" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "VCON" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT#VLS=6" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT#SPK=1,03,3" & vbCr
                Do
                    DoEvents
                        If MSComm1.PortOpen = False Then Exit Sub
                        Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            DialButton.Enabled = True
        Else
            MSComm1.PortOpen = False
            DialEncours = False
        End If
    Case &HFF&
Coupe:
        DialButton.BackColor = &HC0FFC0
        MSComm1.PortOpen = False
End Select

Exit Sub

TraiteErreur:
    'Resume err
DialButton.BackColor = &HC0FFC0
Resume Next
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
DialEncours = False
Erreur 16
Exit Sub
End Sub

Conclusion :


remplacer Data1.Recordset.Fields("Tel") par le numéro de téléphone désiré
DialButton sera le bouton de prise de ligne
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.