2024年3月31日发(作者：)

01. Private Sub cmdSend_Click( 02. '定义文件读写属性结构 03. Dim sa As

SECURITY_ATTRIBUTES 04. '定义串口状态结构 05. Dim typCommStat As COMSTAT

06. '定义串口状态错误 07. Dim lngError As Long 08. 09. '********打开串口******** 10.

Dim hCF As Long 11. hCF = CreateFile("COM4", _ 12. GENERIC_READ Or

GENERIC_WRITE, 0, sa, _ 13. OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or

FILE_FLAG_OVERLAPPED, 0 14. "打开串口：" & hCF 15. 16. '********获

取出错信息******** 17. Dim errNum As Long 18. errNum = GetLastError( 19.

"出错信息：" & errNum 20. 21. '定义标志值 22. Dim flag As Long 23.

24. '定义设备控制块 25. Dim typDCB As DCB 26. 27. '********获取设备控制块********

28. flag = GetCommState(hCF, typDCB 29. "获取串口DCB：" & flag

30. 31. te = 2500 '定义波特率 32. = NOPARITY '无校

验位 33. ze = 8 '数据位 34. ts = 0 '停止位 0/1/2 =

1/1.5/2 35. 36. '********设置串口参数******** 37. flag = SetCommState(hCF, typDCB

38. "设置串口参数：" &flag 39. 40. '********设置缓冲区大小******** 41.

flag = SetupComm(hCF, 1024, 1024 42. ' "设置缓冲区：" & flag 43. 44.

'********清空读写缓冲区******** 45. flag = PurgeComm(hCF, PURGE_RXABORT Or

PURGE_RXCLEAROr PURGE_TXABORT Or PURGE_TXCLEAR 46. ' "强制

清空缓冲区：" & flag 47. 48. '定义超时结构体 49. Dim typCommTimeouts As

COMMTIMEOUTS 50. tervalTimeout = 0 '相邻两字节读

取最大时间间隔（为0表示不使用该超时间隔） 51.

talTimeoutMultiplier = 0 '一个读操作的时间常数 52.

talTimeoutConstant = 0 '读超时常数 53.

otalTimeoutMultiplier = 0 '一个写操作的时间常数（为0

表示不使用该超时间隔） 54. otalTimeoutConstant = 0 '写

超时常数（为0表示不使用该超时间隔） 55. 56. '********超时设置******** 57. flag =

SetCommTimeouts(hCF, typCommTimeouts 58. ' "超时设置：" & flag

59. 60. '********发送数据******** 61. '定义要发送字节数 62. Dim

lngNumberofBytesToWrite As Long 63. '定义实际发送字节数 64. Dim

lngNumberofBytesToWritten As Long 65. '定义重叠结构体 66. Dim typOverLapped

As OVERLAPPED 67. 68. '定义发送数据 69. Dim arrbytTest(0 To 23 As Byte 70. '载波

收发器同步头 71. arrbytTest(0 = CByte(&H53 72. arrbytTest(1 = CByte(&H4E 73.

arrbytTest(2 = CByte(&H44 74. '后续数据包长度 75. arrbytTest(3 = CByte(&H14 76.

'载波表预同步头 77. arrbytTest(4 = CByte(&HFF 78. arrbytTest(5 = CByte(&HFF 79.

arrbytTest(6 = CByte(&HFF 80. arrbytTest(7 = CByte(&HFF 81. arrbytTest(8 =

CByte(&HFF 82.

arrbytTest(9 = CByte(&HFF 83. '载波表帧同步头 84. arrbytTest(10 = CByte(&H9

85. arrbytTest(11 = CByte(&HAF 86. '载波表地址 87. arrbytTest(12 = CByte(&H59

88. arrbytTest(13 = CByte(&H20 89. arrbytTest(14 = CByte(&H0 90. '控制码 91.

arrbytTest(15 = CByte(&H1 92. '数据长度 93. arrbytTest(16 = CByte(&H5 94. '功能

码 95. arrbytTest(17 = CByte(&H10 96. arrbytTest(18 = CByte(&H90 97. '集中器地

址 98. arrbytTest(19 = CByte(&HBB 99. arrbytTest(20 = CByte(&HBB 100.

arrbytTest(21 = CByte(&HBB 101. '校验和 102. arrbytTest(22 = CByte(&H50 103.

arrbytTest(23 = CByte(&H3 104. 105. 106. '获取要发送字节数 107.

lngNumberofBytesToWrite = UBound(arrbytTest + 1 108. 109. '声明等待开始时间、

结束时间值 110. Dim writeStarTime, writeEndTime As Long 111. 112. writeStarTime

= GetTickCount( 113. "发送开始时间："& writeStarTime 114. 115. '定

义发送循环步长值 116. Dim i As Integer 117. '定义累计发送字节数 118. Dim

intTotalNumberOfBytesToWritten As Integer 119. '定义发送间隔时间（毫秒） 120.

Dim intIntervalTime As Integer 121. intIntervalTime = 0 122. 123. '发送数据 124.

For i = 0 To UBound(arrbytTest 125. flag = WriteFile(hCF, arrbytTest(i, 1,

lngNumberofBytesToWritten, typOverLapped 126. 127. '获取出错码 128. errNum =

GetLastError( 129. ' "发送操作出错码：" & errNum 130. 131. '若返回值

不是IO异步操作未决，则关闭串口 132. If (errNum <> ERROR_IO_PENDING And

(errNum<> 0 Then GoTo closeComm 133. 134. '异步IO事件获取（返回值为 0表示

出错） 135. flag = WaitForSingleObject(, 0 136.

' "异步IO事件获取：" & flag 137. 138. '判断异步IO事件获取是否成功

139. If flag <> 0 Then 140. '异步IO操作结果获取(等待标记值，必须为true ，否则需

要事件激活返回结果 141. flag = GetOverlappedResult(hCF, typOverLapped,

lngNumberofBytesToWritten, 1 142. ' "异步IO操作获取：" & flag 143.

144. '判断异步IO操作结果获取是否成功 145. If flag <> 0 Then 146.

intTotalNumberOfBytesToWritten= intTotalNumberOfBytesToWritten+ _ 147.

lngNumberofBytesToWritten 148. End If 149. 150. End If 151. 152. '间隔时间（用于

需要设定每字节间间隔时间的发送协议） 153. Sleep (intIntervalTime 154. Next 155.

156. writeEndTime = GetTickCount( 157. "发送结束时间："&

writeEndTime 158. "发送总时间：" & (writeEndTime - writeStarTime

159. "串口发送操作："& flag 160. "实际发送字节数：" &

intTotalNumberOfBytesToWritten 161. 162. '********清空缓冲区等待数据接收

******** 163. flag = FlushFileBuffers(hCF 164. ' "清空缓冲区：" & flag

165. 166. '********

设置串口事件******** 167. '监听数据接收事件 168. ' flag = SetCommMask(hCF,

EV_ERR Or EV_RXCHAR 169. ' "监听事件设置：" & flag 170. flag =

SetCommMask(hCF, 0 171. "监听事件设置："& flag 172. 173. '********

等待串口接收事件******** 174. '声明等待开始时间、结束时间值 175. Dim

sngStarTime, sngEndTime As Long 176. '事件掩码 177. Dim lngEventMask As Long

178. 179. '定义接收字节数变量 180. Dim tempReceive As Long 181. tempReceive =

0 182. 183. "监听开始" 184. '生成开始时间 185. sngStarTime =

GetTickCount( 186. "开始监听时间："& sngStarTime 187. 188. '定义等

待步骤参数 189. Dim n As Integer 190. n = 1 191. 192. ' '监听串口事件 193. ' flag =

WaitCommEvent(hCF, lngEventMask, typOverLapped 194. ' "监听操

作：" & flag 195. 196. ' '获取出错码 197. ' errNum = GetLastError( 198. '

"监听操作出错码：" & errNum 199. ' 200. ' '若返回值不是IO异步操作未

决，则关闭串口 201. ' If (errNum <> ERROR_IO_PENDING And (errNum<> 0 Then

GoTo closeComm 202. 203. '定义读取间隔时间(毫秒 204. Dim intReadIntervalTime

As Integer 205. intReadIntervalTime = 1 206. 207. Do 208. 209. ' '异步IO事件获取

（返回值为 0 表示出错） 210. ' flag = WaitForSingleObject(,

0 211. ' "异步IO事件获取：" & flag 212. ' '获取出错码 213. ' errNum =

GetLastError( 214. ' "IO事件获取出错码：" & errNum 215. 216. '清除错

误标志函数，获取串口设备状态 217. flag = ClearCommError(hCF, lngError,

typCommStat 218. "获取串口设备状态：" & flag 219. 220. '若获取状态

成功 221. If (flag <> 0 And (e > 0 Then 222. 223.

"已接收字节数："& e 224. 225. '判断接收缓冲区内

的数据是否等于需要接收的字节数 226. If e >= 22 Then 227. '跳

出循环 228. "跳出循环" 229. Exit Do 230. End If 231. 232. End If 233.

234. '生成结束时间 235. sngEndTime = GetTickCount( 236. "第" & n &

"次监听事件时间：" & sngEndTime 237. 238. n = n + 1 239. 240. '读时间间隔 241.

Sleep (intReadIntervalTime 242. 243. Loop Until (sngEndTime - sngStarTime >

1000 244. 245. '生成结束时间 246. sngEndTime = GetTickCount( 247. "

结束监听时间："& sngEndTime 248. 249. "监听结束" 250.

"总接收时间：" & (sngEndTime - sngStarTime 251. 252. '********接收数据********

253. '定义接收数组 254. Dim arrbytReceive(0 To 22 As Byte 255. '定义实际接收字节

数 256. Dim lngNBR As Long 257. '重叠结构置0 258. = 0

259. typOverLapp

al = 0 260. alHigh = 0 261.

= 0 262. High = 0 263. 264. '接收数据

265. flag = ReadFile(hCF, arrbytReceive(0, 23, lngNBR, typOverLapped 266.

"串口接收操作："& flag 267. "实际接收字节数：" &

lngNBR 268. arrbytReceive(0 269. arrbytReceive(21 270.

arrbytReceive(22 271. 272. closeComm: 273. '********关闭所有串口事

件******** 274. flag = SetCommMask(hCF, 0 275. ' "关闭串口事件："&

flag 276. 277. '********关闭串口******** 278. Dim closeFlag As Long 279. closeFlag

= CloseHandle(hCF 280. "关闭串口：" & closeFlag 281. 282. End Sub