Source Code of "sampleVB"

The source code published on this page has been developed by Benjamin NICOLLE. It shows how to access the new interface "direct register access".

Interface to Paraport: file "ParaPort.bas"

Attribute VB_Name = "ParaPort" ' /////////////////////////////////////////////////////////////////////////////// ' // ' // VB types for the interface of ParaPort ' // ' // copyright (c) 2002, 2003, 2004 by Paul R. ADAM ' // all rights reserved ' // read the "http://www.ParaPort.net/TermsOfUse.html" ' // ' // more information on "http://www.ParaPort.net" ' // ' /////////////////////////////////////////////////////////////////////////////// ' /////////////////////////////////////////////////////////////////////////////// ' // interface for getPortAddress( ), input( ) and output( ) ' /////////////////////////////////////////////////////////////////////////////// Public Const PARAPORT_LPT_MAX = 9& ' // only the following registers of the parallel port will be accessed Public Const PARAPORT_ADDRESS_DATA = 0& Public Const PARAPORT_ADDRESS_STATUS = 1& Public Const PARAPORT_ADDRESS_CONTROL = 2& Public Const PARAPORT_ADDRESS_MIN = PARAPORT_ADDRESS_DATA Public Const PARAPORT_ADDRESS_MAX = (PARAPORT_ADDRESS_CONTROL + 1) ' // this error will be returned by functions input( ) and output( ), if there was an error ' // but it might be also a valid value! Public Const PARAPORT_BYTE_ON_ERROR = &HFF ' /////////////////////////////////////////////////////////////////////////////// ' // interface for error handling ' /////////////////////////////////////////////////////////////////////////////// Public Const PARAPORT_ERROR = &H20000000 Public Const PARAPORT_ERROR_INTERNAL_1 = (PARAPORT_ERROR Or 1&) Public Const PARAPORT_ERROR_INTERNAL_2 = (PARAPORT_ERROR Or 2&) Public Const PARAPORT_ERROR_INTERNAL_3 = (PARAPORT_ERROR Or 3&) Public Const PARAPORT_ERROR_INVALID_HANDLE = (PARAPORT_ERROR Or 4&) Public Const PARAPORT_ERROR_INVALID_PORTNAME = (PARAPORT_ERROR Or 5&) Public Const PARAPORT_ERROR_LIBRARY_NOT_IMPLEMENTED = (PARAPORT_ERROR Or 6&) Public Const PARAPORT_ERROR_LIBRARY_NOT_LOADED = (PARAPORT_ERROR Or 7&) Public Const PARAPORT_ERROR_INVALID_ADDRESS = (PARAPORT_ERROR Or 8&) Public Const PARAPORT_ERROR_INVALID_CYCLE = (PARAPORT_ERROR Or 9&) Public Const PARAPORT_ERROR_LIBRARY_NOT_COMPATIBLE = (PARAPORT_ERROR Or 10&) Public Const PARAPORT_ERROR_MIN = PARAPORT_ERROR_INTERNAL_1 Public Const PARAPORT_ERROR_MAX = (PARAPORT_ERROR_LIBRARY_NOT_COMPATIBLE + 1) ' ///////////////////////////////////////////////////////////////////////////////

Interface to Paraport Dll: file "ParaPortDll.bas"

Attribute VB_Name = "ParaPortDll" ' /////////////////////////////////////////////////////////////////////////////// ' // ' // VB interface of ParaPort ' // ' // copyright (c) 2002, 2003, 2004 by Paul R. ADAM ' // all rights reserved ' // read the "http://www.ParaPort.net/TermsOfUse.html" ' // ' // more information on "http://www.ParaPort.net" ' // ' /////////////////////////////////////////////////////////////////////////////// ' /////////////////////////////////////////////////////////////////////////////// ' // new interface v2.0 ' /////////////////////////////////////////////////////////////////////////////// Public Declare Function getPortAddress Lib "C:\Program Files\ParaPort\bin\ParaPort.dll" (ByVal PortName As String) As Long Public Declare Function inputPort Lib "C:\Program Files\ParaPort\bin\ParaPort.dll" Alias "input" (ByVal Address As Long) As Byte Public Declare Function outputPort Lib "C:\Program Files\ParaPort\bin\ParaPort.dll" Alias "output" (ByVal Address As Long, ByVal ByteValue As Byte) As Byte ' ///////////////////////////////////////////////////////////////////////////////

Sample Code "dlgSampleVB.frm"

VERSION 5.00 Begin VB.Form dlgSampleVB BorderStyle = 3 'Fixed Dialog Caption = "sampleVB" ClientHeight = 5145 ClientLeft = 6495 ClientTop = 5235 ClientWidth = 5745 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5145 ScaleWidth = 5745 Begin VB.CommandButton btnExit Cancel = -1 'True Caption = "Exit Application" Height = 375 Left = 3960 TabIndex = 9 Top = 4560 Width = 1575 End Begin VB.Frame fmRegAccess Caption = "Direct Register Access" Height = 3015 Left = 120 TabIndex = 11 Top = 1320 Width = 5415 Begin VB.CommandButton btnControlRegWrite Caption = "Write" Height = 375 Left = 3000 TabIndex = 8 Top = 2400 Width = 975 End Begin VB.CommandButton btnStatusRegRead Caption = "Read" Height = 375 Left = 4200 TabIndex = 6 Top = 1800 Width = 975 End Begin VB.CommandButton btnDataRegRead Caption = "Read" Height = 375 Left = 4200 TabIndex = 4 Top = 1200 Width = 975 End Begin VB.CommandButton btnDataRegWrite Caption = "Write" Height = 375 Left = 3000 TabIndex = 3 Top = 1200 Width = 975 End Begin VB.TextBox tbControlReg Height = 405 Left = 2160 TabIndex = 7 Top = 2400 Width = 615 End Begin VB.TextBox tbStatusReg Height = 405 Left = 2160 TabIndex = 5 Top = 1800 Width = 615 End Begin VB.TextBox tbDataReg Height = 405 Left = 2160 TabIndex = 2 Top = 1200 Width = 615 End Begin VB.Label lblControlReg Caption = "Control Register:" Height = 255 Left = 360 TabIndex = 17 Top = 2520 Width = 1695 End Begin VB.Label lblStatusReg Caption = "Status Register:" Height = 255 Left = 360 TabIndex = 16 Top = 1920 Width = 1695 End Begin VB.Label lblDataReg Caption = "Data Register:" Height = 255 Left = 360 TabIndex = 15 Top = 1320 Width = 1695 End Begin VB.Label lblText3 Caption = "To write to data register, bit 4 of control register (32 ) must be cleared." Height = 255 Left = 120 TabIndex = 14 Top = 840 Width = 5175 End Begin VB.Label lblText2 Caption = "To read from data register, bit 4 of control register ( 32 ) must be set." Height = 255 Left = 120 TabIndex = 13 Top = 600 Width = 5175 End Begin VB.Label lblText1 Caption = "The values must be given or are displayed in decimal format." Height = 255 Left = 120 TabIndex = 12 Top = 360 Width = 5175 End End Begin VB.Frame fmPortParam Caption = "Port Parameter" Height = 975 Left = 120 TabIndex = 0 Top = 120 Width = 5415 Begin VB.ComboBox cbxPort Height = 315 Left = 3240 Style = 2 'Dropdown List TabIndex = 1 Top = 360 Width = 1935 End Begin VB.Label lblPort Caption = "Select one of the possible parallel ports:" Height = 255 Left = 240 TabIndex = 10 Top = 360 Width = 2895 End End End Attribute VB_Name = "dlgSampleVB" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' /////////////////////////////////////////////////////////////////////////////// ' // ' // sampleVB application main dialog management ' // ' // copyright (c) 2002, 2003, 2004 by Paul R. ADAM ' // all rights reserved ' // read the "http://www.ParaPort.net/TermsOfUse.html" ' // ' // more information on "http://www.ParaPort.net" ' // ' /////////////////////////////////////////////////////////////////////////////// ' /////////////////////////////////////////////////////////////////////////////// ' // Win32 API declarations (from the APIViewer tool) ' /////////////////////////////////////////////////////////////////////////////// Private Declare Function GetLastError Lib "kernel32" () As Long Private Const ERROR_SUCCESS = 0& ' /////////////////////////////////////////////////////////////////////////////// ' // Internal variables ' /////////////////////////////////////////////////////////////////////////////// Private SelectedPortAddress As Long ' /////////////////////////////////////////////////////////////////////////////// ' // Dialog box loading (entry point) ' /////////////////////////////////////////////////////////////////////////////// Private Sub Form_Load() Dim Count As Long Dim PortAddress As Long Dim PortName As String For Count = 1 To PARAPORT_LPT_MAX PortName = "LPT" & Count PortAddress = getPortAddress(PortName) If (PortAddress <> 0&) And (GetLastError = ERROR_SUCCESS) Then cbxPort.AddItem PortName End If Next If cbxPort.ListCount = 0 Then MsgBox "No parallel port could be opened!" & vbLf & vbLf & "Check, if the ParaPort driver has been installed" & vbLf & "with the " & Chr(34) & "Add/Remove Hardware" & Chr(34) & " wizard." & vbLf & vbLf & "For help see " & Chr(34) & "http://www.paraport.net" & Chr(34) & ".", vbOKOnly, "sampleVB: Error" Else cbxPort.ListIndex = 0 End If cbxPort_Change End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Change of the selected port ' /////////////////////////////////////////////////////////////////////////////// Private Sub cbxPort_Change() SelectedPortAddress = getPortAddress(cbxPort.Text) End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Data register write button click ' /////////////////////////////////////////////////////////////////////////////// Private Sub btnDataRegWrite_Click() Dim Result As Long Dim RegValue As Byte If IsNumeric(tbDataReg.Text) Then RegValue = tbDataReg.Text Else RegValue = 0& End If outputPort SelectedPortAddress + PARAPORT_ADDRESS_DATA, RegValue Result = GetLastError If Result <> ERROR_SUCCESS Then MsgBox "outputPort( PARAPORT_ADDRESS_DATA ) executed with error: " & Result & vbLf & "For help see " & Chr(34) & "http://www.paraport.net" & Chr(34) & ".", vbOKOnly, "sampleVB: Error" End If End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Data register read button click ' /////////////////////////////////////////////////////////////////////////////// Private Sub btnDataRegRead_Click() Dim Result As Long Dim RegValue As Byte RegValue = inputPort(SelectedPortAddress + PARAPORT_ADDRESS_DATA) Result = GetLastError If Result <> ERROR_SUCCESS Then MsgBox "inputPort( PARAPORT_ADDRESS_DATA ) executed with error: " & Result & vbLf & "For help see " & Chr(34) & "http://www.paraport.net" & Chr(34) & ".", vbOKOnly, "sampleVB: Error" tbDataReg.Text = "" Else tbDataReg.Text = RegValue End If End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Status register read button click ' /////////////////////////////////////////////////////////////////////////////// Private Sub btnStatusRegRead_Click() Dim Result As Long Dim RegValue As Byte RegValue = inputPort(SelectedPortAddress + PARAPORT_ADDRESS_STATUS) Result = GetLastError If Result <> ERROR_SUCCESS Then MsgBox "inputPort( PARAPORT_ADDRESS_STATUS ) executed with error: " & Result & vbLf & "For help see " & Chr(34) & "http://www.paraport.net" & Chr(34) & ".", vbOKOnly, "sampleVB: Error" tbStatusReg.Text = "" Else tbStatusReg.Text = RegValue End If End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Control register write button click ' /////////////////////////////////////////////////////////////////////////////// Private Sub btnControlRegWrite_Click() Dim Result As Long Dim RegValue As Byte If IsNumeric(tbControlReg.Text) Then RegValue = tbControlReg.Text Else RegValue = 0& End If outputPort SelectedPortAddress + PARAPORT_ADDRESS_CONTROL, RegValue Result = GetLastError If Result <> ERROR_SUCCESS Then MsgBox "outputPort( PARAPORT_ADDRESS_CONTROL ) executed with error: " & Result & vbLf & "For help see " & Chr(34) & "http://www.paraport.net" & Chr(34) & ".", vbOKOnly, "sampleVB: Error" End If End Sub ' /////////////////////////////////////////////////////////////////////////////// ' // Exit button click ' /////////////////////////////////////////////////////////////////////////////// Private Sub btnExit_Click() Unload dlgSampleVB End Sub ' ///////////////////////////////////////////////////////////////////////////////

Copyright (c) 2002, 2003, 2004 by Paul R. ADAM, v2.0, read the Terms of Use