modulesub.bas

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

Attribute VB_Name = "ModuleSUB"

Public Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Public trflag As Byte       'trflag=0 为等待终端发送请求
Public Txcount As Long
Public txdatabuf(&H7FFFFF) As Byte   '发送数据缓冲区512K
Public rxdatabuf(&H7FFFFF) As Byte   '接收数据缓冲区512K

Public ReceiveBuf(512) As Byte
Public fileleng As Long
Public TcpIpFlag As Boolean
Public OKFlag As Boolean                            '地址设置确认标志
Public DisFlag As Boolean
Public SourceStrAdd As Long, SourceEndAdd As Long    '源地址
Public DestStrAdd As Long, DestEndAdd As Long        '目的地址
Public FillData As Byte                              '填充数据

Public ZKStartAdd As Long


Public Const AM29F016Code = &H25     '芯片选择位 AM29F016
Public Const SST29EE010Code = &H94     '芯片选择位 AM29F016
Public Const HeaderFlag = &H1B     '命令头
Public Const WinSocketPort = &H20     '
Public Const MSComPort = &H10
Public Const EraseCode = &HA0         '擦除命令代码
Public Const BlankCode = &HA0         '全空检查命令代码
Public Const ProgramCode = &HA2       '编程命令代码
Public Const VerifyCode = &HA3        '校验命令代码
Public Const EncryptCode = &HA4       '加密命令代码
Public Const RestMcuCode = &HA5       '复位MCU命令代码
Public Const ReadMac1 = &H95          '读取一个随机数
Public Const SetMac2 = &H96           '发送MAC2
Type SysInfomationDef
    MsComString As String           '串口通信速度
    MsComNo     As Byte             '通信串口号
    OpenFilePath    As String       '文件路径
    SaveFilePath    As String       '保存文件路径
End Type
Public SysInfomation As SysInfomationDef  '系统初始化数据
Public Sub disdata(windows As RichTextBox, POINT As Long, DISDATABUF() As Byte)


 Dim STR As String, STR1 As String
 Dim STR2 As String
 Dim i As Byte, J As Byte, BYT As Byte
 Dim lcount  As Long
 Dim txcount1 As Long
 Dim CHAR() As Byte
 'If trflag = 1 Then Exit Sub
 windows.Text = "  Address    00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F     0123456789ABCDEF" + vbCrLf
 txcount1 = 16 * POINT
 lcount = LBound(DISDATABUF)
 
 For i = 0 To 15
     STR1 = CStr(Hex(txcount1))
     Select Case Len(STR1)
            Case Is = 1
                    STR1 = "0000" + STR1
            Case Is = 2
                    STR1 = "000" + STR1
            Case Is = 3
                    STR1 = "00" + STR1
            Case Is = 4
                    STR1 = "0" + STR1
    End Select
           windows.Text = windows.Text + "  " + STR1 + "H     "
           STR1 = ""
           STR2 = ""
           STR = ""
     For J = 0 To 15
           BYT = DISDATABUF(lcount + txcount1)
           STR = CStr(Hex(BYT))
           If Len(STR) = 1 Then STR = "0" + STR
           
           STR1 = STR1 + STR + " "
           If BYT < &H20 Or BYT > &H7F Or BYT = 10 Or BYT = 13 Or BYT = 9 Then
                STR = "-"
           Else
                
           
           STR = Chr(DISDATABUF(lcount + txcount1))
           End If
            
           If STR = " " Then STR = "-"
           STR2 = STR2 + STR
           txcount1 = txcount1 + 1
    Next J
          windows.Text = windows.Text + STR1 + "    " + STR2 + vbCrLf
Next i

    
           

End Sub

Public Function CRC16(data() As Byte, DataLength As Byte) As String
    Dim DataBuf() As Byte, Counter As Byte, Temp As Byte, i As Byte
    
    Dim CRC As Long, STR As String
    ReDim DataBuf(DataLength)
    CopyMemory DataBuf(0), data(LBound(data)), DataLength
    CRC = 0
    For Counter = 0 To DataLength - 1
        i = &H80
       Do While (i <> 0)
          CRC = CRC Mod 65536
         If ((CRC And 32768) And 65535) <> 0 Then
            CRC = CRC * 2
            CRC = CRC Xor 32773
         Else
           CRC = CRC * 2
        End If
        If (DataBuf(Counter) And i) <> 0 Then
             CRC = CRC Xor 32773
           End If
        i = i / 2
       Loop
       
    Next Counter
    CRC = CRC Mod 65536
   STR = CStr(Hex(CRC))
   Select Case (Len(STR))
         Case 1
             STR = "000" + STR
        Case 2
            STR = "00" + STR
        Case 3
            STR = "0" + STR
    End Select
    CRC16 = STR
         
       

End Function
    
 

 
 
 

Public Sub ReceiveData(MSCOM As MSComm) '从串口接收数据，接收到的数据 保存在ReceiveBuf(512)中
     Dim TT As Long
     Dim StrADD As Long, EndADD As Long
     Dim ReceiveByteS() As Byte, Count As Byte, DataLength As Byte
     Count = 0
     TT = GetTickCount
    Do
     DoEvents
    Loop Until MSCOM.InBufferCount >= 4 Or GetTickCount - TT >= 30000
    If MSCOM.InBufferCount >= 4 Then
      ReceiveByteS = MSCOM.Input
      EndADD = UBound(ReceiveByteS)
      For StrADD = LBound(ReceiveByteS) To EndADD
       ReceiveBuf(Count) = ReceiveByteS(StrADD)
       Count = Count + 1
      Next StrADD
    Else
     ' MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
      ReceiveBuf(3) = 0
      CloseCom MSCOM
        
      Exit Sub
    End If
    DataLength = ReceiveBuf(3) + 1 - (EndADD - LBound(ReceiveByteS)) '本包数据长度
    If DataLength = 0 Then      '恰好接收到一个数据包的情况
       CloseCom MSCOM
      Exit Sub
    End If
    Do
     DoEvents
    Loop Until MSCOM.InBufferCount >= DataLength
    ReceiveByteS = MSCOM.Input
    EndADD = UBound(ReceiveByteS)
    For StrADD = LBound(ReceiveByteS) To EndADD
       ReceiveBuf(Count) = ReceiveByteS(StrADD)
       Count = Count + 1
    Next StrADD
     CloseCom MSCOM
       
     
End Sub

Public Sub SaveSysInfomation()
  Dim FileNo As Integer
  Dim STR As String
  FileNo = FreeFile()
  Open App.Path + "\SetCom.ini" For Output As #FileNo
  STR = "Speed=" + SysInfomation.MsComString + vbCrLf '保存通信速度
  STR = STR + "ComNo=" + CStr(SysInfomation.MsComNo) + vbCrLf  '保存串口号
  STR = STR + "SaveFilePath=" + SysInfomation.SaveFilePath + vbCrLf '保存文件保存路径
  STR = STR + "OpenFilePath=" + SysInfomation.OpenFilePath + vbCrLf '保存文件打开路径
  STR = Trim(STR)
  Print #FileNo, , STR
  Close #FileNo
  
End Sub
Public Sub OpenCom(MSCOM As MSComm, Rthold As Integer, InputLength As Integer)
If MSCOM.PortOpen = True Then
   MSCOM.PortOpen = False
End If
    
    MSCOM.CommPort = SysInfomation.MsComNo
    MSCOM.Settings = SysInfomation.MsComString
    MSCOM.InBufferCount = 0              '清空缓冲区
    MSCOM.InputMode = comInputModeBinary '
    MSCOM.InputLen = InputLength         '一次从串口读8BYTES数据
    MSCOM.RThreshold = Rthold            '串口接受到的数据超过6字节后引发串口事件
    MSCOM.PortOpen = True                '打开串口
    Frmmain.StatusBar.Panels(3).Text = "Status: Open"
   '/ DelayNu = 0
End Sub
Public Sub CloseCom(MSCOM As MSComm)
If MSCOM.PortOpen = True Then
   MSCOM.PortOpen = False
End If
Frmmain.StatusBar.Panels(3).Text = "Status: Close"
End Sub