Cambiar indicar impresora en tiempo de ejecucion.

programador666
02 de Abril del 2005
Saludos a todos,

Lo que quiero es antes de lanzar un reporte en DataReport setear una impresora por default(defecto) y despues dejar la actual de nuevo por defecto.

A lo mejor alguien conoce alguna API para esto, o cualquier otro codigo.

Gracias anticipadas

soyciro
02 de Abril del 2005
esto es el modulo

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
' VB5-friendly structure used to cache the values in this class.
Private Type PrinterInfo2
pServerName As String
pPrinterName As String
pShareName As String
pPortName As String
pDriverName As String
pComment As String
pLocation As String
pDevMode As Long 'DEVMODE
pSepFile As String
pPrintProcessor As String
pDatatype As String
pParameters As String
pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type

Public Type PRINTER_INFO_2
pServerName As Long 'String
pPrinterName As Long 'String
pShareName As Long 'String
pPortName As Long 'String
pDriverName As Long 'String
pComment As Long 'String
pLocation As Long 'String
pDevMode As Long ' DEVMODE
pSepFile As Long 'String
pPrintProcessor As Long 'String
pDatatype As Long 'String
pParameters As Long 'String
pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type

Public Type PRINTER_DEFAULTS
pDatatype As Long 'String
pDevMode As Long 'DEVMODE
DesiredAccess As Long
End Type

Public Type PORT_INFO_1
pPortName As String
End Type

Public 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

Public Declare Function DeletePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

Public Declare Function AddPrinter Lib "winspool.drv" Alias "AddPrinterA" (ByVal pName As String, ByVal Level As Long, pPrinter As PRINTER_INFO_2) As Long

Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long

Public Declare Function AddPortEx Lib "winspool.drv" Alias "AddPortExA" (ByVal pName As String, ByVal pLevel As Long, lpBuffer As Any, ByVal pMonitorName As String) As Long

Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long


Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

Public Const PORT_STATUS_TYPE_ERROR = 1
Public Const PORT_STATUS_TYPE_WARNING = 2
Public Const PORT_STATUS_TYPE_INFO = 3

Public Enum PortTypes
PORT_TYPE_WRITE = &H1
PORT_TYPE_READ = &H2
PORT_TYPE_REDIRECTED = &H4
PORT_TYPE_NET_ATTACHED = &H8
End Enum

Private m_pi2 As PrinterInfo2
Private m_pi2Null As PrinterInfo2
Private m_GetPrinterError As Long

Public Function CreatePrinter(strServer As String, _
strPrinter As String, _
strPort As String, _
strDriver As String, _
strPrintProcessor As String) As Boolean

On Error Resume Next
Dim hPrinter As Long
Dim pi2 As PRINTER_INFO_2
Dim Port1 As PORT_INFO_1
Dim bBuffer(1000) As Byte
Dim I

For I = 0 To UBound(bBuffer)
bBuffer(I) = 0
Next

Port1.pPortName = strPort
AddPortEx vbNullString, 1, Port1, "Local Port"
ECC Err.Number, "null", "CreatePrinter", "addportex"
pi2.pPrinterName = AddString(strPrinter, bBuffer)
pi2.pPortName = AddString(strPort, bBuffer)
pi2.pDriverName = AddString(strDriver, bBuffer)
pi2.pPrintProcessor = AddString(strPrintProcessor, bBuffer)

pi2.Attributes = 0
pi2.AveragePPM = 0
pi2.cJobs = 0
pi2.DefaultPriority = 0
pi2.pComment = 0
pi2.pDatatype = 0
pi2.pDevMode = 0
pi2.pLocation = 0
pi2.pParameters = 0
pi2.Priority = 0
pi2.pSecurityDescriptor = 0
pi2.pSepFile = 0
pi2.pServerName = 0
pi2.pShareName = 0
pi2.StartTime = 0
pi2.Status = 0
pi2.UntilTime = 0

hPrinter = AddPrinter(vbNullString, 2, pi2)
ECC Err.Number, "null", "CreatePrinter - AddPrinter", "error"
'***
'First paramter should be 'NULL' , but how to implement? ***
If hPrinter <> 0 Then
ClosePrinter (hPrinter)
CreatePrinter = True
Else
CreatePrinter = False
End If
End Function

Private Function AddString(strString As String, ByRef bBuffer() As Byte) As Long
Dim lngEnd As Long
lngEnd = UBound(bBuffer) + 1
Do
lngEnd = lngEnd - 1
Loop While (bBuffer(lngEnd) = 0 And lngEnd > 0)
lngEnd = lngEnd + 2
lstrcpy VarPtr(bBuffer(0)) + lngEnd, strString
AddString = VarPtr(bBuffer(0)) + lngEnd

End Function

Public Function DestroyPrinter(strPrinter As String) As Boolean
Dim hPrinter As Long
Dim pd As PRINTER_DEFAULTS
Dim BuffNewDatatype() As Byte
Dim mivar As Variant

GetPrinterInfo (strPrinter)
ReDim BuffNewDatatype(0 To Len(m_pi2.pDatatype)) As Byte
Dim I As Integer
I = 0
Do
mivar = Mid(m_pi2.pDatatype, I + 1, 1)
'MsgBox mivar & " " & CByte(Asc(Mid(NewPort, i + 1, 1)))
'BuffNewPort(i) = Mid(NewPort, i + 1, 1)
BuffNewDatatype(I) = CByte(Asc(Mid(m_pi2.pDatatype, I + 1, 1)))
I = I + 1
Loop While I <> Len(m_pi2.pDatatype)
BuffNewDatatype(I) = 0
'set up a printer_defaults structure
With pd
'must be datatype of printer driver
'as set in AddPrinter

.pDatatype = VarPtr(BuffNewDatatype(0))

'no devmode, so UDT member is
'declared Long and a null is passed
.pDevMode = 0&

'this is the access level for delete
.DesiredAccess = PRINTER_ALL_ACCESS
End With

OpenPrinter strPrinter, hPrinter, pd

If hPrinter = 0 Then
'MsgBox "no obtuviste handle"
DestroyPrinter = False
Exit Function
End If

If DeletePrinter(hPrinter) = 0 Then
'MsgBox "no pudiste borrarlo"
DestroyPrinter = False
Exit Function
End If 'DeletePrinter

ClosePrinter hPrinter

DestroyPrinter = True
End Function

Private Function GetPrinterInfo(strPrinter As String) As Boolean
Dim pd As PRINTER_DEFAULTS
Dim pi2 As PRINTER_INFO_2
Dim hPrn As Long
Dim Buffer() As Byte
Dim BytesNeeded As Long
Dim BytesUsed As Long

' Zero out cached values
m_pi2 = m_pi2Null

' Get handle to printer.
Call OpenPrinter(strPrinter, hPrn, pd)
If hPrn Then
' Call once to get proper buffer size.
Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
ReDim Buffer(0 To BytesNeeded - 1) As Byte

If GetPrinter(hPrn, 2, Buffer(0), BytesNeeded, BytesUsed) = 0 Then
GetPrinterInfo = False
Exit Function
End If
' Fill local structure with data/pointers.
Call CopyMemory(pi2, Buffer(0), Len(pi2))
' Transfer string data to cached structure.
m_pi2.pServerName = PointerToStringA(pi2.pServerName)
m_pi2.pPrinterName = PointerToStringA(pi2.pPrinterName)
m_pi2.pShareName = PointerToStringA(pi2.pShareName)
m_pi2.pPortName = PointerToStringA(pi2.pPortName)
m_pi2.pDriverName = PointerToStringA(pi2.pDriverName)
m_pi2.pComment = PointerToStringA(pi2.pComment)
m_pi2.pLocation = PointerToStringA(pi2.pLocation)
m_pi2.pSepFile = PointerToStringA(pi2.pSepFile)
m_pi2.pPrintProcessor = PointerToStringA(pi2.pPrintProcessor)
m_pi2.pDatatype = PointerToStringA(pi2.pDatatype)
m_pi2.pParameters = PointerToStringA(pi2.pParameters)
' Copy two sub-structure pointers.
m_pi2.pDevMode = pi2.pDevMode
m_pi2.pSecurityDescriptor = pi2.pSecurityDescriptor
Call ClosePrinter(hPrn)
GetPrinterInfo = True
Else
GetPrinterInfo = False
End If
End Function

Private Function PointerToStringA(ByVal lpStringA As Long) As String
Dim Buffer() As Byte
Dim nLen As Long

If lpStringA Then
nLen = lstrlenA(ByVal lpStringA)
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMemory Buffer(0), ByVal lpStringA, nLen
PointerToStringA = StrConv(Buffer, vbUnicode)
End If
End If
End Function

Public Function InstallPrinter(strPrinter As String) As Long
Dim bResult As Boolean
bResult = GetPrinterInfo(strPrinter)

If bResult = False Then
CreatePrinter "", strPrinter, "c:kimprimir.ps", strPrinter, "WinPrint"
InstallPrinter = 0
Exit Function
End If

If LCase(m_pi2.pPortName) = "c:kimprimir.ps" Then
InstallPrinter = 1
Exit Function
End If

DestroyPrinter strPrinter

CreatePrinter "", strPrinter, "c:kimprimir.ps", strPrinter, "WinPrint"

InstallPrinter = 2
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''fin del modulo
'''''''''y este es un ejemplo
''''''''''inicio

9 oldPrinter = GetDefaultPrinter()
10 'ECC '
'Err.Number, "GetDefaultPrinter", "Form_Load", "btenernombreimpresora"
11 If oldPrinter = "HP Color LaserJet 8500 PS" Then
12 impresora = True
13 Else
14 'MsgBox oldPrinter
15 Screen.MousePointer = vbHourglass
16 DoEvents
17 SetDefaultPrinter ("HP Color LaserJet 8500 PS")
18
19 InstallPrinter "HP Color LaserJet 8500 PS"
'''''''''''''fin