Code: Alles auswählen
EnableExplicit
#V24_MODE_BINARY = $0001 ;binary mode MUST BE TRUE
#V24_MODE_PARITY_CHECK = $0002 ;Parity chacking is performed and errors are reported
#V24_MODE_MONITOR_CTS = $0004 ;If this member is TRUE, the DSR (data-set-ready) signal is monitored
;For output flow control. If this member is TRUE And DSR is turned off,
;output is suspended Until DSR is sent again
#V24_MODE_MONITOR_DSR = $0008 ;If this member is TRUE, the DSR (data-set-ready) signal is monitored
;For output flow control. If this member is TRUE And DSR is turned off,
;output is suspended Until DSR is sent again
#V24_MODE_DTR_ON = $0010 ;Enables the DTR line when the device is opened and leaves it on.
#V24_MODE_DTR_HANDSHAKE = $0020 ;Enables DTR handshaking. If handshaking is enabled, it is an error for the application
;To adjust the line by using the EscapeCommFunction function
#V24_MODE_NEED_DSR = $0040 ;If this member is TRUE, the communications driver is sensitive to the state of the DSR signal.
;The driver ignores any bytes received, unless the DSR modem input line is high.
#V24_MODE_CONT_AFTER_XOFF = $0080 ;If this member is TRUE, transmission continues after the input buffer has come within
;XoffLim bytes of being full And the driver has transmitted the XoffChar character To stop
;receiving bytes. If this member is FALSE, transmission does not Continue Until the input buffer
;is within XonLim bytes of being empty And the driver has transmitted the XonChar character To resume reception.
#V24_MODE_XONOFF_SEND = $0100 ;Indicates whether XON/XOFF flow control is used during transmission. If this member is TRUE,
;transmission stops when the XoffChar character is received And starts again when the XonChar character is received.
#V24_MODE_XONOFF_RECV = $0200 ;Indicates whether XON/XOFF flow control is used during reception.
;If this member is TRUE, the XoffChar character is sent when the input buffer
;comes within XoffLim bytes of being full, And the XonChar character is sent
;when the input buffer comes within XonLim bytes of being empty.
#V24_MODE_ACTIVE_PARITY = $0400 ;Indicates whether bytes received with parity errors are replaced with the character specified by the ErrorChar member.
;If this member is TRUE And the fParity member is TRUE, replacement occurs.
#V24_MODE_DISCARD_NULL = $0800 ;If this member is TRUE, null bytes are discarded when received.
#V24_MODE_RTS_MODE_BIT_01 = $1000 ;00 = Disables the RTS line when the device is opened and leaves it disabled.
#V24_MODE_RTS_MODE_BIT_10 = $2000 ;01 = Enables the RTS line when the device is opened and leaves it on.
;10 = Enables RTS handshaking. The driver raises the RTS line when the "type-ahead" (input) buffer is less than
;one-half full And lowers the RTS line when the buffer is more than
;three-quarters full. If handshaking is enabled, it is an error
;for the application To adjust the line by using the EscapeCommFunction function.
;11 = Specifies that the RTS line will be high if bytes are available for transmission.
;After all buffered bytes have been sent, the RTS line will be low.
; !!Windows Me/98/95: This value is not supported.!!
#V24_MODE_STOP_ON_ERROR = $4000 ;If this member is TRUE, the driver terminates all read and write operations with an error status if an error occurs.
;The driver will not accept any further communications operations
;Until the application has acknowledged the error by calling the ClearCommError function.
#V24_MODE_DEFAULT = #V24_MODE_RTS_MODE_BIT_01 | #V24_MODE_CONT_AFTER_XOFF | #V24_MODE_BINARY | #V24_MODE_PARITY_CHECK
Procedure HandleError(Result.l, Text$)
If Result = 0
MessageRequester("Error", Text$, #MB_ICONERROR)
EndIf
EndProcedure
ProcedureDLL.l Open_Com(Com.l, BaudRate.l, Parity.l, StopBits.l, ByteSize.l, Buffer_Size_IN.l, Buffer_Size_OUT.l, Flags.l = #V24_MODE_DEFAULT, TimeOUT.l = 0)
Protected hCom, ct.COMMTIMEOUTS, TimeOut_Const.l, dcb.DCB, PortConfig.DCB, ComError.l
hCom = CreateFile_("\\.\COM" + Str(Com), #GENERIC_READ |#GENERIC_WRITE ,0,0, #OPEN_EXISTING ,#FILE_FLAG_OVERLAPPED ,0)
If hCom <> #INVALID_HANDLE_VALUE
If GetCommState_(hCom, @PortConfig)
;If WindowID And WindowEvent
SetCommMask_(hCom, #EV_RXCHAR )
;EndIf
HandleError( SetupComm_(hCom, Buffer_Size_IN, Buffer_Size_OUT), "SetupComm()" )
TimeOut_Const = 1
If TimeOUT = 0
TimeOUT = 200
EndIf
ct\ReadIntervalTimeout = #MAXDWORD
ct\ReadTotalTimeoutMultiplier = TimeOut
ct\ReadTotalTimeoutConstant = TimeOut_Const
ct\WriteTotalTimeoutMultiplier = TimeOut
ct\WriteTotalTimeoutConstant = TimeOut_Const
HandleError( SetCommTimeouts_(hCom, ct), "SetCommTimeouts()" )
HandleError( GetCommState_(hCom, @dcb), "GetCommState()" )
If Flags = 0
Flags = #V24_MODE_DEFAULT
EndIf
dcb\BaudRate = BaudRate
dcb\Parity = Parity
dcb\StopBits = StopBits
dcb\ByteSize = ByteSize
dcb\fbits = Flags
HandleError( SetCommState_(hCom, @dcb), "SetCommState()" )
ClearCommError_(hCom, @ComError, #Null)
HandleError( PurgeComm_(hCom, #PURGE_TXCLEAR | #PURGE_RXCLEAR), "PurgeComm()")
EndIf
EndIf
ProcedureReturn hCom
EndProcedure
ProcedureDLL.l Close_Com(Com.l)
If Com
CloseHandle_(Com)
EndIf
EndProcedure
ProcedureDLL.l Read_Com(Com.l, Anzahl, *Buffer)
Protected CountBuffer.l, Result.l, o.OVERLAPPED
If Com
ReadFile_(Com, *Buffer, Anzahl, @CountBuffer, @o)
GetOverlappedResult_(Com, @o, @Result, #True)
EndIf
ProcedureReturn Result
EndProcedure
ProcedureDLL Write_Com(Com.l, String.s)
Protected CountBuffer.l, o.OVERLAPPED, Result.l
If Com
WriteFile_(Com, @String, Len(String), @CountBuffer, @o)
GetOverlappedResult_(Com, @o, @Result.l, #True)
EndIf
ProcedureReturn Result
EndProcedure
Wie immer nahezu nix kommentiert, es lebe Learning by Doing (bzw. by Reading)
