PureBasic Forums - English

Code: Select all

Enumeration
#Window_Main
#Gadget_Panel1
#Gadget_ListIcon
EndEnumeration

#MaxReceiveBuffer = 1024

Global dcb.DCB
Global LF.s         : LF = Chr(10)
Global device.s     : device.s = ""
Global portsetup.s  : portsetup = ""

Procedure.s PortState()
  portsetup = "    " + Str(dcb\BaudRate) + " , " 
  portsetup + Str(dcb\ByteSize) + " , "
  Select dcb\Parity
    Case #NOPARITY
    portsetup + " N, "
    Case #EVENPARITY
    portsetup + " E, "
    Case #ODDPARITY
    portsetup + " O, "
    Case #MARKPARITY
    portsetup + " M, "
    Case #SPACEPARITY
    portsetup + " S, "
  EndSelect 
  Select dcb\StopBits
   Case  #ONESTOPBIT
     portsetup + " 1"
   Case  #TWOSTOPBITS
     portsetup + " 2"
   Case  #ONE5STOPBITS
     portsetup + " 1.5"
   EndSelect
EndProcedure         

Procedure.s SerialPorts()
  For I = 1 To 16  ; look at all 16 ports to see if they exist
    device = "COM" + Str(I) + ":"
    AddGadgetItem(#Gadget_Panel1, -1, "Checking Port " + Str(I) + " of 16")
    LI = ListIconGadget(#Gadget_ListIcon + I, 6, 6, GadgetWidth(#Gadget_Panel1) - 16, GadgetHeight(#Gadget_Panel1) - 36, "Description", 80,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines|#LVS_NOSORTHEADER)
    AddGadgetColumn(#Gadget_ListIcon + I, 1, "Results", 202)
    ; Use WinAPI - try to open desired port
    hCom = CreateFile_(@device, #GENERIC_READ | #GENERIC_WRITE, 0, #Null, #OPEN_EXISTING, 0, #Null)
    
    If hCom = #INVALID_HANDLE_VALUE
      ; Failed to open the port
      ; Use WinAPI to get the error number and report it
      dwError.l = GetLastError_()
      AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't open the Comm Port")
      AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
      ; Brief delay so user can see the activity, otherwise too fast
      Delay(100)
      RemoveGadgetItem(#Gadget_Panel1, CountGadgetItems(#Gadget_Panel1)-1) 
    Else
      SetGadgetItemText(#Gadget_Panel1, CountGadgetItems(#Gadget_Panel1)-1, device,0) 
      AddGadgetItem(#Gadget_ListIcon + I, -1, device + LF + "Found")
      fSuccess.l = GetCommState_(hCom, @dcb)
      ; GetCommState returns a non-zero value upon success, zero if failure
      If fSuccess
        ; Successful
        AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Retrieved the current Comm State")
        ; Use a procedure to check out the current port state, values in the DCB structure
        PortState()
        AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + portsetup)
        ; Set the Data Control Block: baud=115200, 8 Data bits, no parity, 1 stop bit.
        dcb\BaudRate = #CBR_115200
        dcb\ByteSize = 8;
        dcb\Parity   = #NOPARITY;
        dcb\StopBits = #ONESTOPBIT
        ; Use the WinAPI to reset the Comm port's state
        fSuccess = SetCommState_(hCom, @dcb)
        ; SetCommState returns zero on failure, a non-zero value upon success
        If fSuccess
          ; Successful
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Reset the Comm State")
          ; Use the procedure to review the current port state
          PortState()
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + portsetup)
        Else
          ; Failure
          ; Use the WinAPI to get error code and report it
          dwError = GetLastError_()
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't set the Comm State")
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
        EndIf
        
        ; Set the Timeouts 
        ct.COMMTIMEOUTS
        ct\ReadIntervalTimeOut         = 200  ; in milliseconds
        ct\ReadTotalTimeoutConstant    = 1
        ct\ReadTotalTimeoutMultiplier  = 1
        ct\WriteTotalTimeoutConstant   = 10
        ct\WriteTotalTimeoutMultiplier = 1
        If fSuccess
          ; We successfully set the comm port state, now lets set the timeouts for that port
          fSuccess = SetCommTimeouts_(hCom,@ct)
          If fSuccess
            ; Successful
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Reset the Comm Timeouts")
          Else
            ; Failure
            ; Use the WinAPI to get error code and report it
            dwError = GetLastError_()
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't set the Comm Timeouts")
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
          EndIf
        EndIf
        
        ;We set the state and the timeouts, now set the In/Out buffer lengths
        If fSuccess
          fSuccess = SetupComm_(hCom,1200,1200)
          If fSuccess
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Reset the Comm Buffer Sizes")
          Else
            dwError = GetLastError_()
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't set the Comm Buffer Sizes")
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
          EndIf
        EndIf
        ;    MessageRequester("Open Comm Port",Msg$,#MB_ICONINFORMATION)
        AddGadgetItem(#Gadget_ListIcon + I, -1, "")
        
        ; OK, now we are ready to try to communicate with the port
        ; Lets purge the buffer and then write some data to the Comm Port
        ; Here I send a modem command that I would expect a reply to....
        PurgeComm_(hcom, #PURGE_TXCLEAR|#PURGE_TXCLEAR)
        NoOfBytesWritten.l = 0
        DataToWrite.s = "ATI3I4I5I6I7I8I9" + Chr(13)
        Results = WriteFile_(hCom, @DataToWrite, Len(DataToWrite),@NoOfBytesWritten,0)
        ; Flush the file buffer immediately to insure writing is complete
        FlushFileBuffers_(hcom)
        If Results
          ; Successful
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Successfully wrote " + Str(NoOfBytesWritten) + " bytes")
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + RemoveString(DataToWrite,Chr(13)))
        Else
          ; Failure
          ; Use the WinAPI to get error code and report it
          dwError = GetLastError_()
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't write data")
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
        EndIf
        AddGadgetItem(#Gadget_ListIcon + I, -1, "")
        
        ; Now lets try to read some data from the Comm Port
        buffer.s = ""
        Offset = 0
        NoOfBytesReceived.l = 0
        DataReadFromPort.l = AllocateMemory(#MaxReceiveBuffer)
        Repeat
          Results = ReadFile_(hCom, DataReadFromPort + Offset, 256, @NoOfBytesReceived, 0)
          If Results
            ; Successfully read something
            If NoOfBytesReceived > 0
              ; put it in my processing buffer
              AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Successfully read "+ Str(NoOfBytesReceived) + " bytes")
              Offset + NoOfBytesReceived
              buffer + PeekS(DataReadFromPort, NoOfBytesReceived)
            EndIf
          ElseIf Results = 0
            ; Failed to read anything
            ; Use the WinAPI to get error code and report it
            dwError = GetLastError_()
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't receive data")
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Error result: " + Str(dwError))
          EndIf
        Until NoOfBytesReceived = 0 Or Offset > #MaxReceiveBuffer
        FlushFileBuffers_(hCom)
        ; Now lets interpret what we read from the port
        ; First, I will take out some unwanted lines
        buffer = RemoveString(buffer,"OK") ; I don't want the OK reply.  You may.
        buffer = RemoveString(buffer,Chr(10)+Chr(13)) ; Remove LF & CR, you may want them.
        buffer = RemoveString(buffer,Chr(10)) ; Remove just a LF, you may want them.
        If Len(buffer) > 0
          ; OK, show me what I read from the port
          AddGadgetItem(#Gadget_ListIcon + I, -1, "")
          AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Data read")
          For k = 1 To 8
            temp$ = StringField(buffer, k, Chr(13))
            AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + temp$)
          Next 
        EndIf
      Else
        AddGadgetItem(#Gadget_ListIcon + I, -1, "" + LF + "Couldn't get the Comm State" + Chr(10) + "Error result: " + Str(fSuccess))
      EndIf
      ; Finally, close the port
      CloseHandle_(hCom)
    EndIf
  Next
EndProcedure

; Open main window
If OpenWindow(#Window_Main, 0, 0, 311, 430, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Serial Port Information")
  CreateGadgetList(WindowID())
    ; Set up a way to see the results of querying the serial ports
    PanelGadget(#Gadget_Panel1, 4, 30, WindowWidth() - 8, WindowHeight() - 34)

    ; Call the procedure to get the Serial Port statistics,
    ; Look at all 16, try to read and write to each one found.
    SerialPorts()

    ; Processing loop
    Repeat
      Select WaitWindowEvent()
      Case #PB_Event_CloseWindow    ; Window close box clicked
        Quit = #True
      EndSelect
    Until Quit
EndIf   
End

Code: Select all

;- PB-Terminal 1.1
;- a mini terminal-program to connect to a handy or anything else at the serial port
;- needs the port.dll which you'll get here: www.2mal2mal.de/public/port.dll.zip
;-
;- by Froggerprogger 06.01.2005

#Program_Title = "PB-Terminal 1.1"
Global term$ : term$ = Chr(13)
#Max_InitWaitMs = 5000

Structure COM_DATA
  comID.l
  baud.l
  databits.l
  parity.s
  stopbits.l
  timeout.l
EndStructure
 

;- open the port.dll
If OpenLibrary(0, "port.dll")
  Global *com_open.l    : *com_open    = IsFunction(0,"OPENCOM")
  Global *com_close.l   : *com_close   = IsFunction(0,"CLOSECOM")
  Global *com_read.l    : *com_read    = IsFunction(0,"READBYTE")
  Global *com_write.l   : *com_write   = IsFunction(0,"SENDBYTE")
  Global *com_timeout.l : *com_timeout = IsFunction(0,"TIMEOUT")
Else
  MessageRequester(#Program_Title, "couldn't load port.dll.")
  End
EndIf

;- the procedures
Procedure Print_Multiline(str$)
  str$ = ReplaceString(str$, Chr(13)+Chr(10), Chr(13))
  str$ = ReplaceString(str$, Chr(10), Chr(13))
  For i=1 To CountString(str$, Chr(13))
    PrintN(StringField(str$, i, Chr(13))) 
  Next
EndProcedure

Procedure COM_Open(*com.COM_DATA)
  Protected comOpen.l
  comOpen = CallFunctionFast(*com_open, "COM"+Str(*com\comID)+": baud="+Str(*com\baud)+ " parity="+*com\parity+" data="+Str(*com\databits)+" stop="+Str(*com\stopbits))
  ;/ set the port.dll-timeout to 30ms (default)
  CallFunctionFast(*com_timeout.l, *com\timeout)
  ProcedureReturn comOpen
EndProcedure 

Procedure COM_WriteS(str$) ; sends str$ to the serial port (no terminator symbol is added)
  Protected *b.BYTE
  *b = @str$
  While *b\b <> 0
    CallFunctionFast(*com_write,*b\b&$FF)
    *b+1
  Wend
EndProcedure

Procedure.s COM_ReadS(maxWaitMs.l) ; reads an answer string and waits up to maxWaitMs milliseconds for it
  Protected str$, char.l, waitMs.l
  waitMs = ElapsedMilliseconds()
  While ElapsedMilliseconds() - waitMs < maxWaitMs
    Repeat
      char = CallFunctionFast(*com_read)
      If char >= 0
        str$ + Chr(char)
      EndIf
    Until char = -1
    If str$ <> ""
      ProcedureReturn str$
    EndIf
  Wend
  ProcedureReturn str$
EndProcedure

Procedure.l COM_WaitForResponse(maxWaitMs.l) ; waits for a first response up to maxWaitMs milliseconds
  Protected waitMs.l, ok.l, str$
  waitMs = ElapsedMilliseconds()
  While ElapsedMilliseconds() - waitMs < maxWaitMs
    COM_WriteS("AT"+term$)
    str$ = COM_ReadS(1000)
    If str$ <> ""
      Print_Multiline(str$)
      ProcedureReturn ElapsedMilliseconds() - waitMs
    EndIf
    Delay(50)
  Wend
  ProcedureReturn -1
EndProcedure

Procedure Print_Help()
  PrintN("")
  PrintN("a command overview:")
  PrintN("#help    - displays this help")
  PrintN("#quit    - quit program")
  PrintN("#open [COM [int]:] [baud=[int]] [data=[int]] [parity=[char]] [stop=[int]]")
  PrintN("    Changes the given parameters and reconnects. Valid values are:")
  PrintN("    COM[1 2 3 ...]:     (valid COM-port-ID)")
  PrintN("    baud=[75 110150 300 600 1200 2400 4800 9600 19200 38400 57600 115200]")
  PrintN("    parity=[N E O S M]  (No/Even/Odd/Space/Mark parity)")
  PrintN("    data=[5 6 7 8]      (5,6,7,8 data bits)")
  PrintN("    stop=[1 2]          (1 or 2 stop bits)")
  PrintN("    You don't have to change all of those values. E.g. you might just call '#open COM2'")
  PrintN("")
EndProcedure

Procedure Quit() ; quits the program
  CloseConsole()
  CallFunctionFast(*com_close)
  End
EndProcedure

;- some inital values
com.COM_DATA
com\comID       = 1
com\baud        = 19200
com\databits    = 8
com\parity      = "N"
com\stopbits    = 1
com\timeout     = 30

;- the MAIN program
;/ open a new console
OpenConsole()
PrintN(#Program_Title + " by Froggerprogger")
Start:
PrintN("------------------------------------------------------------------------------")
;/ open the COM-port
PrintN("connecting to COM"+Str(com\comID)+": baud="+Str(com\baud)+ " parity="+com\parity+" data="+Str(com\databits)+" stop="+Str(com\stopbits))
COM_open = COM_Open(@com)
If COM_open = 0
  PrintN("couldn't connect!")
  Goto mainLoop
Else
  PrintN("...successful")
EndIf

;/ wait until connection is established
PrintN("waiting for connection established... (waiting for max. "+Str(#Max_InitWaitMs)+"ms)")
temp = COM_WaitForResponse(#Max_InitWaitMs)
If temp = -1
  PrintN("couldn't establish connection! (cannot get any feedback)")
  PrintN("But you can still send anything to the plugged unit.")
  PrintN("")
  Goto mainLoop
Else
  PrintN("...successful.")
  ;/
  PrintN("")
  PrintN("You might send AT-commands to your serial port now.")
  PrintN("Try e.g. 'AT+CGMI'(manufactor code) 'AT+CGMM' (telephone version)")
  PrintN("'AT+GSN' (get serial number) 'ATD 123456' (dial 123456) 'AT+CHUP' (hang up)")
  PrintN("")
EndIf

;/ main loop
mainLoop:
PrintN("type '#help' for more terminalcommands or '#quit' to exit program")
PrintN("")
Repeat
  ;/ get user's command
  Print("? ")
  str$ = Input()+term$
  PrintN("")
 
  tempS$ = UCase(str$)
  If Left(tempS$, 5) = "#QUIT"
    Quit()
  ElseIf Left(tempS$, 5) = "#HELP"
    Print_Help()
    Continue
  ElseIf Left(tempS$, 5) = "#OPEN"
    If FindString(tempS$, "COM", 1)
      com\comID    = Val(StringField(StringField(tempS$, 2, "COM"),2, "M"))
    EndIf
    If FindString(tempS$, "BAUD=", 1)
      com\baud     = Val(StringField(StringField(tempS$, 2, "BAUD="),2, "="))
    EndIf
    If FindString(tempS$, "PARITY=", 1)
      com\parity    = Left(StringField(StringField(tempS$, 2, "PARITY="),2, "="),1)
    EndIf
    If FindString(tempS$, "DATA=", 1)
      com\databits = Val(StringField(StringField(tempS$, 2, "DATA="),2, "="))
    EndIf
    If FindString(tempS$, "STOP=", 1)
      com\stopbits    = Val(StringField(StringField(tempS$, 2, "STOP="),2, "="))
    EndIf
    CallFunctionFast(*com_close)
    Goto Start
  EndIf
 
  ;/ send string
  COM_WriteS(str$)
 
  ;/ retrieve answer
  ret$ = COM_ReadS(1000)
 
  ;/ display answer
  Print_Multiline(ret$)
ForEver 

Code: Select all

Case 1 ; Up
Buffer = 255:ComSendByte(HCom,@Buffer,1)
Buffer = 0:ComSendByte(HCom,@Buffer,1) 
Buffer = 50:ComSendByte(HCom,@Buffer,1) 
Case 2 ; Down 
Buffer = 255:ComSendByte(HCom,@Buffer,1)
Buffer = 0:ComSendByte(HCom,@Buffer,1) 
Buffer = 200:ComSendByte(HCom,@Buffer,1) 

Code: Select all

;Open window
If OpenWindow(0, 50, 50, 200, 140, #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget, "Mini SSC Control Program")

; Create Butons
CreateGadgetList(WindowID())

ButtonGadget(1, 50, 30, 100, 24, " UP ")
ButtonGadget(2, 50, 55, 100, 24, " DOWN ")
ButtonGadget(3, 50, 80, 100, 24, " QUIT ")

HCom=ComOpen(ComPortSettings,0,256,256)

Repeat
EventID = WaitWindowEvent()

If EventID = #PB_Event_Gadget

  Select EventGadgetID()
    Case 1 ; Up
      Data1.b = 255
      ComSendByte(HCom,@Data1,1)
      Data1.b = 0
      ComSendByte(HCom,@Data1,1)
      Data1.b = 50
      ComSendByte(HCom,@Data1,1)

    Case 2 ; Down
      Data1.b = 255
      ComSendByte(HCom,@Data1,1)
      Data1.b = 0
      ComSendByte(HCom,@Data1,1)
      Data1.b = 200
      ComSendByte(HCom,@Data1,1)

    Case 3 ; Quit...
      EventID = #PB_Event_CloseWindow
      ComClose(HCom)
  EndSelect

EndIf

Until EventID = #PB_Event_CloseWindow

EndIf

End