Der Quelltext ist nicht auf meinem Mist gewachsen, weiß
allerdings auch nicht mehr wo er her ist. Mein Beitrag ist der Test und das eindeutschen
der Meldungen.
Mit diesem Sourcecode ist es möglich, automatisch ein angeschlossenes Modem zu erkennen
und die maximale Baudrate zu ermitteln. Wer immer Datenübertragung via Modem benötigt,
kann dies sicher gut gebrauchen.
Dieses Beispiel ist für VB3, die 32Bit API's sind nicht identisch !
1. Erstellen Sie ein neues Projekt - eingebundene VBX sind nicht
erforderlich
2. vergeben Sie der "Form1" den Namen "frmModem"
3. Fügen Sie der Form zwei Comboboxen hinzu und vergeben Sie diesen die
Namen "cboPort" und "cboBaud"
Stellen Sie für beide bei Eigenschaften den Wert für Style auf 1 (Simple Combo)
4. Fügen Sie der Form desweiteren ein Label-Objekt hinzu, daß Sie
"lblDetect" nennen. Das Objekt muß wenigstens so lang definiert sein, das es
den Text
"Es konnte kein Modem gefunden werden !" aufnehmen kann
5. Fügen Sie nun der Form noch einem Commandbutton hinzu, darüber soll
der Start erfolgen
6. Fügen Sie nun entsprechend nachfolgenden Code ein...
Sub Form_Load ()
cboPort.AddItem "COM1"
cboPort.AddItem "COM2"
cboPort.AddItem "COM3"
cboPort.AddItem "COM4" cboBaud.AddItem
"1200"
cboBaud.AddItem "2400"
cboBaud.AddItem "4800"
cboBaud.AddItem "9600"
cboBaud.AddItem "19200"
cboBaud.AddItem "38400"
cboBaud.AddItem "57600"
End Sub
Sub Command1_Click ()
Dim iIndex As Integer
Dim iRet As Integer
iIndex = True
Do
iIndex = iIndex + 1
iRet = AutoDetect(iIndex)
Loop Until iRet <> True Or iIndex = cboPort.ListCount - 1
If iRet <> True Then
cboPort.ListIndex = iIndex
cboBaud.ListIndex = iRet
Else
frmmodem.lbldetect.caption = "Es konnte kein Modem gefunden werden !"
End If
End Sub
7. Fügen Sie nun Ihrem Projekt ein
Modul hinzu und kopieren Sie folgenden
Code hinein
DefInt I
DefLng L
DefStr S
DefSng N
Option Explicit
Type DCB
Id As String * 1
BaudRate As Integer
ByteSize As String * 1
Parity As String * 1
StopBits As String * 1
RlsTimeout As Integer
CtsTimeout As Integer
DsrTimeout As Integer
Bits1 As String * 1
Bits2 As String * 1
XonChar As String * 1
XoffChar As String * 1
XonLim As Integer
XoffLim As Integer
PeChar As String * 1
EofChar As String * 1
EvtChar As String * 1
TxDelay As Integer
End Type
Declare Function OpenComm Lib "User" (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 BuildCommDCB Lib "User" (ByVal lpDef As String, lpDCB As DCB)
As Integer
Declare Function CloseComm Lib "User" (ByVal idComDev As Integer) As Integer
Declare Function ReadComm Lib "User" (ByVal idComDev As Integer, ByVal sDest As
String, ByVal cbRead As Integer) As Integer
Declare Function WriteComm Lib "User" (ByVal idComDev As Integer, ByVal sString
As String, ByVal cbWrite As Integer) As Integer
Declare Function GetCommState Lib "User" (ByVal idComDev As Integer, lpConfig As
DCB) As Integer
Function AutoDetect (iPort As Integer)
Dim iComPort As Integer
Dim DCBConfig As DCB
Dim sConfig As String
Dim iC As Integer
Dim iRet As Integer
Dim iC2 As Integer
Dim sBuff As String * 20
Dim iBauds As Integer
Dim sTemp As String
Dim iTime As Long
Dim lBaud As Long
frmModem.MousePointer = 11
iBauds = True
iComPort = OpenComm(frmModem.cboPort.List(iPort) + "", 512, 128)
If iComPort > -1 Then
For iC = 0 To frmModem.cboBaud.ListCount - 1
sConfig = frmModem.cboPort.List(iPort) + ":9600,n,8,1"
iRet = BuildCommDCB(sConfig, DCBConfig)
lBaud = Val(frmModem.cboBaud.List(iC))
DCBConfig.BaudRate = (lBaud And 32767) Or -(lBaud And 32768)
If iRet > -1 Then
iRet = SetCommState(DCBConfig)
frmModem.lblDetect = "Checking " + Left$(sConfig,
5) + Trim$(Str$(lBaud))
frmModem.lblDetect.Refresh
If iRet > -1 Then
iRet = WriteComm(iComPort, "AT"
+ Chr$(13) + Chr$(0), 3)
If iRet = 3 Then
sTemp = ""
iTime = Timer
While Timer = iTime
DoEvents
Wend
iTime = Timer
While Timer - iTime
< 1 And InStr(sTemp, "OK") = 0
DoEvents
iRet
= ReadComm(iComPort, sBuff, 1)
If
iRet <> 0 Then sTemp = sTemp + Left$(sBuff, iRet)
Wend
If InStr(UCase$(sTemp),
"OK") <> 0 Then iBauds = iC
End If
End If
End If
Next
iRet = GetCommState(iComPort, DCBConfig)
DCBConfig.Bits1 = Chr$(129)
iRet = SetCommState(DCBConfig)
iRet = CloseComm(iComPort)
End If
AutoDetect = iBauds
frmModem.lblDetect = ""
frmModem.MousePointer = 0
End Function |
