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 © 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