Solved

Open "LPT1" for output

Posted on 1998-11-05
5
1,041 Views
Last Modified: 2006-11-17
I write a file to the lpt1. I use 'print #FreeFile, sVarname' for it. That's not a problem. But when there is no printer the program's stops. The only possibility is to use Ctrl-alt-del. Is there an other way to check if there is a printer online.
0
Comment
Question by:rossel
5 Comments
 
LVL 12

Expert Comment

by:mark2150
ID: 1443386
Don't do that!

What do you expect to happen when you open an I/O channel to a non-existent device?

This is why VB uses the Windows printer drivers - it handles that low level stuff.

You'ld have to do a low level byte IN instruction on the port address and VB makes it *HARD* to do that to maintain hardware compatibility.

If you force an I/O port instruction you're effectively locking your software out of running on a network or with a virtual device like Adobe.

Set up the printer as "Generic, Text Only" and print to *THAT* instead of going direct to a port.

M

0
 

Author Comment

by:rossel
ID: 1443387
I can't use the printer drivers from windows 95 because I'm printing to a label printer. This printer  need special control characters. There is also a need for speed. Normally everything works fine. Only when the printer cable is disconnected I have the problem.
0
 
LVL 2

Expert Comment

by:kswinney
ID: 1443388
You're going to have to require that a valid printer be installed to that port.  Do this:

'This will check to be sure a printer is there.
on error goto NoPrinterErr

   if Printers.Count then
      if printer.port = "LPT1:" then
         'Initialize the printer
         Printer.Print " ";
   
         'Now we know there's a printer on port LPT1:
   
         Open "LPT1:" for output as #....... etc.
      else
         msgbox "Your printer is not set up for port "LPT1:"
      end if
   else
      msgbox "There's no printer installed."
   end if
   
   Exit Sub

NoPrinterErr:

   msgbox "You don't have a printer installed."

end sub
0
 

Author Comment

by:rossel
ID: 1443389
An on error statement is not working. There is only a centronic-port with no cable connected. So with printer.print  " " you are able to sent something to the port. After a few seconds you have a windows mesage box. But the programm continues and hangs.
There is no time to wait for a message box.
0
 
LVL 14

Accepted Solution

by:
waty earned 100 total points
ID: 1443390
Here are some functions to get the printer list, default printer... It should be useful for you

Option Explicit

Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long

Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Const HWND_BROADCAST = &HFFFF
Private Const WM_WININICHANGE = &H1A

Private Type OSVERSIONINFO
   dwOSVersionInfoSize  As Long
   dwMajorVersion       As Long
   dwMinorVersion       As Long
   dwBuildNumber        As Long
   dwPlatformId         As Long
   szCSDVersion         As String * 128
End Type

Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

' *** constants for DEVMODE structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

' *** constants for DesiredAccess member of PRINTER_DEFAULTS
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

' *** constant that goes into PRINTER_INFO_5 Attributes member to set it as default
Public Const PRINTER_ATTRIBUTE_DEFAULT = 4

Private Type DEVMODE
   dmDeviceName         As String * CCHDEVICENAME
   dmSpecVersion        As Integer
   dmDriverVersion      As Integer
   dmSize               As Integer
   dmDriverExtra        As Integer
   dmFields             As Long
   dmOrientation        As Integer
   dmPaperSize          As Integer
   dmPaperLength        As Integer
   dmPaperWidth         As Integer
   dmScale              As Integer
   dmCopies             As Integer
   dmDefaultSource      As Integer
   dmPrintQuality       As Integer
   dmColor              As Integer
   dmDuplex             As Integer
   dmYResolution        As Integer
   dmTTOption           As Integer
   dmCollate            As Integer
   dmFormName           As String * CCHFORMNAME
   dmLogPixels          As Integer
   dmBitsPerPel         As Long
   dmPelsWidth          As Long
   dmPelsHeight         As Long
   dmDisplayFlags       As Long
   dmDisplayFrequency   As Long
   dmICMMethod          As Long        ' // Windows 95 only
   dmICMIntent          As Long        ' // Windows 95 only
   dmMediaType          As Long        ' // Windows 95 only
   dmDitherType         As Long        ' // Windows 95 only
   dmReserved1          As Long        ' // Windows 95 only
   dmReserved2          As Long        ' // Windows 95 only
End Type

Private Type PRINTER_INFO_5
   pPrinterName               As String
   pPortName                  As String
   Attributes                 As Long
   DeviceNotSelectedTimeout   As Long
   TransmissionRetryTimeout   As Long
End Type

Private Type PRINTER_DEFAULTS
   pDatatype            As Long
   pDevMode             As DEVMODE
   DesiredAccess        As Long
End Type

Private Function PtrCtoVbString(Add As Long) As String
   Dim sTemp As String * 512, x As Long

   x = lstrcpy(sTemp, Add)
   If (InStr(1, sTemp, Chr(0)) = 0) Then
      PtrCtoVbString = ""
   Else
      PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
   End If

End Function

Public Sub SetDefaultPrinter(ByVal PrinterName As String, ByVal DriverName As String, ByVal PrinterPort As String)

   Dim DeviceLine As String
   Dim r As Long
   Dim l As Long
   DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
   ' *** Store the new printer information in the [WINDOWS] section of
   ' *** the WIN.INI file for the DEVICE= item
   r = WriteProfileString("windows", "Device", DeviceLine)

   ' *** Cause all applications to reload the INI file:
   l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")

End Sub

Public Sub Win95SetDefaultPrinter(sPrinter As String)

   Dim Handle           As Long              ' handle to printer
   Dim PrinterName      As String
   Dim pd               As PRINTER_DEFAULTS
   Dim x                As Long
   Dim need             As Long             ' bytes needed
   Dim pi5              As PRINTER_INFO_5   ' your PRINTER_INFO structure
   Dim LastError        As Long

   ' determine which printer was selected
   PrinterName = sPrinter

   ' none - exit
   If PrinterName = "" Then Exit Sub

   ' set the PRINTER_DEFAULTS members
   pd.pDatatype = 0&
   pd.DesiredAccess = PRINTER_ALL_ACCESS

   ' Get a handle to the printer
   x = OpenPrinter(PrinterName, Handle, pd)

   ' failed the open
   If x = False Then Exit Sub

   ' Make an initial call to GetPrinter, requesting Level 5  (PRINTER_INFO_5)
   ' information, to determine how many bytes  you need
   x = GetPrinter(Handle, 5, ByVal 0&, 0, need)

   ' don 't want to check GetLastError here - it's supposed to fail
   ' with a 122 - ERROR_INSUFFICIENT_BUFFER
   ' redim t as large as you need

   ReDim t((need \ 4)) As Long

   ' and call GetPrinter for keepers this time
   x = GetPrinter(Handle, 5, t(0), need, need)

   ' failed the GetPrinter
   If x = False Then Exit Sub

   ' set the members of the pi5 structure for use with SetPrinter.
   ' PtrCtoVbString copies the memory pointed at by the two    string
   ' pointers contained in the t() array into a Visual Basic string.
   ' The other three elements are just DWORDS (long integers) and
   ' don 't require any conversion
   pi5.pPrinterName = PtrCtoVbString(t(0))
   pi5.pPortName = PtrCtoVbString(t(1))
   pi5.Attributes = t(2)
   pi5.DeviceNotSelectedTimeout = t(3)
   pi5.TransmissionRetryTimeout = t(4)

   ' this is the critical flag that makes it the default printer
   pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT

   ' call SetPrinter to set it
   x = SetPrinter(Handle, 5, pi5, 0)

   ' failed the SetPrinter
   If x = False Then Exit Sub

   ' and close the handle
   ClosePrinter (Handle)

End Sub

Public Sub GetDriverAndPort(ByVal buffer As String, DriverName As String, PrinterPort As String)

   Dim iDriver       As Integer
   Dim iPort         As Integer
   
   DriverName = ""
   PrinterPort = ""

   ' The driver name is first in the string terminated by a comma
   iDriver = InStr(buffer, ",")

   If iDriver > 0 Then
      ' Strip out the driver name
      DriverName = Left(buffer, iDriver - 1)

      ' The port name is the second entry after the driver name separated by commas.
      iPort = InStr(iDriver + 1, buffer, ",")
      If iPort > 0 Then
         ' Strip out the port name
         PrinterPort = Mid(buffer, iDriver + 1, iPort - iDriver - 1)
      End If
   End If

End Sub

Public Sub ParseList(lstCtl As Control, ByVal buffer As String)

   Dim i As Integer

   lstCtl.Clear

   Do
      i = InStr(buffer, Chr(0))
      If i > 0 Then
         If (Trim(Left(buffer, i - 1)) <> "") Then lstCtl.AddItem Left(buffer, i - 1)
         buffer = Mid(buffer, i + 1)
      Else
         If (Trim(buffer) <> "") Then lstCtl.AddItem buffer
         buffer = ""
      End If
   Loop While i > 0

End Sub

Public Sub WinNTSetDefaultPrinter(sPrinter As String)

   Dim buffer        As String
   Dim DeviceName    As String
   Dim DriverName    As String
   Dim PrinterPort   As String
   Dim PrinterName   As String
   Dim r             As Long

   buffer = Space(1024)
   PrinterName = sPrinter
   r = GetProfileString("PrinterPorts", PrinterName, "", buffer, Len(buffer))

   ' Parse the driver name and port name out of the buffer
   GetDriverAndPort buffer, DriverName, PrinterPort
   If DriverName <> "" And PrinterPort <> "" Then
      SetDefaultPrinter sPrinter, DriverName, PrinterPort
   End If

End Sub

Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 13/10/98
   ' * Time             : 09:18
   ' * Module Name      : Capture_Module
   ' * Module Filename  : Capture.bas
   ' * Procedure Name   : PrintPictureToFitPage
   ' * Parameters       :
   ' *                    Prn As Printer
   ' *                    Pic As Picture
   ' **********************************************************************
   ' * Comments         : Prints a Picture object as big as possible
   ' *
   ' *
   ' **********************************************************************

   Const vbHiMetric As Integer = 8
   
   Dim PicRatio      As Double
   Dim PrnWidth      As Double
   Dim PrnHeight     As Double
   Dim PrnRatio      As Double
   Dim PrnPicWidth   As Double
   Dim PrnPicHeight  As Double
   
   ' *** Determine if picture should be printed in landscape or portrait and
   ' set the orientation
   If Pic.Height >= Pic.Width Then
      Prn.Orientation = vbPRORPortrait ' Taller than wide
   Else
      Prn.Orientation = vbPRORLandscape ' Wider than tall
   End If

   ' *** Calculate device independent Width to Height ratio for picture
   PicRatio = Pic.Width / Pic.Height
   
   ' *** Calculate the dimentions of the printable area in HiMetric
   PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
   PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
   
   ' *** Calculate device independent Width to Height ratio for printer
   PrnRatio = PrnWidth / PrnHeight
   
   ' *** Scale the output to the printable area
   If PicRatio >= PrnRatio Then
      ' *** Scale picture to fit full width of printable area
      PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
      PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)
   Else
      ' *** Scale picture to fit full height of printable area
      PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
      PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)
   End If

   ' *** Print the picture using the PaintPicture method
   Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
   
End Sub


0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now