www.pudn.com > LPT_I2C.rar > lpt_lib.bas

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