VB-Homepage Tipp 026

autom. Modemsuche und max. Baudratenermittlung

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


Tipp-Download

Quelle :

Zurück zur Übersichtsseite