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

1886 lines
54 KiB
QBasic
Raw Permalink Blame History

Attribute VB_Name = "Main"
DefInt A-Z
Global Place$(300), Lpt$(300), PrinterGroup$(300), Tray$(300), Limits$(300)
Global submask$(300, 2), submaskI%, plt$(40), lptI%, pltI%, sm, que, Replys$(100), replies%
Global replies2, replys2$(100), WDTServerTime!, Constipation%
Global mov$, Mesgline$, Mesgline2$, pgs%, source$, Stoppit%
Global Errors$, cmd$, logcmd$, func$, Destin$, USER01$, USER02$, msgt$
Global MessageFileName$, MessageLogName$, NetWPath$
Global COMPLETE$, COMPLETE2$, INCOME$, PrintCfg$, Reply$, ReplyComplete$, ReplyComplete2$
Global CADPRINT$, QUEHANDL$, CADPRNT2$, TFIL$, MAKEPS$
Global XEPS$, PLOTCFG$, PrinterCFG$, SUBSCFG$, BUFFER$
Global SendACAD%, SendingACAD, ACADComplete$, ACADReply$
Global ACADWait$, ACADIncome$, ACADCH$, FileTimer, Tog$
Global UserDrive$, EngrDrive$, IEDrive$, temppath$
Global SendPROE, SendingPROE, PROEComplete$, PROEWait$, PROEIncome$
Global PROECH$, PROEReply$, PROERPCM$
Global CQueSize%, PrintGroup%
' PROECH$ ' complete.hld semephore file name
' PROEReply$ ' reply.que semephore file name
Sub AddHeaders(infile$, TempFile$, Headr$, minolta$, NoPages%, Rc%)
On Error GoTo AH_Error
crlf$ = Chr$(13) + Chr$(10)
If minolta$ = "Yes" Then
Open temppath$ + "t2.fil" For Output As #1
Print #1, Chr$(27) + "%-12345X@PJL JOB"
Print #1, "@PJL USTATUS JOB=ON"
Print #1, "@PJL JOB NAME=XXXXXXXX"
' Print #1, "@PJL ECHO PPD @(#)mipwp251.ppd 1.9 14:05:09 8/31/98" + crlf$
Print #1, "@PJL SET RET=ON"
Print #1, "@PJL SET ECONOMODE=OFF"
Print #1, "@PJL ENTER LANGUAGE=POSTSCRIPT"
Close #1
Else
Open temppath$ + "t2.fil" For Output As #1
Close #1
End If
Open TFIL$ For Output As #1
Print #1, Headr$
Close #1
If NoPages = 1 Then
Open MAKEPS$ For Output As #1
Print #1, "PSMODE " + infile$ + " " + temppath$ + "t2.fil " + TFIL$ + " " + TempFile$ + " N"
Print #1, "copy c:\work\shelwait.hld c:\work\shelwait.go"
Close #1
Else
Open MAKEPS$ For Output As #1
Print #1, "PSMODE " + infile$ + " " + temppath$ + "t2.fil " + TFIL$ + " " + TempFile$ + " Y"
Print #1, "copy c:\work\shelwait.hld c:\work\shelwait.go"
Close #1
End If
wh = Shell(MAKEPS$, 2)
Call PrintLog("Single Page File...Shell Complete")
Do While IsItRunning(wh) '"C:\WINNT\SYSTEM32\CMD.EXE")
For idfef = 1 To 100
DoEvents
Next
Loop
Call WaitOnIt
AH_Exit:
Exit Sub
AH_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "Add Header Error"
Resume AH_Exit
' If NoPages = 1 Then
' Call Fcopy(infile$, TFIL$, Rc%)
' Call PrintLog("Multiple Page File...Copy complete")
' If Rc% = 0 Then
' Call PrintLog("Multiple Page File...Creating temporary file and inserting header Filename:" + TempFile$)
' Open TFIL$ For Input As #1
' Open TempFile$ For Output As #2
' Print #2, Headr$
' While Not (EOF(1))
' a$ = Input(1, #1)
' Print #2, a$;
'' If (a$ = Chr$(10)) Or (a$ = Chr$(13)) Then DoEvents
' Wend
' Close #1, #2
' End If
'
' Call PrintLog("Single Page File...Creating T.Fil")
'' Call PrintLog("Single Page File...Creating T.Fil")
'' Open TFIL$ For Output As #1
'' Print #1, Headr$
'' Close #1
''
'' Call PrintLog("Single Page File...Creating makeps.bat")
'' Open MAKEPS$ For Output As #1
' Print #1, "copy " + TFIL$ + " + " + infile$ + " " + TempFile$
' Print #1, "copy c:\work\shelwait.hld c:\work\shelwait.go"
' Close #1
'
' Shell MAKEPS$
' Call PrintLog("Single Page File...Shell Complete")
' Call WaitOnIt
' Else
' Call PrintLog("Multiple Page File...Copying to t.fil")
' Call Fcopy(infile$, TFIL$, Rc%)
' Call PrintLog("Multiple Page File...Copy complete")
' If Rc% = 0 Then
' Call PrintLog("Multiple Page File...Creating temporary file and inserting header Filename:" + TempFile$)
' Open TFIL$ For Input As #1
' Open TempFile$ For Output As #2
' While Not (EOF(1))
' Line Input #1, a$
' b$ = Trim$(a$)
' If UCase$(Left$(b$, 6)) = "%%PAGE" Then
' Print #2, Headr$
' End If
' Print #2, a$
' DoEvents
' Wend
' Close #1, #2
' End If
' End If
End Sub
Sub PassItToACADServer(comnd$)
'
' this routine takes the information passed to it in
' the variable COMND$ and tacks it on the end of the
' WAIT.QUE file.
' If the WAIT.QUE file is in the process of being passed
' to the ACAD Server then it waits till it is done.
'
On Error GoTo PITAS_Error
SendACAD = False
While SendingACAD = True
DoEvents ' wait for copy to income.que
Wend
Open ACADWait$ For Append As #1
Print #1, comnd$
Close #1
SendACAD = True
PITAS_Exit:
Exit Sub
PITAS_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "PassItTOACADServer Error"
Resume PITAS_Exit
End Sub
Sub LoadPlot()
On Error GoTo LP_Error
Open PLOTCFG$ For Input As #1
Do While Not EOF(1)
Line Input #1, a$
If left$(a$, 1) <> ";" Then
If Trim$(a$) <> "" Then
pltI% = pltI% + 1
plt$(pltI%) = a$
frmMain.cboPrinterList.AddItem a$
End If
End If
If pltI% = 40 Then Exit Do
Loop
Close #1
LP_Exit:
Exit Sub
LP_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "LoadPlot Error"
Resume LP_Exit
End Sub
Sub LoadPrinters()
On Error GoTo LdPrnt_Error
Open PrinterCFG$ For Input As #1
Do While Not EOF(1)
Line Input #1, a$
a$ = UCase$(Trim$(a$))
frmMain.cboPrinterList.AddItem a$
If left$(a$, 1) <> ";" Then
If a$ <> "" Then
lptI% = lptI% + 1
Call PARSE(a$, lp$, " ", Rc%)
Place$(lptI%) = lp$
Call PARSE(a$, lp$, " ", Rc%)
Lpt$(lptI%) = lp$
Call PARSE(a$, ort$, " ", Rc%)
PrinterGroup$(lptI%) = ort$
Call PARSE(a$, lims$, " ", Rc%)
Limits$(lptI%) = lims$
Call PARSE(a$, Try$, " ", Rc%)
Tray$(lptI%) = Try$
End If
End If
If lptI% = 300 Then Exit Do
Loop
Close #1
LdPrnt_Exit:
Exit Sub
LdPrnt_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "LoadPrinters Error"
Resume LdPrnt_Exit
End Sub
Sub LoadSubDirs()
On Error GoTo LdSD_Error
Open SUBSCFG$ For Input As #1
sm = 0
Do While Not EOF(1)
Line Input #1, a$
a$ = UCase$(Trim$(a$))
If left$(a$, 1) <> ";" Then
If a$ <> "" Then
sm = sm + 1
Call PARSE(a$, M$, " ", Rc%)
submask$(sm, 1) = Trim$(M$)
Call PARSE(a$, sb$, " ", Rc%)
submask$(sm, 2) = Trim$(sb$)
End If
End If
If sm >= 300 Then
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Call PrintLog("E R R O R L O A D I N G S U B S . C F G !!!!!!!!!")
Exit Do
End If
Loop
submaskI% = sm
Close #1
LdSD_Exit:
Exit Sub
LdSD_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "Load Sub Dir Error"
Resume LdSD_Exit
End Sub
Sub PrintPSFile(printQname$, Who$)
PrintLog "Print PS File...calling ADDHEADERS"
If Tog$ = ".1" Then Tog$ = ".2" Else Tog$ = ".1"
PrintBufferFileName$ = BUFFER$ + Tog$
crlf$ = Chr$(13) + Chr$(10)
'
'Special minolta code!!!!!!
'
If Tray$(que) = "PS3" Then
' If (Lpt$(que) = "SVCMINOLTA") Or (Lpt$(que) = "DOCKC") Then
HED$ = "%%BoundingBox: 0 0 792 1224" + crlf$
HED$ = HED$ + "%%BeginFeature: *PageSize Tabloid" + crlf$
HED$ = HED$ + " << /PageSize [792 1224]" + crlf$
HED$ = HED$ + " /ImagingBBox null" + crlf$
HED$ = HED$ + " >> setpagedevice" + crlf$
HED$ = HED$ + "%%EndFeature" + crlf$
minolta$ = "Yes"
Else
HED$ = ""
minolta$ = ""
End If
'
'
'
HED$ = HED$ + "/Helvetica findfont 10 scalefont setfont" + crlf$
HED$ = HED$ + "45 38 moveto" + crlf$
HED$ = HED$ + "(" + Mesgline$ + ") show"
HED$ = HED$ + crlf$ + "/Helvetica findfont 10 scalefont setfont" + crlf$
HED$ = HED$ + "45 48 moveto" + crlf$
HED$ = HED$ + "(" + Mesgline2$ + ") show"
Call AddHeaders(mov$, PrintBufferFileName$, HED$, minolta$, pgs%, Rc%)
nam1$ = Trim$(left$(source$ + " ", 8)) + "_" + Trim$(left$(USER01$ + " ", 3))
PrintLog "Print PS File...creating printcfg.bat"
On Error GoTo PrnPSF_Error
Open PrintCfg$ For Output As #1
Print #1, "NPRINT " + PrintBufferFileName$ + " /NAM=" + nam1$ + " /Q=Q-" + Lpt$(que) + " NT NB NFF NNOTI"
Print #1, "copy c:\work\shelwait.hld c:\work\shelwait.go"
Close #1
PrintLog "Print PS File...created file printcfg.bat"
PrintLog "Print PS File...shelling to printcfg.bat"
'
'
'
Select Case printQname$
Case "DISTILL"
frmPSSpooler.lstDistiller.AddItem Who$ + "|" + PrintBufferFileName$
PrintLog "Sending print to Distiller Waiting"
While frmPSSpooler.lstDistiller.ListCount > 0
For idfef = 1 To 100
DoEvents
Next
Wend
Case "DISTILLENG", "DISTILLSVC", "DISTILLBDV"
frmPSSpooler.lstDistiller.AddItem printQname$ + Who$ + "|" + PrintBufferFileName$
PrintLog "Sending print to Distiller Waiting"
While frmPSSpooler.lstDistiller.ListCount > 0
For idfef = 1 To 100
DoEvents
Next
Wend
Case Else
If frmMain.UseSpooler = 1 Then
frmPSSpooler.lstFiles.AddItem Lpt$(que) + "|" + PrintBufferFileName$
PrintLog "Sending print to PS Spooler and Waiting"
While frmPSSpooler.lstFiles.ListCount > 0
For idfef = 1 To 100
DoEvents
Next
Wend
PrintLog "PS Spooler Complete"
Else
wh = Shell(PrintCfg$, 2)
Call PrintLog("Single Page File...Shell Complete")
Do While IsItRunning(wh) '"C:\WINNT\SYSTEM32\CMD.EXE")
For idfef = 1 To 100
DoEvents
Next
Loop
PrintLog "Print PS File...shell complete printcfg.bat"
Call WaitOnIt
End If
End Select
'
'
'
PrnPSF_Exit:
Exit Sub
PrnPSF_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "PrintPSFile Error"
Resume PrnPSF_Exit
End Sub
Function Replace$(strng$, sfnd$, Rplc$)
Dim i%, s$
s$ = ""
For i% = 1 To Len(strng$)
If Mid$(strng$, i%, Len(sfnd$)) = sfnd$ Then
s$ = s$ + Rplc$
Else
s$ = s$ + Mid$(strng$, i%, 1)
End If
Next
Replace$ = s$
End Function
'
' This subroutine searches the array submask$(300,2) for the subdirectory
' that this part is in . . . if the part has no agreed to mask then it is
' given no sub directory
'
Sub subsearch(part$, subd$)
subd$ = ""
If Len(part$) < 7 Then Exit Sub
sear$ = left$(part$ + " ", 7)
For ix = 1 To submaskI%
lx = InStr(submask$(ix, 1), "X") - 1
If lx = -1 Then lx = 7
If lx = 0 Then
subd$ = submask$(ix, 2) + "\"
Exit For
End If
If left$(part$, lx) = left$(submask$(ix, 1), lx) Then
subd$ = submask$(ix, 2) + "\"
Exit For
End If
Next
End Sub
Public Sub StartSystem()
'On Error GoTo allerrs
'
' P DANNY.DWG ENGR WO999999 JO88888
'
' ECO_IN FILE.NAM USER
'
' ECO_OUT FILE.NAM USER
'
'
' Process Income.Que File
'
StepNo$ = "call WDTserver1" 'Debug Var
Call WDTServer
StepNo$ = "?" 'Debug Var
frmMain.LstPrint.Enabled = True
If Exists(COMPLETE$) And Exists(INCOME$) Then
PrintLog "'Complete File' exists translating commands"
On Error GoTo StartError_Error
StepNo$ = "Open Income$" 'Debug Var
Open INCOME$ For Input As #4
StepNo$ = "?" 'Debug Var
While Not (EOF(4))
If replies <> 0 Then
GoSub GetCmd
Else
Line Input #4, cmd$
If Len(cmd$) > 6 Then
'
' is this the dreaded CheckIn command?
'
ccc$ = UCase$(Mid$(cmd$, 1, 1))
Select Case ccc$
Case "I"
frmMain.lstCheckIn.AddItem cmd$
DoEvents
cmd$ = ""
Case "Y"
frmMain.lstCheckIn.AddItem cmd$
DoEvents
cmd$ = ""
Case "P"
PrinterName$ = Trim$(UCase$(Mid$(cmd$, 10, 10)))
PartName$ = Trim$(UCase$(Mid$(cmd$, 2, 7)))
prtgrp = 0
For i = 1 To lptI%
If UCase$(Place$(i)) = PrinterName$ Then
prtgrp = Val(PrinterGroup$(i))
Exit For
End If
Next i
If prtgrp > frmMain.lstPGroup.Count - 1 Then prtgrp = 0
ChecinQ = False
xxxx = frmMain.lstCheckIn.ListCount
If xxxx > 0 Then
For ixx = 0 To xxxx - 1
cmx$ = frmMain.lstCheckIn.List(ixx)
cmxPN$ = Trim$(UCase$(Mid$(cmx$, 2, 7)))
If PartName$ = cmxPN$ Then
ChecinQ = True
Exit For
End If
Next
End If
If ChecinQ Then
frmMain.lstCheckIn.AddItem cmd$
Else
frmMain.lstPGroup(prtgrp).AddItem cmd$
End If
DoEvents
cmd$ = ""
Case Else
If cmd$ <> "" Then
frmMain.lstPGroup(0).AddItem cmd$
DoEvents
cmd$ = ""
End If
End Select
End If
End If
If cmd$ <> "" Then
StepNo$ = "GoSub ProcessCmd1" 'Debug Var
GoSub ProcessCmd
End If
' Call checkPROEServer
StepNo$ = "call WDTserver2" 'Debug Var
Call WDTServer
Wend
Close #4
PrintLog "reseting the semephore files and looping to top"
StepNo$ = "Kill Complete$" 'Debug Var
KillIt (COMPLETE$)
StepNo$ = "Kill INCOME$" 'Debug Var
KillIt (INCOME$)
StepNo$ = "Enter Kill Loop" 'Debug Var
ccnt = 0
Do While (Exists(COMPLETE$) Or Exists(INCOME$))
Beep& 800&, 500&
Beep& 700&, 500&
If ccnt = 0 Then
ccnt = 1
frmMain.lstError.AddItem "******* did not kill complete or income file" + Time + " " + Date
PrintLog "******* did not kill complete or income file"
End If
pause (10)
KillIt (COMPLETE$)
KillIt (INCOME$)
Loop
StepNo$ = "Exit Kill Loop" 'Debug Var
Else
If replies <> 0 Then
StepNo$ = "GoSub GetCmd" 'Debug Var
GoSub GetCmd
StepNo$ = "GoSub ProcessCmd2" 'Debug Var
GoSub ProcessCmd
Else
cmd$ = ""
For i = 1 To frmMain.lstPGroup.Count
PrintGroup = PrintGroup + 1
If PrintGroup > frmMain.lstPGroup.Count - 1 Then PrintGroup = 1
If frmMain.lstPGroup(PrintGroup).ListCount <> 0 Then
cmd$ = frmMain.lstPGroup(PrintGroup).List(0)
frmMain.lstPGroup(PrintGroup).RemoveItem (0)
Exit For
End If
Next
If cmd = "" Then
PrintGroup = 0
If frmMain.lstPGroup(PrintGroup).ListCount <> 0 Then
cmd$ = frmMain.lstPGroup(PrintGroup).List(0)
frmMain.lstPGroup(PrintGroup).RemoveItem (0)
End If
End If
If cmd$ <> "" Then
If UCase$(left$(cmd$, 5)) = "*CAD*" Then
cmd$ = Mid$(cmd$, 6)
End If
StepNo$ = "GoSub ProcessCmd3" 'Debug Var
GoSub ProcessCmd
Else
'
'handle checkin list
'
If frmMain.lstCheckIn.ListCount <> 0 Then
cmd$ = frmMain.lstCheckIn.List(0)
frmMain.lstCheckIn.RemoveItem (0)
If UCase$(left$(cmd$, 5)) = "*CAD*" Then
cmd$ = Mid$(cmd$, 6)
End If
StepNo$ = "GoSub ProcessCmd4" 'Debug Var
GoSub ProcessCmd
End If
End If
End If
StepNo$ = "Call FlushReplies" 'Debug Var
Call FlushReplies
StepNo$ = "Call WDTServer3" 'Debug Var
Call WDTServer
If (Exists(COMPLETE$) And (Not (Exists(INCOME$)))) Then
frmMain.lstError.AddItem "******* An odd condition exists complete$ exists and Income$ doesn't " + Time$ + " " + Date$
PrintLog "******* An odd condition exists complete$ exists and Income$ doesn't"
StepNo$ = "Odd condition" 'Debug Var
KillIt (COMPLETE$)
End If
End If
Exit Sub
GetCmd:
cmd$ = Replys$(1)
replies = replies - 1
For rpx = 1 To replies
Replys$(rpx) = Replys$(rpx + 1)
Next
frmMain.lstReply1.RemoveItem 0
If UCase$(left$(cmd$, 5)) = "*CAD*" Then
cmd$ = Mid$(cmd$, 6)
End If
Return
ProcessCmd:
'''''' 1 2 3 4 5 6
'''''' 123456789012345678901234567890123456789012345678901234567890
''''''print P Part Printer Banner1 Date Product Number mesg type
'''''' 1<---8--><---10---><---10---><-----14-----><------15----->XY
'''''' 123456781234567890123451234567890123456789012345678
''''''ck out O Part# Product # Directory New Name Date EXT
'''''' in 1<---8--><------15-----><---10---><--8---><-----14----->
''''''refer R<---8--><------15-----><---10---><--8---><-----14-----><3>
'''''' 1 2 3 4 5 6 7
'''''' 1234567890123456789012345678901234567890123456789012345678901234567890
''''''
'''''' back
''''''ie move
'''''' 1 2 3 4 5 6
'''''' 1234567890123456789012345678901234567890123456789012345678901234567890
'''''' PROE 1234567812345678901234512345678901234567890
'''''' in 1<---8--><------15-----><---10---><--8---><-----14----->X
''''''start S Part# Product # Directory IE Dir Date IGES Indicator
''''''end D Part# Product # Directory IE Dir Date
''''''IGES G Part# Product # Directory IE Dir Date
''''''ASM A Part# Product # Directory IE Dir Date
''''''Copy Y Part# Product # <- newpart 15-><-user 9-><- date 14 -->
''''''kill MU X part# Product # Directory Date
''''''CLS
Errors$ = " "
cmd$ = RPad$(UCase$(cmd$), 77)
FileExtCopied$ = ""
logcmd$ = cmd$
func$ = left$(cmd$, 1)
source$ = Mid$(cmd$, 2, 8)
Call subsearch(source$, subdirect$)
Destin$ = Mid$(cmd$, 10, 10)
USER01$ = Mid$(cmd$, 20, 10)
USER02$ = Mid$(cmd$, 30, 14)
msgt$ = Mid$(cmd$, 59, 1) ' message to print indicator
Rohs$ = UCase(Mid$(cmd$, 60, 1)) 'rohs message
Select Case Rohs$
Case " ", "Y"
Mesgline2$ = " MUST BE ROHS COMPLIANT AFTER MARCH 1, 2006 "
Case "N"
Mesgline2$ = " "
Case Else
Mesgline2$ = " MUST BE ROHS COMPLIANT AFTER MARCH 1, 2006 "
End Select
ProductRev$ = Mid$(cmd$, 9, 1)
Product$ = Trim(Mid$(cmd$, 10, 15))
NewProduct$ = Trim(Mid$(cmd$, 25, 15))
Directry$ = Mid$(cmd$, 25, 10)
NewName$ = Mid$(cmd$, 35, 8)
Newdate$ = Mid$(cmd$, 43, 14)
IEDir$ = Mid$(cmd$, 35, 10)
IEDate$ = Mid$(cmd$, 45, 14)
RefExt$ = Mid$(cmd$, 57, 3)
IGESPRoe$ = Mid$(cmd$, 57, 1)
PrintLog "command received >" + cmd$
pgs% = 0
Select Case func$
Case "P" ' plot
GoSub PrintDrawing
Case "W" ' wiring diagram
GoSub PrintWiring
Case "R" ' reference
GoSub MoveOUT
Case "O" ' checkout
GoSub MoveOUT
Case "B" ' checkout
GoSub MoveBACK
Case "I" ' checkin
GoSub MoveIN
cmd$ = RPad(cmd$, 58) + IGESIncluded$
Case "Y" ' Copy to New part
GoSub CopyPart
Case "E"
' move to IE
GoSub MoveIE
Case "X"
GoSub KillMarkUp
Case "A", "G", "S", "D"
GoSub Hand2Proe ' Proe Command
pgs% = -1
Case Else
Errors$ = "E99" ' invalid command
End Select
GoSub FormatReply
GM$ = RPad$("*CAD*S" + frmMain.MakePGroupPacket, CQueSize%)
frmMain.lblPkt.Caption = GM$
replies2 = replies2 + 1
replys2$(replies2) = GM$
frmMain.lstReply2.AddItem GM$
If pgs% >= 0 Then
' Print #5, ReplyMsg$
replies2 = replies2 + 1
PrintLog "REPLY>>>" + ReplyMsg$ + "<<<"
replys2$(replies2) = ReplyMsg$
frmMain.lstReply2.AddItem ReplyMsg$
End If
' While frmCheckAssembly.lstRepliesToProcess.ListCount > 0
' rplyfrmass$ = frmCheckAssembly.lstRepliesToProcess.List(0)
' frmCheckAssembly.lstRepliesToProcess.RemoveItem 0
' frmMain.lstReply2.AddItem rplyfrmass$
' replies2 = replies2 + 1
' replys2$(replies2) = rplyfrmass$
' Wend
If (replies > 2) Or (replies2 > 2) Then
Call FlushReplies
End If
Return
FormatReply:
If Errors$ = "" Then Errors$ = " "
CADFlag$ = right$(" " + CADFlag$, 1)
NOFiles$ = right$("000" + Trim$(Str$(NoOfFilesMoved)), 3)
ReplyMsg$ = RPad$("*CAD*" + cmd$, CQueSize% - 3) + Errors$
If (func$ <> "P") And (func$ <> "Y") Then
Mid$(ReplyMsg$, 62, 4) = right$(" " + CADFlag$ + NOFiles$, 4)
PrintLog "Main - Process Income.Que ... printing to reply.que"
Mid$(ReplyMsg$, 66, 9) = LPad$(Format$(FileSizes&, "0"), 9)
Mid$(ReplyMsg$, 75, 48) = RPad$(FileExtCopied$, 48)
End If
GoSub logline
Return
Hand2Proe:
If IGESPRoe$ <> "A" Then
Call PassItToPROEServer(cmd$)
Else
Call PassItToACADServer(cmd$)
End If
mov$ = ""
pgs% = -1
Return
PrintDrawing:
pgs% = 0
qname$ = Trim$(Destin$)
Namer$ = Trim$(USER01$)
Who$ = Namer$ + "-" + source$
TypPrint$ = " "
InvMesg$ = " "
For i = 1 To pltI%
If msgt$ = LTrim$(left$(plt$(i), 1)) Then
TypPrint$ = Trim$(Mid$(plt$(i), 2, 31))
InvMesg$ = Trim$(Mid$(plt$(i), 34))
Exit For
End If
Next
que = 0
For i = 1 To lptI%
If UCase$(Place$(i)) = qname$ Then
que = i
Exit For
End If
Next i
'
' Does PRO-E Exist?
'
mov$ = EngrDrive$ + subdirect$ + Trim$(source$)
movplt$ = mov$ + ".plt"
movps$ = mov$ + ".ps"
Movdwg$ = mov$ + ".dwg"
moveps$ = mov$ + ".eps"
If Not (Exists%(movplt$)) Then
'
' No, Does POST SCRIPT Exist?
'
If Not (Exists%(movps$)) Then
'
' No, Does ACAD Exist?
'
If Not (Exists%(Movdwg$)) Then
'
' No, Does Encapsulated PS Exist?
'
If Not (Exists%(moveps$)) Then
'
' No, Nothing exists --- ERROR !!!
'
mov$ = ""
Else ' .EPS Exists !!!!
'
' EPS Exists - One page to print
'
mov$ = moveps$
pgs% = 1
End If
Else ' .DWG Exists !!!!
'
' ACAD Exists - Create EPS FILE!!! then Print
'
Call PassItToACADServer(cmd$)
mov$ = ""
pgs% = -1
End If
Else ' .PS Exists !!!!
'
' PS Exists - One page to print
'
mov$ = movps$
pgs% = 1
End If
Else ' .PLT Exists !!!!
'
' Pro-E Exists - Two pages to print
'
mov$ = movplt$
pgs% = 2
End If
If pgs% <> -1 Then ' -1 means it was passed to another server
Errors$ = " " ' no error
PrintLog "Mov$=" + mov$
If Exists%(Trim$(mov$)) Then
If FileLen(Trim$(mov$)) = 0 Then
Errors$ = "P03"
Else
Mesgline$ = " " + TypPrint$ + " " + Time$ + " " + Date$ + " "
Mesgline$ = Mesgline$ + InvMesg$ + " " + mov$ + " printed at "
Mesgline$ = Mesgline$ + qname$ + " by " + USER01$
PrintLog "Message Line =" + Mesgline$
PSFileStr$ = Replace$(Mesgline$, "\", "\\")
Mesgline$ = PSFileStr$
Call PrintPSFile(qname$, Who$)
End If
Else
Errors$ = "P01"
End If
End If
Return
MoveOUT:
'
' Moves the Drawing from the Main CAD Directory to the User
'
If left$(source$, 2) = "PD" Then
RefExt$ = "TXT"
End If
If left$(source$, 2) = "SW" Then
Qfldr$ = EngrDrive$ + subdirect$ + Trim$(source$)
Ufldr$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
frmFolderCopy.pthSrc = Qfldr$
frmFolderCopy.pthDst = Ufldr$
Call frmFolderCopy.Command1
Else
FrommExt$ = UCase$(Trim$(RefExt$))
If func$ = "R" And (FrommExt$ <> "") Then
Fromm$ = EngrDrive$ + subdirect$ + Trim$(source$) + "." + FrommExt$
fromm1$ = Trim$(source$)
fromm1$ = EngrDrive$ + subdirect$ + left$(fromm1$, Len(fromm1$) - 1) + "." + FrommExt$
If (FrommExt$ <> "PLT") And (FrommExt$ <> "TXT") Then Fromm$ = fromm1$
Too$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$) + "." + FrommExt$
Too1$ = Trim$(NewName$)
Too1$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + left$(Too1$, Len(Too1$) - 1) + "." + FrommExt$
If (FrommExt$ = "DRW") Or (FrommExt$ = "PRT") Or (FrommExt$ = "ASM") Or (FrommExt$ = "BOM") Then
Too$ = Too1$ + ".1"
End If
PrintLog "Main - CopyIt... copying file " + Fromm$ + " to " + Too$
GoSub CopyWithCount
If Rc% <> 0 Then
Errors$ = "C" + right$("00" + Trim$(Str$(Rc%)), 2)
NoOfFilesMoved = 0
Else
Errors$ = " "
NoOfFilesMoved = 1
End If
Else
If left$(source$, 2) = "PD" Then
Tailn$ = ""
Else
Tailn$ = ".1"
End If
Fromm$ = EngrDrive$ + subdirect$ + Trim$(source$)
Too$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
GoSub CopyIt
End If
Return
MoveIN:
'
' Moves the Drawing from the User to then Main CAD Directory
'
Errors$ = ""
Call subsearch(NewName$, subdirect$)
Fromm$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
TooIE$ = IEDrive$ + "\IGES\" + Trim$(NewName$)
FrommPE$ = Trim$(NewName$)
FrommPE$ = left$(FrommPE$, Len(FrommPE$) - 1)
FrommPE$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(FrommPE$)
If ThisIsProE(Fromm$) Then
jc% = 0
Call RenameProe(FrommPE$ + ".DRW", Rc%): jc% = jc% + Rc%
Call RenameProe(FrommPE$ + ".PRT", Rc%): jc% = jc% + Rc%
Call RenameProe(FrommPE$ + ".PTD", Rc%): jc% = jc% + Rc%
bomcnt% = 0
Call RenameProe(FrommPE$ + ".BOM", Rc%): jc% = jc% + Rc%: bomcnt = bomcnt + Rc%
Call RenameProe(FrommPE$ + ".IGS", Rc%) 'IGES Files don't count
If Rc% = 0 Then
IGESIncluded$ = "0"
Else
IGESIncluded$ = "1"
Call Fcopy(FrommPE$ + ".IGS", TooIE$ + ".IGS", Rc%)
PurgeIt (FrommPE$ + ".IGS")
End If
Call RenameProe(FrommPE$ + ".ASM", Rc%): jc% = jc% + Rc%
assm% = 0
If Rc% <> 0 Then 'do we have an assembly?
If frmCheckAssembly.chkNoCheck = 0 Then 'are we checking assemblies?
If frmCheckAssembly.Execute(FrommPE$ + ".asm") > 90 Then
assm% = 1
Errors$ = "I14"
End If
End If
If (assm% = 0) Then
If (bomcnt <> 0) Then
'
' if we have an assembly we might have a bom
'
frmBOM.txtGood.Text = "False"
frmBOM.txtAssembly = NewName$
frmBOM.txtBOM = FrommPE$ + ".BOM"
If (Errors$ = "") And (jc% <> 0) Then
Call frmBOM.cmdClearBOM_Click ' clear the old assembly
Call frmBOM.cmdReadBOM_Click ' read in the new assembly
End If
Select Case frmBOM.txtGood.Text
Case "0" ' good bom
Case "1" ' bad bom
assm% = 1
Errors$ = "I16"
Case "2" ' no bom
assm% = 1
Errors$ = "I15"
Case Else ' unknown bom
assm% = 1
Errors$ = "I16"
End Select
Else
Prefx$ = left(NewName$, 3)
Suffix$ = right(NewName$, 1)
If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Suffix$)) <> 0 Then
If (Prefx$ <> "810") And (Prefx$ <> "807") Then
assm% = 1
Errors$ = "I15"
End If
End If
End If
End If
End If
If assm% = 0 Then
If jc% = 0 Then
Errors$ = "C06"
frmBOM.txtAssembly = NewName$
Call frmBOM.cmdClearBOM_Click
Else
Lev$ = UCase$(right$(Fromm$, 1))
plev$ = Trim$(UCase$(right$(source$, 1)))
If plev$ <> "" Then
Fromm$ = left$(Too$, Len(Too$) - 1)
Call SaveRev(Fromm$, plev$)
PurgeIt (Fromm$ + ".DRW")
PurgeIt (Fromm$ + ".PTD")
PurgeIt (Fromm$ + ".PRT")
PurgeIt (Fromm$ + ".BOM")
PurgeIt (Fromm$ + ".ASM")
Fromm$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
End If
End If
Else
'
' if the assembly is bad clear it out of the work file
'
frmBOM.txtAssembly = NewName$
Call frmBOM.cmdClearBOM_Click
End If
End If
If Errors$ = "" Then
Killr$ = Too$
Tailn$ = ""
GoSub CopyIt
GoSub DeleteIt
Killr$ = ""
End If
Return
MoveBACK:
'
' Moves the Drawing from the Main CAD Directory to the User
'
Call subsearch(NewName$, subdirect$)
Too$ = UserDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
Fromm$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
Killr$ = Too$
Tailn$ = ".1"
GoSub CopyIt
Fromm$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
GoSub DeleteIt
'If ThisIsProE(fromm$) Then
Lev$ = UCase$(right$(Fromm$, 1))
If Lev$ > "A" Then
plev$ = Chr$(Asc(Lev$) - 1)
If plev$ = "I" Then plev$ = "H"
If plev$ = "O" Then plev$ = "N"
Call RestoreLev(Fromm$, plev$)
End If
'End If
Killr$ = ""
Return
CopyPart:
'
' Copies a Drawing from the Main CAD Directory to the Main CAD Directory with a new name
'
Call subsearch(Product$, subdirect$)
Fromm$ = EngrDrive$ + subdirect$ + Product$ + ProductRev$
Call subsearch(NewProduct$, subdirect$)
Too$ = EngrDrive$ + subdirect$ + NewProduct$ + ProductRev$
Tailn$ = ""
GoSub CopyIt
Killr$ = ""
Return
KillMarkUp:
'
' kills the markup drawing
'
kll$ = EngrDrive$ + "\Markup\" + Trim$(Directry$) + "\" + Trim$(source$)
If Exists(kll$ + ".zip") Then
On Error Resume Next
Kill kll$ + ".zip"
On Error GoTo 0
End If
If Exists(kll$ + ".mrk") Then
On Error Resume Next
Kill kll$ + ".mrk"
On Error GoTo 0
End If
Return
MoveIE:
'
' Moves the Drawing from the Main CAD Directory to the IE User
'
Fromm$ = EngrDrive$ + subdirect$ + Trim$(source$)
Too$ = IEDrive$ + "\" + Trim$(Directry$) + "\" + Trim$(NewName$)
Tailn$ = ""
GoSub CopyIt
Return
DeleteIt:
' If rc% = 0 Then
If CADFlag$ = "P" Then
fromm1$ = left$(Fromm$, Len(Fromm$) - 1)
PurgeIt (Fromm$ + ".PLT")
PurgeIt (fromm1$ + ".DRW")
PurgeIt (fromm1$ + ".PTD")
PurgeIt (fromm1$ + ".PRT")
PurgeIt (fromm1$ + ".BOM")
PurgeIt (fromm1$ + ".ASM")
ElseIf CADFlag$ = "E" Then
PurgeIt (Fromm$ + ".TXT")
Else
PurgeIt (Fromm$ + ".DWG")
End If
PrintLog "Main - DeleteIt... deleting file " + Fromm$
' End If
Return
CopyIt:
'
' copies all files related to a drawing
' from the FROMM$ to the TOO$
'
' FROMM$ and TOO$ are preserved
'
' FROMM$ and TOO$ must be in the format pppppppr (no extension)
' where ppppppp = part number and r = revision level
'
' Returns
' NoOfFilesMoved
' CADFlag = "A" or "P" or "E" or "S"
'
'
NoOfFilesMoved = 0
FileExtCopied$ = ""
CADFlag$ = ""
HFromm$ = Fromm$
HToo$ = Too$
If left(source$, 1) = "S" Then 'This is special copy (Folder)
If Exists%(Fromm$ + ".PLT") Then
CADFlag$ = "P" ' Proe
fromm1$ = Fromm$
Too1$ = Too$
Fromm$ = Fromm$ + ".PLT"
Too$ = Too$ + ".PLT"
If left$(source$, 2) = "PS" Then
CADFlag$ = "S" ' Palm checkin
End If
ElseIf left$(source$, 2) = "PD" Then
CADFlag$ = "E" ' Parameter Data File
Fromm$ = Fromm$ + ".TXT"
Too$ = Too$ + ".TXT"
Else
CADFlag$ = "A" ' Autocad Files
Fromm$ = Fromm$ + ".DWG"
Too$ = Too$ + ".DWG"
If Killr$ <> "" Then
Killr$ = Killr$ + ".PS"
If Exists%(Killr$) Then
Kill Killr$
End If
End If
End If
PrintLog "Main - CopyIt... copying file " + Fromm$ + " to " + Too$
GoSub CopyWithCount
If Rc% <> 0 Then
Errors$ = "C" + right$("00" + Trim$(Str$(Rc%)), 2)
NoOfFilesMoved = 0
FileExtCopied$ = ""
Else
Errors$ = " "
NoOfFilesMoved = 1
End If
FileSizes& = 0
If (NoOfFilesMoved = 1) Then
Select Case CADFlag$
Case "P"
'
' move the ProE files!!!!!!
'
fromm1$ = left$(fromm1$, Len(fromm1$) - 1) 'take off revision
Too1$ = left$(Too1$, Len(Too1$) - 1) 'take off revision
Fromm$ = fromm1$ + ".DRW"
Too$ = Too1$ + ".DRW" + Tailn$
GoSub CopyWithCount
If Rc% = 0 Then
FileSizes& = FileLen(Fromm$)
End If
Fromm$ = fromm1$ + ".PTD"
Too$ = Too1$ + ".PTD"
GoSub CopyWithCount
Fromm$ = fromm1$ + ".PRT"
Too$ = Too1$ + ".PRT" + Tailn$
GoSub CopyWithCount
Fromm$ = fromm1$ + ".BOM"
Too$ = Too1$ + ".BOM" + Tailn$
GoSub CopyWithCount
Fromm$ = fromm1$ + ".ASM"
Too$ = Too1$ + ".ASM" + Tailn$
GoSub CopyWithCount
Case "S"
'
' move the ProE files!!!!!!
'
fromm1$ = left$(fromm1$, Len(fromm1$) - 1) 'take off revision
Too1$ = left$(Too1$, Len(Too1$) - 1) 'take off revision
Fromm$ = fromm1$ + ".DRW"
Too$ = Too1$ + ".DRW" + Tailn$
GoSub CopyWithCount
If Rc% = 0 Then
FileSizes& = FileLen(Fromm$)
End If
Fromm$ = fromm1$ + ".PTD"
Too$ = Too1$ + ".PTD"
GoSub CopyWithCount
Fromm$ = fromm1$ + ".PRT"
Too$ = Too1$ + ".PRT" + Tailn$
GoSub CopyWithCount
Fromm$ = fromm1$ + ".BOM"
Too$ = Too1$ + ".BOM" + Tailn$
GoSub CopyWithCount
Fromm$ = fromm1$ + ".ASM"
Too$ = Too1$ + ".ASM" + Tailn$
GoSub CopyWithCount
'
' need to xfer the subdirectory here
'
Case Else
FileSizes& = FileLen(Fromm$)
End Select
End If
Fromm$ = HFromm$
Too$ = HToo$
Return
CopyWithCount:
Too$ = LCase$(Too$)
Call Fcopy(Fromm$, Too$, Rc%)
If (Rc% = 0) And (CADFlag$ = "P") Then
Call MyLowercaser(Too$)
End If
If Rc% = 0 Then
NoOfFilesMoved = NoOfFilesMoved + 1
extensd = InStr(Fromm$, ".")
If extensd <> 0 Then
Extens$ = LPad$(Mid$(Fromm$, extensd + 1, 3), 4)
FileExtCopied$ = FileExtCopied$ + Extens$
End If
End If
Return
logline:
If frmMain.ChkLogging.value = 1 Then
If func$ <> "P" Then
Logs$ = "Extensions=>" + FileExtCopied$
Else
Logs$ = ""
End If
Logs$ = Errors$ + logcmd$ + Logs$
Call Messages(Logs$)
End If
Return
allerrs:
On Error GoTo 0
Open MessageFileName$ For Output As #11
Print #11, " I HAVE BEEN TERMINATED"
Close #11
End
FileRETRY:
frmMain.ErrorCondition.Caption = "File Retry - StartSystem"
If Err.Number = 70 Then
frmMain.FileErrInd.value = True
FileTimer = 0
DoEvents
While FileTimer > 0
DoEvents
Wend
Resume
End If
On Error GoTo 0
Resume
PrintWiring:
pgs% = 0
qname$ = Trim$(Destin$)
Namer$ = Trim$(USER01$)
TypPrint$ = " "
InvMesg$ = " "
For i = 1 To pltI%
If msgt$ = LTrim$(left$(plt$(i), 1)) Then
TypPrint$ = Trim$(Mid$(plt$(i), 2, 31))
InvMesg$ = Trim$(Mid$(plt$(i), 34))
Exit For
End If
Next
que = 0
For i = 1 To lptI%
If UCase$(Place$(i)) = qname$ Then
que = i
Exit For
End If
Next i
'
' Does PRO-E Exist?
'
mov$ = EngrDrive$ + subdirect$ + Trim$(source$)
movplt$ = mov$ + ".wir"
If Not (Exists%(movplt$)) Then
mov$ = ""
Else ' .PLT Exists !!!!
'
' Pro-E Exists - Two pages to print
'
mov$ = movplt$
pgs% = 1
End If
Errors$ = " " ' no error
PrintLog "Mov$=" + mov$
If Exists%(Trim$(mov$)) Then
If FileLen(Trim$(mov$)) = 0 Then
Errors$ = "P03"
Else
Mesgline$ = " " + TypPrint$ + " " + Time$ + " " + Date$ + " "
Mesgline$ = Mesgline$ + InvMesg$ + " " + mov$ + " printed at "
Mesgline$ = Mesgline$ + qname$ + " by " + USER01$
PrintLog "Message Line =" + Mesgline$
PSFileStr$ = Replace$(Mesgline$, "\", "\\")
Mesgline$ = PSFileStr$
Call PrintPSFile(qname$, Who$)
End If
Else
Errors$ = "P01"
End If
Return
StartError_Exit:
Exit Sub
StartError_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "Start System Error - " + StepNo$
Resume StartError_Exit
End Sub
Public Sub Messages(a$)
On Error GoTo Message_Error
Open MessageLogName$ For Append As #10
Print #10, UCase$(Format$(Now, "DD-MMM-YY HH:MM:SS == ")) + a$
Close #10
Call PrintLog(a$)
Message_Exit:
Exit Sub
Message_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "Message Error"
Resume Message_Exit
End Sub
Public Sub WDTServer()
If Constipation% <> 0 Then
Tweet
frmMain.lstReply2.BackColor = QBColor(12)
Exit Sub
End If
frmMain.lstReply2.BackColor = QBColor(15)
WDTFile$ = NetWPath$ + "CMNDPROC.WDT"
If (WDTServerTime! < Timer) Or (Abs(Timer - WDTServerTime!) > 100) Then
WDTServerTime! = Timer + 60
On Error Resume Next
Open WDTFile$ For Output As #8
Close #8
Kill WDTFile$
Open WDTFile$ For Output As #8
Close #8
On Error GoTo 0
End If
End Sub
Public Sub InitVars()
frmMain.Caption = "Command Processor Version: " + AppRevision$
NetWPath$ = "\\fm1\eng\users\cadprint\"
MainPath$ = "C:\Work"
ChDir MainPath$
MainPath$ = MainPath$ + "\"
ACADPath$ = "\\fm1\eng\users\286\"
CQueSize% = 250
Constipation% = 0
UserDrive$ = "\\fm1\eng\users"
EngrDrive$ = "\\fm1\eng\eng\drawings"
IEDrive$ = "\\fm1\eng\depts\IE"
MainPath$ = ""
temppath$ = "C:\"
PROEPath$ = "\\fm1\eng\users\286\proe\"
MessageFileName$ = NetWPath$ + "CADPRINT.MSG"
MessageLogName$ = NetWPath$ + "CADPRINT.LOG"
COMPLETE$ = NetWPath$ + "COMPLETE.QUE"
COMPLETE2$ = NetWPath$ + "COMPLET2.QUE"
INCOME$ = NetWPath$ + "INCOME.QUE"
Reply$ = NetWPath$ + "REPLY.QUE"
ReplyComplete$ = NetWPath$ + "REPLYCMP.QUE"
ReplyComplete2$ = NetWPath$ + "REPLYCM2.QUE"
CADPRINT$ = NetWPath$ + "CADPRINT.LOG"
QUEHANDL = NetWPath$ + "QUEHANDL.MSG"
CADPRNT2 = NetWPath$ + "CADPRNT2.LOG"
PLOTCFG$ = NetWPath$ + "PLOT.CFG"
PrinterCFG$ = NetWPath$ + "PRINTER.CFG"
SUBSCFG$ = NetWPath$ + "SUBS.CFG"
PrintCfg$ = MainPath$ + "PRINTCFG.BAT"
MAKEPS$ = MainPath$ + "Makeps.BAT"
TFIL$ = temppath$ + "T.FIL"
BUFFER$ = temppath$ + "CMDPBUFF"
ACADComplete$ = ACADPath$ + "COMPLETE.QUE"
ACADWait$ = ACADPath$ + "WAIT.QUE"
ACADIncome$ = ACADPath$ + "INCOME.QUE"
ACADCH$ = ACADPath$ + "COMPLETE.SAV"
ACADReply$ = ACADPath$ + "REPLY.QUE"
'
PROEComplete$ = PROEPath$ + "COMPLETE.QUE"
PROEWait$ = PROEPath$ + "WAIT.QUE"
PROEIncome$ = PROEPath$ + "INCOME.QUE"
PROECH$ = PROEPath$ + "HOLD.QUE"
PROEReply$ = PROEPath$ + "REPLY.QUE"
PROERPCM$ = PROEPath$ + "RCM.Que"
'
Stoppit = False
'
SendACAD = False
SendingACAD = False
SendPROE = False
SendingPROE = False
'
' Program
'
On Error Resume Next
Open MessageFileName$ For Output As #1
Print #1, " I AM RUNNING"
Close #1
On Error GoTo 0
lptI% = 0
pltI% = 0
Lpt$(0) = "LPT1"
PrinterGroup$(0) = "0"
Tray$(0) = "UT"
Call LoadPrinters
Call LoadPlot
Call LoadSubDirs
End Sub
Public Sub FileDisplay(a$)
If Exists(a$) Then
Stoppit = False
frmMain.cmdStoppit.Visible = True
DoEvents
On Error GoTo FDError
Open a$ For Input As #4
While (Not EOF(4)) And (Not (Stoppit))
Line Input #4, ax$
Call PrintLog(ax$)
im = im + 1
If im > 10 Then
im = 0
DoEvents
End If
Wend
Close #4
frmMain.cmdStoppit.Visible = False
Else
PrintLog ("FILE >" + a$ + "< DOES NOT EXIST")
End If
FDExit:
Exit Sub
FDError:
frmMain.lstError.AddItem "FileDisplay Error"
Resume FDExit
End Sub
Public Sub PrintLog(a$)
frmMain.LstPrint.AddItem a$
If frmMain.LstPrint.ListCount > 1600 Then
frmMain.LstPrint.RemoveItem 0
End If
DoEvents
End Sub
Public Sub checkACADServer()
'
' SendACAD ' checked by timer
' SendingACAD ' set by timer
' ACADComplete$ ' complete.que semephore file name
' ACADWait$ ' wait.que semephore file name
' ACADIncome$ ' income.que semephore file name
' ACADCH$ ' complete.hld semephore file name
'
'
'
If frmMain.CheckACAD = False Then
Exit Sub
End If
If SendACAD Then 'is there info to be passed????
'Can we pass info to ACAD Handler???????
If (Not (Exists(ACADComplete$))) And (Not (Exists(ACADIncome$))) Then
'Dont let any more stuff get in the way
'while we pass it
SendingACAD = True
'Pass it
Call Fcopy(ACADWait$, ACADIncome$, Rc%)
Call Fcopy(ACADCH$, ACADComplete$, Rc%)
Kill ACADWait$
'Okay now more stuff can be stuffed !!!!
SendingACAD = False
'Okay I'm ready for another file!!!
SendACAD = False
End If
End If
If Exists(ACADReply$) Then
On Error GoTo ReplyExists
Open ACADReply$ For Input As #1
frmMain.FileErrInd.value = True
On Error GoTo 0
While Not EOF(1)
Line Input #1, rp$
If Mid$(rp$ + " ", 6, 1) = "G" Then
replies2 = replies2 + 1
replys2$(replies2) = rp$
frmMain.lstReply2.AddItem ReplyMsg$
Else
replies = replies + 1
Replys$(replies) = rp$
frmMain.lstReply1.AddItem rp$
End If
Wend
Close #1
Kill ACADReply$
End If
Exit Sub
Ender:
frmMain.FileErrInd.value = False
Exit Sub
ReplyExists:
frmMain.ErrorCondition.Caption = "Reply Exists - checkACADServer"
If Err.Number = 70 Then
frmMain.FileErrInd.value = True
FileTimer = 1
DoEvents
While FileTimer > 0
DoEvents
Wend
Resume Ender
End If
On Error GoTo 0
Resume
End Sub
Public Function ThisIsProE(x$)
tx% = Exists(x$ + ".PLT")
ThisIsProE = tx%
End Function
Public Function PurgeIt(a$)
On Error Resume Next
If Exists(a$) Then
Kill a$
End If
On Error GoTo 0
End Function
Public Sub SaveRev(fromm1$, Lev$)
'
' Fromm1$="u:\GRICE\9101234"
' Lev$="B"
' move drawings to new revision from users drive
'
'
Too1$ = fromm1$ + Lev$
Fromm$ = fromm1$ + ".DRW"
Too$ = Too1$ + ".DRW"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Fromm$ = fromm1$ + ".PTD"
Too$ = Too1$ + ".PTD"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Fromm$ = fromm1$ + ".PRT"
Too$ = Too1$ + ".PRT"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Fromm$ = fromm1$ + ".BOM"
Too$ = Too1$ + ".BOM"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Fromm$ = fromm1$ + ".ASM"
Too$ = Too1$ + ".ASM"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
End Sub
Public Sub RestoreLev(Too1$, Lev$)
Too1$ = left$(Too1$, Len(Too1$) - 1)
fromm1$ = Too1$ + Lev$
Fromm$ = fromm1$ + ".DRW"
Too$ = Too1$ + ".DRW"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Call PurgeIt(Fromm$)
Fromm$ = fromm1$ + ".PTD"
Too$ = Too1$ + ".PTD"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Call PurgeIt(Fromm$)
Fromm$ = fromm1$ + ".PRT"
Too$ = Too1$ + ".PRT"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Call PurgeIt(Fromm$)
Fromm$ = fromm1$ + ".BOM"
Too$ = Too1$ + ".BOM"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Call PurgeIt(Fromm$)
Fromm$ = fromm1$ + ".ASM"
Too$ = Too1$ + ".ASM"
Call Fcopy(Fromm$, Too$, Rc%)
Call MyLowercaser(Too$)
Call PurgeIt(Fromm$)
End Sub
Public Sub WaitOnIt()
While Not (Exists("c:\work\shelwait.go"))
DoEvents
Wend
On Error GoTo WaitErr
Kill "c:\work\shelwait.go"
frmMain.ErrorCondition.Caption = " "
Exit Sub
WaitErr:
frmMain.ErrorCondition.Caption = "WaitErr - Waitonit"
If Err.Number = 70 Then
frmMain.FileErrInd.value = True
FileTimer = 0
DoEvents
While FileTimer > 0
DoEvents
Wend
frmMain.FileErrInd.value = False
DoEvents
Resume
End If
On Error GoTo 0
Resume
End Sub
Public Sub FlushReplies()
frmMain.CheckACAD = False
On Error GoTo Flush_Err
If ((replies2 <> 0)) And (Not (Exists(ReplyComplete$))) Then
Open Reply$ For Output As #5
For rpx = 1 To replies2
Print #5, replys2$(rpx)
Next
Close #5
Call Fcopy(ReplyComplete2$, ReplyComplete$, Rc%)
replies2 = 0
frmMain.lstReply2.Clear
End If
Flush_End:
frmMain.CheckACAD = True
Exit Sub
Flush_Err:
frmMain.FileErrInd = True
frmMain.ErrorCondition.Caption = "Flush Fail"
Resume Flush_End
End Sub
Public Sub Send2Proe()
'
' this routine takes the information passed to it in
' the variable COMND$ and tacks it on the end of the
' WAIT.QUE file.
' If the WAIT.QUE file is in the process of being passed
' to the ACAD Server then it waits till it is done.
'
' SendPROE = False
' While SendingPROE = True
' DoEvents ' wait for copy to income.que
' Wend
' Open PROEWait$ For Append As #1
' Print #1, comnd$
' Close #1
' SendPROE = True
'
End Sub
Public Sub checkPROEServer()
'
' SendPROE ' checked by timer
' SendingPROE ' set by timer
' PROEComplete$ ' complete.que semephore file name
' PROEWait$ ' wait.que semephore file name
' PROEIncome$ ' income.que semephore file name
' PROECH$ ' complete.hld semephore file name
' PROEReply$ ' reply.que semephore file name
'
'
'
' If frmMain.CheckAcad = False Then
' Exit Sub
'End If
If SendPROE Then 'is there info to be passed????
'Can we pass info to ACAD Handler???????
If (Not (Exists(PROEComplete$))) And (Not (Exists(PROEIncome$))) Then
'Dont let any more stuff get in the way
'while we pass it
SendingPROE = True
'Pass it
Call Fcopy(PROEWait$, PROEIncome$, Rc%)
Call Fcopy(PROEWait$, PROEComplete$, Rc%)
Kill PROEWait$
'Okay now more stuff can be stuffed !!!!
SendingPROE = False
'Okay I'm ready for another file!!!
SendPROE = False
End If
End If
If Exists(PROEReply$) And Exists(PROERPCM$) Then
On Error GoTo ReplyExists
Open PROEReply$ For Input As #1
frmMain.FileErrInd.value = True
On Error GoTo 0
While Not EOF(1)
Line Input #1, rp$
replies2 = replies2 + 1
replys2$(replies2) = rp$
frmMain.lstReply2.AddItem rp$
Call Messages("PROE REPLY-" + rp$)
Wend
Close #1
Kill PROEReply$
Kill PROERPCM$
End If
Exit Sub
Ender:
frmMain.FileErrInd.value = False
Exit Sub
ReplyExists:
frmMain.ErrorCondition.Caption = "Reply Exists - checkACADServer"
If Err.Number = 70 Then
frmMain.FileErrInd.value = True
FileTimer = 1
DoEvents
While FileTimer > 0
DoEvents
Wend
Resume Ender
End If
On Error GoTo 0
Resume
End Sub
Public Sub PassItToPROEServer(comnd$)
'
' this routine takes the information passed to it in
' the variable COMND$ and tacks it on the end of the
' WAIT.QUE file.
' If the WAIT.QUE file is in the process of being passed
' to the PROE Server then it waits till it is done.
'
SendPROE = False
While SendingPROE = True
DoEvents ' wait for copy to income.que
Wend
On Error GoTo PITPS_Error
Open PROEWait$ For Append As #1
Print #1, comnd$
Close #1
Call Messages("PROE MESSG-" + comnd$)
SendPROE = True
PITPS_Exit:
Exit Sub
PITPS_Error:
frmMain.lstError.AddItem Date$ + " " + Time$ + "Pass It to proe server Error"
Resume PITPS_Exit
End Sub
Public Function IsItRunning%(tskid)
Well = True
On Error GoTo IsTskError
AppActivate tskid
On Error GoTo 0
IsItRunning% = Well
Exit Function
IsTskError:
Well = False
Resume Next
End Function
Public Sub MyLowercaser(direct$)
'
' This routine converts the files specified by
' direct$ to lowercase file names.
'
Dim FileNamesToChange$(900)
a% = LastStr(direct$, "\")
pth$ = left$(direct$, a%)
retrycnt = 200
d$ = Dir$(direct$)
fcnt = 0
While d$ <> ""
FileNamesToChange$(fcnt) = d$
fcnt = fcnt + 1
d$ = Dir$
Wend
zzx$ = "0 - activate ON ERROR"
On Error GoTo lchandle
For ixx = 0 To fcnt - 1
zzx$ = "1 - load d$": d$ = FileNamesToChange$(ixx)
zzx$ = "2 - prefix xxx": lc1$ = "xxxx" + LCase$(d$)
zzx$ = "3 - lowercase name": lc$ = LCase$(d$)
zzx$ = "4 - kill prev file": Kill pth$ + lc1$
zzx$ = "5 - rename file to wierd": Name pth$ + d$ As pth$ + lc1$
zzx$ = "6 - pause": pause (1)
zzx$ = "7 - rename file to lcName": Name pth$ + lc1$ As pth$ + lc$
Next
lchandleOut:
Exit Sub
lchandle:
If Err.Number <> 53 Then
ax$ = Str$(Err.Number)
b$ = (Err.Description)
retrycnt = retrycnt - 1
mb = 0
If retrycnt < 0 Then
mm1$ = Chr$(13) + " D$=" + pth$ + d$ + " lc1$=" + pth$ + lc1$
mm2$ = Chr$(13) + " lc$=" + pth$ + lc$
mm3$ = Chr$(13) + " Function Step =" + zzx$
mm3$ = mm3$ + Chr$(13) + " direct=" + direct$
mm4$ = Chr$(13) + " Resume = YES" + Chr$(13) + "Resume Next = NO" + Chr$(13) + "Abort lcRoutine = Cancel"
'
' handle the error to keep this from ever happening again
'
Call frmMain.lstReply2Cnt_DblClick
If zzx$ = "7 - do dir$ cmnd" Then
frmMain.lstError.AddItem Date$ + " " + Time$ + zzx$
d$ = ""
Resume lchandleOut
End If
'
'
'
mb = MsgBox("Lower case - error no:" + ax$ + Chr$(13) + "Errdesc-" + b$ + mm1$ + mm2$ + mm3$ + mm4$, vbYesNoCancel)
End If
Select Case mb
Case 0, vbYes
pause (1)
Resume
Case vbNo
Resume Next
Case vbCancel
d$ = ""
Resume lchandleOut
Case Else
Resume Next
End Select
End If
Resume Next
End Sub
Reference in New Issue View Git Blame Copy Permalink