drv_prn.bas

VB代码

Attribute VB_Name = "Driver_PrintPort"
Option Explicit

Const c_Mode_EraseChip = &H1
Const c_Mode_WritePGMCode = &H2
Const c_Mode_ReadPGMCode = &H3
Const c_Mode_ReadSignature = &H4
Const c_Mode_LockBit1 = &H5
Const c_Mode_LockBit2 = &H6


Const c_CharNumberPerLine = 16
Const c_PRINT_PE_MASK = &H20
Const c_LockType_unLock = 0
Public Const c_LockType_LockLevel1 = 1
Public Const c_LockType_LockLevel2 = 2
Public Const c_LockType_LockLevel3 = 3


Public Const c_AT89S51ID = 0
Public Const c_AT89S52ID = 1
Public Const c_AT89S53ID = 2

Public Const c_AT89S51Name = "AT89S51"
Public Const c_AT89S52Name = "AT89S52"
Public Const c_AT89S53Name = "AT89S53"

Public Const c_AT89S51DeviceSignature = "1E 51 06"
'Public Const c_AT89S52DeviceSignature = "1E 52 06"
Public Const c_AT89S52DeviceSignature = "1E 21 FF"
Public Const c_AT89S53DeviceSignature = "1E 53 06"

Dim ucPrintDataPortMemImage As Byte
Dim ucPrintControlPortMemImage As Byte
Public iCurrentPrintBaseAddress As Integer
Public ucDataBuff(0 To &H4000) As Byte
Public iMaxCodeLength As Integer
Public iCurrentDeviceID As Integer
'Inp and Out declarations for direct port I/O
'in 32-bit Visual Basic 4 programs.
'直接操纵IO口的API函数的说明。
Public Declare Function Inp Lib "inpout32.dll" _
Alias "Inp32" (ByVal PortAddress As Integer) As Integer

Public Declare Sub Out Lib "inpout32.dll" _
Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)

'STDZ　制作　2006－12－20
'对底层IO控制的驱动程序进行封装。

'功能介绍：读取IO口1字节
'入口参数：IO端口地址
'返回：     读取到的字节数据。
Public Function InPortByte(ByVal PortAddress As Integer) As Byte
    InPortByte = CByte(Inp(PortAddress))
End Function


'功能介绍：写IO口1字节
'入口参数：IO端口地址,待写入端口的1字节数据。
'返回：     读取到的字节数据。
Public Function OutPortByte(ByVal PortAddress As Integer, ByVal ucWriteData As Byte) As Boolean
    Dim bReturnResult As Boolean
    
    Call Out(PortAddress, CInt(ucWriteData))
    
    bReturnResult = True
    OutPortByte = bReturnResult
    
End Function


'对PC机打印机口进行控制的底层驱动

'功能介绍：设定当前应用的打印机端口的IO基地址
'入口参数   打印机端口的IO基地址。
'返回：     无
Public Function SetPrintPortBaseAddress(ByVal iPrintPortBaseAddr As Integer) As Boolean
    Dim bReturnValue As Boolean

    iCurrentPrintBaseAddress = iPrintPortBaseAddr
    
    ucPrintDataPortMemImage = &H0
    ucPrintControlPortMemImage = &HB
    bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
    bReturnValue = WriteData_PrintControlPort(ucPrintControlPortMemImage)
   
    SetPrintPortBaseAddress = True
End Function

'功能介绍：写1字节数据到打印机的数据口
'入口参数   待写入端口的1字节数据。
'返回：     无
Public Function WriteData_PrintDataPort(ByVal ucWrData As Byte) As Boolean
    Dim bReturnValue As Boolean

    bReturnValue = OutPortByte(iCurrentPrintBaseAddress, ucWrData)
    
    WriteData_PrintDataPort = bReturnValue
End Function

'功能介绍：写1字节数据到打印机的控制口
'入口参数   待写入端口的1字节数据。
'返回：     无
Public Function WriteData_PrintControlPort(ByVal ucWrData As Byte) As Boolean
    Dim bReturnValue As Boolean

    bReturnValue = OutPortByte(iCurrentPrintBaseAddress + 2, ucWrData)
    
    WriteData_PrintControlPort = bReturnValue
End Function

'功能介绍：从打印机状态端口读1字节数据
'入口参数   无。
'返回：     读取到的当前状态端口的数据。
Public Function ReadData_PrintStatusPort() As Byte
    Dim ucReturnValue As Byte

    ucReturnValue = InPortByte(iCurrentPrintBaseAddress + 1)
    
    ReadData_PrintStatusPort = ucReturnValue
End Function

'EPP打印端口扩展应用
'
'

'面向应用的打印机端口控制与状态线操作
'以下是为AT89SXX编程器进行的封装。

Function ShiftDataRight(ByVal ucSrcData As Byte) As Byte
        
        ShiftDataRight = ucSrcData \ &H2

End Function

Function CStr_Hex(ucSrcValue As Byte) As String
    Dim ucHighHex As Byte
    Dim ucLowHex As Byte


    ucHighHex = ucSrcValue \ 16
    ucLowHex = ucSrcValue Mod 16
        
    If ucHighHex < 10 Then
        ucHighHex = ucHighHex + &H30
    Else
        ucHighHex = ucHighHex + &H30 + 7
    End If
    
    If ucLowHex < 10 Then
        ucLowHex = ucLowHex + &H30      '转换成ascii码准备显示
    Else
        ucLowHex = ucLowHex + &H30 + 7
    End If

    CStr_Hex = Chr$(ucHighHex) + Chr$(ucLowHex)
End Function



Function CIntToHexStr(iSrcValue As Integer) As String
    Dim ucHighByte As Byte
    Dim ucLowByte As Byte

    ucHighByte = iSrcValue \ &H100
    ucLowByte = iSrcValue Mod &H100
        
    CIntToHexStr = CStr_Hex(ucHighByte) & CStr_Hex(ucLowByte)

End Function


Sub SetResetLineHigh()
    Dim bReturnValue As Boolean
    
    ucPrintDataPortMemImage = ucPrintDataPortMemImage Or &H20

    bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
   
End Sub

Sub SetResetLineLow()
    Dim bReturnValue As Boolean
    
    ucPrintDataPortMemImage = ucPrintDataPortMemImage And &HDF

    bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)

End Sub
Sub SetClkLineHigh()
   ' Dim bReturnValue As Boolean
    
    'ucPrintDataPortMemImage = ucPrintDataPortMemImage Or &H1

    'bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
    MainForm.ComProgram.DTREnable = False

End Sub

Sub SetClkLineLow()
    'Dim bReturnValue As Boolean
    
    'ucPrintDataPortMemImage = ucPrintDataPortMemImage And &HFE

    'bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
    MainForm.ComProgram.DTREnable = True

End Sub
Sub SetMOSILineHigh()
    'Dim bReturnValue As Boolean
    
    'ucPrintDataPortMemImage = ucPrintDataPortMemImage Or &H4

    'bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
    MainForm.ComProgram.RTSEnable = False
End Sub

Sub SetMOSILineLow()
    'Dim bReturnValue As Boolean
    
    'ucPrintDataPortMemImage = ucPrintDataPortMemImage And &HFB

    'bReturnValue = WriteData_PrintDataPort(ucPrintDataPortMemImage)
    MainForm.ComProgram.RTSEnable = True

End Sub
'Function GetMISOLineStatus() As Boolean
'    Dim ucTemp As Byte
'    Dim bReturnValue As Boolean
        
'    ucTemp = ReadData_PrintStatusPort()
'    If (ucTemp And c_PRINT_PE_MASK) Then
'        bReturnValue = False
'    Else
'        bReturnValue = True
'    End If
    
'    GetMISOLineStatus = bReturnValue
    
'End Function
'RS232版
Function GetMISOLineStatus() As Boolean
    Dim bReturnValue As Boolean
        
    If (MainForm.ComProgram.CTSHolding) Then
        bReturnValue = False
    Else
        bReturnValue = True
    End If
    
    GetMISOLineStatus = bReturnValue
    
End Function

Sub SPITrans_WriteOneByte(ByVal ucWrite As Byte)
    Dim ucMaskCode As Byte
    Dim ucCount As Byte
    
    ucMaskCode = &H80
    Call SetClkLineLow
    For ucCount = 0 To 7 Step 1
        If (ucWrite And ucMaskCode) Then
            Call SetMOSILineHigh
        Else
            Call SetMOSILineLow
        End If
        Call SetClkLineHigh
        ucMaskCode = ShiftDataRight(ucMaskCode)
        Call SetClkLineLow
    Next ucCount
  '  Call SetClkLineHigh
End Sub
Function SPITrans_ReadOneByte() As Byte
    Dim ucCount As Byte
    Dim ucMaskCode As Byte
    Dim ucReturnValue As Byte
    
    ucMaskCode = &H80
    ucReturnValue = 0
    'Call SetClkLineLow
    For ucCount = 0 To 7 Step 1