1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
| Option Compare Database
Type DCB
Id As String * 1
Vitesse As Integer
longueur As String * 1
Parité As String * 1
BitsStop As String * 1
RlsTimeout As Integer
CtsTimeout As Integer
DsrTimeout As Integer
Bits1 As String * 1
Bits2 As String * 1
XonCar As String * 1
XoffCar As String * 1
XonLim As Integer
XoffLim As Integer
PeCar As String * 1
EofCar As String * 1
EvtCar As String * 1
TxDelay As Integer
End Type
'********************************
'Déclaration des Functions de l'API Windows
'********************************
Declare Function ReadComm Lib "USER32" (ByVal nCid As Integer, _
ByVal lpBuf As String, ByVal nSize As Integer) As Integer
Declare Function WriteComm Lib "USER32" (ByVal nCid As Integer, _
ByVal lpBuf As String, ByVal nSize As Integer) As Integer
Declare Function BuildCommDCB Lib "USER32" (ByVal lpDef As String, _
lpDCB As DCB) As Integer
Declare Function OpenComm Lib "USER32" (ByVal lpComName As String, _
ByVal wInQueue As Integer, ByVal wOutQueue As Integer) As Integer
Declare Function SetCommState Lib "USER" (lpDCB As DCB) As Integer
Declare Function CloseComm Lib "USER32" (ByVal nCid As Integer) As Integer
' Procédure d'ouverture, de configuration, d'écriture de la phrase
' "Hello World" sur le port et de lecture de 10 caractères
Public Sub ouvre_configure_ecrit_lit()
Dim numéro_port As Integer
Dim leDCB As DCB
Dim retour As Integer
Dim car_reçus As String * 20
Const LaPhrase = "Hello World"
' Ouvre COM1 et initialise un buffer d'entrée et de sortie.
numéro_port = OpenComm("com1", 1024, 1024)
If numéro_port < 0 Then
MsgBox "Problème d'ouverture du port : " & numéro_port
Exit Sub
End If
retour = BuildCommDCB("Com1:1200,n,8,1", leDCB)
If retour <> 0 Then
MsgBox "Problème de configuration : " & retour
Exit Sub
End If
retour = SetCommState(leDCB)
If retour <> 0 Then
MsgBox "Problème de configuration : " & retour
Exit Sub
End If
retour = WriteComm(numéro_port, LaPhrase, Len(LaPhrase))
If retour < 0 Then
MsgBox "Problème d'écriture : " & retour
Exit Sub
End If
retour = ReadComm(numéro_port, car_reçus, 10)
MsgBox car_reçus
retour = CloseComm(numéro_port)
If retour <> 0 Then
MsgBox "Problème de fermeture : " & retour
Exit Sub
End If
End Sub
'######################################################################### |
Partager