frmmain.frm

VB写PC端ISP程序W78E516UpdataOfVB,请配合本人用C51写的华邦8位单片机ISP程序w78e516_ISPofC51使用

Select Case Index
        Case Is = 0              '"OPEN"打开串口命令
            
       Case Is = 1              '"CLOSE"关闭串口命令
            
       Case Is = 2              '选择文件命令

             
     Case Is = 20       '字库下载
           Dim addr As Long
           
           Dim DataBuf() As Byte
          ' Dim TT As Long
          
           
           addr = 0
           Me.MSCOM.InputMode = comInputModeBinary
           Me.MSCOM.RThreshold = 0
           TXOVER = False
           
         Do
            RXOVER = False
            SendData addr, 128
             TT = GetTickCount
             Do
             DoEvents
             
             Loop Until Me.MSCOM.InBufferCount >= 6 Or GetTickCount - TT >= 10000
             If GetTickCount - TT >= 10000 Then
               MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
               Exit Sub
            Else
              DataBuf = Me.MSCOM.Input
              Me.MSCOM.InBufferCount = 0
            End If
            TT = GetTickCount
             Do
             DoEvents
             
             Loop Until GetTickCount - TT >= 350
             addr = addr + 128      '调整指针
         Loop Until TXOVER = True
              
             
            
           'Next Addr
           
             
             
            
            
     
 End Select

 
End Sub

Private Sub CMSSEND_Click()
Dim STR As String
Dim SendByte(512) As Byte
If Me.tcpsock.State <> sckConnected Then
 MsgBox "没有联机!", vbExclamation + vbOKOnly, "系统信息"
 Exit Sub
End If

STR = SendTXT.Text
STR = Chr(&H1B) + Chr(&H20) + Chr(3) + STR

 Me.tcpsock.SendData STR
                      
End Sub

Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
 Dim STR As String, FileNo As Integer
Dim DataCount As Integer
Toolbar2.Visible = False
ZKStartAdd = 0
FileNo = FreeFile()
On Error GoTo OpenFileER
Open App.Path + "\SetCom.ini" For Input As FileNo
Do Until (EOF(FileNo))
    Line Input #FileNo, STR
    DataCount = InStr(1, STR, "=")
    
    If InStr(1, STR, "Speed") > 0 Then
        
        STR = Mid(STR, DataCount + 1, Len(STR) - DataCount)
        SysInfomation.MsComString = STR
    End If
    If InStr(1, STR, "ComNo") > 0 Then
        'DataCount = InStr(1, STR, "ComNo")
        STR = Mid(STR, DataCount + 1, Len(STR) - DataCount)
        SysInfomation.MsComNo = CByte(STR)
    End If
    If InStr(1, STR, "OpenFilePath") > 0 Then
        'DataCount = InStr(1, STR, "OpenFilePath")
        STR = Mid(STR, DataCount + 1, Len(STR) - DataCount)
        SysInfomation.OpenFilePath = STR
    End If
    If InStr(1, STR, "SaveFilePath") > 0 Then
        'DataCount = InStr(1, STR, "SaveFilePath")
        STR = Mid(STR, DataCount + 1, Len(STR) - DataCount)
        SysInfomation.SaveFilePath = STR
    End If
Loop
Close #FileNo   '关闭文件
 Call VS_Change
 OpenFileFunction SysInfomation.OpenFilePath
 Me.MSCOM.InputMode = comInputModeBinary
 Me.MSCOM.CommPort = SysInfomation.MsComNo
 Me.MSCOM.Settings = SysInfomation.MsComString
 Me.MSCOM.InputLen = 0              '一次从串口读8BYTES数据
 Me.MSCOM.RThreshold = 0            '串口接受到的数据超过6字节后引发串口事件
 Me.StatusBar.Panels(1).Text = "Port: Com" + CStr(SysInfomation.MsComNo)
 Me.StatusBar.Panels(2).Text = "Speed: " + Mid(SysInfomation.MsComString, 1, InStr(SysInfomation.MsComString, ",") - 1)
 Me.StatusBar.Panels(3).Text = "Status: Close"
 OpenFileFlag = False
   Exit Sub
Exit Sub
  
OpenFileER:
  



End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 MsgBox "确认关闭吗!", vbExclamation + vbOKOnly, "系统信息"
 Cancel = False
 
End Sub

Private Sub OpenFile_Click()
OPENFILES
 
End Sub

Private Sub SetCom_Click()
  Me.Enabled = False
  Load FrmSet
  FrmSet.Visible = True
End Sub

Private Sub tcpsock_DataArrival(ByVal bytesTotal As Long)
Dim BYT() As Byte
Dim BYT1() As Byte

Dim i As Integer, J As Integer
 Me.tcpsock.GetData BYT, vbByte
 
 i = LBound(BYT)
 For J = LBound(BYT) To UBound(BYT)
     ReceiveBuf(J - i) = BYT(i)
 Next J
 TcpIpFlag = True


           
     
End Sub

 

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
  DisFlag = True
  If Button = "打开" Then
   OPENFILES
   Exit Sub
  End If
  If Button = "保存" Then
   SaveFile
   Exit Sub
  End If
   If Button = "清空" Then
   ClearBuff  '清空缓冲区
   Exit Sub
  End If
  If Button = "填充" Then
   FillBuff
   Exit Sub
  End If
  If Button = "移动" Then
    MoveData
   Exit Sub
  End If
   If Button = "擦除" Then
   SENDEraseCode
   Exit Sub
  End If
   If Button = "全空检查" Then
   SENDBlankCode
   Exit Sub
  End If
   If Button = "编程" Then
   SENDProgramCode
   Exit Sub
  End If
   If Button = "校验" Then
   Exit Sub
  End If
  If Button = "加密" Then
   Exit Sub
  End If
  If Button = "自动编程" Then
     DisFlag = False
    Call AutoProgram
   Exit Sub
  End If
  If Button = "字库下载" Then
   Call DownLoadZK
   Exit Sub
  End If
   If Button = "ISP" Then
   Call SetInISP
   Exit Sub
  End If
  If Button = "退出" Then
   If Me.MSCOM.PortOpen = True Then Me.MSCOM.PortOpen = False
   If Me.tcpsock.State <> SOCKCLOSED Then Me.tcpsock.Close
   End
  End If
  
  
End Sub



Private Sub VS_Change()
 disdata RICHbox(Index), Me.VS.Value, txdatabuf
End Sub
Public Sub SendData(addr As Long, Lenght As Byte)
   Dim DataBuf() As Byte
   Dim STR As String
   Dim i As Byte, J As Byte
   If (fileleng - addr) < Lenght Then
        Lenght = fileleng - addr
        TXOVER = 1
   End If
     
   i = Lenght + 8 + 4
   ReDim DataBuf(i)
   DataBuf(0) = &H1B
   DataBuf(1) = &H10
   DataBuf(2) = &H22
   DataBuf(3) = &H0
   DataBuf(4) = Lenght + 10
   DataBuf(5) = &H15        '写标志
   
   STR = CStr(Hex(addr))
   Select Case Len(STR)
          Case Is = 7
                STR = "0" + STR
          Case Is = 6
                STR = "00" + STR
          Case Is = 5
                STR = "000" + STR
          Case Is = 4
                STR = "0000" + STR
          Case Is = 3
               STR = "00000" + STR
          Case Is = 2
               STR = "000000" + STR
          Case Is = 1
               STR = "0000000" + STR
  End Select
  'Me.LBT.Caption = STR
   DataBuf(6) = CByte("&H" + Mid(STR, 1, 2))
   DataBuf(7) = CByte("&H" + Mid(STR, 3, 2))
   DataBuf(8) = CByte("&H" + Mid(STR, 5, 2))
   DataBuf(9) = CByte("&H" + Mid(STR, 7, 2))
    i = 10
     
   For J = 1 To Lenght
       DataBuf(i + J) = txdatabuf(addr + J)
       
    Next J
    DataBuf(i) = 0
    i = i + 1
    DataBuf(i) = 0
    Me.MSCOM.Output = DataBuf
End Sub
 
Public Sub OPENFILES()

  Me.CDIAL.Filter = "十六进制文件(*.HEX)|*.HEX|二进制文件(*.bin)|*.bin|"
            Me.CDIAL.FileName = ""
           Me.CDIAL.Object = 1
           
           If Me.CDIAL.FileName <> "" Then
                OpenFileFunction (Me.CDIAL.FileName)
                
          End If
End Sub
Public Sub OpenFileFunction(STR1 As String)
    Dim STR As String, FileNo As Integer
    Dim BYT As Byte, i As Byte, J As Byte
    Dim DataCount, FileCount As Long
    Dim groupcount As Long
    Dim BYTES() As Byte
    SysInfomation.OpenFilePath = STR1
    STR1 = UCase(STR1)
    FileNo = FreeFile()
    If InStr(1, STR1, ".HEX") <> 0 Then
        Open STR1 For Input As #FileNo
        DataCount = 0
        fileleng = 0
        groupcount = 0
        Do While (Not EOF(FileNo))
          Line Input #FileNo, STR
          If STR <> ":00000001FF" Then
             i = CByte("&h" + Mid(STR, 2, 2))       '记录长度
             If Mid(STR, 8, 2) = "04" Then
                 groupcount = CLng("&h" + Mid(STR, 10, 4)) * &H10000
             End If
             If Mid(STR, 8, 2) = "00" Then
                DataCount = groupcount + CLng("&H" + Mid(STR, 4, 4)) '记录开始地址
                For J = 0 To i - 1
                  FileCount = DataCount + J
                  BYT = CByte("&H" + Mid(STR, J * 2 + 10, 2))
                  txdatabuf(FileCount) = BYT
                  If fileleng < FileCount Then fileleng = FileCount
                Next J
            End If
        End If
            'If Mid(STR, 8, 2) = "02" Then
      Loop
      fileleng = fileleng + 1
   Else
     
      Open STR1 For Binary As #FileNo
      fileleng = LOF(FileNo)
      For DataCount = 1 To fileleng
         Get #FileNo, , BYT
         txdatabuf(DataCount - 1) = BYT
      Next DataCount
  End If
readhexfileend:  'fileleng = fileleng + 32
      Close #FileNo
      LB1.Caption = "当前文件： " + SysInfomation.OpenFilePath + "     文件长度：" + CStr(fileleng)
      VS.Max = fileleng / 16
      VS.Value = 0
     
      VS_Change
      SaveSysInfomation   '保存系统信息
End Sub

Public Sub SaveFile()
Dim DataCount As Long
Dim BYT As Byte, FileNo As Integer

Me.CDIAL.FileName = ""
Me.CDIAL.Filter = "二进制文件(*.BIN)|*.Bin|"
          Me.CDIAL.Object = 2
          
          If Me.CDIAL.FileName <> "" Then
                  
                    FileNo = FreeFile()
                    
                    Open Me.CDIAL.FileName For Binary As #FileNo
                    
                     For DataCount = 1 To fileleng
                          BYT = txdatabuf(DataCount - 1)
                           Put #FileNo, , BYT
                    Next DataCount
                    Close #1
                    LB1.Caption = "当前文件： " + Me.CDIAL.FileName + "     文件长度：" + CStr(fileleng)
            End If
End Sub
Public Sub FillBuff()      '填充缓冲区
Dim DataCount As Long
OKFlag = False
FrmAdd.Visible = True
FrmAdd.Height = 3500
FrmAdd.Fram(0).Height = 2655
FrmAdd.Fram(1).Top = FrmAdd.Fram(0).Top + FrmAdd.Fram(0).Height
FrmAdd.TextAdd(2).Locked = False
Do
 DoEvents
Loop Until FrmAdd.Visible = False
If OKFlag = False Then Exit Sub
For DataCount = SourceStrAdd To SourceEndAdd
  txdatabuf(DataCount) = FillData
Next DataCount
VS.Value = SourceStrAdd \ 16
VS_Change
End Sub

Public Sub ClearBuff()      '清空缓冲区
Dim DataCount As Long
OKFlag = False
FrmAdd.Visible = True
FrmAdd.Height = 3500
FrmAdd.TextAdd(2).Text = "FF"
FrmAdd.TextAdd(2).Locked = True
FrmAdd.Fram(0).Height = 2655
FrmAdd.Fram(1).Top = FrmAdd.Fram(0).Top + FrmAdd.Fram(0).Height
Do
 DoEvents
Loop Until FrmAdd.Visible = False
If OKFlag = False Then Exit Sub
For DataCount = SourceStrAdd To SourceEndAdd
  txdatabuf(DataCount) = &HFF
Next DataCount
VS.Value = SourceStrAdd \ 16
VS_Change
End Sub
Public Sub MoveData()      '移动数据
Dim DataLength As Long
Dim BYT() As Byte

OKFlag = False
FrmAdd.Visible = True
FrmAdd.Height = 4200
FrmAdd.TextAdd(2).Text = "FF"
FrmAdd.TextAdd(2).Locked = True
FrmAdd.Fram(1).Visible = True
Do
 DoEvents
Loop Until FrmAdd.Visible = False
If OKFlag = False Then Exit Sub
DataLength = SourceEndAdd - SourceStrAdd + 1
ReDim BYT(DataLength)
CopyMemory BYT(0), txdatabuf(SourceStrAdd), DataLength
CopyMemory txdatabuf(DestStrAdd), BYT(0), DataLength

VS.Value = DestStrAdd \ 16
VS_Change
End Sub
Public Sub SendTcpIpCommand(ByVal PortNo As Byte, ByVal handle As Byte, DataLength As Byte, DataBuf() As Byte)               '发送命令