Printing Raw Prn Files

#1 16-09-2004, 10:47

I've had some code for awhile now to print some prn files I made (such as sending a head cleaning signal to the printer). I'm cleaning up some of my Draw11 code to Draw12 & was just wondering if there's a simpler answer. Below is the code I use now.

Code:

Option Explicit

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const GENERIC_READ = &amp;H80000000
Private Const OF_READ = &amp;H0
Private Const OFS_MAXPATHNAME = 128

Private Const PRINTER_ENUM_LOCAL = &amp;H2
Private Const PRINTER_ENUM_DEFAULT = &amp;H1

Private Type OFSTRUCT
        cBytes As Byte
        fFixedDisk As Byte
        nErrCode As Integer
        Reserved1 As Integer
        Reserved2 As Integer
        szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Type DOC_INFO_1
   pDocName As String
   pOutputFile As String
   pDatatype As String
End Type

Public Type PrnInf
    DeviceName As String
    PortName As String
End Type
Public Function DefaultPrn() As PrnInf
Dim tmpPrns() As PrnInf

EnumPrn tmpPrns(), PRINTER_ENUM_DEFAULT

DefaultPrn = tmpPrns(0)
End Function

Public Sub EnumPrn(ByRef PrnArray() As PrnInf, Optional ByVal dwFlags As Long = PRINTER_ENUM_LOCAL)
Dim pcbNeeded As Long, pcReturned As Long
Dim lpLA() As Byte, lpPrns As String
Dim ret As Boolean, i As Long, II As Long

ret = EnumPrinters(dwFlags, vbNullString, 5, vbNull, 0, pcbNeeded, pcReturned)
ReDim lpLA(pcbNeeded) As Byte
ret = EnumPrinters(dwFlags, vbNullString, 5, lpLA(0), pcbNeeded, pcbNeeded, pcReturned)
pcbNeeded = pcbNeeded

For i = 0 To pcbNeeded - 1
    lpPrns = lpPrns &amp; Chr(lpLA(i))
Next i

i = InStr(1, lpPrns, Chr(200) &amp; Chr(175) &amp; Chr(0))
Do Until i = 0
lpPrns = Mid(lpPrns, i + 4)
i = InStr(1, lpPrns, Chr(200) &amp; Chr(175) &amp; Chr(0))
Loop

AddPrnsToStruct lpPrns, PrnArray()
End Sub
Private Sub AddPrnsToStruct(ByVal lpPrns As String, ByRef PrnArray() As PrnInf)
Dim tmpPrnSt() As PrnInf
Dim NumStructs As Long
Dim tmp As String, tmp2 As String
Dim pos As Long, i As Long


For i = 1 To Len(lpPrns)
    tmp2 = Mid(lpPrns, i, 1)
    If tmp2 &lt;> Chr(0) Then
        tmp = tmp &amp; tmp2
    ElseIf tmp2 = Chr(0) And tmp &lt;> "" Then
        If pos = 0 Then
            ReDim Preserve tmpPrnSt(NumStructs)
            tmpPrnSt(NumStructs).PortName = tmp
            pos = 1
        Else
            tmpPrnSt(NumStructs).DeviceName = tmp
            pos = 0
            NumStructs = NumStructs + 1
        End If
        tmp = ""
    End If
Next
On Error GoTo NoPrinters:
For i = LBound(tmpPrnSt) To UBound(tmpPrnSt)
    ReDim Preserve PrnArray(i)
    PrnArray(i) = tmpPrnSt(i)
Next i
NoPrinters:
End Sub
Public Function OpenPrn(ByVal PrnDevice As String) As Long
Dim hPrn As Long
OpenPrn = OpenPrinter(PrnDevice, hPrn, ByVal &amp;O0)
OpenPrn = hPrn
End Function
Public Function ClosePrn(ByVal hPrn As Long) As Long
ClosePrn = ClosePrinter(hPrn)
End Function
Public Function StartDocPrn(ByVal hPrn As Long, Optional ByVal DocType As String, Optional ByVal DocName As String = vbNullString) As Long
Dim DocInf As DOC_INFO_1
' DocInf.pDocName = IIf(DocName = vbNullString, "Untitled by " &amp; App.Title, DocName)
DocInf.pDatatype = DocType
DocInf.pOutputFile = vbNullString
StartDocPrn = StartDocPrinter(hPrn, 1, DocInf)
End Function
Public Function EndDocPrn(ByVal hPrn As Long) As Long
EndDocPrn = EndDocPrinter(hPrn)
End Function
Public Function NewPagePrn(ByVal hPrn As Long) As Long
NewPagePrn = StartPagePrinter(hPrn)
End Function
Public Function EndPagePrn(ByVal hPrn As Long) As Long
EndPagePrn = EndPagePrinter(hPrn)
End Function
Public Function WritePrn(ByVal hPrn As Long, pBuf() As Byte, ByVal cdBuf As Long) As Long
WritePrinter hPrn, pBuf(0), cdBuf, WritePrn
End Function
Public Function SendRawFilePrn(ByVal hPrn As Long, ByVal FileName As String, Optional ByVal DocName As String = vbNullString) As Long
Dim ofs As OFSTRUCT
Dim bit(10000) As Byte
Dim r As Long, i As Long
Dim ret As Boolean

' DocName = IIf(DocName = vbNullString, "File: " &amp; FileName &amp; " by " &amp; App.Title, DocName)
StartDocPrn hPrn, "RAW", DocName
NewPagePrn hPrn

i = OpenFile(FileName, ofs, GENERIC_READ + OF_READ)
Do
r = lread(i, bit(0), 10000)
ret = WritePrinter(hPrn, bit(0), r, 0)
Loop Until r &lt; 1 Or ret = False
If ret = False Then SendRawFilePrn = -1
i = CloseHandle(i)

EndPagePrn hPrn
EndDocPrn hPrn
i = ClosePrn(hPrn)
SendRawFilePrn = SendRawFilePrn + 1
End Function

And I call it with

Code:

Sub HeadCleaning()
    Dim hPrn As Long
    hPrn = OpenPrn("SpecifiedPriter")
    Call SendRawFilePrn(hPrn, "G:\Script Files\Printer\Cleaning.prn", "Head Cleaning")
End Sub

This may not be the correct forum for this, but I think we all know this is the best place to come for help.

Alex · #2 16-09-2004, 14:21

Mark,

I think this topic belongs more in Code Critique section rather than in CorelDRAW VBA, so moving it over...

You have a big piece of code there which suffers from some formatting issues and quite hard to read. So I "fixed" those and I'm preposting it here with proper indentation, function separation, etc for anyone who wants to look at the original code:

Code:

Option Explicit

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const GENERIC_READ = &amp;H80000000
Private Const OF_READ = &amp;H0
Private Const OFS_MAXPATHNAME = 128

Private Const PRINTER_ENUM_LOCAL = &amp;H2
Private Const PRINTER_ENUM_DEFAULT = &amp;H1

Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Type DOC_INFO_1
   pDocName As String
   pOutputFile As String
   pDatatype As String
End Type

Public Type PrnInf
    DeviceName As String
    PortName As String
End Type

Public Function DefaultPrn() As PrnInf
    Dim tmpPrns() As PrnInf
    
    EnumPrn tmpPrns(), PRINTER_ENUM_DEFAULT
    
    DefaultPrn = tmpPrns(0)
End Function

Public Sub EnumPrn(ByRef PrnArray() As PrnInf, Optional ByVal dwFlags As Long = PRINTER_ENUM_LOCAL)
    Dim pcbNeeded As Long, pcReturned As Long
    Dim lpLA() As Byte, lpPrns As String
    Dim ret As Boolean, i As Long, II As Long
    
    ret = EnumPrinters(dwFlags, vbNullString, 5, vbNull, 0, pcbNeeded, pcReturned)
    ReDim lpLA(pcbNeeded) As Byte
    ret = EnumPrinters(dwFlags, vbNullString, 5, lpLA(0), pcbNeeded, pcbNeeded, pcReturned)
    pcbNeeded = pcbNeeded
    
    For i = 0 To pcbNeeded - 1
        lpPrns = lpPrns &amp; Chr(lpLA(i))
    Next i
    
    i = InStr(1, lpPrns, Chr(200) &amp; Chr(175) &amp; Chr(0))
    Do Until i = 0
        lpPrns = Mid(lpPrns, i + 4)
        i = InStr(1, lpPrns, Chr(200) &amp; Chr(175) &amp; Chr(0))
    Loop
    
    AddPrnsToStruct lpPrns, PrnArray()
End Sub

Private Sub AddPrnsToStruct(ByVal lpPrns As String, ByRef PrnArray() As PrnInf)
    Dim tmpPrnSt() As PrnInf
    Dim NumStructs As Long
    Dim tmp As String, tmp2 As String
    Dim pos As Long, i As Long
    
    
    For i = 1 To Len(lpPrns)
        tmp2 = Mid(lpPrns, i, 1)
        If tmp2 &lt;> Chr(0) Then
            tmp = tmp &amp; tmp2
        ElseIf tmp2 = Chr(0) And tmp &lt;> "" Then
            If pos = 0 Then
                ReDim Preserve tmpPrnSt(NumStructs)
                tmpPrnSt(NumStructs).PortName = tmp
                pos = 1
            Else
                tmpPrnSt(NumStructs).DeviceName = tmp
                pos = 0
                NumStructs = NumStructs + 1
            End If
            tmp = ""
        End If
    Next
    
    On Error GoTo NoPrinters
    
    For i = LBound(tmpPrnSt) To UBound(tmpPrnSt)
        ReDim Preserve PrnArray(i)
        PrnArray(i) = tmpPrnSt(i)
    Next i
NoPrinters:
End Sub

Public Function OpenPrn(ByVal PrnDevice As String) As Long
    Dim hPrn As Long
    OpenPrn = OpenPrinter(PrnDevice, hPrn, ByVal &amp;O0)
    OpenPrn = hPrn
End Function

Public Function ClosePrn(ByVal hPrn As Long) As Long
    ClosePrn = ClosePrinter(hPrn)
End Function

Public Function StartDocPrn(ByVal hPrn As Long, Optional ByVal DocType As String, Optional ByVal DocName As String = vbNullString) As Long
    Dim DocInf As DOC_INFO_1
    ' DocInf.pDocName = IIf(DocName = vbNullString, "Untitled by " &amp; App.Title, DocName)
    DocInf.pDatatype = DocType
    DocInf.pOutputFile = vbNullString
    StartDocPrn = StartDocPrinter(hPrn, 1, DocInf)
End Function

Public Function EndDocPrn(ByVal hPrn As Long) As Long
    EndDocPrn = EndDocPrinter(hPrn)
End Function

Public Function NewPagePrn(ByVal hPrn As Long) As Long
    NewPagePrn = StartPagePrinter(hPrn)
End Function

Public Function EndPagePrn(ByVal hPrn As Long) As Long
    EndPagePrn = EndPagePrinter(hPrn)
End Function

Public Function WritePrn(ByVal hPrn As Long, pBuf() As Byte, ByVal cdBuf As Long) As Long
    WritePrinter hPrn, pBuf(0), cdBuf, WritePrn
End Function

Public Function SendRawFilePrn(ByVal hPrn As Long, ByVal FileName As String, Optional ByVal DocName As String = vbNullString) As Long
    Dim ofs As OFSTRUCT
    Dim bit(10000) As Byte
    Dim r As Long, i As Long
    Dim ret As Boolean
    
    ' DocName = IIf(DocName = vbNullString, "File: " &amp; FileName &amp; " by " &amp; App.Title, DocName)
    StartDocPrn hPrn, "RAW", DocName
    NewPagePrn hPrn
    
    i = OpenFile(FileName, ofs, GENERIC_READ + OF_READ)
    Do
        r = lread(i, bit(0), 10000)
        ret = WritePrinter(hPrn, bit(0), r, 0)
    Loop Until r &lt; 1 Or ret = False
    
    If ret = False Then SendRawFilePrn = -1
    i = CloseHandle(i)
    
    EndPagePrn hPrn
    EndDocPrn hPrn
    i = ClosePrn(hPrn)
    SendRawFilePrn = SendRawFilePrn + 1
End Function

Alex · #3 16-09-2004, 16:15

Now, back to critiquing. First, I'd like to say that you are on the right track. Working with Windows API is the way to go for this kind of a problem. However there are a few issues that I think could have been simplified. For example, instead of using Kernel's functions to read the data from the file, you can have used the VBA's native file I/O functions.

Here is an example:

Code:

Public Function SendRawFilePrn(ByVal hPrn As Long, ByVal FileName As String, Optional ByVal DocName As String = vbNullString) As Boolean
    Dim bit As String
    Dim FileNumber As Long
    Dim SizeToRead As Long
    Dim FileSize As Long
    Dim ret As Boolean
    
    ' DocName = IIf(DocName = vbNullString, "File: " &amp; FileName &amp; " by " &amp; App.Title, DocName)
    StartDocPrn hPrn, "RAW", DocName
    NewPagePrn hPrn
    
    ret = True
    FileNumber = FreeFile()
    Open FileName For Binary Access Read As FileNumber
    FileSize = LOF(FileNumber)
    Do While FileSize > 0
        SizeToRead = 10000
        If SizeToRead > FileSize Then SizeToRead = FileSize
        bit = Input(SizeToRead, FileNumber)
        If WritePrinter(hPrn, ByVal bit, SizeToRead, 0) = 0 Then
            ret = False
            Exit Do
        End If
        FileSize = FileSize - SizeToRead
    Loop
    Close FileNumber
    
    EndPagePrn hPrn
    EndDocPrn hPrn
    ClosePrn hPrn
    SendRawFilePrn = ret
End Function

I'll post some more comments a little later...

Thread Tools	Search this Thread
Show Printable Version Email this Page	Search this Thread: Advanced Search
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
files import	graphicdesigner	CorelDRAW/Corel DESIGNER VBA	11	19-11-2004 23:56
Draw 12 : Printing Problem	Hernán	General	3	20-09-2004 10:54
I need HELP printing corel files from VB6!	dcs	CorelDRAW/Corel DESIGNER VBA	0	20-04-2004 16:32
Thumbnailer Issue with EPS files	vallentin	Macros/Add-ons	2	16-03-2004 10:04
Corel 10 file conversion script doesn't convert files	Kevin	CorelDRAW CS	0	13-04-2003 20:28

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)