| Segunda parte del objeto
If StartPagePrinter(lPrinter) <= 0 Then
With FormOtraImpresora
.Mensaje ("La impresora[" & sDeviceName & "] No esta disponible o conectada al red Seleccine otra impresora")
.Show 1
sDeviceName = .Impresora
End With
If Len(DeviceName) = 0 Then
ErrorImpesion = True
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
ErrorImpesion = True
Exit Sub
End If
GoTo Reintentar1
End If
lBytesWritten = 0
lBytesSent = 0
bJobStarted = True
End Sub
Public Sub KillDoc()
Dim b As Long
If G_LogPRG = 1 Then GenerarLogPRG ("39:0003;")
'Mod Abril 2004
Dim Errores
ErrorImpesion = False
If bJobStarted Then
b = SetJob(lPrinter, lJob, 0, ByVal 0&, JOB_CONTROL_CANCEL)
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Else
b = 0
End If
If b <= 0 Then
Errores = MsgBox("Imposible Cancelar el trabajo de impresion", vbInformation)
'Err.Raise vbPE_KillDocFailed, "RAWPrinter", "Could not cancle the print job."
End If
End Sub
Public Sub EndDoc()
If Not bJobStarted Then
Exit Sub
End If
Dim Errores
If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Errores = MsgBox("No se puede finalizar la pagina", vbInformation)
ErrorImpesion = True
Exit Sub
'Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
'Exit Sub
End If
If EndDocPrinter(lPrinter) <= 0 Then
Call ClosePrinter(lPrinter)
bJobStarted = False
Errores = MsgBox("No se puede finalizar el trabajo de Impresion", vbInformation)
ErrorImpesion = True
Exit Sub
End If
Call ClosePrinter(lPrinter)
bJobStarted = False
If lBytesWritten <> lBytesSent Then
Errores = MsgBox("Predida de informacion, Algunos datos no se enviaron a la impresora", vbInformation)
ErrorImpesion = True
'Err.Raise vbPE_UnSentBytes, "RAWPrinter", "Some data was not sent to the printer."
End If
End Sub
Public Property Let DeviceName(Name As String)
If bJobStarted Then
Err.Raise vbPE_CantChangeDevice, "RAWPrinter", "Can't change device while printing."
Else
sDeviceName = Name
End If
End Property
Public Property Get DeviceName() As String
DeviceName = sDeviceName
End Property
Public Property Get DocumentName() As String
DocumentName = sDocName
End Property
Public Sub PrintText(TXT As String)
Dim I As Long
If Not bJobStarted Then
NewDoc
End If
lBytesSent = lBytesSent + Len(TXT)
If WritePrinter(lPrinter, ByVal TXT, Len(TXT), I) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If
lBytesWritten = lBytesWritten + I
End Sub
Public Sub PrintFile(fname As String)
Dim fh As Long
Dim Buffer As String
Dim fl As Long
Dim r As Long
Dim I As Long
Dim bs As Long
If G_LogPRG = 1 Then GenerarLogPRG ("39:0010;")
If Not bJobStarted Then
NewDoc
End If
fh = FreeFile(0)
bs = 8192
Buffer = String(bs, 0)
Open fname For Binary Access Read As fh
fl = LOF(fh)
r = 0
If fl = 0 Then
Close fh
Exit Sub
End If
Do
If fl - r < bs Then
bs = fl - r
Buffer = String(bs, 0)
End If
Get fh, , Buffer
lBytesSent = lBytesSent + bs
r = r + bs
If WritePrinter(lPrinter, ByVal Buffer, bs, I) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
On Error GoTo 0
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If
lBytesWritten = lBytesWritten + I
Loop While r <> fl
Close fh
Exit Sub
PrintFileError:
On Error Resume Next
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Close fh
On Error GoTo 0
Err.Raise vbPE_ReadFileError, "RAWPrinter", "Could not read from file."
End Sub
Private Sub Class_Initialize()
sDocName = "Simple"
bJobStarted = False
End Sub
Public Sub SelectImpresora(Impresora As String)
If G_LogPRG = 1 Then GenerarLogPRG ("39:0012;")
sDeviceName = Impresora
End Sub
Private Sub Class_Terminate()
If G_LogPRG = 1 Then GenerarLogPRG ("39:0013;")
If bJobStarted Then
EndDoc
End If
End Sub
Public Property Get hPrinter() As Long
If G_LogPRG = 1 Then GenerarLogPRG ("39:0014;")
hPrinter = lPrinter
End Property
Public Property Get hJob() As Long
If G_LogPRG = 1 Then GenerarLogPRG ("39:0015;")
hJob = lJob
End Property
Public Property Get Priority() As Long
Dim di As String ' stores JOB_INFO_1
Dim I As Long
If G_LogPRG = 1 Then GenerarLogPRG ("39:0016;")
Call GetJob(lPrinter, lJob, 1, ByVal di, 0, I)
di = String(I, 0)
Call CopyMemory(I, ByVal (Mid$(di, 33, 4)), 4)
Priority = I
End Property
' Bug: Doesn't work?
Public Property Let Priority(ByVal I As Long)
Dim di As JOB_INFO_1
If G_LogPRG = 1 Then GenerarLogPRG ("39:0017;")
'JobId, pPrinterName, pMachineName, pDrivername,
'Size, Submitted, and Time are ignored
If I < MIN_PRIORITY Then
I = DEF_PRIORITY
ElseIf I > MAX_PRIORITY Then
I = MAX_PRIORITY
End If
di.Priority = I
di.Position = JOB_POSITION_UNSPECIFIED
di.pUserName = vbNullString
di.pDocument = vbNullString
di.pDatatype = vbNullString
di.pStatus = vbNullString
di.Status = 0
di.TotalPages = 0
di.PagesPrinted = 0
Call SetJob(lPrinter, lJob, 1, di, 0)
End Property
Public Function Errores() As Boolean
Errores = ErrorImpesion
End Function
Public Function EstadoImpresora() As Boolean
EstadoImpresora = bJobStarted
End Function
Private Function AddString(strString As String, ByRef bBuffer() As Byte) As Long
'************************************************* ********************
' AddString copies a string into a Byte array and returns a long
' pointer to that string
'************************************************* ********************
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 |