VB 串口数据采集

实时采集的数据可直接用来画曲线，但往往为了以后查询，同时应按定时间隔写入数据库或文本文件。所以可在写入数据库后通过查询做到实时显示和更新。

'窗体加载时将已记录的数据查询后绘图

Private Sub Form_Load()

chaxun1 = "select from jishijilu where gyh_riqi='" & gongyi_sj(0) & "-" & record_rq & "'order by shijian "

mdh = chaxun1

Adodc3ConnectionString = "Provider=MicrosoftJetOLEDB40;Data Source=C:\Ldgz\wdmdb;Persist Security Info=False"

Adodc3RecordSource = mdh

Adodc3Refresh

zslNew = Adodc3RecordsetRecordCount

Text4 = zslNew

If zslNew >= 1 Then

Adodc3RecordsetMoveFirst

For i = 0 To zslNew - 1

quexian(0, i) = Adodc3Recordset(0)

For j = 2 To 9

quexian(j, i) = Adodc3Recordset(j)

Next j

Adodc3RecordsetMoveNext

Next i

Adodc3RecordsetMoveFirst

For j = 0 To zslNew - 1

Picture1Line (j 5 + 500, quexian(2, j) -30 + 3399)-(j 5 + 500, quexian(2, j) -30 + 3401), vbRed, BF

Picture1Line (j 5 + 500, quexian(3, j) -30 + 3399)-(j 5 + 500, quexian(3, j) -30 + 3401), QBColor(7), BF

Picture1Line (j 5 + 500, quexian(4, j) -30 + 3399)-(j 5 + 500, quexian(4, j) -30 + 3401), vbWhite, BF

Picture1Line (j 5 + 500, quexian(5, j) -30 + 3399)-(j 5 + 500, quexian(5, j) -30 + 3401), vbYellow, BF

Picture1Line (j 5 + 500, quexian(6, j) -30 + 3399)-(j 5 + 500, quexian(6, j) -30 + 3401), vbGreen, BF

If quexian(8, j) < 1 Then

wy_wy = 0 + 1667

br_br = 55

ElseIf quexian(8, j) >= 1 And quexian(8, j) < 10 Then

wy_wy = -1500 + 1667

br_br = 55556

ElseIf quexian(8, j) >= 10 And quexian(8, j) < 100 Then

wy_wy = -3000 + 1667

br_br = 05555

ElseIf quexian(8, j) >= 100 And quexian(8, j) < 1000 Then

wy_wy = -4500 + 1667

br_br = 0055555

End If

Picture1Line (j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3397 + 3000)-(j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3403 + 3000), QBColor(11), BF

Next j

zslOld = zslNew

End If

'记录时间最长75小时

Picture2Height = 10000

Picture2Visible = True

Picture1Visible = True

colvb = vbWhite

xx = 100

yy = 150

txt = "℃"

wp = xp(colvb, xx, yy, txt)

yy = 350

txt = "100"

wp = xp(colvb, xx, yy, txt)

xx = 200

yy = 1850

txt = "50"

wp = xp(colvb, xx, yy, txt)

yy = 3350

xx = 300

txt = "0"

wp = xp(colvb, xx, yy, txt)

xx = 100

yy = 4850

txt = "-50"

wp = xp(colvb, xx, yy, txt)

xx = 0

yy = 6350

txt = "-100"

wp = xp(colvb, xx, yy, txt)

xx = 10800 + 100

yy = 150

txt = "℃"

wp = xp(colvb, xx, yy, txt)

yy = 350

txt = "100"

wp = xp(colvb, xx, yy, txt)

xx = 10800 + 200

yy = 1850

txt = "50"

wp = xp(colvb, xx, yy, txt)

yy = 3350

xx = 10800 + 300

txt = "0"

wp = xp(colvb, xx, yy, txt)

xx = 10800 + 100

yy = 4850

txt = "-50"

wp = xp(colvb, xx, yy, txt)

xx = 10800 + 0

yy = 6350

txt = "-100"

wp = xp(colvb, xx, yy, txt)

'真空坐标

colvb = vbRed

xx = 11400

yy = 150

txt = "Pa"

wp = xp(colvb, xx, yy, txt)

yy = 350

txt = "1000"

wp = xp(colvb, xx, yy, txt)

xx = 11500

yy = 1850

txt = "100"

wp = xp(colvb, xx, yy, txt)

yy = 3350

xx = 11600

txt = "10"

wp = xp(colvb, xx, yy, txt)

xx = 11700

yy = 4850

txt = "1"

wp = xp(colvb, xx, yy, txt)

xx = 11500

yy = 6350

txt = "01"

wp = xp(colvb, xx, yy, txt)

xx = 500

yy = 150

txt = "Pa"

wp = xp(colvb, xx, yy, txt)

yy = 350

txt = "1000"

wp = xp(colvb, xx, yy, txt)

yy = 150

xx = 2200

txt = "6hr"

wp = xp(colvb, xx, yy, txt)

xx = 4000

txt = "12hr"

wp = xp(colvb, xx, yy, txt)

xx = 5800

txt = "18hr"

wp = xp(colvb, xx, yy, txt)

xx = 7600

txt = "24hr"

wp = xp(colvb, xx, yy, txt)

xx = 9400

txt = "30hr"

wp = xp(colvb, xx, yy, txt)

xx = 13000

txt = "42hr"

wp = xp(colvb, xx, yy, txt)

xx = 14800

txt = "48hr"

wp = xp(colvb, xx, yy, txt)

xx = 16600

txt = "54hr"

wp = xp(colvb, xx, yy, txt)

xx = 18400

txt = "60hr"

wp = xp(colvb, xx, yy, txt)

xx = 20200

txt = "66hr"

wp = xp(colvb, xx, yy, txt)

xx = 22000

txt = "72hr"

wp = xp(colvb, xx, yy, txt)

xx = 23800

txt = "78hr"

wp = xp(colvb, xx, yy, txt)

xx = 25600

txt = "84hr"

wp = xp(colvb, xx, yy, txt)

xx = 27400

txt = "90hr"

wp = xp(colvb, xx, yy, txt)

xx = 29200

txt = "96hr"

wp = xp(colvb, xx, yy, txt)

xx = 600

yy = 1850

txt = "100"

wp = xp(colvb, xx, yy, txt)

yy = 3350

xx = 11600

txt = "10"

wp = xp(colvb, xx, yy, txt)

xx = 700

yy = 4850

txt = "1"

wp = xp(colvb, xx, yy, txt)

xx = 600

yy = 6350

txt = "01"

wp = xp(colvb, xx, yy, txt)

xx = 22100

yy = 350

txt = "1000"

wp = xp(colvb, xx, yy, txt)

yy = 1850

txt = " 100"

wp = xp(colvb, xx, yy, txt)

yy = 3350

txt = " 10"

wp = xp(colvb, xx, yy, txt)

yy = 4850

txt = " 1"

wp = xp(colvb, xx, yy, txt)

yy = 6350

txt = " 01"

wp = xp(colvb, xx, yy, txt)

'画格

Picture1ForeColor = vbWhite

Picture1Line (450, 700)-(500, 700)

Picture1Line (450, 1000)-(500, 1000)

Picture1Line (450, 1300)-(500, 1300)

Picture1Line (450, 1600)-(500, 1600)

Picture1ForeColor = vbRed

Picture1Line (500, 5667)-(550, 5667)

Picture1Line (500, 7333)-(550, 7333)

Picture1Line (500, 900)-(550, 900)

Picture1Line (500, 10667)-(550, 10667)

Picture1Line (500, 12333)-(550, 12333)

Picture1Line (500, 1400)-(550, 1400)

Picture1Line (500, 15667)-(550, 15667)

Picture1Line (500, 17333)-(550, 17333)

Picture1Line (500, 20667)-(550, 20667)

Picture1Line (500, 22333)-(550, 22333)

Picture1Line (500, 2400)-(550, 2400)

Picture1Line (500, 25667)-(550, 25667)

Picture1Line (500, 27333)-(550, 27333)

Picture1Line (500, 2900)-(550, 2900)

Picture1Line (500, 30667)-(550, 30667)

Picture1Line (500, 32333)-(550, 32333)

Picture1Line (500, 35667)-(550, 35667)

Picture1Line (500, 37333)-(550, 37333)

Picture1Line (500, 3900)-(550, 3900)

Picture1Line (500, 40667)-(550, 40667)

Picture1Line (500, 42333)-(550, 42333)

Picture1Line (500, 4400)-(550, 4400)

Picture1Line (500, 45667)-(550, 45667)

Picture1Line (500, 47333)-(550, 47333)

Picture1Line (500, 50667)-(550, 50667)

Picture1Line (500, 52333)-(550, 52333)

Picture1Line (500, 5400)-(550, 5400)

Picture1Line (500, 55667)-(550, 55667)

Picture1Line (500, 57333)-(550, 57333)

Picture1Line (500, 5900)-(550, 5900)

Picture1Line (500, 60667)-(550, 60667)

Picture1Line (500, 62333)-(550, 62333)

Picture1ForeColor = vbWhite

Picture1Line (450, 400)-(27500, 400)

Picture1Line (450, 1900)-(27500, 1900)

Picture1Line (450, 3400)-(27500, 3400)

Picture1Line (450, 4900)-(27500, 4900)

Picture1Line (450, 6400)-(27500, 6400)

Picture1Line (450, 2200)-(500, 2200)

Picture1Line (450, 2500)-(500, 2500)

Picture1Line (450, 2800)-(500, 2800)

Picture1Line (450, 3100)-(500, 3100)

Picture1Line (450, 3700)-(500, 3700)

Picture1Line (450, 4000)-(500, 4000)

Picture1Line (450, 4300)-(500, 4300)

Picture1Line (450, 4600)-(500, 4600)

Picture1Line (450, 5200)-(500, 5200)

Picture1Line (450, 5500)-(500, 5500)

Picture1Line (450, 5800)-(500, 5800)

Picture1Line (450, 6100)-(500, 6100)

Picture1Line (500, 400)-(500, 6400)

Picture1Line (500 + 0, 400)-(500 + 0, 6400)

Picture1Line (1400 + 0, 400)-(1400 + 0, 6400)

Picture1Line (2300 + 0, 400)-(2300 + 0, 6400)

Picture1Line (3200 + 0, 400)-(3200 + 0, 6400)

Picture1Line (4100 + 0, 400)-(4100 + 0, 6400)

Picture1Line (5000 + 0, 400)-(5000 + 0, 6400)

Picture1Line (5900 + 0, 400)-(5900 + 0, 6400)

Picture1Line (6800 + 0, 400)-(6800 + 0, 6400)

Picture1Line (7700 + 0, 400)-(7700 + 0, 6400)

Picture1Line (8600 + 0, 400)-(8600 + 0, 6400)

Picture1Line (9500 + 0, 400)-(9500 + 0, 6400)

Picture1Line (10400 + 0, 400)-(10400 + 0, 6400)

Picture1Line (11300, 400)-(11300, 6400)

Picture1Line (12200, 400)-(12200, 6400)

Picture1Line (13100, 400)-(13100, 6400)

Picture1Line (14000, 400)-(14000, 6400)

Picture1Line (14900, 400)-(14900, 6400)

Picture1Line (15800, 400)-(15800, 6400)

Picture1Line (16700, 400)-(16700, 6400)

Picture1Line (17600, 400)-(17600, 6400)

Picture1Line (18500, 400)-(18500, 6400)

Picture1Line (19400, 400)-(19400, 6400)

Picture1Line (20300, 400)-(20300, 6400)

Picture1Line (21200, 400)-(21200, 6400)

Picture1Line (22100, 400)-(22100, 6400)

Picture1Line (23000, 400)-(23000, 6400)

Picture1Line (23900, 400)-(23900, 6400)

Picture1Line (24800, 400)-(24800, 6400)

Picture1Line (25700, 400)-(25700, 6400)

Picture1Line (26600, 400)-(26600, 6400)

Picture1Line (27500, 400)-(27500, 6400)

Picture1Line (0 5 + 500, 3400 - b(0) 30)-(c(1) 5 + 500, 3400 - b(0) 30), QBColor(12)

Picture1Line (c(1) 5 + 498, 3400 - b(1) 30)-(c(2) 5 + 502, 3400 - b(1) 30), QBColor(12)

Picture1Line (c(2) 5 + 498, 3400 - b(2) 30)-(c(3) 5 + 502, 3400 - b(2) 30), QBColor(12)

Picture1Line (c(3) 5 + 498, 3400 - b(3) 30)-(c(4) 5 + 502, 3400 - b(3) 30), QBColor(12)

Picture1Line (c(4) 5 + 498, 3400 - b(4) 30)-(c(5) 5 + 502, 3400 - b(4) 30), QBColor(12)

Picture1Line (c(5) 5 + 498, 3400 - b(5) 30)-(c(6) 5 + 502, 3400 - b(5) 30), QBColor(12)

Picture1Line (c(6) 5 + 498, 3400 - b(6) 30)-(c(7) 5 + 502, 3400 - b(6) 30), QBColor(12)

Picture1Line (c(7) 5 + 498, 3400 - b(7) 30)-(c(8) 5 + 502, 3400 - b(7) 30), QBColor(12)

Picture1Line (c(8) 5 + 498, 3400 - b(8) 30)-(c(9) 5 + 502, 3400 - b(8) 30), QBColor(12)

Picture1Line (c(9) 5 + 498, 3400 - b(9) 30)-(c(10) 5 + 502, 3400 - b(9) 30), QBColor(12)

Picture1Line (c(10) 5 + 498, 3400 - b(10) 30)-(c(11) 5 + 502, 3400 - b(10) 30), QBColor(12)

Picture1Line (c(11) 5 + 498, 3400 - b(11) 30)-(c(12) 5 + 502, 3400 - b(11) 30), QBColor(12)

Picture1Line (c(12) 5 + 498, 3400 - b(12) 30)-(c(13) 5 + 502, 3400 - b(12) 30), QBColor(12)

Picture1Line (c(13) 5 + 498, 3400 - b(13) 30)-(c(14) 5 + 502, 3400 - b(13) 30), QBColor(12)

Picture1Line (c(14) 5 + 498, 3400 - b(14) 30)-(c(15) 5 + 502, 3400 - b(14) 30), QBColor(12)

Picture1Line (c(15) 5 + 498, 3400 - b(15) 30)-(c(16) 5 + 502, 3400 - b(15) 30), QBColor(12)

chaxun1 = "select from jishijilu where gyh_riqi='" & gongyi_sj(0) & "-" & record_rq & "'order by shijian "

mdh = chaxun1

Adodc3ConnectionString = "Provider=MicrosoftJetOLEDB40;Data Source=C:\Ldgz\wdmdb;Persist Security Info=False"

Adodc3RecordSource = mdh

Adodc3Refresh

zslNew = Adodc3RecordsetRecordCount

Text4 = zslNew

If zslNew >= 1 Then

Adodc3RecordsetMoveFirst

For i = 0 To zslNew - 1

quexian(0, i) = Adodc3Recordset(0)

For j = 2 To 7

quexian(j, i) = Adodc3Recordset(j)

Next j

Adodc3RecordsetMoveNext

Next i

Adodc3RecordsetMoveFirst

For j = 0 To zslNew - 1

Picture1Line (j 5 + 500, quexian(2, j) -30 + 3399)-(j 5 + 500, quexian(2, j) -30 + 3401), vbRed, BF

Picture1Line (j 5 + 500, quexian(3, j) -30 + 3399)-(j 5 + 500, quexian(3, j) -30 + 3401), QBColor(7), BF

Picture1Line (j 5 + 500, quexian(4, j) -30 + 3399)-(j 5 + 500, quexian(4, j) -30 + 3401), vbWhite, BF

Picture1Line (j 5 + 500, quexian(5, j) -30 + 3399)-(j 5 + 500, quexian(5, j) -30 + 3401), vbYellow, BF

Picture1Line (j 5 + 500, quexian(6, j) -30 + 3399)-(j 5 + 500, quexian(6, j) -30 + 3401), vbGreen, BF

If quexian(8, j) < 1 Then

wy_wy = 0 + 1667

br_br = 55

ElseIf quexian(8, j) >= 1 And quexian(8, j) < 10 Then

wy_wy = -1500 + 1667

br_br = 55556

ElseIf quexian(8, j) >= 10 And quexian(8, j) < 100 Then

wy_wy = -3000 + 1667

br_br = 05555

ElseIf quexian(8, j) >= 100 And quexian(8, j) < 1000 Then

wy_wy = -4500 + 1667

br_br = 0055555

End If

Picture1Line (j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3397 + 3000)-(j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3403 + 3000), QBColor(11), BF

Next j

zslOld = zslNew

End If

zslOld = zslNew

End Sub

'通过计时器调用定时更新

Private Sub cmdRef_Click()

chaxun1 = "select from jishijilu where gyh_riqi='" & gongyi_sj(0) & "-" & record_rq & "'order by shijian "

mdh = chaxun1

Adodc3ConnectionString = "Provider=MicrosoftJetOLEDB40;Data Source=C:\Ldgz\wdmdb;Persist Security Info=False"

Adodc3RecordSource = mdh

Adodc3Refresh

zslNew = Adodc3RecordsetRecordCount

Text4 = zslNew

If zslNew > 1 Then

Adodc3RecordsetMoveLast

For j = 2 To 7

quexian(j, i) = Adodc3Recordset(j)

Next j

Picture2Height = 10000

Picture1Visible = True

If zslOld >= 1 Then

For j = zslOld - 1 To zslNew - 1

Picture1Line (j 5 + 500, quexian(2, j) -30 + 3399)-(j 5 + 500, quexian(2, j) -30 + 3401), vbRed, BF

Picture1Line (j 5 + 500, quexian(3, j) -30 + 3399)-(j 5 + 500, quexian(3, j) -30 + 3401), QBColor(7), BF

Picture1Line (j 5 + 500, quexian(4, j) -30 + 3399)-(j 5 + 500, quexian(4, j) -30 + 3401), vbWhite, BF

Picture1Line (j 5 + 500, quexian(5, j) -30 + 3399)-(j 5 + 500, quexian(5, j) -30 + 3401), vbYellow, BF

Picture1Line (j 5 + 500, quexian(6, j) -30 + 3399)-(j 5 + 500, quexian(6, j) -30 + 3401), vbGreen, BF

If quexian(8, j) < 1 Then

wy_wy = 0 + 1667

br_br = 55

ElseIf quexian(8, j) >= 1 And quexian(8, j) < 10 Then

wy_wy = -1500 + 1667

br_br = 55556

ElseIf quexian(8, j) >= 10 And quexian(8, j) < 100 Then

wy_wy = -3000 + 1667

br_br = 05555

ElseIf quexian(8, j) >= 100 And quexian(8, j) < 1000 Then

wy_wy = -4500 + 1667

br_br = 0055555

End If

Picture1Line (j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3395 + 3000)-(j 5 + 500, quexian(8, j) br_br -30 + wy_wy + 3405 + 3000), QBColor(11), BF

Next j

End If

'记录时间最长96小时

cmdPrintEnabled = True

End If

zslOld = zslNew

End Sub

先是VB发送一段14位的十六进制数据过去，字头和检验位正确后，单片机接收后回发给一段13位的十六进制数据给VB，VB判断这个数据是单片机告诉自己发送正确（错误），如果错误的再发数据。

' 可用的串口总数保存在注册表中，读一下就行了。

Option Explicit

Private Declare Function RegOpenKey Lib "advapi32dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegEnumValue Lib "advapi32dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Command1_Click()

Dim ret As Long, REG As Long, i As Long

Dim ValueName As String, lValueName As Long, ValueType As Long

Dim cntCOM As Long

RegOpenKey HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", REG

cntCOM = 0

i = 0

Do

ValueName = String(255, Chr(0))

lValueName = 256

ret = RegEnumValue(REG, i, ByVal ValueName, lValueName, 0, ValueType, ByVal 0&, ByVal 0&)

If ret = 0 Then

cntCOM = cntCOM + 1

i = i + 1

Else

Exit Do

End If

Loop

MsgBox "本机有" & CStr(cntCOM) & "个COM口可用!"

End Sub

' 上面那个好像复杂了点，我又重新写了个函数，放到标准模块中就可以调用了。

Private Declare Function RegOpenKey Lib "advapi32dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegQueryInfoKey Lib "advapi32dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long

Type FILETIME ' 8 Bytes

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Const HKEY_LOCAL_MACHINE = &H80000002

' 获得当前系统的 COM 口的数量

Function GetCOMCount() As Integer

Dim ret As Long, f As FILETIME, cntCOM As Long

RegOpenKey HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", ret

RegQueryInfoKey ret, "", 0, 0, 0, 0, 0, cntCOM, 0, 0, 0, f

GetCOMCount = cntCOM

End Function

'第三个方案可能最适合你!!!!!

Option Explicit

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_USERS = &H80000003

Public Const HKEY_PERFORMANCE_DATA = &H80000004

Public Const HKEY_CURRENT_CONFIG = &H80000005

Public Const HKEY_DYN_DATA = &H80000006

Public Const REG_NONE = 0

Public Const REG_SZ = 1

Public Const REG_EXPAND_SZ = 2

Public Const REG_BINARY = 3

Public Const REG_DWORD = 4

Public Const REG_DWORD_BIG_ENDIAN = 5

Public Const REG_MULTI_SZ = 7

'注意以下的函数声明须在一行内写完

Declare Function RegOpenKey Lib "advapi32dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32dll" (ByVal hKey As Long) As Long

Declare Function RegQueryValue Lib "advapi32dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegEnumValue Lib "advapi32dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

Declare Function RegEnumValueAsAny Lib "advapi32dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegEnumValueAsAny2 Lib "advapi32dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

Public Sub MultiStringToStringArray(S As String, S2() As String)

'S为我们读取出来的多重字符串

'S2为转换后的字符串数组

Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer

pos = InStr(S, Chr(0))

While pos > 0

count = count + 1

pos = InStr(pos + 1, S, Chr(0))

Wend

'取得多重字符串中的字符串个数

count = count - 1

ReDim S2(0 To count - 1)

pos = 1

For idx = 0 To count - 1

pos2 = InStr(pos, S, Chr(0))

S2(idx) = Mid(S, pos, pos2 - pos)

pos = pos2 + 1

Next

End Sub

Option Explicit

'在form中添加command按钮和text文本框

'EnumVal2frm

'以下的Command1_Click事件中我们将列举出'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run下的所有name及其Value

Private Sub Command1_Click()

Dim hKey As Long

Dim ret As Long

Dim lenData As Long

Dim typeData As Long

Dim Name As String

Dim lenName As Long

Dim idx As Integer

Dim j As Integer

Dim bName(256) As Byte

ret = RegOpenKey(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", hKey)

If ret <> 0 Then Exit Sub

ret = 0

idx = 0

While ret = 0

lenName = 256

ret = RegEnumValueAsAny2(hKey, idx, bName(0), lenName, ByVal 0, typeData, ByVal vbNullString, lenData)

If ret <> 0 Then

RegCloseKey hKey

Exit Sub

End If

'上面的RegEnumValueAsAny2调用得到了第一个Name的长度lenName,不含chr(0)

Name = String(lenName + 1, Chr(0))

lenName = Len(Name)

Select Case typeData

Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ

Dim S As String

S = String(lenData, Chr(0))

RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, ByVal S, lenData

If typeData = REG_SZ Then

S = Left(S, InStr(S, Chr(0)) - 1)

Text1SelText = IIf(lenName = 0, "(预设值)", Left(Name, InStr(Name, Chr(0)) - 1)) & "=" & S & vbCrLf

ElseIf typeData = REG_EXPAND_SZ Then

Dim S2 As String

S2 = String(Len(S) + 256, Chr(0))

ExpandEnvironmentStrings S, S2, Len(S2)

S = Left(S2, InStr(S2, Chr(0)) - 1)

Text1SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & S & vbCrLf

ElseIf typeData = REG_MULTI_SZ Then

Dim SArr() As String

MultiStringToStringArray S, SArr

For j = 0 To UBound(SArr)

Text1SelText = Left(Name, InStr(Name, Chr(0)) - 1) & "(" & j & ") = " & SArr(j) & vbCrLf

Next

End If

Case REG_DWORD, REG_DWORD_BIG_ENDIAN

Dim L As Long

RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, L, lenData

Text1SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & L & vbCrLf

Case REG_BINARY

ReDim bArr(0 To lenData - 1) As Byte

RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, bArr(0), lenData

Text1SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = "

For j = 0 To UBound(bArr)

Text1SelText = Hex(bArr(j)) & " "

Next

Text1SelText = vbCrLf

End Select

idx = idx + 1

Wend

RegCloseKey hKey

End Sub

'''''再补充个链接给你参考!!!!!

>

使用MSComm控件

Private Sub MSComm_OnComm()

'MSComm 的 OnComm 事件程序

'根据 CommEvent 属性值的不同，将各自的程序代码写入

'相关的子程序中

'在此例中，只要 属性RThresold 中设定字符数到达时

'便会使得 CommEvent 属性值变成 comEvReceive

'因此接收的子程序便会被执行

''''''''''''''''''''''''''''''''''''''

Select Case MSCommCommEvent

Case comEvReceive ' 收到 RThreshold # of

BB = MSCommInput

For jj = 0 To UBound(BB)

Call bbPrintVVV(BB(jj))

txtReceive = Str(BB(jj)) & txtReceive

Next jj

DDi = DDi + 1

' tt = StrConv(MSCommInput, vbUnicode) '返回按指定类型转换的 Variant (String)。

' DD = AscW(tt) '首字符的(16位编码方案)字符代码 ， 0 - 255

' txtReceive = txtReceive & " " & tt & "(" & DD & ")"

' Case comEvSend ' 传输缓冲区有 Sthreshold 个字符

' Case comEvCD ' CD 线的状态发生变化

'

' Case comEvCTS ' CTS 线的状态发生变化

'

' Case comEvDSR ' DSR 线的状态发生变化

'

' Case comEvRing ' Ring Indicator 变化

'

End Select

End Sub

以上就是关于VB 串口数据采集全部的内容，包括:VB 串口数据采集、vb怎么读取单片机串口数据、急寻解决，vb中串口问题等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！