{****************************************************************************} {* File Name: CommUnit.pas *} {* Date : 13-SEP-1995 *} {* Date : 09-DEC-2003 fjl reworked for Delphi 7 *} {* call your_object := tcommdriver.create;, then your_object.MyCreate() *} { to init a few critical flags... *} {****************************************************************************} unit CommUnit; interface uses SysUtils, Dialogs; const BAUD110 = 0; {110 baud} BAUD150 = 1; {150 baud} BAUD300 = 2; {300 baud} BAUD600 = 3; {600 baud} BAUD1200 = 4; {1200 baud} BAUD2400 = 5; {2400 baud} BAUD4800 = 6; {4800 baud} BAUD9600 = 7; {9600 baud} BAUD19200 = 8; {19200 baud} BAUD38400 = 9; {38400 baud} BAUD57600 = 10; {57600 baud} BAUD115200 = 11; {115.2 kbaud} PARITY_NONE = 0; {No parity} PARITY_ODD = 1; {ODD parity} PARITY_EVEN = 2; {Even parity} PARITY_SODD = 3; {Sticky ODD parity} PARITY_SEVEN = 4; {Sticky Even parity} LENGTH_5 = 0; {5 bits} LENGTH_6 = 1; {6 bits} LENGTH_7 = 2; {7 bits} LENGTH_8 = 3; {8 bits} STOPBIT_1 = 0; {1 Stop bit} STOPBIT_2 = 1; {2 Stop bit} BREAK_OFF = 0; {Break off} BREAK_ON = 1; {Break on} PROT_RTSRTS = 0; {Local CTS/RTS-Remote CTS/RTS} PROT_RTSXON = 1; {Local CTS/RTS-Remote XON/XOFF} PROT_RTSDTR = 2; {Local CTS/RTS-Remote DSR/DTR} PROT_RTSNON = 3; {Local CTS/RTS-Remote no prot} PROT_NONNON = 4; {Local no prot-Remote no prot} PROT_NONXON = 5; {Local no protocol-Remote XOFF/XON} PROT_XONNON = 6; {Local XOFF/XON-Remote no prot} PROT_XONXON = 7; {Local XON/XOFF-Remote XON/XOFF} PROT_DTRNON = 8; {Local DSR/DTR-Remote no protocol} PROT_DTRRTS = 9; {Local DSR/DTR-Remote CTS/RTS} PROT_DTRDTR = 10; {Local DSR/DTR-Remote DSR/DTR} PROT_DTRXON = 11; {Local DSR/DTR-Remote DSR/DTR} PROT_NONRTS = 12; {Local no prot-Remote CTS/RTS prot} PROT_NONDTR = 13; {Local no prot-Remote DSR/DTR prot} PROT_XONRTS = 14; {Local XOFF/XON- Remote CTS/RTS} PROT_XONDTR = 15; {Local XOFF/XON-Remote DSR/DTR} {/************************************************************************/} {/*=====Cardtype Indeces */} {/************************************************************************/} CARD_NORMAL = 0; { Normal cards } CARD_INTELH = 1; { Intel HUB card(No Longer supported) } CARD_CYCLOMY = 1; { Cyclades ISA & PCI Yx Cards } CARD_DIGCXI = 2; { Digiboard COMXI } CARD_ARNETSPLUS = 3; { Arnet Smartplus } CARD_BOCA1610 = 4; { BOCA 1610 } CARD_DIGPCX = 5; { Digiboard PCX } CARD_GTEK = 6; { GTEK board } CARD_INT14 = 7; { 3rd party INT14H board } CARD_WCSCVXD = 8; { WCSC high speed VxD for 8250 family } CARD_WINAPI = 9; { Uses Windows API } RS232ERR_NONE = 0 ; {RS232 no error} RS232ERR_BUFFER = 1 ; {RS232 buffer not set or buf changed} RS232ERR_ACTIVE = 2 ; {RS232 port not active} RS232ERR_XMTBUF = 3 ; {RS232 xmit buffer full} RS232ERR_RCVBUF = 4 ; {RS232 recv buffer empty} RS232ERR_SYNTAX = 5 ; {RS232 port syntax error} RS232ERR_BUFSIZ = 6 ; {RS232 invalid buffer size} RS232ERR_PORT = 7 ; {RS232 invalid port} RS232ERR_HANDLR = 8 ; {RS232 handler changed} RS232ERR_BAUD = 9 ; {RS232 invalid baud rate} RS232ERR_PARITY = 10; {RS232 invalid parity} RS232ERR_LNGTH = 11; {RS232 invalid data length} RS232ERR_STOPBIT = 12; {RS232 invalid # stopbits} RS232ERR_PROTOCOL = 13; {RS232 invalid protocol} RS232ERR_IRQCHANGED = 14; {RS232 IRQ changed} RS232ERR_PORTCHANGED = 15; {RS232 port changed} RS232ERR_THRESHOLD = 16; {RS232 invalid threshold} RS232ERR_INVIRQ = 17; {RS232 invalid IRQ} RS232ERR_INTOFF = 18; {RS232 interrupts not enabled} RS232ERR_BREAK = 19; {RS232 invalid break syntax} RS232ERR_FATAL = 20; {RS232 fatal error} RS232ERR_DSR = 21; {RS232 CTS error} RS232ERR_INVADR = 22; {RS232 Invalid RS232 address} RS232ERR_ENVIRON = 23; {Environment variable not set } RS232ERR_IOCTL = 24; {Error issuing IOCTL call } RS232ERR_ATEXIT = 25; {Error issuing atexit cleanup } RS232ERR_DEVINIT = 26; {Error mapping device for dir calls} RS232ERR_DOSOPEN = 27; {Error opening Device } RS232ERR_MALLOC = 28; {Error allocating memory } RS232ERR_EXTMICRO = 29; {Error on external micro} RS232ERR_CARDCHANGED = 30; {Card changed error } RS232ERR_CARDTYPE = 31; {Card type error } RS232ERR_NOSUPPORT = 32; {Not supported } RS232ERR_CMDBUFFULL = 33; {Card command buffer full} RS232ERR_PPORT = 34; {Invalid parent PCB} RS232ERR_NODEVICE = 35; {No device for this port} RS232ERR_UNKNOWN = 36; {Unknow error} RS232ERR_BUSY = 37; {Busy} RS232ERR_NOTIMER = 38; {No more timers available} RS232ERR_INT14VEC = 39; {INT 14H vector changed} RS232ERR_INT1CVEC = 40; {Timer vector changed} RS232ERR_DPMI = 41; {DPMI error} RS232ERR_WINBUF = 42; {No windows buffer or too small} RS232ERR_NOASYNCRES = 43; {No asynchronous resources left } RS232ERR_NOTIMERRES = 44; {No timer resources left } RS232ERR_NOOTHERES = 45; {Out of other resources } RS232ERR_FILEIO = 46; {File I/O error } RS232ERR_HMEMG64 = 47; {Hardware memory exceeded 64K } RS232ERR_MAPVXD = 48; {VXD/Kernel Driver not loaded } RS232ERR_THREAD = 49; {Could not start a thread } RS232ERR_MAPVDD = 50; {NT VDD CDRVVDD.DLL not loaded } RS232ERR_PCIBIOS = 51; {No PCI BIOS present } RS232ERR_TSRNOTLOADED = 52; {TSR not loaded } RS232ERR_TIMEOUT = 53; {Timeout } {/************************************************************************/} {/*======Offsets to callbacks from sub-device functions to COMM-DRV */} {/************************************************************************/} CALLBACK_MSR =0 ; { Called on every MSR change int. } CALLBACK_XMT =4 ; { Called on every XMIT interrupt. } CALLBACK_RCV =8 ; { Called on every RCV interrupt. } CALLBACK_LSR =12; { Called on every LSR interrupt. } CALLBACK_SETTIM =16; { Called to set a timer. } CALLBACK_RSTTIM =20; { Called to reset a timer. } CALLBACK_GETPATH =24; { Called to reset a timer. } CALLBACK_GETDATA =28; { Called to get data pointer. */ {/************************************************************************/} {/*======Offsets to sub-device functions */} {/************************************************************************/} CALLDEV_CALLBACK =0 ; { IDX for adr of ptr to c'back funcs } CALLDEV_UINTHDR =4 ; { IDX for sub-dev interrupt handler } CALLDEV_UDTROFF =8 ; { IDX for sub-dev dtr_off function } CALLDEV_UDTRON =12; { IDX for sub-dev dtr_on function } CALLDEV_UGETREG =16; { IDX for sub-dev get uart reg func } CALLDEV_UIPRIME =20; { IDX for sub-dev input primer } CALLDEV_UOPRIME =24; { IDX for sub-dev output primer } CALLDEV_UPUTREG =28; { IDX for sub-dev put uart reg func } CALLDEV_URESET =32; { IDX for sub-dev reset/cleanup } CALLDEV_URTSOFF =36; { IDX for sub-dev rts_off } CALLDEV_URTSON =40; { IDX for sub-dev rts_on } CALLDEV_USETUP =44; { IDX for sub-dev init/setup } CALLDEV_UXMIT =48; { IDX for sub-dev xmit trigger } CALLDEV_UKXMIT =52; { IDX for sub-dev kill xmitter } CALLDEV_UIXMIT =56; { IDX for sub-dev immediate xmit } CALLDEV_UBAUDIV =60; { IDX for sub-dev baud rate divisor } CALLDEV_INTENTER =64; { IDX for sub-dev enter isr } CALLDEV_INTEXIT =68; { IDX for sub-dev exit isr } CALLDEV_MPX =72; { IDX for multiplex functions } COMMDRV_SUBDEV_FLAG =96; { Offset to subdevice flags */ {/************************************************************************/} {/*======Auxiliary flag bits(auxpcb.aux_flag) */} {/************************************************************************/} AUXFLAG_BRKERR = $00000001; { Set=Break error occurred } AUXFLAG_FRAMERR = $00000002; { Set=Framing error occurred } AUXFLAG_IOVRERR = $00000004; { Set=Input overrun occurred } AUXFLAG_OVRERR = $00000008; { Set=UART overrun occurred } AUXFLAG_PARERR = $00000010; { Set=Parity error occurred } AUXFLAG_RING = $00000020; { Set=Ring detected on UART } AUXFLAG_XFERDLG = $00000040; { Set=Show File Xfer Dialog } AUXFLAG_XFERCAN = $00000080; { Set=Cancel File Xfer } AUXFLAG_NOMSGLOOP = $00000100; { Set=No to 2ndary Msg Loop } AUXFLAG_NOTIMER = $00000200; { Set=No to timer routine } AUXFLAG_SWITCHONDELAY = $00000400; { Set=Force context on del } AUXFLAG_9BITTOGGLE1 = $00000800; { Nine bit toggle} AUXFLAG_9BITTOGGLE2 = $00001000; { Nine bit toggle} AUXFLAG_SLEEPONDELAY = $00001000; { Set=Force Sleep on delay } type pWord = ^word; eStatusTypes = (stCarrierDetect, stBreak, stCTS, stDSR, stFramingError, stInputOverrun, stParityError, stRinging, stPortAvailable, stReceiveBufferEmpty, stTransmitBufferEmpty, stOverrunError); eBufferType = (btReceiveBuffer, btTransmitBuffer); eBaudRates = (br110, br150, br300, br600, br1200, br2400, br4800, br9600, br19200, br38400, br57600, br115200); eParity = (parNone, parOdd, parEven); eLength = (lt5, lt6, lt7, lt8); eStopBits = (sb1, sb2); eProtocolTypes = (ptRTSRTS, ptRTSXON, ptRTSDTR, ptRTSNON, ptNONNON, ptXONNON, ptNONXON, ptXONXON, ptDTRNON, ptDTRRTS, ptDTRDTR, ptDTRXON, ptNONRTS, ptNONDTR, ptXONRTS, ptXONDTR); tCommDriver = class private mBytesRead, mBytesWritten : longint; mDiagLevel, mPort, mSubPort : integer; mAddress, mIRQ, mCardType, mCardSeg, mInBufferLength, mOutBufferLength, mFlag : word; mFileStream : file; bFileStream: boolean; public procedure MyCreate(); { unable to override the static class constructor } procedure setDiag(level: integer); procedure DisplayErrorMessage(value_Error : integer); function returnBytesWritten : longint; procedure resetBytesWritten; function returnBytesRead : longint; procedure resetBytesRead; function BytesInBuffer(param_BufferType : eBufferType; var value_ReturnValue : integer) : boolean; function SetDTR(value_DTR : boolean) : boolean; function FlushBuffer(param_BufferType : eBufferType) : boolean; { byte/buffer and save to file retrieval if filename has been assigned } function setFile(fileName : string): boolean; procedure closeStream; function RetrieveByte(var value_Byte : byte) : boolean; function RetrievePacket(param_Length : integer; value_Packet : pChar) : boolean; function RetrievePacketCnt(param_Length : integer; value_Packet : pChar) : integer; function RetrieveTimeout(var value_Timeout : word) : boolean; function OInitPort(value_subport : longint; value_InBufferLength : longint; value_OutBufferLength : longint): longint; function InitPort(value_Port : integer; value_SubPort : integer; value_Address : word; value_IRQ : word; value_CardType : word; value_CardSeg : word; value_InBufferLength : word; value_OutBufferLength : word; value_Flag : word) : boolean; function UnInitPort : boolean; function CheckStatus(param_StatusToCheck : eStatusTypes) : boolean; function PeekCharacter(var value_Byte : byte) : boolean; { character/buffer based transmission } function SendByte(value_Byte : byte) : boolean; function SendPacket(param_Length : integer; value_Packet : pChar) : boolean; function BufferSize(param_BufferType : eBufferType; var value_BufferSize : integer) : boolean; function SetRTS(value_RTS : boolean) : boolean; function SendBreakSignal(param_Length : integer) : boolean; function SetBaudRate(value_NewBaudRate : eBaudRates) : boolean; function SetParameters(param_BaudRate : eBaudRates; param_Parity : eParity; param_Length : eLength; param_Stopbit : eStopBits; param_Protocol : eProtocolTypes) : boolean; end; implementation procedure tCommDriver.MyCreate(); begin bFileStream := False; mDiagLevel := 0; end; {*****************************************************************************************} {*****************************************************************************************} (*{**} struct port_param FAR * FARPAS CdrvGetPcb(int port); int FARPAS CdrvSetTimeoutFunction(int port,int (FAR *func)(int port)); int FARPAS CdrvSetTimerResolution(int port,int resolution); int FARPAS WaitFor(int port,int timeout,char FAR *out,char FAR *in); int FARPAS WaitForFixed(int port,int timeout,char FAR *out, char FAR *in,int olen,int ilen); int FARPAS WaitForPeek(int port,int timeout,char FAR *out,char FAR *in); int FARPAS WaitForPeekFixed(int port,int timeout,char FAR *out, char FAR *in,int olen,int ilen); int FARPAS WaitForPeekTable(int port,int timeout,char FAR *out, char FAR * FAR *in); int FARPAS WaitForPeekTableFixed(int port,int timeout,char FAR *out, char FAR * FAR *in,int olen,int *ilen); int FARPAS WaitForTable(int port,int timeout,char FAR *out,char FAR * FAR *in); int FARPAS WaitForTableFixed(int port,int timeout,char FAR *out, char FAR * FAR *in,int olen,int *ilen); {**}*) function BytesInReceiveBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function BytesInTransmitBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function DtrOff(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function DtrOn(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function FlushReceiveBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function FlushTransmitBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function GetByte(port: integer): byte; stdcall far; external 'cdrvhf32.dll'; function GetPaceTime(port : integer): word; stdcall far; external 'cdrvhf32.dll'; function GetPacket(port : integer; len : integer; pkt : pChar): integer; stdcall far; external 'cdrvhf32.dll'; function GetString(port : integer; len : integer; str : pChar): integer; stdcall far; external 'cdrvhf32.dll'; function GetTimeout(port : integer): word; stdcall far; external 'cdrvhf32.dll'; function InitializePort(port, subport : integer; addr, irq, cardtype, cardseg, inbuflen, outbuflen, flag : word): integer; stdcall far; external 'cdrvhf32.dll'; function OpenComPort(port, inbuflen, outbuflen: longint): longint; stdcall far; external 'cdrvhf32.dll'; function IsBreak(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsCarrierDetect(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsCts(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsDsr(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsFramingError(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsInputOverrun(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsOverrunError(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsParityError(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsPortAvailable(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsReceiveBufferEmpty(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsRing(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function IsTransmitBufferEmpty(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function PeekChar(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function PutByte(port : integer; ch : byte): integer; stdcall far; external 'cdrvhf32.dll'; function PutPacket(port, len : integer; pkt : PChar): integer; stdcall far; external 'cdrvhf32.dll'; function PutString(port : integer; str : PChar): integer; stdcall far; external 'cdrvhf32.dll'; function ReceiveBufferSize(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function RtsOff(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function RtsOn(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SendBreak(port : integer; timeval : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SetBaud(port : integer; baud : word): integer; stdcall far; external 'cdrvhf32.dll'; function SetFlowControlCharacters(port, xoff, xon, xxoff, xxon : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SetFlowControlThreshold(port, inbuf_low, inbuf_high : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SetPaceTime(port, timeval : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SetPortCharacteristics(port : integer; baud, parity, length, Stopbit, Protocol : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SetTimeout(port, timeval : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SpaceInReceiveBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function SpaceInTransmitBuffer(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function TransmitBufferSize(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; function UnInitializePort(port : integer): integer; stdcall far; external 'cdrvhf32.dll'; {*****************************************************************************************} {* Wrap up example to convert the functions into a Delphi Unit *} {*****************************************************************************************} procedure tCommDriver.setDiag(level: integer); begin mDiagLevel := level; end; procedure tCommDriver.closeStream; begin if bFileStream then begin closeFile(mFileStream); bFileStream := false; end; end; function tCommDriver.setFile(fileName : string): boolean; begin if bFileStream then closeStream; {$I-} assignFile(mFileStream, fileName); reWrite(mFileStream, 1); {$I+} if IOResult = 0 then bFileStream := true; setFile := bFileStream; end; procedure tCommDriver.DisplayErrorMessage(value_Error : integer); var serr: string; begin if mDiagLevel > 0 then begin case value_Error of RS232ERR_NONE : ShowMessage('There was no error'); RS232ERR_BUFFER : ShowMessage('RS-232 Buffer not set or Buffer Changed'); RS232ERR_ACTIVE : ShowMessage('RS-232 Port Already Active'); RS232ERR_XMTBUF : ShowMessage('RS-232 Transmit Buffer Full'); RS232ERR_RCVBUF : ShowMessage('RS-232 Receive Buffer Empty'); RS232ERR_SYNTAX : ShowMessage('RS-232 Port Syntax Error'); RS232ERR_BUFSIZ : ShowMessage('RS-232 Invalid Buffer Size'); RS232ERR_PORT : ShowMessage('RS-232 Invalid Port'); RS232ERR_HANDLR : ShowMessage('RS-232 Handler changed'); RS232ERR_BAUD : ShowMessage('RS-232 Invalid Baud rate'); RS232ERR_PARITY : ShowMessage('RS-232 Invalid parity'); RS232ERR_LNGTH : ShowMessage('RS-232 Invalid data length'); RS232ERR_STOPBIT : ShowMessage('RS-232 Invalid # stopbits'); RS232ERR_PROTOCOL : ShowMessage('RS-232 Invalid protocol'); RS232ERR_IRQCHANGED : ShowMessage('RS-232 IRQ changed'); RS232ERR_PORTCHANGED : ShowMessage('RS-232 Port changed'); RS232ERR_THRESHOLD : ShowMessage('RS-232 Invalid threshold'); RS232ERR_INVIRQ : ShowMessage('RS-232 Invalid IRQ'); RS232ERR_INTOFF : ShowMessage('RS-232 Interrupts not enabled'); RS232ERR_BREAK : ShowMessage('RS-232 Invalid break syntax'); RS232ERR_FATAL : ShowMessage('RS-232 Fatal error'); RS232ERR_DSR : ShowMessage('RS-232 CTS error'); RS232ERR_INVADR : ShowMessage('RS232 Invalid RS232 address'); RS232ERR_ENVIRON : ShowMessage('Environment variable not set'); RS232ERR_IOCTL : ShowMessage('Error issuing IOCTL call'); RS232ERR_ATEXIT : ShowMessage('Error issuing atexit cleanup'); RS232ERR_DEVINIT : ShowMessage('Error mapping for dir calls'); RS232ERR_DOSOPEN : ShowMessage('Error opening Device'); RS232ERR_MALLOC : ShowMessage('Error allocating memory'); RS232ERR_EXTMICRO : ShowMessage('Error on external micro'); RS232ERR_CARDCHANGED : ShowMessage('Card changed error'); RS232ERR_CARDTYPE : ShowMessage('Card type error'); RS232ERR_NOSUPPORT : ShowMessage('Not supported'); RS232ERR_CMDBUFFULL : ShowMessage('Card command buffer full'); RS232ERR_PPORT : ShowMessage('Invalid parent PCB'); RS232ERR_NODEVICE : ShowMessage('No device for this port'); RS232ERR_UNKNOWN : ShowMessage('Unknown error'); RS232ERR_BUSY : ShowMessage('Busy'); RS232ERR_NOTIMER : ShowMessage('No more timers available'); RS232ERR_INT14VEC : ShowMessage('INT 14H vector changed'); RS232ERR_INT1CVEC : ShowMessage('Timer vector changed'); RS232ERR_DPMI : ShowMessage('DPMI error'); RS232ERR_WINBUF : ShowMessage('No windows buffer or too small'); RS232ERR_NOASYNCRES : ShowMessage('No asynchronous resources left'); RS232ERR_NOTIMERRES : ShowMessage( 'No timer resources left'); RS232ERR_NOOTHERES : ShowMessage('Out of other resources'); RS232ERR_FILEIO : ShowMessage('File I/O error'); RS232ERR_HMEMG64 : ShowMessage('Hardware memory exceeded 64K'); RS232ERR_MAPVXD : ShowMessage('VxD not present/other VxD error;'); else str(value_Error, serr); ShowMessage('Unknown error ' + serr); end; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.returnBytesWritten : longint; begin returnBytesWritten := mBytesWritten; end; function tCommDriver.returnBytesRead : longint; begin returnBytesRead := mBytesRead; end; procedure tCommDriver.resetBytesWritten ; begin mBytesWritten := 0; end; procedure tCommDriver.resetBytesRead ; begin mBytesRead := 0; end; function tCommDriver.BytesInBuffer(param_BufferType : eBufferType; var value_ReturnValue : integer) : boolean; var ReturnValue: integer; begin ReturnValue := -1; case param_BufferType of btReceiveBuffer : ReturnValue := BytesInReceiveBuffer(mPort); btTransmitBuffer : ReturnValue := BytesInTransmitBuffer(mPort); end; if ReturnValue = -1 then BytesInBuffer := false else begin BytesInBuffer := true; value_ReturnValue := ReturnValue; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SetDTR(value_DTR : boolean) : boolean; var ReturnValue : integer; begin ReturnValue := -1; case value_DTR of true : ReturnValue := DtrOn(mPort); false : ReturnValue := DtrOff(mPort); end; setDTR := ReturnValue <> -1; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.FlushBuffer(param_BufferType : eBufferType) : boolean; var ReturnValue : integer; begin ReturnValue := -1; case param_BufferType of btReceiveBuffer : ReturnValue := FlushReceiveBuffer(mPort); btTransmitBuffer : ReturnValue := FlushTransmitBuffer(mPort); end; flushBuffer := returnValue <> -1; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.RetrieveByte(var value_Byte : byte) : boolean; var ReturnValue : integer; begin ReturnValue := GetByte(mPort); if ReturnValue = -1 then RetrieveByte := false else begin inc(mBytesRead); value_Byte := ReturnValue; RetrieveByte := true; if bFileStream then blockWrite(mFileStream, value_Byte, sizeOf(value_Byte)); end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.RetrievePacket(param_Length : integer; value_Packet : pChar) : boolean; var ReturnValue : integer; begin if param_Length > 0 then begin ReturnValue := GetPacket(mPort, param_Length, value_Packet); if ReturnValue = -1 then RetrievePacket := false else begin mBytesRead := mBytesRead + returnValue; RetrievePacket := true; value_Packet[ReturnValue] := chr(0); { assign the null termination } if bFileStream then blockWrite(mFileStream, value_Packet, strLen(value_Packet)); end; end else RetrievePacket := false; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.RetrievePacketCnt(param_Length: integer; value_Packet : pChar) : integer; var ReturnValue : integer; begin if param_Length > 0 then begin ReturnValue := GetPacket(mPort, param_Length, value_Packet); if ReturnValue = -1 then RetrievePacketCnt := 0 else begin mBytesRead := mBytesRead + returnValue; RetrievePacketCnt := ReturnValue; value_Packet[ReturnValue] := chr(0); { assign the null termination } if bFileStream then blockWrite(mFileStream, value_Packet, strLen(value_Packet)); end; end else RetrievePacketCnt := 0; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.RetrieveTimeout(var value_Timeout : word) : boolean; var ReturnValue : word; begin ReturnValue := GetTimeout(mPort); if ReturnValue = $ffff then RetrieveTimeout := false else begin RetrieveTimeout := true; value_Timeout := ReturnValue; end; end; {****************************************************************************} {* The normal port initialize 0=com1, 1=com2... you supply handle... *} {****************************************************************************} function tCommDriver.InitPort(value_Port : integer; value_SubPort : integer; value_Address : word; value_IRQ : word; value_CardType : word; value_CardSeg : word; value_InBufferLength : word; value_OutBufferLength : word; value_Flag : word): boolean; var ReturnValue : integer; begin mBytesRead := 0; mBytesWritten := 0; ReturnValue := InitializePort(value_Port, value_SubPort, value_Address, value_IRQ, value_CardType, value_CardSeg, value_InBufferLength, value_OutBufferLength, value_Flag); if ReturnValue <> RS232ERR_NONE then begin InitPort := false; DisplayErrorMessage(ReturnValue); end else begin mPort := value_Port; mSubPort := value_SubPort; mAddress := value_Address; mIRQ := value_IRQ; mCardType := value_CardType; mCardSeg := value_CardSeg; mInBufferLength := value_InBufferLength; mOutBufferLength := value_OutBufferLength; mFlag := value_Flag; InitPort := true; end; end; {****************************************************************************} {* The WIN_API only port initialize 1=com1, 2=com2... the handle >= 0 if opened *} {****************************************************************************} function tCommDriver.OInitPort(value_subport : longint; value_InBufferLength : longint; value_OutBufferLength : longint): longint; var ReturnValue : longint; port_plus : integer; begin mBytesRead := 0; mBytesWritten := 0; port_plus := value_subport + 1; ReturnValue := OpenComPort(port_plus, value_InBufferLength,value_OutBufferLength); if ReturnValue < 0 then begin OInitPort := ReturnValue; DisplayErrorMessage(-ReturnValue); end else begin mPort := ReturnValue; mAddress := 0; mIRQ := 0; mCardSeg := 0; mSubPort := value_SubPort; mCardType := CARD_WINAPI; mInBufferLength := value_InBufferLength; mOutBufferLength := value_OutBufferLength; mFlag := 0; OInitPort := ReturnValue; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.UnInitPort : boolean; var ReturnValue : integer; begin ReturnValue := UnInitializePort(mPort); if (ReturnValue <> RS232ERR_NONE) then begin UnInitPort := false; ShowMessage('tCommDriver.UnInitPort Failed'); end else UnInitPort := true; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.CheckStatus(param_StatusToCheck : eStatusTypes) : boolean; var ReturnValue : integer; begin case param_StatusToCheck of stCarrierDetect : ReturnValue := IsCarrierDetect(mPort); stBreak : ReturnValue := IsBreak(mPort); stCTS : ReturnValue := IsCTS(mPort); stDSR : ReturnValue := IsDSR(mPort); stFramingError : ReturnValue := IsFramingError(mPort); stInputOverrun : ReturnValue := IsInputOverrun(mPort); stOverrunError : ReturnValue := IsOverrunError(mPort); stParityError : ReturnValue := IsParityError(mPort); stRinging : ReturnValue := IsRing(mPort); stPortAvailable : ReturnValue := IsPortAvailable(mPort); stReceiveBufferEmpty : ReturnValue := IsReceiveBufferEmpty(mPort); stTransmitBufferEmpty : ReturnValue := IsTransmitBufferEmpty(mPort); else returnValue := 0; end; checkStatus := returnValue = 1; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.PeekCharacter(var value_Byte : byte) : boolean; var ReturnValue : integer; begin ReturnValue := PeekChar(mPort); if ReturnValue = -1 then PeekCharacter := false else begin PeekCharacter := true; value_Byte := ReturnValue; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SendByte(value_Byte : byte) : boolean; var ReturnValue : integer; begin ReturnValue := PutByte(mPort, value_Byte); if ReturnValue = -1 then SendByte := false else begin SendByte := true; inc(mBytesWritten); end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SendPacket(param_Length : integer; value_Packet : pChar) : boolean; var ReturnValue : integer; begin ReturnValue := PutPacket(mPort, param_Length, value_Packet); if ReturnValue = -1 then SendPacket := false else begin SendPacket := true; mBytesWritten := mBytesWritten + param_Length; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.BufferSize(param_BufferType : eBufferType; var value_BufferSize : integer) : boolean; var ReturnValue : integer; begin ReturnValue := -1; case param_BufferType of btReceiveBuffer : ReturnValue := ReceiveBufferSize(mPort); btTransmitBuffer : ReturnValue := TransmitBufferSize(mPort); end; if ReturnValue = -1 then BufferSize := false else begin BufferSize := true; value_BufferSize := ReturnValue; end; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SetRTS(value_RTS : boolean) : boolean; var ReturnValue : integer; begin ReturnValue := -1; case value_RTS of true : ReturnValue := RtsOn(mPort); false : ReturnValue := RtsOff(mPort); end; setRTS := returnValue <> -1; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SendBreakSignal(param_Length : integer) : boolean; var ReturnValue : integer; begin ReturnValue := SendBreak(mPort, param_Length); sendBreakSignal := returnValue <> -1; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SetBaudRate(value_NewBaudRate : eBaudRates) : boolean; var returnValue : integer; begin case value_newBaudRate of br110 : returnValue := setBaud(mPort, BAUD110); br150 : returnValue := setBaud(mPort, BAUD150); br300 : returnValue := setBaud(mPort, BAUD300); br600 : returnValue := setBaud(mPort, BAUD600); br1200 : returnValue := setBaud(mPort, BAUD1200); br2400 : returnValue := setBaud(mPort, BAUD2400); br4800 : returnValue := setBaud(mPort, BAUD4800); br9600 : returnValue := setBaud(mPort, BAUD9600); br19200 : returnValue := setBaud(mPort, BAUD19200); br38400 : returnValue := setBaud(mPort, BAUD38400); br57600 : returnValue := setBaud(mPort, BAUD57600); br115200 : returnValue := setBaud(mPort, BAUD115200); else returnValue := setBaud(mPort, BAUD9600); end; if ReturnValue <> RS232ERR_NONE then begin SetBaudRate := False; DisplayErrorMessage(ReturnValue); end else SetBaudRate := true; end; {****************************************************************************} {* *} {****************************************************************************} function tCommDriver.SetParameters(param_BaudRate : eBaudRates; param_Parity : eParity; param_Length : eLength; param_StopBit : eStopBits; param_Protocol : eProtocolTypes) : boolean; var cdrv_BaudRate, cdrv_Parity, cdrv_Length, cdrv_StopBit, cdrv_Protocol : integer; ReturnValue : integer; begin case param_BaudRate of br110 : cdrv_BaudRate := BAUD110; br150 : cdrv_BaudRate := BAUD150; br300 : cdrv_BaudRate := BAUD300; br600 : cdrv_BaudRate := BAUD600; br1200 : cdrv_BaudRate := BAUD1200; br2400 : cdrv_BaudRate := BAUD2400; br4800 : cdrv_BaudRate := BAUD4800; br9600 : cdrv_BaudRate := BAUD9600; br19200 : cdrv_BaudRate := BAUD19200; br38400 : cdrv_BaudRate := BAUD38400; br57600 : cdrv_BaudRate := BAUD57600; br115200 : cdrv_BaudRate := BAUD115200; else cdrv_BaudRate := BAUD9600; end; case param_Parity of parNone : cdrv_Parity := PARITY_NONE; parOdd : cdrv_Parity := PARITY_ODD; parEven : cdrv_Parity := PARITY_EVEN; else cdrv_Parity := PARITY_NONE; end; case param_Length of lt5 : cdrv_Length := LENGTH_5; lt6 : cdrv_Length := LENGTH_6; lt7 : cdrv_Length := LENGTH_7; lt8 : cdrv_Length := LENGTH_8; else cdrv_Length := LENGTH_8; end; case param_StopBit of sb1 : cdrv_StopBit := STOPBIT_1; sb2 : cdrv_StopBit := STOPBIT_2; else cdrv_StopBit := STOPBIT_1; end; case param_Protocol of ptRTSRTS : cdrv_Protocol := PROT_RTSRTS; ptRTSXON : cdrv_Protocol := PROT_RTSXON; ptRTSDTR : cdrv_Protocol := PROT_RTSDTR; ptRTSNON : cdrv_Protocol := PROT_RTSNON; ptNONNON : cdrv_Protocol := PROT_NONNON; ptXONNON : cdrv_Protocol := PROT_XONNON; ptNONXON : cdrv_Protocol := PROT_NONXON; ptXONXON : cdrv_Protocol := PROT_XONXON; ptDTRNON : cdrv_Protocol := PROT_DTRNON; ptDTRRTS : cdrv_Protocol := PROT_DTRRTS; ptDTRDTR : cdrv_Protocol := PROT_DTRDTR; ptDTRXON : cdrv_Protocol := PROT_DTRXON; ptNONRTS : cdrv_Protocol := PROT_NONRTS; ptNONDTR : cdrv_Protocol := PROT_NONDTR; ptXONRTS : cdrv_Protocol := PROT_XONRTS; ptXONDTR : cdrv_Protocol := PROT_XONDTR; else cdrv_Protocol := PROT_NONNON; end; ReturnValue := SetPortCharacteristics(mPort, cdrv_BaudRate, cdrv_Parity, cdrv_Length, cdrv_StopBit, cdrv_Protocol); if ReturnValue <> RS232ERR_NONE then begin SetParameters := False; DisplayErrorMessage(ReturnValue); end else SetParameters := true; end; end.