发信人: pthinker()
整理人: flyingmist(2000-03-04 02:50:53), 站内信件
|
//以下是我写的一个基本的在pb6中读写串口的用户对象，
只完成了基本功能，可再完善。
$PBExportHeader$uo_comm.sru
forward
global type uo_comm from nonvisualobject
end type
end forward
type dcb from structure
long dcblength
long baudrate
long bits1
integer wreserved
integer xonlim
integer xofflim
unsignedlong bytesize
unsignedlong parity
unsignedlong stopbits
unsignedlong xonchar
unsignedlong xoffchar
unsignedlong errorchar
unsignedlong eofchar
unsignedlong evtchar
integer wreserved2
end type
type OVERLAPPED from structure
unsignedlong Internal
unsignedlong InternalHigh
unsignedlong offset
unsignedlong OffsetHigh
unsignedlong hEvent
end type
shared variables
end variables
global type uo_comm from nonvisualobject
end type
global uo_comm uo_comm
type prototypes
FUNCTION ulong CreateFileA(ref string fname, ulong f_access, ulong f_s
hare, ulong f_sec, ulong f_create, ulong f_flag, ulong f_attrib) LIBRA
RY "kernel32.dll"
FUNCTION ulong SetupComm (ulong hFile , ulong dwInQueue, ulong dwOutQ
ueue ) LIBRARY "kernel32.dll"
FUNCTION ulong WriteFile (ulong hFile ,ref string lpBuffer ,ulong nNu
mberOfBytesToWrite , long lpNumberOfBytesWritten,OVERLAPPED lpOverlapp
ed ) LIBRARY "kernel32.dll"
FUNCTION ulong ReadFile (ulong hFile ,ulong lpBuffer ,ulong nNumberO
fBytesToRead , ulong lpNumberOfBytesRead ,OVERLAPPED lpOverlapped )
LIBRARY "kernel32.dll"
FUNCTION ulong CloseHandle (ulong hObject) LIBRARY "kernel32.dll"
FUNCTION ulong SetCommState(ulong comm, DCB dcbType) LIBRARY "kernel32
.dll"
FUNCTION ulong GetCommState(ulong comm, DCB dcbType) LIBRARY "kernel3
2.dll"
end prototypes
type variables
public ulong commid
// DCB结构
public ulong DCBlength
public ulong BaudRate = 9600
public ulong Bits1
public uint wReserved
public uint XonLim = 100
public uint XoffLim
public long ByteSize = 8
public long Parity = 0
public long StopBits = 0
public long XonChar
public long XoffChar
public long ErrorChar
public long EofChar
public long EvtChar
public uint wReserved2
end variables
forward prototypes
public function unsignedlong uf_open (string devname)
public function unsignedlong uf_write (string wstring)
public function unsignedlong uf_close ()
public function unsignedlong uf_setcomm (unsignedlong InQueue, unsigne
dlong OutQueue)
public function integer uf_set (string parm, unsignedlong pvalues)
public function integer uf_setstatus ()
end prototypes
public function unsignedlong uf_open (string devname);IF commid <> 0 t
hen
uf_close()
end if
commid = CreateFileA(devname,3221225472, 0, 0,3,128, 0)
uf_setstatus()
return commid
end function
public function unsignedlong uf_write (string wstring);string ls_buffe
r
ulong lu_resu
ulong lu_bytewrt,lu_numbytes
OVERLAPPED lpOverlapped
ls_buffer = space(100)
ls_buffer = wstring
lu_numbytes = len(ls_buffer)
lu_resu = writefile(commid,ls_buffer,lu_numbytes,lu_bytewrt,lpOverlapp
ed)
return lu_resu
end function
public function unsignedlong uf_close ();ulong resu = 0
If commid >0 Then
resu = CloseHandle(commid)
end if
return resu
end function
public function unsignedlong uf_setcomm (unsignedlong InQueue, unsigne
dlong OutQueue);return SetupComm(commid,InQueue,OutQueue)
end function
public function integer uf_set (string parm, unsignedlong pvalues);if
lower(parm) = "baudrate" then
baudrate = pvalues
end if
if lower(parm) = "parity" then
parity = pvalues
end if
if lower(parm) = "bytesize" then
bytesize = pvalues
end if
if lower(parm) = "stopbits" then
stopbits = pvalues
end if
if lower(parm) = "eofchar" then
eofchar = pvalues
end if
if lower(parm) = "errorchar" then
errorchar = pvalues
end if
if lower(parm) = "evtchar" then
evtchar = pvalues
end if
if lower(parm) = "xoffchar" then
xoffchar = pvalues
end if
if lower(parm) = "xonchar" then
xonchar = pvalues
end if
if lower(parm) = "wreserved" then
wreserved = pvalues
end if
if lower(parm) = "wreserved2" then
wreserved2 = pvalues
end if
if lower(parm) = "xofflim" then
xofflim = pvalues
end if
if lower(parm) = "xonlim" then
xonlim = pvalues
end if
if lower(parm) = "bits1" then
bits1 = pvalues
end if
if lower(parm) = "dcblength" then
dcblength = pvalues
end if
return 0
end function
public function integer uf_setstatus ();long resu
dcb dwdcb
dwDCB.ByteSize = ByteSize
dwDCB.Parity = Parity
dwDCB.StopBits = StopBits
dwDCB.BaudRate = BaudRate
resu = setCommState(commid,dwdcb)
//
return 0
end function
on uo_comm.create
TriggerEvent( this, "constructor" )
end on
on uo_comm.destroy
TriggerEvent( this, "destructor" )
end on
event constructor;commid = 0
end event
event destructor;uf_close()
end event
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.98.183.11]
|
|