690 lines
21 KiB
Plaintext
690 lines
21 KiB
Plaintext
VERSION 5.00
|
||
Begin VB.Form frmPSSpooler
|
||
Caption = "Post Script File Spooler"
|
||
ClientHeight = 7950
|
||
ClientLeft = 60
|
||
ClientTop = 345
|
||
ClientWidth = 11205
|
||
Icon = "SPOOLER1.frx":0000
|
||
LinkTopic = "Form1"
|
||
ScaleHeight = 7950
|
||
ScaleWidth = 11205
|
||
StartUpPosition = 3 'Windows Default
|
||
Begin VB.CommandButton cmdClearlstLog
|
||
Caption = "clear"
|
||
Height = 195
|
||
Left = 1320
|
||
TabIndex = 16
|
||
Top = 4200
|
||
Width = 735
|
||
End
|
||
Begin VB.FileListBox filDistilled
|
||
Height = 675
|
||
Left = 90
|
||
Pattern = "*.pdf"
|
||
TabIndex = 15
|
||
Top = 6540
|
||
Width = 5295
|
||
End
|
||
Begin VB.CommandButton cmdHide
|
||
Caption = "Hide"
|
||
Height = 255
|
||
Left = 10020
|
||
TabIndex = 14
|
||
Top = 60
|
||
Width = 945
|
||
End
|
||
Begin VB.ListBox lstDistilled
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 780
|
||
ItemData = "SPOOLER1.frx":27A2
|
||
Left = 5430
|
||
List = "SPOOLER1.frx":27A4
|
||
TabIndex = 13
|
||
Top = 5700
|
||
Width = 5295
|
||
End
|
||
Begin VB.ListBox lstDistiller
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 780
|
||
ItemData = "SPOOLER1.frx":27A6
|
||
Left = 180
|
||
List = "SPOOLER1.frx":27A8
|
||
TabIndex = 11
|
||
Top = 5700
|
||
Width = 5295
|
||
End
|
||
Begin VB.CheckBox Scanning
|
||
Caption = "Scanning"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 285
|
||
Left = 7230
|
||
TabIndex = 10
|
||
Top = 60
|
||
Value = 1 'Checked
|
||
Width = 1545
|
||
End
|
||
Begin VB.ListBox lstLog
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 1020
|
||
ItemData = "SPOOLER1.frx":27AA
|
||
Left = 180
|
||
List = "SPOOLER1.frx":27AC
|
||
TabIndex = 8
|
||
Top = 4380
|
||
Width = 18495
|
||
End
|
||
Begin VB.CommandButton cmdTest
|
||
Caption = "Test Print"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 675
|
||
Left = 7200
|
||
TabIndex = 7
|
||
Top = 390
|
||
Width = 1665
|
||
End
|
||
Begin VB.ListBox lstLocalQs
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 2460
|
||
Left = 3330
|
||
TabIndex = 5
|
||
Top = 330
|
||
Width = 3825
|
||
End
|
||
Begin VB.Timer Timer1
|
||
Interval = 1000
|
||
Left = 2490
|
||
Top = 60
|
||
End
|
||
Begin VB.CommandButton cmdPrintFromList
|
||
Caption = "Print File From List"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 675
|
||
Left = 7200
|
||
TabIndex = 4
|
||
Top = 1080
|
||
Width = 1665
|
||
End
|
||
Begin VB.ListBox lstFiles
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 1020
|
||
ItemData = "SPOOLER1.frx":27AE
|
||
Left = 60
|
||
List = "SPOOLER1.frx":27B0
|
||
TabIndex = 2
|
||
Top = 3090
|
||
Width = 18555
|
||
End
|
||
Begin VB.ListBox lstPrintQs
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 2460
|
||
Left = 120
|
||
TabIndex = 0
|
||
Top = 330
|
||
Width = 3165
|
||
End
|
||
Begin VB.Label Label5
|
||
Caption = "Files to Distill"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 285
|
||
Left = 120
|
||
TabIndex = 12
|
||
Top = 5430
|
||
Width = 4815
|
||
End
|
||
Begin VB.Label Label4
|
||
Caption = "Error Log double click to copy buffer "
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 285
|
||
Left = 120
|
||
TabIndex = 9
|
||
Top = 4110
|
||
Width = 5955
|
||
End
|
||
Begin VB.Label Label3
|
||
Caption = "Local Printers Loaded"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 255
|
||
Left = 3360
|
||
TabIndex = 6
|
||
Top = 60
|
||
Width = 3825
|
||
End
|
||
Begin VB.Label Label2
|
||
Caption = "Files to Print"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 285
|
||
Left = 120
|
||
TabIndex = 3
|
||
Top = 2820
|
||
Width = 4815
|
||
End
|
||
Begin VB.Label Label1
|
||
Caption = "Printer Queues"
|
||
BeginProperty Font
|
||
Name = "Courier New"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 255
|
||
Left = 120
|
||
TabIndex = 1
|
||
Top = 60
|
||
Width = 2235
|
||
End
|
||
End
|
||
Attribute VB_Name = "frmPSSpooler"
|
||
Attribute VB_GlobalNameSpace = False
|
||
Attribute VB_Creatable = False
|
||
Attribute VB_PredeclaredId = True
|
||
Attribute VB_Exposed = False
|
||
' Copyright <20> 1997 by Desaware Inc. All Rights Reserved.
|
||
|
||
'**********************************
|
||
'** Type Definitions:
|
||
|
||
#If Win32 Then
|
||
Private Type DOC_INFO_1
|
||
pDocName As String
|
||
pOutputFile As String
|
||
pDatatype As String
|
||
End Type
|
||
|
||
#End If 'WIN32 Types
|
||
|
||
'**********************************
|
||
'** Function Declarations:
|
||
|
||
#If Win32 Then
|
||
Private Declare Function OpenPrinter& Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) ' Third param changed to long
|
||
Private Declare Function StartDocPrinter& Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1)
|
||
Private Declare Function StartPagePrinter& Lib "winspool.drv" (ByVal hPrinter As Long)
|
||
Private Declare Function WritePrinter& Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long)
|
||
Private Declare Function EndDocPrinter& Lib "winspool.drv" (ByVal hPrinter As Long)
|
||
Private Declare Function EndPagePrinter& Lib "winspool.drv" (ByVal hPrinter As Long)
|
||
Private Declare Function ClosePrinter& Lib "winspool.drv" (ByVal hPrinter As Long)
|
||
#End If 'WIN32
|
||
|
||
Dim DistillPathIn$, DistillPathOut$, userdataarea$, haldataarea$, engrdataarea$, svcdataarea$, bdvdataarea$, anyonedataarea$
|
||
Dim chinadataarea$, MCFdataarea$, HZdataarea$
|
||
|
||
|
||
Private Sub cmdClearlstLog_Click()
|
||
lstLog.Clear
|
||
End Sub
|
||
|
||
Private Sub cmdHide_Click()
|
||
frmPSSpooler.Hide
|
||
End Sub
|
||
|
||
Private Sub cmdPrintFromList_Click()
|
||
Call PrintFile
|
||
End Sub
|
||
Private Sub addlstLog(st$)
|
||
lstLog.AddItem st$ + "|" + Date$ + " " + Time$
|
||
End Sub
|
||
|
||
Private Sub cmdResendtoLst_Click()
|
||
|
||
End Sub
|
||
|
||
Private Sub cmdTest_Click()
|
||
a$ = "|c:\files\buffers\cmdpbuff.ps"
|
||
pr$ = lstPrintQs.List(lstPrintQs.ListIndex)
|
||
If pr$ <> "" Then
|
||
If left(pr$, 7) = "DISTILL" Then
|
||
lstDistiller.AddItem "DONLEY-9109999" + a$
|
||
Else
|
||
If InStr(pr$, "queue not available") <> 0 Then
|
||
a$ = pr$ + a$ + "|Printer Selected for TEST not available"
|
||
Call addlstLog(a$)
|
||
Else
|
||
pr$ = pr$ + a$
|
||
lstFiles.AddItem pr$
|
||
End If
|
||
End If
|
||
Else
|
||
a$ = a$ + "|No Printer Selected for TEST"
|
||
Call addlstLog(a$)
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub Command1_Click()
|
||
|
||
End Sub
|
||
|
||
Private Sub Form_Load()
|
||
frmPSSpooler.Caption = "Post Script File Spooler Version " + AppRevision$
|
||
Dim c As Collection
|
||
Dim sp As New dwSpool
|
||
Dim obj As Object
|
||
|
||
'DistillPathIn$ = "\\fm1\eng\users\286\CMNDPROC\in\"
|
||
'DistillPathOut$ = "\\fm1\eng\users\286\CMNDPROC\out\"
|
||
'filDistilled.Path = DistillPathOut$
|
||
'userdataarea$ = "\\fm1\DATA\DEPTS\PURCH\PDFDrawings\"
|
||
'engrdataarea$ = "\\fm1\eng\users\"
|
||
'svcdataarea$ = "\\fm1\service\USERS\"
|
||
'bdvdataarea$ = "\\fm1\DATA\DEPTS\BUSDEV\"
|
||
'anyonedataarea$ = "\\fm1\DATA\USERS\"
|
||
'haldataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS"
|
||
'chinadataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS\CHINADRAWINGS"
|
||
'MCFdataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS\MCFDRAWINGS"
|
||
'Open "\\fm1\eng\users\cadprint\printer.cfg" For Input As #13 'using #13
|
||
|
||
DistillPathIn$ = NETDRV + "\eng\users\286\CMNDPROC\in\"
|
||
DistillPathOut$ = NETDRV + "\eng\users\286\CMNDPROC\out\"
|
||
filDistilled.Path = DistillPathOut$
|
||
userdataarea$ = NETDRV + "\DATA\DEPTS\PURCH\PDFDrawings\"
|
||
engrdataarea$ = NETDRV + "\eng\users\"
|
||
svcdataarea$ = NETDRV + "\service\USERS\"
|
||
bdvdataarea$ = NETDRV + "\DATA\DEPTS\BUSDEV\"
|
||
anyonedataarea$ = NETDRV + "\DATA\USERS\"
|
||
haldataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS"
|
||
chinadataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\CHINADRAWINGS"
|
||
MCFdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\MCFDRAWINGS"
|
||
HZdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\HZDRAWINGS"
|
||
Open NETDRV + "\eng\users\cadprint\printer.cfg" For Input As #13 'using #13
|
||
While Not EOF(13)
|
||
Line Input #13, prt$
|
||
If left$(prt$, 1) <> ";" Then
|
||
prt$ = Trim$(Mid$(prt$, 19, 15))
|
||
lstPrintQs.AddItem prt$
|
||
End If
|
||
Wend
|
||
Close #13
|
||
lstLocalQs.Clear
|
||
lstDistiller.Clear
|
||
Set c = sp.EnumPrinters(PRINTER_ENUM_LOCAL, "", 1)
|
||
For Each obj In c
|
||
lstLocalQs.AddItem obj.pName
|
||
Next
|
||
|
||
For i = 0 To lstPrintQs.ListCount - 1
|
||
prt$ = lstPrintQs.List(i)
|
||
fnd = False
|
||
For j = 0 To lstLocalQs.ListCount - 1
|
||
If UCase(prt$) = UCase(lstLocalQs.List(j)) Then
|
||
fnd = True
|
||
Exit For
|
||
End If
|
||
Next
|
||
If fnd = False Then
|
||
lstPrintQs.List(i) = prt$ + " - queue not available"
|
||
End If
|
||
Next
|
||
End Sub
|
||
Private Sub PrintFile()
|
||
If lstFiles.ListCount > 0 Then
|
||
fln$ = lstFiles.List(0)
|
||
Req$ = fln$
|
||
lstFiles.RemoveItem 0
|
||
q = InStr(fln$, "|")
|
||
queue$ = UCase$(left(fln$, q - 1))
|
||
fln$ = Mid(fln$, q + 1)
|
||
|
||
Prntr$ = ""
|
||
For i = 0 To lstPrintQs.ListCount - 1
|
||
If queue$ = UCase(lstPrintQs.List(i)) Then
|
||
Prntr$ = queue$
|
||
Exit For
|
||
End If
|
||
Next
|
||
|
||
If Prntr$ <> "" Then
|
||
If Not (ExistsNew(fln$)) Then
|
||
Pause 3
|
||
End If
|
||
If ExistsNew(fln$) Then
|
||
Call PrintIt(Prntr$, fln$, RC%)
|
||
If RC <> 0 Then
|
||
Call addlstLog(Req$ + "|print error" + Str(RC%))
|
||
End If
|
||
Else
|
||
Call addlstLog(Req$ + "|file does not exist")
|
||
End If
|
||
Else
|
||
Call addlstLog(Req$ + "|no such printer")
|
||
End If
|
||
End If
|
||
|
||
|
||
If lstDistiller.ListCount > 0 Then
|
||
|
||
fln$ = lstDistiller.List(0)
|
||
Req$ = fln$
|
||
lstDistiller.RemoveItem 0
|
||
q = InStr(fln$, "|")
|
||
Who$ = UCase$(left(fln$, q - 1))
|
||
fln$ = Mid(fln$, q + 1)
|
||
If Not (ExistsNew(fln$)) Then
|
||
Pause 3
|
||
End If
|
||
If ExistsNew(fln$) Then
|
||
Call Fcopy(fln$, DistillPathIn$ + Who$ + ".ps", RC%)
|
||
If RC <> 0 Then
|
||
Pause 3
|
||
Call Fcopy(fln$, DistillPathIn$ + Who$ + ".ps", RC%)
|
||
If RC <> 0 Then
|
||
Call addlstLog(Req$ + "|copy error" + Str(RC%))
|
||
End If
|
||
End If
|
||
Else
|
||
Call addlstLog(Req$ + "|file does not exist")
|
||
End If
|
||
End If
|
||
|
||
filDistilled.Refresh
|
||
For idx = 0 To filDistilled.ListCount - 1
|
||
fl$ = UCase(filDistilled.List(idx))
|
||
fndfl = False
|
||
For icx = 0 To lstDistilled.ListCount - 1
|
||
xxx$ = lstDistilled.List(icx)
|
||
q = InStr(xxx$, "|")
|
||
xy$ = UCase$(left(xxx$, q - 1))
|
||
tg$ = UCase$(Mid(xxx$, q + 1))
|
||
If xy$ = fl$ Then
|
||
fndfl = True
|
||
Exit For
|
||
End If
|
||
Next
|
||
If Not (fndfl) Then
|
||
lstDistilled.AddItem fl$ + "|15"
|
||
End If
|
||
Next
|
||
icx = 0
|
||
Do While icx <= lstDistilled.ListCount - 1
|
||
xxx$ = lstDistilled.List(icx)
|
||
q = InStr(xxx$, "|")
|
||
xy$ = UCase$(left(xxx$, q - 1))
|
||
cnt = Val(UCase$(Mid(xxx$, q + 1))) - 1
|
||
If cnt <= 0 Then
|
||
f$ = DistillPathOut$ + xy$
|
||
q = InStr(xxx$, "-")
|
||
If q > 0 Then
|
||
WhoGetsIt$ = Trim(UCase$(left(xxx$, q - 1)))
|
||
If (WhoGetsIt$ = "QHAL") Or (WhoGetsIt$ = "CHINA") Or (WhoGetsIt$ = "MCF") Then
|
||
Select Case WhoGetsIt$
|
||
Case "QHAL"
|
||
usrs$ = haldataarea$ + "\"
|
||
Case "CHINA"
|
||
usrs$ = chinadataarea$ + "\"
|
||
Case "MCF"
|
||
usrs$ = MCFdataarea$ + "\"
|
||
Case "HZ"
|
||
usrs$ = HZdataarea$ + "\"
|
||
Case Else
|
||
usrs$ = haldataarea$ + "\"
|
||
End Select
|
||
Else
|
||
If left$(WhoGetsIt$, 10) = "DISTILLENG" Then
|
||
usrs$ = engrdataarea$ + Mid(WhoGetsIt$, 11) + "\"
|
||
ElseIf left$(WhoGetsIt$, 10) = "DISTILLSVC" Then
|
||
usrs$ = svcdataarea$ + Mid(WhoGetsIt$, 11) + "\"
|
||
ElseIf left$(WhoGetsIt$, 10) = "DISTILLBDV" Then
|
||
usrs$ = bdvdataarea$ + Mid(WhoGetsIt$, 11) + "\"
|
||
ElseIf left$(WhoGetsIt$, 10) = "DISTILLANY" Then
|
||
usrs$ = anyonedataarea$ + Mid(WhoGetsIt$, 11) + "\"
|
||
Else
|
||
usrs$ = userdataarea$ + WhoGetsIt$ + "\"
|
||
End If
|
||
End If
|
||
t$ = usrs$ + UCase$(Mid(xxx$, q + 1))
|
||
t$ = left(t$, Len(t$) - 2)
|
||
Call Fcopy(f$, t$, RC%)
|
||
If RC% <> 0 Then
|
||
If InStr(usrs$, "AUTHORIZED") = 0 Then
|
||
Pause 2
|
||
Call Fcopy(f$, t$, RC%)
|
||
Pause 3
|
||
If RC% <> 0 Then
|
||
Call addlstLog(f$ + "|from copy to user failed|" + Str(RC%))
|
||
Call addlstLog(t$ + "|to copy to user failed|" + Str(RC%))
|
||
End If
|
||
End If
|
||
End If
|
||
Else
|
||
Call addlstLog(f$ + "|File name format invalid|-1")
|
||
|
||
Select Case WhoGetsIt$
|
||
Case "QHAL"
|
||
usrs$ = haldataarea$ + "\"
|
||
Case "CHINA"
|
||
usrs$ = chinadataarea$ + "\"
|
||
Case "MCF"
|
||
usrs$ = MCFdataarea$ + "\"
|
||
Case "HZ"
|
||
usrs$ = HZdataarea$ + "\"
|
||
Case Else
|
||
usrs$ = haldataarea$ + "\"
|
||
End Select
|
||
|
||
t$ = usrs$ + UCase$(Mid(xxx$, q + 1))
|
||
t$ = left(t$, Len(t$) - 2)
|
||
Call Fcopy(f$, t$, RC%)
|
||
If RC% <> 0 Then
|
||
Pause 2
|
||
Call Fcopy(f$, t$, RC%)
|
||
Pause 3
|
||
If RC% <> 0 Then
|
||
Call addlstLog(f$ + "|from copy to user failed|" + Str(RC%))
|
||
Call addlstLog(t$ + "|to copy to user failed|" + Str(RC%))
|
||
End If
|
||
End If
|
||
End If
|
||
If Not KillIt(f$) Then PrintLog "---------- Failed to delete " + f$ + " Removing distiller file"
|
||
lstDistilled.RemoveItem (icx)
|
||
Else
|
||
lstDistilled.List(icx) = xy$ + "|" + Trim(Str(cnt))
|
||
icx = icx + 1
|
||
End If
|
||
Loop
|
||
|
||
End Sub
|
||
Private Sub PrintIt(Prntr$, fln$, RC%)
|
||
Dim hPrinter&
|
||
Dim jobid&
|
||
Dim res&, itsaText
|
||
Dim written&
|
||
Dim printdata$
|
||
Dim docinfo As DOC_INFO_1
|
||
|
||
If UCase(right(fln, 3)) = "TXT" Then
|
||
itsaText = True
|
||
Else
|
||
itsaText = False
|
||
End If
|
||
RC% = 0
|
||
res& = OpenPrinter(Prntr$, hPrinter, 0)
|
||
If res = 0 Then
|
||
RC% = 1 'unable to open printer
|
||
Exit Sub
|
||
End If
|
||
spname$ = UCase(BreakFileName(fln$, 4))
|
||
If spname$ = "" Then spname$ = "Spooler"
|
||
docinfo.pDocName = spname$
|
||
docinfo.pOutputFile = vbNullString
|
||
docinfo.pDatatype = vbNullString
|
||
jobid = StartDocPrinter(hPrinter, 1, docinfo)
|
||
Call StartPagePrinter(hPrinter)
|
||
|
||
Open fln$ For Input As #27 'using #27
|
||
While Not EOF(27)
|
||
Line Input #27, printdata$
|
||
If itsaText = True Then
|
||
printdata$ = printdata$ + vbCrLf
|
||
Else
|
||
printdata$ = printdata$ + Chr$(10)
|
||
End If
|
||
|
||
Call WritePrinter(hPrinter, ByVal printdata$, Len(printdata$), written)
|
||
Wend
|
||
Close #27
|
||
Call EndPagePrinter(hPrinter)
|
||
Call EndDocPrinter(hPrinter)
|
||
Call ClosePrinter(hPrinter) ' Close when done
|
||
End Sub
|
||
|
||
Private Sub PrintItText(Prntr$, fln$, RC%)
|
||
Dim hPrinter&
|
||
Dim jobid&
|
||
Dim res&
|
||
Dim written&
|
||
Dim printdata$
|
||
Dim docinfo As DOC_INFO_1
|
||
RC% = 0
|
||
res& = OpenPrinter(Prntr$, hPrinter, 0)
|
||
If res = 0 Then
|
||
RC% = 1 'unable to open printer
|
||
Exit Sub
|
||
End If
|
||
spname$ = UCase(left$(right$(fln$, 10), 8))
|
||
If spname$ = "" Then spname$ = "Spooler"
|
||
docinfo.pDocName = spname$
|
||
docinfo.pOutputFile = vbNullString
|
||
docinfo.pDatatype = vbNullString
|
||
jobid = StartDocPrinter(hPrinter, 1, docinfo)
|
||
Call StartPagePrinter(hPrinter)
|
||
|
||
Open fln$ For Input As #26 'using #26
|
||
While Not EOF(26)
|
||
Line Input #26, printdata$
|
||
printdata$ = printdata$ + vbCrLf
|
||
Call WritePrinter(hPrinter, ByVal printdata$, Len(printdata$), written)
|
||
Wend
|
||
Close #26
|
||
Call EndPagePrinter(hPrinter)
|
||
Call EndDocPrinter(hPrinter)
|
||
Call ClosePrinter(hPrinter) ' Close when done
|
||
End Sub
|
||
|
||
|
||
Private Sub lstLog_DblClick()
|
||
Clipboard.Clear
|
||
Z$ = lstLog.List(lstLog.ListIndex)
|
||
Clipboard.SetText (Z$)
|
||
|
||
End Sub
|
||
|
||
Private Sub Timer1_Timer()
|
||
If Timer1.Tag = "" Then
|
||
Timer1.Tag = "Busy"
|
||
If Scanning = 1 Then
|
||
Call PrintFile
|
||
End If
|
||
If lstLog.ListCount > 1000 Then
|
||
lstLog.RemoveItem (0)
|
||
End If
|
||
Timer1.Tag = ""
|
||
End If
|
||
End Sub
|
||
|