📄 frmdxlptselect.frm
字号:
VERSION 5.00
Object = "{9504898C-33FD-11D1-8F93-EC6D05C10000}#1.0#0"; "Dxocx.dll"
Begin VB.Form frmLPTSelect
BorderStyle = 3 'Fixed Dialog
Caption = "Select Port"
ClientHeight = 3885
ClientLeft = 5025
ClientTop = 4185
ClientWidth = 5235
Icon = "frmDXLPTSelect.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3885
ScaleWidth = 5235
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.Frame fraPortList
BorderStyle = 0 'None
Caption = "Frame1"
Height = 1815
Left = 0
TabIndex = 1
Top = 960
Width = 4455
Begin VB.CommandButton cmdAdd
Caption = "&Add Port"
Height = 375
Left = 120
TabIndex = 7
Top = 1440
Width = 855
End
Begin VB.CommandButton cmdRefresh
Caption = "Refresh"
Height = 375
Left = 1080
TabIndex = 6
Top = 1440
Width = 855
End
Begin VB.CommandButton cmdOK
Caption = "&Ok"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 2040
TabIndex = 4
Top = 1440
Width = 1095
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 375
Left = 3240
TabIndex = 3
Top = 1440
Width = 1095
End
Begin VB.ListBox lstLPTPorts
Height = 1035
ItemData = "frmDXLPTSelect.frx":000C
Left = 120
List = "frmDXLPTSelect.frx":001C
TabIndex = 2
Top = 240
Width = 4215
End
Begin VB.Label lblPort
Caption = " Port Address Type"
Height = 255
Left = 120
TabIndex = 5
Top = 0
Width = 4215
End
End
Begin DXOCXLibCtl.DxControl dxcParallelPort
Left = 240
OleObjectBlob = "frmDXLPTSelect.frx":00BF
Top = 3000
End
Begin VB.Image imgIcon
Height = 480
Left = 240
Picture = "frmDXLPTSelect.frx":00E3
Top = 240
Width = 480
End
Begin VB.Label lblSPDMessage
AutoSize = -1 'True
Caption = "Select a parallel printer port."
Height = 195
Left = 960
TabIndex = 0
Top = 120
Width = 1965
End
End
Attribute VB_Name = "frmLPTSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************************
'* LPTSelect Dialog Form *
'***************************************************************************
'* This dialog was designed to be used with the Driver X 3.4 Active X *
'* Control. *
'* This dialog will supply all Port I/O Functions for accessing the *
'* printer ports, if a function needed isn't supported this form may be *
'* modified to supply the needed function as long as the revision is *
'* and documented. *
'***************************************************************************
'* Revision 1.0 beta Last Modified: 07/16/99 *
'* Revision 1.1 beta Last Modified: 08/10/99 *
'* Modification: Removed LPTAddrs array now uses listbox instead *
'* Added a product specific device name *
'* Revision 1.11 beta Last Modified: 08/30/99 *
'* Revision 1.12 Added a WinXP compatability and better error checking *
' Last Modified: 09/26/02 *
'* Modification: Added LPTSelect() and LPTGetPortCount methods *
'* Revision 1.13 Fixed a bug in cleanup DriverX where the device isn't *
'* closed properly. *
'* Last Modified: 09/25/02 *
'***************************************************************************
'Private PPDeviceName As String
Private CancelHit As Boolean
'Private LPTAddrs(1 To 4) As Integer
Private PortNotFound As Integer
Public Enum dxLPTRegs
lpt_bp0_DataReg = 0&
lpt_bp1_StatusReg = 1&
lpt_bp2_ControlReg = 2&
End Enum
'After loading the form this property can be checked to see
'if the driver loaded correctly and the status
Public DriverStartupResults As Integer
'Declare Private property variables
Private m_BaseAddr As Long
'Must be set in the load event to a valid device name that appears in the
'registry
Private m_DeviceName As String
'This function will test the address passed and return a
'True if the port address is a Standard Parallel Printer Port or
'a False if it is not or doesn't exist.
'Public Function TestForSPP(ByVal BaseAddress As Integer) As Boolean
' Dim ReadBackVal As Long
'
' 'Set the Data Outputs Enabled bit write to control port
' Out32 BaseAddress + 2, &HF
'
' 'Write the test value to the port base address
' Out32 BaseAddress, &H55
' 'Readback a value from the port base address
' ReadBackVal = Inp32(BaseAddress)
'
' 'Check to see if the port exists
' If ReadBackVal = &H55 Then
' 'Write the test value to the port base address
' Out32 BaseAddress, &HAA
' 'Readback a value from the port base address
' ReadBackVal = Inp32(BaseAddress)
' If ReadBackVal = &HAA Then
' 'Yes it does exist
' TestForSPP = True
' Else
' 'Test passed
' TestForSPP = False
' End If
' End If
'End Function
Private Function TestForSPP() As Boolean
Dim ReadBackVal As Long
'Set the Data Outputs Enabled bit write to control port
LptOutput lpt_bp2_ControlReg, &HF
'Write the test value to the port base address
LptOutput lpt_bp0_DataReg, &H55
'Readback a value from the port base address
ReadBackVal = LptInput(lpt_bp0_DataReg)
'Check to see if the port exists
If ReadBackVal = &H55 Then
'Write the test value to the port base address
LptOutput lpt_bp0_DataReg, &HAA
'Readback a value from the port base address
ReadBackVal = LptInput(lpt_bp0_DataReg)
If ReadBackVal = &HAA Then
'Yes it does exist
TestForSPP = True
Else
'Test passed
TestForSPP = False
End If
End If
End Function
Private Sub cmdAdd_Click()
Dim retval As String
Dim MsgBoxRetVal As Integer
Dim OldAddress As Long
Dim msg As String
msg = "The address you entered will now be tested!!!" & Chr(13)
msg = msg & "Only test port addresses that you know are parallel ports." & Chr(13)
msg = msg & "Testing a port address other than a valid parallel printer port" & Chr(13)
msg = msg & "address can cause the system to crash and even system damage!" & Chr(13)
msg = msg & "Press " & Chr(34) & "OK" & Chr(34) & " to continue or " & Chr(34) & "Cancel" & Chr(34) & " to cancel now."
'Show an input box
retval = InputBox("Please enter the port address in hex.", "Add a Non-Standard Parallel Printer Port")
retval = "&H" & retval
If retval <> "" Then
If IsNumeric(retval) Then
'Check to see if the port is allready in the list
If IsPortListed(CLng(retval)) Then
Exit Sub
End If
'Display the warning message
MsgBoxRetVal = MsgBox(msg, vbApplicationModal + vbCritical + vbOKCancel, "Warning!!!")
If MsgBoxRetVal = vbOK Then
'Store the currently selected address
OldAddress = LPTBaseAddress
'Plug in the user defined address
LPTBaseAddress = CLng(retval)
'Test the user definded parallel port
If TestForSPP Then
'If a user defined parallel port has been added then
'erase its list entry
If lstLPTPorts.Tag = "UDAdded" Then
lstLPTPorts.RemoveItem (lstLPTPorts.ListCount - 1)
End If
lstLPTPorts.AddItem "User Defined" & " " & Hex(retval) & " Hex SPP"
lstLPTPorts.ItemData(lstLPTPorts.ListCount - 1) = CLng(retval)
'LPTAddrs(lstLPTPorts.ListCount) = CLng(retval)
lstLPTPorts.Tag = "UDAdded"
Else
'The address failed so show a failure box
msg = "The parallel port at address " & Chr(34) _
& Hex(CLng(retval)) & " Hex" & Chr(34) & _
" failed the Standard Parallel Port test." & Chr(13)
msg = msg & "Check your port's address to make sure you typed it right."
MsgBox msg, vbInformation + vbApplicationModal + vbOKOnly, "Test Failed!"
End If
'Reselect the previously selected port
LPTBaseAddress = OldAddress
End If
End If
End If
End Sub
Private Sub cmdCancel_Click()
'Hide the dialog
Me.Hide
CancelHit = True
End Sub
Private Sub cmdOK_Click()
'Hide the dialog
Me.Hide
End Sub
Private Sub cmdRefresh_Click()
'Refresh the list
RefreshLPTList
End Sub
Private Sub Form_Load()
Dim sMsg As String
Dim cntr As Integer
'Initialize the private property variables
m_BaseAddr = -1
If DevName <> "" Then
'Use the product
m_DeviceName = DevName
Else
'Initialize the forms internal variables
m_DeviceName = "AD9854PP" 'Name this whatever the product name is plus PP
'Ex: AD9854PP
End If
'Initialize the Driver X Driver
'Check to see if the driver is configured
'dxcParallelPort.ConfigureDriver
' If dxcParallelPort.IsDriverConfigured() = False Then
' 'Display an error message
' MsgBox "The driver is not configured!!!" & Chr(13) & "Quiting program now!!!", vbApplicationModal + vbCritical + vbOKOnly, "Critical Error!!!"
' End If
'
' 'Check to see if the device is running
' If dxcParallelPort.IsDeviceRunning(m_DeviceName) = False Then
' If dxcParallelPort.StartDevice(m_DeviceName) = False Then
' MsgBox "Can't start device " & Chr(34) & m_DeviceName & Chr(34) & ".", vbApplicationModal + vbCritical + vbOKOnly, "Fatal Error"
' 'End
' End If
' End If
'
' 'Connect to the device
' If dxcParallelPort.ConnectDevice(m_DeviceName) = False Then
' 'Alert the user
' MsgBox "Failed to connect to the device: " & m_DeviceName, vbApplicationModal + vbCritical + vbOKOnly, "Fatal Error"
' Else
' 'Print "Connecting to the device PPort378"
' End If
Screen.MousePointer = 11
For cntr = 0 To 110
DriverStartupResults = StartupDrvDevice(m_DeviceName)
If DriverStartupResults = 0 Then
Exit For
End If
lsfDelay (0.5)
Next cntr
Screen.MousePointer = 0
Select Case DriverStartupResults
Case 0 'Sucess
Case -1 'Failure
sMsg = "DriverX was not configured." & vbCrLf & vbCrLf & _
"An attempt has been made to configure the DriverX driver." & vbCrLf & _
"Please reboot so that windows will load the driver."
MsgBox sMsg, vbApplicationModal + vbCritical, "Fatal Error - Ending Program!"
End
Case -2 'Failure
sMsg = "DriverX was not configured." & vbCrLf & vbCrLf & _
"An attempt has been made to configure the DriverX driver" & vbCrLf & _
"and the attempt has failed." & vbCrLf & vbCrLf & _
"This can be caused by 2 things:" & vbCrLf & _
"* If you are not logged in with administrative rights" & vbCrLf & _
" and you are running Windows NT,2K or XP." & vbCrLf & _
"* If the file driverx.sys is not located in the WINSYS\SYSTEM32\DRIVERS" & vbCrLf & _
" directory." & vbCrLf & vbCrLf & _
"Try reinstalling the software with adminstrative rights."
MsgBox sMsg, vbApplicationModal + vbCritical, "Fatal Error - Ending Program!"
End
Case -3 'Failure
sMsg = "Could not start DriverX" & vbCrLf & vbCrLf & _
"This error may occur on Windows XP machines." & vbCrLf & _
"If so, try running the software again."
MsgBox sMsg, vbApplicationModal + vbCritical, "Fatal Error - Ending Program!"
End
End Select
'Detect and update the list of parallel ports
RefreshLPTList
End Sub
'Delays program execution by the DelayTime
'Input: DelayTime - Time to delay in Seconds (1ms Resolution in WinNT, 55ms Resolution in Win95)
Private Sub lsfDelay(ByVal DelayTime As Single)
Dim Start As Single
Dim OldTimerVal As Single
Dim EndTime As Single
Dim Midnight As Boolean
Dim DelayCntr As Long 'used to make sure that
Midnight = False 'Assume it isn't midnight
Start = Timer ' Set start time.
OldTimerVal = Start 'Set the current timer val
'Calculate the end time
EndTime = Start + DelayTime
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -