lpt.cls

VB控制并口

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "LPT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim hLPT As LPT_HANDLE
Public Function OpenLPT() As Boolean
OpenLPT = LPT_Open(hLPT)
End Function
Public Sub CloseLPT()
LPT_Close hLPT
End Sub
Public Sub SetLptBit(ByVal LptPort As Integer, ByVal LptBit As Byte)
'SetPortBit LptPort, LptBit
LPT_WriteByte hLPT, 0, LptPort - 888, (LPT_ReadByte(hLPT, 0, LptPort - 888) Or 2 ^ LptBit)
End Sub
Public Sub ClrLptBit(ByVal LptPort As Integer, ByVal LptBit As Byte)
'ClrPortBit LptPort, LptBit
LPT_WriteByte hLPT, 0, LptPort - 888, (LPT_ReadByte(hLPT, 0, LptPort - 888) And (Not 2 ^ LptBit))
End Sub
Public Function GetLptBit(ByVal LptPort As Integer, ByVal LptBit As Byte) As Boolean
 'GetLptBit = GetPortBit(LptPort, LptBit)
 If (LPT_ReadByte(hLPT, 0, LptPort - 888) And 2 ^ LptBit) = 0 Then
    GetLptBit = False
    Exit Function
Else
    GetLptBit = True
    Exit Function
End If
End Function
Public Function LptWriteByte(ByVal LptPort As Integer, ByVal data As Byte)
   LPT_WriteByte hLPT, 0, LptPort - 888, data
End Function
Public Function LptReadByte(ByVal LptPort As Integer) As Byte
   LptReadByte = LPT_ReadByte(hLPT, 0, LptPort - 888)
End Function