module1.bas

目前只支持 s51

        SetPinLogic = True
    Case 14
        CtrlCode = CtrlCode And &HFD
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 16
        CtrlCode = CtrlCode Or &H4
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 17
        CtrlCode = CtrlCode And &HF7
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case Else
        SetPinLogic = False
    End Select
    
Else
    
    If (nPin = 0) Then SetPinLogic = False
    
    Select Case nPin
    Case 1
        CtrlCode = CtrlCode Or &H1
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 2
        DataCode = DataCode And &HFE
        WriteData DataCode
        SetPinLogic = True
    Case 3
        DataCode = DataCode And &HFD
        WriteData DataCode
        SetPinLogic = True
    Case 4
        DataCode = DataCode And &HFB
        WriteData DataCode
        SetPinLogic = True
    Case 5
        DataCode = DataCode And &HF7
        WriteData DataCode
        SetPinLogic = True
    Case 6
        DataCode = DataCode And &HEF
        WriteData DataCode
        SetPinLogic = True
    Case 7
        DataCode = DataCode And &HDF
        WriteData DataCode
        SetPinLogic = True
    Case 8
        DataCode = DataCode And &HBF
        WriteData DataCode
        SetPinLogic = True
    Case 9
        DataCode = DataCode And &H7F
        WriteData DataCode
        SetPinLogic = True
    Case 14
        CtrlCode = CtrlCode Or &H2
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 16
        CtrlCode = CtrlCode And &HFB
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 17
        CtrlCode = CtrlCode Or &H8
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case Else
        SetPinLogic = False
    End Select
End If
End Function

Public Function GetPinLogic(nPin As Integer) As Byte
    Select Case nPin
    Case 1
        CtrlCode = ReadCtrl()
        GetPinLogic = Not (CtrlCode And &H1)
    Case 2
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H1)
    Case 3
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H2)
    Case 4
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H4)
    Case 5
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H8)
    Case 6
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H10)
    Case 7
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H20)
    Case 8
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H40)
    Case 9
        DataCode = ReAddrata()
        GetPinLogic = (DataCode And &H80)
    Case 10
        StatCode = ReadState()
        GetPinLogic = (StatCode And &H40)
    Case 11
        StatCode = ReadState()
        GetPinLogic = Not (StatCode And &H80)
    Case 12
        StatCode = ReadState()
        GetPinLogic = (StatCode And &H20)
    Case 13
        StatCode = ReadState()
        GetPinLogic = (StatCode And &H10)
    Case 14
        CtrlCode = ReadCtrl()
        GetPinLogic = Not (CtrlCode And &H2)
    Case 15
        StatCode = ReadState()
        GetPinLogic = (StatCode And &H8)
    Case 16
        CtrlCode = ReadCtrl()
        GetPinLogic = (CtrlCode And &H4)
    Case 17
        CtrlCode = ReadCtrl()
        GetPinLogic = Not (CtrlCode And &H8)
    Case Else
        GetPinLogic = False
    End Select
End Function


Sub SckBytes(nBytes As Integer)  '通过下载线与器件通信
    Dim n As Integer
    For n = 0 To nBytes - 1
    
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H80)  ' SCK为低电平时，发送一位
        SetSCK 1
        If GetPinLogic(MISO) Then   ' SCK为搞电平时，接收一位
            InBuf(n) = InBuf(n) Or &H80
        Else
            InBuf(n) = InBuf(n) And &H7F
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H40)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H40
        Else
            InBuf(n) = InBuf(n) And &HBF
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H20)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H20
        Else
            InBuf(n) = InBuf(n) And &HDF
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H10)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H10
        Else
            InBuf(n) = InBuf(n) And &HEF
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H8)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H8
        Else
            InBuf(n) = InBuf(n) And &HF7
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H4)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H4
        Else
            InBuf(n) = InBuf(n) And &HFB
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H2)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H2
        Else
            InBuf(n) = InBuf(n) And &HFD
        End If
        
        SetPinL SCK
        SetPinLogic MOSI, (OutBuf(n) And &H1)
        SetSCK 1
        If GetPinLogic(MISO) Then
            InBuf(n) = InBuf(n) Or &H1
        Else
            InBuf(n) = InBuf(n) And &HFE
        End If
        
        SetPinL SCK
  Next
End Sub

Sub SetSCK(bLogic As Boolean)
    Dim n As Integer
    If bLogic Then
        SetPinH (SCK)
    Else
        SetPinL (SCK)
    End If
    SetPinLogic LE, LEE '1 '  开启锁存
    DelayUS DelayTime ' 延时
    SetPinLogic LE, LED '  关闭锁存
End Sub

Sub SetRST(bLogic As Boolean)
    Dim n As Integer
    If bLogic Then
        SetPinH (RST)
    Else
        SetPinL (RST)
    End If
    SetPinLogic LE, LEE '  开启锁存
    DelayUS DelayTime ' 延时
    SetPinLogic LE, LED '  关闭锁存
End Sub

Sub SetMOSI(bLogic As Boolean)
    Dim n As Integer
    If bLogic Then
        SetPinH (MOSI)
    Else
        SetPinL (MOSI)
    End If
    SetPinLogic LE, LEE '  开启锁存
    DelayUS DelayTime ' 延时
    SetPinLogic LE, LED '  关闭锁存
End Sub

Public Function GetMISO() As Boolean
    Dim n As Integer
    SetPinLogic LE, LEE '  开启锁存
    DelayUS DelayTime ' 延时
    SetPinLogic LE, LED '  关闭锁存
    GetMISO = GetPinLogic(MISO)
End Function




'''''******************************************

'''''''''几个通用函数

'''''******************************************

Function ReadSign(s1 As Byte, s2 As Byte, s3 As Byte, s4 As Byte) As String     '读特征字
    Dim pBuf(0 To 3) As Byte
    OutBuf(0) = s1
    OutBuf(1) = s2
    OutBuf(2) = s3
    OutBuf(3) = s4
    SckBytes (4) '向器件发编程命令
    pBuf(0) = InBuf(3) '第1个特征字
    OutBuf(1) = &H1
    SckBytes (4)
    pBuf(1) = InBuf(3) '第2个特征字
    OutBuf(1) = &H2
    SckBytes (4)
    pBuf(2) = InBuf(3) '第3个特征字
    ReadSign = Hex(pBuf(0)) & Hex(pBuf(1)) & Hex(pBuf(2))
End Function
 

Sub WriteS(CodeAddr As Integer, Code As Byte, SignByte As Byte) '写代码字节
    OutBuf(0) = SignByte
    OutBuf(1) = (CodeAddr And &HFF00) / 256
    OutBuf(2) = CodeAddr And &HFF
    OutBuf(3) = Code
    SckBytes 4
End Sub


Function ReadS(CodeAddr As Integer, SignByte As Byte) As Byte  '读一个单元
   OutBuf(0) = SignByte '根据编程协议规定
   OutBuf(1) = (CodeAddr And &HFF00) / 256  '高地址
   OutBuf(2) = CodeAddr And &HFF  '低地址
   SckBytes 4 '向器件发编程命令
   ReadS = InBuf(3)
End Function