Dual Port - Send & Receive

Category: Serial Port

Date: 03-28-2012

Return to Index


 
'This is an all-in-one example, showing how to open a serial port,
'both set/get it's configuration data, send/receive data and then
'close the serial port.
 
 
'Primary Code:
'open
Function OpenPort(cPort$) As Long
      Local iFree As Long
      iFree = FreeFile : Comm Open cPort$ As iFree
      If ErrClear Then Function = 0 Else Function = iFree
End Sub
 
'set configuration
Function ConfigurePort(iPort&, iBaud&, iByte&, iParity&, iStop&, iTxBuf&, iRxBuf&) As Long
   Comm Set iPort&, Baud     = iBaud&
   Comm Set iPort&, Byte     = iByte&
   Comm Set iPort&, Parity   = iParity&
   Comm Set iPort&, Stop     = iStop&
   Comm Set iPort&, TxBuffer = iTxBuf&
   Comm Set iPort&, RxBuffer = iRxBuf&
End Function
 
'get configuration
Function GetConfiguration(iPort&, i&, j&, k&, L&) As String
      i = Comm(iPort&,Baud)
      j = Comm(iPort&,Byte)
      k = Comm(iPort&,Parity)
      L = Comm(iPort&,Stop)
      Function = Str$(i) + "," + Str$(j) + "," + Str$(k) + "," + Str$(L)
End Function
 
'receive
Qty& = Comm(hComm, RXQUE)   'check que to see how many bytes are available
Comm Recv hComm, Qty&, a$    'get that many bytes
 
'send
Comm Send iPort, "My serial port test!"    'Send from opened serial port
 
'close
Comm Close iPort
 
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg as Dword, iPort2 As Long, iPort4 As Long, SndMsg$, RcvMsg$, sPort$
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,280, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, 101, "COM2", 35,10,70,20
   Control Add Label, hDlg, 102, "COM4", 120,10,70,20
   Control Add Button, hDlg, 100,"Open", 10,30,70,20
   Control Add Button, hDlg, 110,"Configure", 10,60,70,20
   Control Add Button, hDlg, 120,"Get Config", 10,90,70,20
   Control Add Button, hDlg, 130,"Send", 10,120,70,20
   Control Add Button, hDlg, 140,"Receive", 10,150,70,20
   Control Add Button, hDlg, 150,"Close", 10,180,70,20
 
   Control Add Button, hDlg, 200,"Open", 100,30,70,20
   Control Add Button, hDlg, 210,"Configure", 100,60,70,20
   Control Add Button, hDlg, 220,"Get Config", 100,90,70,20
   Control Add Button, hDlg, 230,"Send", 100,120,70,20
   Control Add Button, hDlg, 240,"Receive", 100,150,70,20
   Control Add Button, hDlg, 250,"Close", 100,180,70,20
 
   Control Add TextBox, hDlg, 155,"<InMsg2>", 10,210,180,20
   Control Add TextBox, hDlg, 156,"<InMsg4>", 10,240,180,20
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local Qty&, iResult&
   Static iCount2&, iCount4&
   Select Case CB.Msg
      Case %WM_Command
         Select Case CB.Ctl
            Case 100 : iPort2 = OpenPort("com2")
            Case 110 : SetConfiguration(iPort2, 14400,8,%False, 0, 4096,4096)
            Case 120 : MsgBox (GetConfiguration (iPort2))
            Case 130 : Control Get Text hDlg, 155 To SndMsg$
               Incr iCount2&
               Comm Send iPort2, "Msg2 " + Str$(iCount2&)  'Send
            Case 140 : Qty& = Comm(iPort2, RxQue)         'check que to see how many bytes are available
               Comm Recv iPort2, Qty&, RcvMsg$   'get that many bytes
               Control Set Text hDlg, 155, RcvMsg$
            Case 150 : Comm Close iPort2
 
            Case 200 : iPort4 = OpenPort("com4")
            Case 210 : SetConfiguration(iPort4, 14400,8,%False, 0, 4096,4096)
            Case 220 : MsgBox (GetConfiguration (iPort4))
            Case 230 : Control Get Text hDlg, 155 To SndMsg$
               Incr iCount4&
               Comm Send iPort4, "Msg4 " + Str$(iCount4&)  'Send
            Case 240 : Qty& = Comm(iPort4, RxQue)         'check que to see how many bytes are available
               Comm Recv iPort4, Qty&, RcvMsg$   'get that many bytes
               Control Set Text hDlg, 156, RcvMsg$
            Case 250 : Comm Close iPort4
         End Select
   End Select
End Function
 
Function OpenPort(cPort$) As Long
   Local iFree As Long
   iFree = FreeFile : Comm Open cPort$ As iFree
   If ErrClear Then Function = 0 Else Function = iFree
End Function
 
Function SetConfiguration(sPort&, iBaud&, iByte&, iParity&, iStop&, iTxBuf&, iRxBuf&) As Long
   Comm Set sPort&, Baud     = iBaud&
   Comm Set sPort&, Byte     = iByte&
   Comm Set sPort&, Parity   = iParity&
   Comm Set sPort&, Stop     = iStop&
   Comm Set sPort&, TxBuffer = iTxBuf&
   Comm Set sPort&, RxBuffer = iRxBuf&
End Function
 
Function GetConfiguration(sPort&) As String
   Local i&, j&, k&, L&
   i& = Comm(sPort&,Baud)
   j& = Comm(sPort&,Byte)
   k& = Comm(sPort&,Parity)
   L& = Comm(sPort&,Stop)
   Function = Str$(i&) + "," + Str$(j&) + "," + Str$(k&) + "," + Str$(L&)
End Function
 
'gbs_00339
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm