TheGameCreators - CodeBase - Low level serial and parallel port access with Dark Basic Pro

Return to the CodeBase listing

Category: Input / Output

Version: 1.0

Information

Uploaded: 9th Dec 2004 09:58

Modified: 1st Jan 1970 01:00

Author: Twilight zone

Summary

Low level serial and Parallel port access with Dark Basic Pro. tested and working with 5.7.

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

`###########################################################################################################

`  Serial and LPT Port Access

`  Uses Information Gathered from MSDN article 823179 and various parts of MSDN Knowledge base

`###########################################################################################################

#CONSTANT GENERIC_READ = 0x80000000

#CONSTANT GENERIC_WRITE = 0x40000000

#CONSTANT OPEN_EXISTING = 3

#CONSTANT FILE_ATTRIBUTE_NORMAL = 0x80

#CONSTANT NOPARITY = 0

#CONSTANT ONESTOPBIT = 0

#CONSTANT MAXDWORD = 4294967295

#CONSTANT SETXOFF =            1

` Simulate XOFF received

#CONSTANT SETXON  =            2

` Simulate XON received

#CONSTANT SETRTS  =            3

` Set RTS high

#CONSTANT CLRRTS  =            4

` Set RTS low

#CONSTANT SETDTR  =            5

` Set DTR high

#CONSTANT CLRDTR  =            6

` Set DTR low

#CONSTANT RESETDEV =           7

` Reset device if possible

#CONSTANT SETBREAK =           8

` Set the device break line.

#CONSTANT CLRBREAK =           9

` Clear the device break line.

#CONSTANT BUFFER_SIZE = 256

#CONSTANT KERNEL_DLL_ID = 1

#CONSTANT DCB_MEMBLOCK_ID = 1

#CONSTANT TIMEOUTS_MEMBLOCK_ID = 2

#CONSTANT IO_BUFFER_MEMBLOCK_ID = 3

#CONSTANT BYTES_READ_WRITE_ID = 4

Type T_DCB

DCBlength as dword

BaudRate as dword

fBinary as dword

fParity as dword

fOutxCtsFlow as dword

fOutcDsrFlow as dword

fDtrControl as dword

fDsrSensitivity as dword

fTXContinueONXoff as dword

fOutX as dword

fInX as dword

fErrorChar as dword

fNull as dword

fRtsControl as dword

fAbortOnError as dword

fDummy as dword

XonLim as word

XoffLim as word

ByteSize as byte

Parity as byte

StopBits as byte

XonChar as byte

XoffChar as byte

ErrorChar as byte

EofChar as byte

EvtChar as byte

wReservedl as word

endtype

type T_COMMTIMEOUTS

ReadIntervalTimeout as dword

ReadTotalTimeoutMultiplier as dword

ReadTotalTimeOutConstant as dword

WriteTotalTimeoutMultiplier as dword

WriteTotalTimeoutConstant as dword

endtype

`These Global variables will have to be inserted into you main source file

global hPort as dword

global DCB as T_DCB

global CommTimeouts as T_COMMTIMEOUTS

global Buffer as string

global Success as dword

`##########################################################################################################################

`  Initialization Driver

`##########################################################################################################################

Initialize_Serial_Driver()

`##########################################################################################################################

`  Initialize port

`##########################################################################################################################

hPort = CreateFile("COM1", GENERIC_READ || GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

` Can use "COM2", "LPT1", etc...

print "Successfully open COM1!(Press any key to continue)"

wait key

`##########################################################################################################################

`  Get Current COM port Settings

`##########################################################################################################################

Success = GetCommState(hPort)

print "Successfully retrieved COM Settings!(Press any key to continue)"

print "Baud Rate :" ;DCB.BaudRate

print "ByteSize :";DCB.ByteSize

print "Parity :"; DCB.Parity

print "StopBits :";DCB.StopBits

wait key

`##########################################################################################################################

`  Change Com Port Settings

`##########################################################################################################################

DCB.BaudRate = 9600

DCB.ByteSize = 8

DCB.Parity = NOPARITY

DCB.StopBits = ONESTOPBIT

Success = SetCommState(hPort)

print "Successfully Set COM port values!(Press any key to continue)"

wait key

`#########################################################################################################################

`  Get COM port Settings (again)

`#########################################################################################################################

Success = GetCommState(hPort)

print "Successfully retrieved COM Settings!(Press any key to continue)"

print "Baud Rate :" ;DCB.BaudRate

print "ByteSize :";DCB.ByteSize

print "Parity :"; DCB.Parity

print "StopBits :";DCB.StopBits

wait key

`########################################################################################################################

`  Get COM port Timeouts

`########################################################################################################################

Success = GetCommTimeouts(hPort)

print "Successfully retrieved COM Timeouts!(Press any key to continue)"

print "ReadIntervalTimeout = "; CommTimeouts.ReadIntervalTimeout

print "ReadTotalTimeoutConstant = "; CommTimeouts.ReadTotalTimeoutConstant

print "ReadTotalTimeoutMultiplier = "; CommTimeouts.ReadTotalTimeoutMultiplier

print "WriteTotalTimeoutConstant = "; CommTimeouts.WriteTotalTimeoutConstant

print "WriteTotalTimeoutMultiplier = ";CommTimeouts.WriteTotalTimeoutMultiplier

wait key

`########################################################################################################################

`  Set COM port Timeouts

`########################################################################################################################

CommTimeouts.ReadIntervalTimeout = 100

CommTimeouts.ReadTotalTimeoutConstant = 3000 :`In Milliseconds

CommTimeouts.ReadTotalTimeoutMultiplier = 0

CommTimeouts.WriteTotalTimeoutConstant = 1000

CommTimeouts.WriteTotalTimeoutMultiplier = 0

Success = SetCommTimeouts(hPort)

print "Successfully set COM Timeouts!(Press any key to continue)"

wait key

`########################################################################################################################

`  Get COM port Timeouts

`########################################################################################################################

Success = GetCommTimeouts(hPort)

print "Successfully retrieved COM Timeouts!(Press any key to continue)"

print "ReadIntervalTimeout = "; CommTimeouts.ReadIntervalTimeout

print "ReadTotalTimeoutConstant = "; CommTimeouts.ReadTotalTimeoutConstant

print "ReadTotalTimeoutMultiplier = "; CommTimeouts.ReadTotalTimeoutMultiplier

print "WriteTotalTimeoutConstant = "; CommTimeouts.WriteTotalTimeoutConstant

print "WriteTotalTimeoutMultiplier = ";CommTimeouts.WriteTotalTimeoutMultiplier

wait key

`########################################################################################################################

`  Clear DTR

`########################################################################################################################

Success = EscapeCommFunction(hPort,CLRDTR)

print "Successfully cleared DTR!(Press any key to continue)"

wait key

`#######################################################################################################################

`  Read From Serial Port

`#######################################################################################################################

print "Reading from Serial Port...Please wait."

repeat

success = ReadFile(hPort, BUFFER_SIZE - 1)

print "Serial in Data (Press ENTER to continue): "; buffer

until returnkey()

`######################################################################################################################

`  Write To Serial Port

`######################################################################################################################

buffer = "Hello!"

repeat

success = WriteFile(hPort, len(buffer))

print "Serial out Data (Press space to continue): ";buffer

until spacekey()

`#######################################################################################################################

`  Close the COM port

`#######################################################################################################################

Success = CloseHandle(hPort)

print "Done!"

wait key

Cleanup_Memory()

end

`#######################################################################################################################

`  Internal Functions

`#######################################################################################################################

function Initialize_Serial_Driver()

load dll "\windows\system32\kernel32.dll", KERNEL_DLL_ID

if dll exist(KERNEL_DLL_ID) = 0

Print "Could not find kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "CreateFileA") = 0

Print "Could not find CreateFile command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "GetCommState") = 0

Print "Could not find GetCommState command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "SetCommState") = 0

Print "Could not find SetCommState command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "GetCommTimeouts") = 0

Print "Could not find GetCommTimeouts command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "SetCommTimeouts") = 0

Print "Could not find SetCommTimeouts command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "ReadFile") = 0

Print "Could not find ReadFile command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "WriteFile") = 0

Print "Could not find WriteFile command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "CloseHandle") = 0

Print "Could not find CloseHandle command in kernel32.dll"

wait key

end

endif

if dll call exist(KERNEL_DLL_ID, "EscapeCommFunction") = 0

Print "Could not find EscapeCommFunction command in kernel32.dll"

wait key

end

endif

Make memblock DCB_MEMBLOCK_ID, 80 : ` For DCB

Make memblock TIMEOUTS_MEMBLOCK_ID, 20 : ` For TimeOuts

Make memblock IO_BUFFER_MEMBLOCK_ID, BUFFER_SIZE : `I/O buffer

Make memblock BYTES_READ_WRITE_ID, 4 : `Bytes Written or Read

endfunction

function CreateFile(lpFileName as String, dwDesiredAccess as Dword, dwShareMode as dword, lpSecurityAttributes as dword, dwCreationDisposition as Dword, dwFlagsAndAttributes as dword, hTemplateFile as Dword)

ret = call dll (KERNEL_DLL_ID, "CreateFileA",lpFilename, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)

if ret = -1

Print "Could not retrieve handle for COM port.(Is something else using the Port?)"

wait key

end

endif

endfunction ret

function GetCommState(nCid as dword)

ret = call dll (KERNEL_DLL_ID, "GetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))

if ret = 0

print "Could not get Com port state"

wait key

end

endif

DCB.DCBlength  = memblock dword(DCB_MEMBLOCK_ID,0)

DCB.BaudRate  = memblock dword(DCB_MEMBLOCK_ID,4)

DCB.fBinary  = memblock dword(DCB_MEMBLOCK_ID,8)

DCB.fParity  = memblock dword(DCB_MEMBLOCK_ID,12)

DCB.fOutxCtsFlow  = memblock dword(DCB_MEMBLOCK_ID,16)

DCB.fOutcDsrFlow  = memblock dword(DCB_MEMBLOCK_ID,20)

DCB.fDtrControl  = memblock dword(DCB_MEMBLOCK_ID,24)

DCB.fDsrSensitivity  = memblock dword(DCB_MEMBLOCK_ID,28)

DCB.fTXContinueONXoff  = memblock dword(DCB_MEMBLOCK_ID,32)

DCB.fOutX  = memblock dword(DCB_MEMBLOCK_ID,36)

DCB.fInX  = memblock dword(DCB_MEMBLOCK_ID,40)

DCB.fErrorChar  = memblock dword(DCB_MEMBLOCK_ID,44)

DCB.fNull  = memblock dword(DCB_MEMBLOCK_ID,48)

DCB.fRtsControl  = memblock dword(DCB_MEMBLOCK_ID,52)

DCB.fAbortOnError  = memblock dword(DCB_MEMBLOCK_ID,56)

DCB.fDummy  = memblock dword(DCB_MEMBLOCK_ID,60)

DCB.XonLim  = memblock word(DCB_MEMBLOCK_ID,64)

DCB.XoffLim  = memblock word(DCB_MEMBLOCK_ID,66)

DCB.ByteSize  = memblock byte(DCB_MEMBLOCK_ID,68)

DCB.Parity  = memblock byte(DCB_MEMBLOCK_ID,69)

DCB.StopBits  = memblock byte(DCB_MEMBLOCK_ID,70)

DCB.XonChar  = memblock byte(DCB_MEMBLOCK_ID,71)

DCB.XoffChar  = memblock byte(DCB_MEMBLOCK_ID,72)

DCB.ErrorChar  = memblock byte(DCB_MEMBLOCK_ID,73)

DCB.EofChar  = memblock byte(DCB_MEMBLOCK_ID,74)

DCB.EvtChar  = memblock byte(DCB_MEMBLOCK_ID,75)

DCB.wReservedl  = memblock word(DCB_MEMBLOCK_ID,76)

endfunction ret

function SetCommState(nCid as dword)

Write memblock dword DCB_MEMBLOCK_ID,0,DCB.DCBlength

Write memblock dword DCB_MEMBLOCK_ID,4,DCB.BaudRate

Write memblock dword DCB_MEMBLOCK_ID,8,DCB.fBinary

Write memblock dword DCB_MEMBLOCK_ID,12,DCB.fParity

Write memblock dword DCB_MEMBLOCK_ID,16,DCB.fOutxCtsFlow

Write memblock dword DCB_MEMBLOCK_ID,20,DCB.fOutcDsrFlow

Write memblock dword DCB_MEMBLOCK_ID,24,DCB.fDtrControl

Write memblock dword DCB_MEMBLOCK_ID,28,DCB.fDsrSensitivity

Write memblock dword DCB_MEMBLOCK_ID,32,DCB.fTXContinueONXoff

Write memblock dword DCB_MEMBLOCK_ID,36,DCB.fOutX

Write memblock dword DCB_MEMBLOCK_ID,40,DCB.fInX

Write memblock dword DCB_MEMBLOCK_ID,44,DCB.fErrorChar

Write memblock dword DCB_MEMBLOCK_ID,48,DCB.fNull

Write memblock dword DCB_MEMBLOCK_ID,52,DCB.fRtsControl

Write memblock dword DCB_MEMBLOCK_ID,56,DCB.fAbortOnError

Write memblock dword DCB_MEMBLOCK_ID,60,DCB.fDummy

Write memblock word DCB_MEMBLOCK_ID,64,DCB.XonLim

Write memblock word DCB_MEMBLOCK_ID,66,DCB.XoffLim

Write memblock byte DCB_MEMBLOCK_ID,68,DCB.ByteSize

Write memblock byte DCB_MEMBLOCK_ID,69,DCB.Parity

Write memblock byte DCB_MEMBLOCK_ID,70,DCB.StopBits

Write memblock byte DCB_MEMBLOCK_ID,71,DCB.XonChar

Write memblock byte DCB_MEMBLOCK_ID,72,DCB.XoffChar

Write memblock byte DCB_MEMBLOCK_ID,73,DCB.ErrorChar

Write memblock byte DCB_MEMBLOCK_ID,74,DCB.EofChar

Write memblock byte DCB_MEMBLOCK_ID,75,DCB.EvtChar

Write memblock word DCB_MEMBLOCK_ID,76,DCB.wReservedl

ret = call dll (KERNEL_DLL_ID, "SetCommState", nCid, get memblock ptr(DCB_MEMBLOCK_ID))

if ret = 0

print "Could not set Com port state"

wait key

end

endif

endfunction ret

function GetCommTimeouts(nCid as dword)

ret = call dll (KERNEL_DLL_ID, "GetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))

if ret = 0

print "Could not get Com Timeouts."

wait key

end

endif

CommTimeouts.ReadIntervalTimeout = memblock dword(TIMEOUTS_MEMBLOCK_ID,0)

CommTimeouts.ReadTotalTimeoutMultiplier = memblock dword(TIMEOUTS_MEMBLOCK_ID,4)

CommTimeouts.ReadTotalTimeOutConstant = memblock dword(TIMEOUTS_MEMBLOCK_ID,8)

CommTimeouts.WriteTotalTimeoutMultiplier = memblock dword(TIMEOUTS_MEMBLOCK_ID,12)

CommTimeouts.WriteTotalTimeoutConstant = memblock dword(TIMEOUTS_MEMBLOCK_ID,16)

endfunction ret

function SetCommTimeouts(nCid as dword)

Write memblock dword TIMEOUTS_MEMBLOCK_ID,0,CommTimeouts.ReadIntervalTimeout

Write memblock dword TIMEOUTS_MEMBLOCK_ID,4,CommTimeouts.ReadTotalTimeoutMultiplier

Write memblock dword TIMEOUTS_MEMBLOCK_ID,8,CommTimeouts.ReadTotalTimeOutConstant

Write memblock dword TIMEOUTS_MEMBLOCK_ID,12,CommTimeouts.WriteTotalTimeoutMultiplier

Write memblock dword TIMEOUTS_MEMBLOCK_ID,16,CommTimeouts.WriteTotalTimeoutConstant

ret = call dll (KERNEL_DLL_ID, "SetCommTimeouts", nCid, get memblock ptr(TIMEOUTS_MEMBLOCK_ID))

if ret = 0

print "Could not set Com Timeouts."

wait key

end

endif

endfunction ret

function WriteFile(hFile as dword, nNumberOfBytesToWrite as dword)

if len(Buffer) > BUFFER_SIZE then Buffer = left$(Buffer,BUFFER_SIZE)

for i = 1 to len(buffer)

write memblock byte IO_BUFFER_MEMBLOCK_ID,i-1,asc(mid$(buffer,i))

next i

ret = call dll(KERNEL_DLL_ID, "WriteFile", hfile, get memblock ptr(IO_BUFFER_MEMBLOCK_ID), nNumberOfBytesToWrite, get memblock ptr(BYTES_READ_WRITE_ID),0)

if ret = 0

print "Could not write to com port."

wait key

endif

endfunction ret

function ReadFile(hFile as dword, nNumberOfBytesToRead as dword)

ret = call dll(KERNEL_DLL_ID, "ReadFile", hfile, get memblock ptr(IO_BUFFER_MEMBLOCK_ID), nNumberOfBytesToRead, get memblock ptr(BYTES_READ_WRITE_ID),0)

if ret = 0

print "Could not read from com port."

wait key

endif

buffer = ""

for i = 0 to memblock dword(BYTES_READ_WRITE_ID,0) - 1

buffer = buffer + chr$(memblock byte(IO_BUFFER_MEMBLOCK_ID,i))

next i

endfunction ret

function CloseHandle(hObject as dword)

ret = call dll(KERNEL_DLL_ID, "CloseHandle", hObject)

if ret = 0

print "Could not close handle."

wait key

end

endif

endfunction ret

function EscapeCommFunction(hFile as dword, dwFunc as dword)

ret = call dll(KERNEL_DLL_ID, "EscapeCommFunction", hFile, dwFunc)

if ret = 0

Print "EscapeCommFunction Failed."

wait key

end

endif

endfunction ret

function Cleanup_Memory()

delete memblock DCB_MEMBLOCK_ID

delete memblock TIMEOUTS_MEMBLOCK_ID

delete memblock IO_BUFFER_MEMBLOCK_ID

delete memblock BYTES_READ_WRITE_ID

delete dll KERNEL_DLL_ID

endfunction

Download

Please login to download

Comments

No comments yet.

Author Name:	Twilight zone
CodeBase Entries:	1

CodeBase - Low level serial and parallel port access with Dark Basic Pro

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments