📄 editform.frm
字号:
Caption = "里程"
Height = 255
Left = 5520
TabIndex = 7
Top = 7560
Width = 375
End
Begin VB.Label Label4
Caption = "运行时间"
Height = 255
Left = 4080
TabIndex = 6
Top = 7560
Width = 855
End
Begin VB.Label Label3
Caption = "日期"
Height = 255
Left = 3120
TabIndex = 5
Top = 7560
Width = 375
End
Begin VB.Label Label2
Caption = "车辆编号"
Height = 255
Left = 1680
TabIndex = 4
Top = 7560
Width = 855
End
Begin VB.Label Label1
Caption = "编号"
Height = 255
Left = 720
TabIndex = 3
Top = 7560
Width = 375
End
End
Attribute VB_Name = "EditForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public DB As New ADODB.Connection '系统基本数据库对象
Dim adoTable As New ADODB.Recordset
Dim strCnnString, strSQLCommand As String
Dim modify As Boolean '用来保存更改模式
Dim i, j As Integer
Dim a1, a2, a3, a4 As Byte
Dim m(3) As Byte
Dim n As Byte
'Dim j As Integer
Dim s(15) As Byte
Dim v As Variant
Dim success, reload, gameover As Variant
Dim ff(2) As Byte
Dim flag As Integer
Dim ddd As String
Dim he, ca As Long
Dim jg(4096, 16) As Byte
Dim ok As Integer
Private Sub cmdadd1_Click()
For i = 0 To 10
'自动添加新记录
For j = 8 To 18
Adodata.Recordset.AddNew
'0006 0005
If j > 9 Then
Txtcar_id = "00" + CStr(j) '"0011"
Else
Txtcar_id = "000" + CStr(j)
End If
txtcar_info_date = CStr(Date) '"2007-6-6"
txtcar_fact_time = Abs(Rnd() * 10000)
txtcar_fact_lc = Abs(Rnd() * 10000)
txtcar_fact_hy = Abs(Rnd() * 10000)
txtcar_average_speed = Abs(Rnd() * 10000)
txtcar_average_hy = Abs(Rnd() * 10000)
txtcar_end_alllc = Abs(Rnd() * 10000)
txtcar_run_data = Abs(Rnd() * 10000)
Txtremark = Abs(Rnd() * 10000)
Next j
Next i
End Sub
Private Sub cmdDelete_Click()
'删除当前记录
Adodata.Recordset.Delete
Adodata.Recordset.MoveNext
If Adodata.Recordset.EOF Then
Adodata.Recordset.MovePrevious
End If
End Sub
Private Sub cmdInsert_Click()
'添加新记录
' Adodata.Recordset.AddNew
' Txtcar_id.SetFocus
Command1.Enabled = False
Command2.Enabled = False
Label1.Caption = "数据接收中..."
flag = 0
a1 = &HAA
a2 = &H1
a3 = &H1
a4 = &HAC
m(0) = a1
m(1) = a2
m(2) = a3
m(3) = a4
'ddd = "aa" & " 01" & " 01" & " ac"
he = 0
ca = 0
success = &HBB
reload = &HCC
gameover = &HDD
' Adodc1.Recordset.AddNew
' MSComm1.Output = m
Timer1.Enabled = True
Timer2.Enabled = True
End Sub
Private Sub cmdUpdata_Click()
'提交修改记录
Adodata.Recordset.Update
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 1
Timer2.Interval = 100
Timer2.Enabled = False
i = 0
ok = 0
strMailAdd = "wenye1207@163.com" '收信人地址
strAddName = "影子" '收信人姓名
strSubject = "数据" '发信的主题
strNoteText = "今日数据" '发信的内容
With MSComm1
If .PortOpen = True Then
.PortOpen = False
End If
.CommPort = 1 '使用COM1
.Settings = "9600,n,8,1 " '设置通信口参数
.InBufferSize = 1024 '设置MSComm1接收缓冲区为1024字节
.OutBufferSize = 1024 '设置MSComm1发送缓冲区为1024字节
.InputMode = comInputModeBinary '设置接收数据模式为二进制形式
'-----------------------------------------------------------------------------------------------------
.InputLen = 1 '设置Input 一次从接收缓冲读取全部字节数
.SThreshold = 4 '设置发送完所有产生OnComm事件
.InBufferCount = 0 '清除接收缓冲区
.OutBufferCount = 0 '清除发送缓冲区
.RThreshold = 16 '设置接收一个字节产生OnComm事件
' .RTSEnable = True
'-----------------------------------------------------------------------------------------------------
If Not .PortOpen Then '判断通信口是否打开
On Error Resume Next
.PortOpen = True '打开通信口
If Err Then '错误处理
MsgBox "串口被占用或此串口不存在！通信无效！", 16, "错误提示"
Exit Sub
End If
End If
End With
'-----------------------------------------------------------------------------------------------------
End Sub
Private Sub MSComm1_OnComm()
Dim sss As Long
'dim mm as
Dim h As Byte
Dim x As Integer
Timer1.Enabled = False
success = &HBB
reload = &HCC
gameover = &HDD
ff(0) = success
ff(1) = reload
ff(2) = gameover
Timer1.Enabled = False
Timer2.Enabled = False
m(1) = 0
m(2) = 0
m(3) = 0
'With MSComm1
Select Case MSComm1.CommEvent '选择事件
Case comEvReceive '接收到字符
For i = 0 To 15
v = MSComm1.Input
h = v(0)
s(i) = h
Next i
If s(0) = &HA5 And s(1) = &H0 And s(15) = &HAE Then
sss = 0
For x = 0 To 13
sss = sss + s(x)
Next x
sss = sss Mod 256
If sss = s(14) Then
m(0) = &HBB
he = he + 1
For x = 0 To 15
jg(he, x) = s(x)
Next x
Timer1.Enabled = True
Else
m(0) = &HCC
Timer1.Enabled = True
End If
End If
If s(0) = &HA5 And s(1) = &H11 And s(15) = &HAE Then
sss = 0
For x = 0 To 13
sss = sss + s(x)
Next x
sss = sss Mod 256
If sss = s(14) Then
m(0) = &HBB
he = he + 1
Label1.Caption = he
For x = 0 To 15
jg(he, x) = s(x)
Next x
Timer1.Enabled = True
Else
m(0) = &HCC
Timer1.Enabled = True
End If
End If
If s(0) = &HA5 And s(1) = &H22 And s(2) = &HEE And s(15) = &HAE Then
sss = 0
For x = 0 To 13
sss = sss + s(x)
Next x
sss = sss Mod 256
If sss = s(14) Then
m(0) = &HDD
MSComm1.Output = m
he = he + 1
For x = 0 To 15
jg(he, x) = s(x)
Next x
Dim xls As New Excel.Application
xls.Workbooks.Add
For ca = 1 To he
For x = 0 To 15
xls.Cells(ca, x + 1) = CStr(Hex(jg(ca, x)))
Next x
Next ca
ddd = Date
xls.ActiveWorkbook.SaveAs "C:\" + ddd + ".xls"
SaveChanges = True
xls.Workbooks.Close '关闭文档
xls.Quit '退出excel程序
MAPISession1.DownLoadMail = False '不立即进入用户的收信箱(非常有用的，不信你设为 True试一下)
MAPISession1.LogonUI = True '显示一个启动动话框
MAPISession1.SignOn '这因该算激活吧，注意：不要把FoxMail在IE中设置为默认电子邮件，否则会出现错误
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose '构成一条消息
MAPIMessages1.RecipAddress = strMailAdd '收信人地址
MAPIMessages1.ResolveName
MAPIMessages1.RecipDisplayName = strAddName '收信人姓名
MAPIMessages1.MsgSubject = strSubject '发信的主题
MAPIMessages1.MsgNoteText = strNoteText '发信的内容
MAPIMessages1.AttachmentIndex = 0 '当前附件的索引位置
MAPIMessages1.AttachmentPathName = "C:\" + ddd + ".xls" '附件的路径
MAPIMessages1.Send '开始发送
MAPISession1.SignOff '可以算成关闭吧
Label1.Caption = "数据接收结束"
Command2.Enabled = True
Else
m(0) = &HCC
Timer1.Enabled = True
End If
End If
End Select
Timer2.Enabled = True
End Sub
Private Sub Timer1_Timer()
MSComm1.Output = m
If m(0) = &HDD Or m(0) = &HBB Or m(0) = &HCC Then
Timer1.Enabled = False
End If
Timer2.Enabled = True
End Sub
Private Sub Timer2_Timer()
MSComm1.Output = m
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -