利用API进行串口通信VB代码

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. Debug.Print "打开串口：" & hCF
15.
16. '********获取出错信息********
17. Dim errNum As Long
18. errNum = GetLastError()
19. Debug.Print "出错信息：" & errNum
20.
21. '定义标志值
22. Dim flag As Long
23.
24. '定义设备控制块
25. Dim typDCB As DCB
26.
27. '********获取设备控制块********
28. flag = GetCommState(hCF, typDCB)
29. Debug.Print "获取串口DCB：" & flag
30.
31. typDCB.BaudRate = 2500 '定义波特率
32. typDCB.Parity = NOPARITY '无校验位
33. typDCB.ByteSize = 8 '数据位
34. typDCB.StopBits = 0 '停止位 0/1/2 = 1/1.5/2
35.
36. '********设置串口参数********
37. flag = SetCommState(hCF, typDCB)
38. Debug.Print "设置串口参数：" &flag
39.
40. '********设置缓冲区大小********
41. flag = SetupComm(hCF, 1024, 1024)
42. 'Debug.Print "设置缓冲区：" & flag
43.
44. '********清空读写缓冲区********
45. flag = PurgeComm(hCF, PURGE_RXABORT Or PURGE_RXCLEAROr PURGE_TXABORT Or PURGE_TXCLEAR)
46. 'Debug.Print "强制清空缓冲区：" & flag
47.
48. '定义超时结构体
49. Dim typCommTimeouts As COMMTIMEOUTS
50. typCommTimeouts.ReadIntervalTimeout = 0 '相邻两字节读取最大时间间隔（为0表示不使用该超时间隔）
51. typCommTimeouts.ReadTotalTimeoutMultiplier = 0 '一个读操作的时间常数
52. typCommTimeouts.ReadTotalTimeoutConstant = 0 '读超时常数
53. typCommTimeouts.WriteTotalTimeoutMultiplier = 0 '一个写操作的时间常数（为0表示不使用该超时间隔）
54. typCommTimeouts.WriteTotalTimeoutConstant = 0 '写超时常数（为0表示不使用该超时间隔）
55.
56. '********超时设置********
57. flag = SetCommTimeouts(hCF, typCommTimeouts)
58. 'Debug.Print "超时设置：" & 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. Debug.Print "发送开始时间："& 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. 'Debug.Print "发送操作出错码：" & errNum
130.
131. '若返回值不是IO异步操作未决，则关闭串口
132. If (errNum <> ERROR_IO_PENDING) And (errNum<> 0) Then GoTo closeComm
133.
134. '异步IO事件获取（返回值为 0表示出错）
135. flag = WaitForSingleObject(typOverLapped.hEvent, 0)
136. 'Debug.Print "异步IO事件获取：" & flag
137.
138. '判断异步IO事件获取是否成功
139. If flag <> 0 Then
140. '异步IO操作结果获取(等待标记值，必须为true ，否则需要事件激活返回结果)
141. flag = GetOverlappedResult(hCF, typOverLapped, lngNumberofBytesToWritten, 1)
142. 'Debug.Print "异步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. Debug.Print "发送结束时间："& writeEndTime
158. Debug.Print "发送总时间：" & (writeEndTime - writeStarTime)
159. Debug.Print "串口发送操作："& flag
160. Debug.Print "实际发送字节数：" & intTotalNumberOfBytesToWritten
161.
162. '********清空缓冲区等待数据接收********
163. flag = FlushFileBuffers(hCF)
164. 'Debug.Print "清空缓冲区：" & flag
165.
166. '********

设置串口事件********
167. '监听数据接收事件
168. ' flag = SetCommMask(hCF, EV_ERR Or EV_RXCHAR)
169. ' Debug.Print "监听事件设置：" & flag
170. flag = SetCommMask(hCF, 0)
171. Debug.Print "监听事件设置："& 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. Debug.Print "监听开始"
184. '生成开始时间
185. sngStarTime = GetTickCount()
186. Debug.Print "开始监听时间："& sngStarTime
187.
188. '定义等待步骤参数
189. Dim n As Integer
190. n = 1
191.
192. ' '监听串口事件
193. ' flag = WaitCommEvent(hCF, lngEventMask, typOverLapped)
194. ' Debug.Print "监听操作：" & flag
195.
196. ' '获取出错码
197. ' errNum = GetLastError()
198. ' Debug.Print "监听操作出错码：" & 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(typOverLapped.hEvent, 0)
211. ' Debug.Print "异步IO事件获取：" & flag
212. ' '获取出错码
213. ' errNum = GetLastError()
214. ' Debug.Print "IO事件获取出错码：" & errNum
215.
216. '清除错误标志函数，获取串口设备状态
217. flag = ClearCommError(hCF, lngError, typCommStat)
218. Debug.Print "获取串口设备状态：" & flag
219.
220. '若获取状态成功
221. If (flag <> 0) And (typCommStat.cbInQue > 0) Then
222.
223. Debug.Print "已接收字节数："& typCommStat.cbInQue
224.
225. '判断接收缓冲区内的数据是否等于需要接收的字节数
226. If typCommStat.cbInQue >= 22 Then
227. '跳出循环
228. Debug.Print "跳出循环"
229. Exit Do
230. End If
231.
232. End If
233.
234. '生成结束时间
235. sngEndTime = GetTickCount()
236. Debug.Print "第" & 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. Debug.Print "结束监听时间："& sngEndTime
248.
249. Debug.Print "监听结束"
250. Debug.Print "总接收时间：" & (sngEndTime - sngStarTime)
251.
252. '********接收数据********
253. '定义接收数组
254. Dim arrbytReceive(0 To 22) As Byte
255. '定义实际接收字节数
256. Dim lngNBR As Long
257. '重叠结构置0
258. typOverLapped.hEvent = 0
259. typOverLapp

ed.Internal = 0
260. typOverLapped.InternalHigh = 0
261. typOverLapped.offset = 0
262. typOverLapped.OffsetHigh = 0
263.
264. '接收数据
265. flag = ReadFile(hCF, arrbytReceive(0), 23, lngNBR, typOverLapped)
266. Debug.Print "串口接收操作："& flag
267. Debug.Print "实际接收字节数：" & lngNBR
268. Debug.Print arrbytReceive(0)
269. Debug.Print arrbytReceive(21)
270. Debug.Print arrbytReceive(22)
271.
272. closeComm:
273. '********关闭所有串口事件********
274. flag = SetCommMask(hCF, 0)
275. 'Debug.Print "关闭串口事件："& flag
276.
277. '********关闭串口********
278. Dim closeFlag As Long
279. closeFlag = CloseHandle(hCF)
280. Debug.Print "关闭串口：" & closeFlag
281.
282. End Sub