Rob
/
FrymasterVB
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
FrymasterVB/Pdf.frm

310 lines
9.2 KiB
Plaintext
Raw Normal View History

first commit
2024-12-18 13:56:36 -06:00
VERSION 5.00
Begin VB.Form frmPDF
Caption = "PDF Printer"
ClientHeight = 7380
ClientLeft = 60
ClientTop = 345
ClientWidth = 11355
LinkTopic = "Form1"
ScaleHeight = 7380
ScaleWidth = 11355
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtPrintedBy
Height = 285
Left = 1920
TabIndex = 14
Text = "FEDUCIA"
Top = 1200
Width = 5730
End
Begin VB.TextBox txtBanner
Height = 285
Left = 1920
TabIndex = 13
Text = "Official Production Print"
Top = 1515
Width = 5730
End
Begin VB.ListBox List5
Height = 3765
Left = 5760
TabIndex = 12
Top = 3195
Width = 1635
End
Begin VB.ListBox List4
Height = 3765
Left = 4050
TabIndex = 11
Top = 3195
Width = 1635
End
Begin VB.ListBox List3
Height = 3765
Left = 2340
TabIndex = 10
Top = 3195
Width = 1635
End
Begin VB.ListBox List2
Height = 3765
Left = 630
TabIndex = 9
Top = 3195
Width = 1635
End
Begin VB.ListBox List1
Height = 2790
Left = 7785
TabIndex = 8
Top = 225
Width = 3390
End
Begin VB.Timer Timer1
Left = 9960
Top = 6000
End
Begin VB.TextBox Text1
Height = 735
Left = 90
MultiLine = -1 'True
TabIndex = 7
Text = "Pdf.frx":0000
Top = 2400
Width = 7575
End
Begin VB.TextBox txtPDFPrinter
Height = 285
Left = 1890
TabIndex = 6
Text = "MIS LJ4000"
Top = 855
Width = 5730
End
Begin VB.CommandButton cmdPrintPDF
Caption = "Print PDF"
Height = 405
Left = 120
TabIndex = 4
Top = 1920
Width = 2040
End
Begin VB.TextBox txtPDFtoPrint
Height = 285
Left = 1890
TabIndex = 3
Text = "c:\files\test.pdf"
Top = 540
Width = 5730
End
Begin VB.TextBox txtAdobeStr
Height = 285
Left = 1920
TabIndex = 1
Text = "C:\Program Files\Adobe\Acrobat 5.0\Acrobat\Acrobat.exe"
Top = 225
Width = 5730
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Printed By: "
Height = 240
Index = 4
Left = 120
TabIndex = 16
Top = 1245
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Banner: "
Height = 240
Index = 3
Left = 120
TabIndex = 15
Top = 1560
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Printer to Print to:"
Height = 240
Index = 2
Left = 90
TabIndex = 5
Top = 900
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "File To Print:"
Height = 240
Index = 1
Left = 90
TabIndex = 2
Top = 585
Width = 1725
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Adobe Start up string:"
Height = 240
Index = 0
Left = 90
TabIndex = 0
Top = 270
Width = 1725
End
End
Attribute VB_Name = "frmPDF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdPrintPDF_Click()
' cmdstr$ = "%Start% " + Chr$(34) + "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe" + Chr$(34) + " /N /T " + Chr$(34) + "%~1" + Chr$(34) + " " + Chr$(34) + "%~2" + Chr$(34) + ""
FileToPrint$ = txtPDFtoPrint.Text
PrinterToUse$ = txtPDFPrinter.Text
PrintedBy$ = txtPrintedBy.Text
Banner$ = txtBanner.Text
Call PrintAPDF(FileToPrint$, PrinterToUse$, PrintedBy$, Banner$)
End Sub
Private Sub Form_Load()
ppp$ = GetAdobeShellStr
If ppp$ <> "" Then
txtAdobeStr.Text = GetAdobeShellStr
End If
End Sub
Public Sub PrintAPDF(FileToPrint$, PrinterToUse$, PrintedBy$, Banner$)
txtPDFtoPrint.Text = FileToPrint$
txtPDFPrinter.Text = PrinterToUse$
txtPrintedBy.Text = PrintedBy$
txtBanner.Text = Banner$
cmdstr$ = "C:\files\exefolder\printrequest " + Chr$(34) + "sendto=pdfPrinter mesg=" + FileToPrint$ + "|" + PrinterToUse$ + "|" + PrintedBy$ + "|" + Banner$ + Chr$(34)
' cmdstr$ = "cmd /c " + Chr$(34) + "START /MIN " + Chr$(34) + Chr$(34) + " " + Chr$(34) + txtAdobeStr + Chr$(34) + " /N /T " + Chr$(34) + FileToPrint$ + Chr$(34) + " " + Chr$(34) + PrinterToUse$ + Chr$(34) + "" + Chr$(34)
Text1.Text = cmdstr$
pid = Shell(cmdstr$, vbMinimizedNoFocus)
Pause 2
Do
Call LookForAndKillAdobeErrors
If List5.ListCount > 0 Then
Pause 2
a = a
Else
Exit Do
End If
Loop
haldataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS"
chinadataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\CHINADRAWINGS"
MCFdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\MCFDRAWINGS"
HZdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\HZDRAWINGS"
If PrintedBy$ = "CHINA" Then
fln$ = BreakFileName(FileToPrint, 3)
Call Fcopy(FileToPrint$, pathCheck$(chinadataarea$) + fln$, RC%)
Call PrintLog("Copy File - " + FileToPrint + " -> ")
Call PrintLog(" To -> " + pathCheck(chinadataarea) + fln)
Call PrintLog(" Results = " + Str(RC%))
End If
If PrintedBy$ = "MCF" Then
fln$ = BreakFileName(FileToPrint, 3)
Call Fcopy(FileToPrint$, pathCheck$(MCFdataarea$) + fln$, RC%)
Call PrintLog("Copy File - " + FileToPrint + " -> ")
Call PrintLog(" To -> " + pathCheck(MCFdataarea) + fln)
Call PrintLog(" Results = " + Str(RC%))
End If
If PrintedBy$ = "HZ" Then
fln$ = BreakFileName(FileToPrint, 3)
Call Fcopy(FileToPrint$, pathCheck$(HZdataarea$) + fln$, RC%)
Call PrintLog("Copy File - " + FileToPrint + " -> ")
Call PrintLog(" To -> " + pathCheck(HZdataarea) + fln)
Call PrintLog(" Results = " + Str(RC%))
End If
If PrintedBy$ = "QHAL" Then
fln$ = BreakFileName(FileToPrint, 3)
Call Fcopy(FileToPrint$, pathCheck$(haldataarea$) + fln$, RC%)
Call PrintLog("Copy File - " + FileToPrint + " -> ")
Call PrintLog(" To -> " + pathCheck(haldataarea) + fln)
Call PrintLog(" Results = " + Str(RC%))
End If
End Sub
Public Sub LookForAndKillAdobeErrors()
'
' this subroutine requires
' list2, list3,list4,list5
'
List2.Clear
' Call findalllevel(0&, "Adobe Reader", List2)
Call findalllevel(0&, "Adobe Acrobat", List2)
'
' find children with error
'
List5.Clear
For ix = 0 To List2.ListCount - 1
zzz& = Val(Trim(List2.List(ix)))
List3.Clear
Call findalllevel(zzz&, "", List3)
If List3.ListCount > 0 Then
zzc& = Val(Trim(List3.List(0)))
List4.Clear
Call findalllevel(zzc&, "There was an error", List4)
If List4.ListCount > 0 Then
List4.Clear
Call findalllevel(zzc&, "OK", List4)
If List4.ListCount > 0 Then
List5.AddItem Trim(List4.List(0))
End If
End If
End If
Next
For ix = 0 To List5.ListCount - 1
pid$ = List5.List(ix)
zzc& = Val(Trim(pid$))
ck& = SetForegroundWindow(zzc&)
ck& = SetFocusAPI(zzc&)
Pause (0.2)
Call SendKeys("~")
Next
End Sub
Private Sub findalllevel(lvl&, WindowString$, List1 As ListBox)
'
xxt& = lvl&
hdl& = 0
Do
hdl& = FindWindowEx&(xxt&, hdl&, vbNullString, vbNullString)
If WindowString$ = "" Then
List1.AddItem Str(hdl&)
Else
wn$ = left(WindowName$(hdl&), Len(WindowString$))
If wn$ = WindowString$ Then
List1.AddItem Str(hdl&)
End If
End If
If hdl& = 0 Then Exit Do
Loop
End Sub
Private Function WindowName$(wnd&)
If wnd& <> 0 Then
BufferA$ = Space(300)
winlen& = GetWindowText(wnd&, BufferA$, 250)
BufferA$ = left$(BufferA$, winlen&)
WindowName$ = BufferA$
End If
End Function