lpt_lib.bas

VB控制并口

Attribute VB_Name = "lpt_lib"
Option Explicit
'
' ---------------------------------------------------------------------
' File - lpt_lib.bas
'
' Library for accessing the LPT card,
' Code was generated by DriverWizard.
' The library accesses the hardware via WinDriver functions.
'
' Copyright (c) 2005 Jungo Ltd.  http://www.jungo.com
' ---------------------------------------------------------------------
'
Public LPT_ErrorString As String ' If an error occurs, this string will be set to contain a relevant error message

' Internal data structures
Type LPT_IntA_RESULT
    dwCounter As Long   ' number of interrupts received
    dwLost As Long      ' number of interrupts yet to be handled
    fStopped As Boolean     ' was interrupt disabled during wait
End Type

Global Const LPT_MODE_BYTE = 0
Global Const LPT_MODE_INTEGER = 1
Global Const LPT_MODE_LONG = 2

Global Const LPT_IO_Range1 = 0
Global Const LPT_IntA = 1

' Number of IO and memory ranges
Global Const LPT_ITEMS = 1
Global Const LPT_TOTAL_ITEMS = 2

Type LPT_IntA_INTERRUPT
    Int     As WD_INTERRUPT
    hThread As Long   ' HANDLE
    funcIntHandler As Long ' LPT_IntA_HANDLER
End Type


Type LPT_HANDLE
    hWD As Long   ' HANDLE
    IntA As LPT_IntA_INTERRUPT
    cardReg As WD_CARD_REGISTER
End Type


' IO ranges definitions
Global Const LPT_IO_Range1_ADDR = &H378&
Global Const LPT_IO_Range1_BYTES = &H8&

' Interrupts definitions
Global Const LPT_IntA_IRQ = &H7
Global Const LPT_IntA_OPTIONS = 0

' LPT register definitions
Global Const LPT_data_SPACE = LPT_IO_Range1
Global Const LPT_data_OFFSET = &H0&
Global Const LPT_status_SPACE = LPT_IO_Range1
Global Const LPT_status_OFFSET = &H1&
Global Const LPT_control_SPACE = LPT_IO_Range1
Global Const LPT_control_OFFSET = &H2&
Global Const LPT_strobe_addr_SPACE = LPT_IO_Range1
Global Const LPT_strobe_addr_OFFSET = &H3&
Global Const LPT_strobe_data_0_SPACE = LPT_IO_Range1
Global Const LPT_strobe_data_0_OFFSET = &H4&
Global Const LPT_strobe_data_1_SPACE = LPT_IO_Range1
Global Const LPT_strobe_data_1_OFFSET = &H5&
Global Const LPT_strobe_data_2_SPACE = LPT_IO_Range1
Global Const LPT_strobe_data_2_OFFSET = &H6&
Global Const LPT_strobe_data_3_SPACE = LPT_IO_Range1
Global Const LPT_strobe_data_3_OFFSET = &H7&



' Implementation

Function LPT_Open(hLPT As LPT_HANDLE) As Boolean
    Dim ver As WD_Version
    Dim dwStatus As Long

    LPT_ErrorString = ""
    hLPT.cardReg.hCard = 0

    dwStatus = LPT_RegisterWinDriver()
    If dwStatus > 0 Then
        LPT_ErrorString = "Failed registering WinDriver license"
        GoTo Finish
    End If

    hLPT.hWD = WD_Open()

    ' Verify that the handle is valid and that the version number is correct
    If hLPT.hWD = INVALID_HANDLE_VALUE Then
        LPT_ErrorString = "Failed opening WinDriver device"
        GoTo Finish
    End If

    Call WD_Version(hLPT.hWD, ver)
    If (ver.dwVer < WD_VER) Then
        LPT_ErrorString = "Incorrect WinDriver version"
        GoTo Finish
    End If

    Call LPT_SetCardElements(hLPT)
    hLPT.cardReg.fCheckLockOnly = 0
    dwStatus = WD_CardRegister(hLPT.hWD, hLPT.cardReg)
    If hLPT.cardReg.hCard = 0 Then
        LPT_ErrorString = "Failed locking device with status &H" & Hex(dwStatus) & " - " & Stat2Str(dwStatus)
        GoTo Finish
    End If

    hLPT.IntA.Int.hInterrupt = hLPT.cardReg.Card.Item(LPT_IntA).dw3
    hLPT.IntA.Int.dwOptions = hLPT.cardReg.Card.Item(LPT_IntA).dw2
    ' LPT_Open() was successful
    LPT_Open = True
    Exit Function

Finish:  ' An error occured during the execution of LPT_Open()
    If hLPT.cardReg.hCard <> 0 Then
        Call WD_CardUnregister(hLPT.hWD, hLPT.cardReg)
    End If
    If (hLPT.hWD <> INVALID_HANDLE_VALUE) Then
        WD_Close (hLPT.hWD)
    End If
    LPT_Open = False
    MsgBox LPT_ErrorString, vbCritical + vbOKOnly, "LPT"
End Function


Sub LPT_Close(hLPT As LPT_HANDLE)
    ' Disable interrupts
    If LPT_IntAIsEnabled(hLPT) Then
        Call LPT_IntADisable(hLPT)
    End If

    ' Unregister card
    If hLPT.cardReg.hCard <> 0 Then
        Call WD_CardUnregister(hLPT.hWD, hLPT.cardReg)
    End If

    ' close WinDriver
    WD_Close (hLPT.hWD)

End Sub


Function LPT_RegisterWinDriver() As Long
    Dim hWD As Long   ' HANDLE
    Dim lic As WD_License
    Dim dwStatus As Long

    hWD = WD_Open
    If hWD = INVALID_HANDLE_VALUE Then
        dwStatus = WD_INVALID_HANDLE
    Else
        lic.cLicense = "6C3CC2BFF76637EC558F0D4D088AF4534612428E.ssda" & Chr(0)
        dwStatus = WD_License(hWD, lic)
        WD_Close (hWD)
    End If
    LPT_RegisterWinDriver = dwStatus
End Function


Sub LPT_SetCardElements(hLPT As LPT_HANDLE)
    hLPT.cardReg.Card.dwItems = LPT_TOTAL_ITEMS
    '
    hLPT.cardReg.Card.Item(LPT_IO_Range1).Item = ITEM_IO
    hLPT.cardReg.Card.Item(LPT_IO_Range1).fNotSharable = 0
    hLPT.cardReg.Card.Item(LPT_IO_Range1).dw1 = LPT_IO_Range1_ADDR
    hLPT.cardReg.Card.Item(LPT_IO_Range1).dw2 = LPT_IO_Range1_BYTES

    '
     hLPT.cardReg.Card.Item(LPT_IntA).Item = ITEM_INTERRUPT
    hLPT.cardReg.Card.Item(LPT_IntA).fNotSharable = 0
    hLPT.cardReg.Card.Item(LPT_IntA).dw1 = LPT_IntA_IRQ
    hLPT.cardReg.Card.Item(LPT_IntA).dw2 = LPT_IntA_OPTIONS

End Sub


' General read/write function
Sub LPT_ReadWriteBlock(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long, fRead As Boolean, buf As Long, dwBytes As Long, mode As Integer)
    Dim Trans As WD_Transfer
    Dim fMem As Boolean

    fMem = (hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY)
    If fRead Then
        Select Case mode
        Case LPT_MODE_BYTE
            If fMem Then
                Trans.cmdTrans = RM_SBYTE
            Else
                Trans.cmdTrans = RP_SBYTE
            End If
        Case LPT_MODE_INTEGER
            If (fMem) Then
                Trans.cmdTrans = RM_SWORD
            Else
                Trans.cmdTrans = RP_SWORD
            End If
        Case LPT_MODE_LONG
            If (fMem) Then
                Trans.cmdTrans = RM_SDWORD
            Else
                Trans.cmdTrans = RP_SDWORD
            End If
        End Select
    Else
        Select Case mode
        Case LPT_MODE_BYTE
            If (fMem) Then
                Trans.cmdTrans = WM_SBYTE
            Else
                Trans.cmdTrans = WP_SBYTE
            End If
        Case LPT_MODE_INTEGER
            If (fMem) Then
                Trans.cmdTrans = WM_SWORD
            Else
                Trans.cmdTrans = WP_SWORD
            End If
        Case LPT_MODE_LONG
            If (fMem) Then
                Trans.cmdTrans = WM_SDWORD
            Else
                Trans.cmdTrans = WP_SDWORD
            End If
        End Select
    End If
    If (fMem) Then
        Trans.dwPort = hLPT.cardReg.Card.Item(addrSpace).dw3 'Memory.dwTransAddr
    Else
        Trans.dwPort = hLPT.cardReg.Card.Item(addrSpace).dw1 'IO.dwAddr
    End If
    Trans.dwPort = Trans.dwPort + dwOffset

    Trans.fAutoInc = 1
    Trans.dwBytes = dwBytes
    Trans.dwOptions = 0
    Trans.dwLowDataTransfer = buf
    Trans.dwHighDataTransfer = 0
    Call WD_Transfer(hLPT.hWD, Trans)
End Sub


Function LPT_ReadByte(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long) As Byte
    Dim data As Byte
    Dim pData As Long 'PBYTE

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(VarPtr(data), pData, LenB(data)) ' read from the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, True, VarPtr(data), 1, LPT_MODE_BYTE)
    End If
    LPT_ReadByte = data
End Function


Function LPT_ReadInteger(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long) As Integer
    Dim data As Integer
    Dim pData As Long 'PINTEGER

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(VarPtr(data), pData, LenB(data)) ' read from the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, True, VarPtr(data), 2, LPT_MODE_INTEGER)
    End If
    LPT_ReadInteger = data
End Function


Function LPT_ReadLong(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long) As Long
    Dim data As Long
    Dim pData As Long 'PLONG

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(VarPtr(data), pData, LenB(data)) ' read from the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, True, VarPtr(data), 4, LPT_MODE_LONG)
    End If
    LPT_ReadLong = data
End Function


Sub LPT_WriteByte(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long, data As Byte)
    Dim pData As Long 'PBYTE

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(pData, VarPtr(data), LenB(data)) ' write to the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, False, VarPtr(data), 1, LPT_MODE_BYTE)
    End If
End Sub


Sub LPT_WriteInteger(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long, data As Integer)
    Dim pData As Long 'PINTEGER

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(pData, VarPtr(data), LenB(data)) ' write to the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, False, VarPtr(data), 2, LPT_MODE_INTEGER)
    End If
End Sub


Sub LPT_WriteLong(hLPT As LPT_HANDLE, addrSpace As Integer, dwOffset As Long, data As Long)
    Dim pData As Long 'PLONG

    If hLPT.cardReg.Card.Item(addrSpace).Item = ITEM_MEMORY Then
        pData = (hLPT.cardReg.Card.Item(addrSpace).dw4 + dwOffset)
        Call memcpy(pData, VarPtr(data), LenB(data)) ' write to the memory mapped range directly
    Else
        Call LPT_ReadWriteBlock(hLPT, addrSpace, dwOffset, False, VarPtr(data), 4, LPT_MODE_LONG)
    End If
End Sub


Function LPT_Readdata(hLPT As LPT_HANDLE) As Byte
    LPT_Readdata = LPT_ReadByte(hLPT, CByte(LPT_data_SPACE), LPT_data_OFFSET)
End Function

Sub LPT_Writedata(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_data_SPACE), LPT_data_OFFSET, data)
End Sub

Function LPT_Readstatus(hLPT As LPT_HANDLE) As Byte
    LPT_Readstatus = LPT_ReadByte(hLPT, CByte(LPT_status_SPACE), LPT_status_OFFSET)
End Function

Sub LPT_Writestatus(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_status_SPACE), LPT_status_OFFSET, data)
End Sub

Function LPT_Readcontrol(hLPT As LPT_HANDLE) As Byte
    LPT_Readcontrol = LPT_ReadByte(hLPT, CByte(LPT_control_SPACE), LPT_control_OFFSET)
End Function

Sub LPT_Writecontrol(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_control_SPACE), LPT_control_OFFSET, data)
End Sub

Function LPT_Readstrobe_addr(hLPT As LPT_HANDLE) As Byte
    LPT_Readstrobe_addr = LPT_ReadByte(hLPT, CByte(LPT_strobe_addr_SPACE), LPT_strobe_addr_OFFSET)
End Function

Sub LPT_Writestrobe_addr(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_strobe_addr_SPACE), LPT_strobe_addr_OFFSET, data)
End Sub

Function LPT_Readstrobe_data_0(hLPT As LPT_HANDLE) As Byte
    LPT_Readstrobe_data_0 = LPT_ReadByte(hLPT, CByte(LPT_strobe_data_0_SPACE), LPT_strobe_data_0_OFFSET)
End Function

Sub LPT_Writestrobe_data_0(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_strobe_data_0_SPACE), LPT_strobe_data_0_OFFSET, data)
End Sub

Function LPT_Readstrobe_data_1(hLPT As LPT_HANDLE) As Byte
    LPT_Readstrobe_data_1 = LPT_ReadByte(hLPT, CByte(LPT_strobe_data_1_SPACE), LPT_strobe_data_1_OFFSET)
End Function

Sub LPT_Writestrobe_data_1(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_strobe_data_1_SPACE), LPT_strobe_data_1_OFFSET, data)
End Sub

Function LPT_Readstrobe_data_2(hLPT As LPT_HANDLE) As Byte
    LPT_Readstrobe_data_2 = LPT_ReadByte(hLPT, CByte(LPT_strobe_data_2_SPACE), LPT_strobe_data_2_OFFSET)
End Function

Sub LPT_Writestrobe_data_2(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_strobe_data_2_SPACE), LPT_strobe_data_2_OFFSET, data)
End Sub

Function LPT_Readstrobe_data_3(hLPT As LPT_HANDLE) As Byte
    LPT_Readstrobe_data_3 = LPT_ReadByte(hLPT, CByte(LPT_strobe_data_3_SPACE), LPT_strobe_data_3_OFFSET)
End Function

Sub LPT_Writestrobe_data_3(hLPT As LPT_HANDLE, data As Byte)
    Call LPT_WriteByte(hLPT, CByte(LPT_strobe_data_3_SPACE), LPT_strobe_data_3_OFFSET, data)
End Sub


Function LPT_IntAIsEnabled(hLPT As LPT_HANDLE) As Boolean
   LPT_IntAIsEnabled = True
    If hLPT.IntA.hThread = 0 Then LPT_IntAIsEnabled = False
End Function

Sub LPT_IntAHandler(pData As LPT_HANDLE)
    Dim hLPT       As LPT_HANDLE
    Dim intResult As LPT_IntA_RESULT

    hLPT = (pData)
    intResult.dwCounter = hLPT.IntA.Int.dwCounter
    intResult.dwLost = hLPT.IntA.Int.dwLost
    intResult.fStopped = (hLPT.IntA.Int.fStopped)
    'Call LPT_IntAHandlerRoutine(hLPT, intResult)
End Sub


'Function LPT_IntAEnable(hLPT As LPT_HANDLE, funcIntHandler As Long) As Boolean
 '   Dim dwStatus As Long

'        If hLPT.IntA.hThread <> 0 Then  ' check if interrupt is already enabled
 '           LPT_IntAEnable = False
  '      Else

   '         ' this calls WD_IntEnable() and creates an interrupt handler thread
    '        hLPT.IntA.funcIntHandler = funcIntHandler
     '       dwStatus = InterruptEnable(hLPT.IntA.hThread, hLPT.hWD, hLPT.IntA.Int, _
      '          AddressOf LPT_IntAHandler, VarPtr(hLPT), Form1.hWnd)
       '     If dwStatus > 0 Then
        '        LPT_ErrorString = "InterruptEnable failed with status &H" & Hex(dwStatus) & " - " & Stat2Str(dwStatus)
         '       LPT_IntAEnable = False
          '  Else
           '     LPT_IntAEnable = True
           ' End If
        'End If
'End Function


Sub LPT_IntADisable(hLPT As LPT_HANDLE)
    If hLPT.IntA.hThread <> 0 Then
        ' this calls WD_IntDisable()
        InterruptDisable (hLPT.IntA.hThread)
        hLPT.IntA.hThread = 0
    End If
End Sub