dfh.frm

vb通讯程序

Put #2, i, arry1(i)
Next i
Close #2
Timer2.Enabled = True
On Error GoTo 0
End Sub
'transmmit data.
Private Sub mnushu_Click()
On Error Resume Next
Dim s2 As Integer
Dim s3 As Integer
Dim sun1() As Byte
Dim hsend
Form1.Caption = "下载数据"
Call loadsettings
statusbar.Panels(2).Text = "settings:  " & MSComm1.Settings
  temp1 = InputBox("请输入数据的起始地址:地址必须以“&H”开头，地址为16位！", "ADRESS")
    If Len(temp1) = 0 Or Len(temp1) <> 6 Then
    MsgBox "无起始地址或地址格式不对！请再次按＇下载数据＇菜单", 48, "错误"
     Form1.Caption = "PC与单片机串行通讯"
     statusbar.Panels(2).Text = "settings:  "
    Exit Sub
    End If
a1(1) = CByte(Val("&H" & Mid(temp1, 3, 2)))
a1(2) = CByte(Val("&H" & Mid(temp1, 5, 2)))
 b3 = MsgBox("下面请寻找您要下载的数据！", vbOKCancel + vbInformation)
If b3 = 1 Then
GoTo adresss
ElseIf b3 = 2 Then
Form1.Caption = "PC与单片机串行通讯"
statusbar.Panels(2).Text = "settings:  "
statusbar.Panels(1).Text = "status: "
Exit Sub
End If
'get the rom filename from the user.
adresss:
openlog.DialogTitle = "send rom file"
openlog.Filter = "bin files(*.bin)|*.bin|all files(*.*)|*.*"
Do
  openlog.CancelError = True
  openlog.FileName = " "
  openlog.ShowOpen
  If Err = cdlCancel Then
  Exit Sub
  End If
  temp = openlog.FileName
'if the  file doesn't exist,go back.
  ret = Len(Dir(temp))
  If Err Then
  MsgBox Error$, 48
  Exit Sub
  End If
  If ret Then
  Exit Do
  Else
  MsgBox temp + "not found!", 48
  End If
Loop
'open the rom file.
hsend = FreeFile
Open temp For Binary As hsend
  sun = LOF(hsend)
  a1(5) = &H77
  If Val("&H" & Mid(temp, 5, 2)) + sun Mod 256 > 256 Then
      a1(4) = CByte((Val("&H" & Mid(temp1, 5, 2)) + sun Mod 256 - 256)) 'faaaadg
      a1(3) = CByte((Val("&H" & Mid(temp1, 3, 2)) + sun \ 256 + 1))
  Else
   a1(4) = CByte((Val("&H" & Mid(temp1, 5, 2)) + sun Mod 256))
   a1(3) = CByte((Val("&H" & Mid(temp1, 3, 2)) + sun \ 256))
  End If
  b1(1) = CByte(sun \ 256)
  b1(2) = CByte(sun Mod 256)
  Form1.Caption = "正在发送数据..."
adress22:
j = 0
  For i = 1 To 5
    Do While j >= 256
    j = j - 256
    Loop
    j = j + a1(i)
  Next i
  If j >= 256 Then
  j = j - 256
  End If
  a1(6) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To 5
    a2(1) = a1(i)
    MSComm1.Output = a2
  Next i
 MSComm1.InBufferCount = 0
 Do
  DoEvents
 Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  MSComm1.Output = a2
  If a2(0) = a1(6) Then
   GoTo adress11
  ElseIf a2(0) <> a1(6) Then
   GoTo adress22
  End If
adress11:
ReDim sun1(1 To 257) As Byte
s3 = sun \ 256
s2 = 0
If b1(1) >= 1 Then
adress44:
j = 0
  For i = 1 To 256
   Get hsend, s2 * 256 + i, sun1(i)
   Do While j >= 256
    j = j - 256
   Loop
   j = j + sun1(i)
  Next i
   If j >= 256 Then
    j = j - 256
   End If
  sun1(257) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To 256
   a2(1) = sun1(i)
   MSComm1.Output = a2
  Next i
  MSComm1.InBufferCount = 0
  Do
   DoEvents
  Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  MSComm1.Output = a2
  If a2(0) = sun1(257) Then
     s3 = s3 - 1
    If s3 = 0 Then
       If b1(2) = 0 Then
         GoTo adress77
       End If
      GoTo adress33
    Else
      s2 = s2 + 1
      GoTo adress44
    End If
  ElseIf a2(0) <> sun1(257) Then
    GoTo adress44
  End If
adress33:
j = 0
   ReDim sun1(b1(2) + 1) As Byte
  For i = 1 To sun Mod 256
   Get hsend, (s2 + 1) * 256 + i, sun1(i)
   Do While j >= 256
    j = j - 256
   Loop
   j = j + sun1(i)
  Next i
  If j > 256 Then
     j = j - 256
  End If
  sun1(b1(2) + 1) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To b1(2)
    a2(1) = sun1(i)
    MSComm1.Output = a2
  Next i
  MSComm1.InBufferCount = 0
  Do
  DoEvents
  Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  If a2(0) = sun1(b1(2) + 1) Then
    GoTo adress77
  ElseIf a2(0) <> sun1(b1(2) + 1) Then
   GoTo adress33
  End If
ElseIf b1(1) = 0 Then
adress88:
j = 0
   ReDim sun1(b1(2) + 1) As Byte
   For i = 1 To sun Mod 256
    Get hsend, i, sun1(i)
    Do While j >= 256
    j = j - 256
    Loop
    j = j + sun1(i)
   Next i
   If j >= 256 Then
      j = j - 256
   End If
   sun1(b1(2) + 1) = CByte(j)
   ReDim a2(1) As Byte
   For i = 1 To b1(2)
     a2(1) = sun1(i)
     MSComm1.Output = a2
   Next i
   MSComm1.InBufferCount = 0
    MSComm1.InputLen = 1
   Do
    DoEvents
   Loop Until MSComm1.InBufferCount > 0
   a3 = MSComm1.Input
   a2 = a3
   MSComm1.Output = a2
   If a2(0) = sun1(b1(2) + 1) Then
     GoTo adress77
   ElseIf a2(0) <> sun1(b1(2) + 1) Then
     GoTo adress88
   End If
End If
adress77:
MsgBox "数据下载完毕，无错误！", vbOKOnly + vbInformation, "congratuation！"
 Form1.Caption = "PC与单片机串行通讯 "
statusbar.Panels(2).Text = "settings:  "
statusbar.Panels(1).Text = "status: "
fangshi (False)
Close hsend
On Error GoTo 0
End Sub


'trasmmit programme!
Private Sub mnutransmit_Click()
On Error Resume Next
Dim s2 As Integer
Dim s3 As Integer
Dim sun1() As Byte
Dim hsend
Form1.Caption = "下载程序"
Call loadsettings
statusbar.Panels(2).Text = "settings:  " & MSComm1.Settings
  temp = InputBox("请输入程序的起始地址:地址必须以“&H”开头，地址为16位！", "ADRESS")
    adr = Val(temp)
    If adr = 0 Or Len(temp) <> 6 Then
    MsgBox "无起始地址或地址格式不对！请再次按＇下载程序＇菜单", 48, "错误"
     Form1.Caption = "PC与单片机串行通讯 "
     statusbar.Panels(2).Text = "settings:  "
    Exit Sub
    End If

 b3 = MsgBox("下面请寻找您要下载的程序！", vbOKCancel + vbInformation)
If b3 = 1 Then
GoTo adress
ElseIf b3 = 2 Then
 Form1.Caption = "PC与单片机串行通讯"
statusbar.Panels(2).Text = "settings:  "
statusbar.Panels(1).Text = "status: "
Exit Sub
End If
'get the rom filename from the user.
adress:
openlog.DialogTitle = "send rom file"
openlog.Filter = "rom files(*.rom)|*.rom|all files(*.*)|*.*"
Do
  openlog.CancelError = True
  openlog.FileName = " "
  openlog.ShowOpen
  If Err = cdlCancel Then
  Exit Sub
  End If
  temp = openlog.FileName
'if the  file doesn't exist,go back.
  ret = Len(Dir(temp))
  If Err Then
  MsgBox Error$, 48
  Exit Sub
  End If
  If ret Then
  Exit Do
  Else
  MsgBox temp + "not found!", 48
  End If
Loop
'open the rom file.
hsend = FreeFile
Open temp For Binary As hsend
  sun = LOF(hsend)
 If adr + sun > 16383 Then
 MsgBox "I am sorry ! 你的程序从起始地址存不下", 48
  Form1.Caption = "PC与单片机串行通讯"
statusbar.Panels(2).Text = "settings:  "
statusbar.Panels(1).Text = "status: "
 Exit Sub
 End If
  a1(5) = &H88
  a1(1) = CByte(adr \ 256)
  a1(2) = CByte(adr Mod 256)
  a1(3) = CByte((sun + adr) \ 256)
  a1(4) = CByte((sun + adr) Mod 256)
  b1(1) = CByte(sun \ 256)
  b1(2) = CByte(sun Mod 256)
  Form1.Caption = "正在发送程序..."
adress2:
j = 0
  For i = 1 To 5
    Do While j >= 256
    j = j - 256
    Loop
    j = j + a1(i)
  Next i
  If j >= 256 Then
  j = j - 256
  End If
  a1(6) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To 5
    a2(1) = a1(i)
    MSComm1.Output = a2
  Next i
 MSComm1.InBufferCount = 0
 Do
  DoEvents
Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  MSComm1.Output = a2
  If a2(0) = a1(6) Then
   GoTo adress1
  ElseIf a2(0) <> a1(6) Then
   GoTo adress2
  End If
adress1:
ReDim sun1(1 To 257) As Byte
s3 = sun \ 256
s2 = 0
If b1(1) >= 1 Then
adress4:
j = 0
  For i = 1 To 256
   Get hsend, s2 * 256 + i, sun1(i)
   Do While j >= 256
    j = j - 256
   Loop
   j = j + sun1(i)
  Next i
   If j >= 256 Then
    j = j - 256
   End If
  sun1(257) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To 256
   a2(1) = sun1(i)
   MSComm1.Output = a2
  Next i
  Do
   DoEvents
  Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  MSComm1.Output = a2
  If a2(0) = sun1(257) Then
     s3 = s3 - 1
    If s3 = 0 Then
       If b1(2) = 0 Then
         GoTo adress7
       End If
      GoTo adress3
    Else
      s2 = s2 + 1
      GoTo adress4
    End If
  ElseIf a2(0) <> sun1(257) Then
    GoTo adress4
  End If
adress3:
j = 0
   ReDim sun1(b1(2) + 1) As Byte
  For i = 1 To sun Mod 256
   Get hsend, (s2 + 1) * 256 + i, sun1(i)
   Do While j >= 256
    j = j - 256
   Loop
   j = j + sun1(i)
  Next i
  If j > 256 Then
     j = j - 256
  End If
  sun1(b1(2) + 1) = CByte(j)
  ReDim a2(1) As Byte
  For i = 1 To b1(2)
    a2(1) = sun1(i)
    MSComm1.Output = a2
  Next i
  Do
  DoEvents
  Loop Until MSComm1.InBufferCount > 0
  MSComm1.InputLen = 1
  a3 = MSComm1.Input
  a2 = a3
  MSComm1.Output = a2
  If a2(0) = sun1(b1(2) + 1) Then
    GoTo adress7
  ElseIf a2(0) <> sun1(b1(2) + 1) Then
   GoTo adress3
  End If
ElseIf b1(1) = 0 Then
adress8:
j = 0
   ReDim sun1(b1(2) + 1) As Byte
   For i = 1 To sun Mod 256
    Get hsend, i, sun1(i)
    Do While j >= 256
    j = j - 256
    Loop
    j = j + sun1(i)
   Next i
   If j >= 256 Then
      j = j - 256
   End If
   sun1(b1(2) + 1) = CByte(j)
   ReDim a2(1) As Byte
   For i = 1 To b1(2)
     a2(1) = sun1(i)
     MSComm1.Output = a2
   Next i
   MSComm1.InBufferCount = 0
    MSComm1.InputLen = 1
   Do
    DoEvents
   Loop Until MSComm1.InBufferCount > 0
   a3 = MSComm1.Input
   a2 = a3
   MSComm1.Output = a2
   If a2(0) = sun1(b1(2) + 1) Then
     GoTo adress7
   ElseIf a2(0) <> sun1(b1(2) + 1) Then
     GoTo adress8
   End If
End If
adress7:
MsgBox "程序下载完毕，无错误！", vbOKOnly + vbInformation, "congratuation!"
 Form1.Caption = "PC与单片机串行通讯 "
statusbar.Panels(2).Text = "settings:  "
statusbar.Panels(1).Text = "status: "
fangshi (False)
Close hsend
End Sub


Private Sub relation_Click()
Form4.Show vbModal
End Sub
Private Sub Text2_Click()
SendKeys "{tab}"
End Sub

Private Sub Text3_Click()
SendKeys "{tab}"
End Sub

'Private Sub Timer1_Timer()
'statusbar.Panels(3).Text = "time:" & Format(Now - strtime, "hh:nn:ss") & " "
'End Sub

Private Sub startime()
strtime = Now
Timer1.Enabled = True
End Sub
Private Sub stoptime()
Timer1.Enabled = False
End Sub


Private Sub Timer2_Timer()
Form1.Caption = "visual basic terminal"
Timer2.Enabled = False
Form1.MousePointer = vbDefault
End Sub

Private Sub Timer3_Timer()
cjxyf = False
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "openfile"
  Call mnuopen_Click
Case "savefile"
 Call mnusave_Click
Case "xinjian"
  Call mnuclear_Click
Case "jianqie"
 Call mnuj_Click
Case "fuzhi"
 Call mnuf_Click
Case "niantie"
 Call mnun_Click
End Select
On Error GoTo 0
End Sub

Private Sub mnuSelectAll_Click()
    ' 使用 SelStart 和 SelLength 选定文本
    Form1.Text1.SelStart = 0
    Form1.Text1.SelLength = Len(Form1.Text1.Text)
End Sub

Private Sub mnudate_Click()
    ' 在当前光标处插入当前时间和日期
    Text1.SelText = Now
End Sub