2429 lines
76 KiB
QBasic
2429 lines
76 KiB
QBasic
Attribute VB_Name = "Main"
|
||
' This module contains the main program logic for handling print jobs and printer management
|
||
' The module name "Main" indicates this is likely the primary module containing core functionality
|
||
' VB_Name is a Visual Basic attribute that sets the module name in the project
|
||
DefInt A-Z
|
||
' Global variables that store information about places, printers, printer groups, trays, and limits.
|
||
' These variables are likely used throughout the application to manage printing-related functionality.
|
||
Global Place$(300), Lpt$(300), PrinterGroup$(300), Tray$(300), Limits$(300)
|
||
Global submask$(1000, 2), submaskI%, plt$(40), lptI%, pltI%, sm, que, Replys$(100), replies%
|
||
Global replies2, replys2$(100), WDTServerTime!, Constipation%
|
||
Global mov$, Mesgline$, Mesgline2$, pgs%, source$
|
||
Global Errors$, cmd$, logcmd$, func$, Destin$, USER01$, USER02$, msgt$
|
||
Global MessageFileName$, MessageLogName$, MessageLogName2$, NetWPath$
|
||
Global COMPLETE$, COMPLETE2$, INCOME$, PrintCfg$, Reply$, ReplyComplete$, ReplyComplete2$
|
||
Global CADPRINT$, QUEHANDL$, CADPRNT2$, TFIL$, MAKEPS$
|
||
Global XEPS$, PLOTCFG$, PrinterCFG$, SUBSCFG$, BufferName$
|
||
Global FileTimer, Tog$
|
||
Global EngrDrive$, IEDrive$, temppath$
|
||
Global SendPROE, SendingPROE, PROEComplete$, PROEWait$, PROEIncome$
|
||
Global PROECH$, PROEReply$, PROERPCM$
|
||
Global CQueSize%, PrintGroup%, textSerialNo$, textPrinter$
|
||
Global ExNames$(300, 2), Exusers%
|
||
Global OddCondition%
|
||
Global NETDRV As String
|
||
Global NETHAL As String
|
||
Global TogCount As Integer
|
||
|
||
' PROECH$ ' complete.hld semephore file name
|
||
' PROEReply$ ' reply.que semephore file name
|
||
|
||
|
||
Sub AddHeaders(infile$, TempFile$, Headr$, minolta$, NoPages%, RC%)
|
||
On Error GoTo 0
|
||
On Error GoTo AH_Error
|
||
crlf$ = Chr$(13) + Chr$(10)
|
||
If minolta$ = "Yes" Then
|
||
|
||
Open temppath$ + "t2.fil" For Output As #15 'using #15
|
||
Print #15, Chr$(27) + "%-12345X@PJL JOB"
|
||
Print #15, "@PJL USTATUS JOB=ON"
|
||
Print #15, "@PJL JOB NAME=XXXXXXXX"
|
||
' Print #15, "@PJL ECHO PPD @(#)mipwp251.ppd 1.9 14:05:09 8/31/98" + crlf$
|
||
Print #15, "@PJL SET RET=ON"
|
||
Print #15, "@PJL SET ECONOMODE=OFF"
|
||
Print #15, "@PJL ENTER LANGUAGE=POSTSCRIPT"
|
||
Close #15
|
||
Else
|
||
Open temppath$ + "t2.fil" For Output As #15 'using #15
|
||
Close #15
|
||
End If
|
||
|
||
Open TFIL$ For Output As #15 'using #15
|
||
Print #15, Headr$
|
||
Close #15
|
||
|
||
If NoPages = 1 Then
|
||
Open MAKEPS$ For Output As #15 'using #15
|
||
Print #15, "C:\work\PSMODE " + infile$ + " " + temppath$ + "t2.fil " + TFIL$ + " " + TempFile$ + " Y"
|
||
Print #15, "copy c:\work\shelwait.hld c:\work\shelwait.go"
|
||
Close #15
|
||
Else
|
||
Open MAKEPS$ For Output As #15 'using #15
|
||
Print #15, "C:\work\PSMODE " + infile$ + " " + temppath$ + "t2.fil " + TFIL$ + " " + TempFile$ + " Y"
|
||
Print #15, "copy c:\work\shelwait.hld c:\work\shelwait.go"
|
||
Close #15
|
||
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:
|
||
Close
|
||
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'using #XX
|
||
' Open TempFile$ For Output As #2 'using #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'using #XX
|
||
'' Print #1, Headr$
|
||
'' Close #1
|
||
''
|
||
'' Call PrintLog("Single Page File...Creating makeps.bat")
|
||
'' Open MAKEPS$ For Output As #1'using #XX
|
||
' 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'using #XX
|
||
' 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 GetExternalUsersFile()
|
||
'
|
||
' Loads External Users Into Program for processing
|
||
'
|
||
' File should be named as Follows: NetWPath$ + "\ExternalUsers.txt"
|
||
' and have the following format:
|
||
'
|
||
' TEUSCH|M:\MANITOWOCDrive\Paul\
|
||
' JJOHNSTON|M:\MANITOWOCDrive\JimmyJohnson\
|
||
' COLEY|\\fm1\service\service\RcoleyCheckIn\
|
||
'
|
||
'
|
||
Exusers% = 0
|
||
If ExistsNew(NetWPath$ + "\ExternalUsers.txt") Then
|
||
Open NetWPath$ + "\ExternalUsers.txt" For Input As #18 'using #18
|
||
Do While Not EOF(18)
|
||
Line Input #18, a$
|
||
a$ = Trim(a$)
|
||
If a$ = "" Then a$ = "'"
|
||
If left(a$, 1) <> "'" Then
|
||
|
||
Call PARSE(a$, EUserName$, "|", RC%)
|
||
Call PARSE(a$, EPath$, "|'", RC%)
|
||
Exusers% = Exusers% + 1
|
||
|
||
ExNames$(Exusers%, 1) = UCase(Trim(EUserName$))
|
||
ExNames$(Exusers%, 2) = Trim(EPath$)
|
||
|
||
End If
|
||
Loop
|
||
Close #18
|
||
End If
|
||
End Sub
|
||
|
||
Sub LoadPlot()
|
||
On Error GoTo LP_Error
|
||
Open PLOTCFG$ For Input As #19 'using #19
|
||
Do While Not EOF(19)
|
||
Line Input #19, 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 #19
|
||
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 #20 'using #20
|
||
Do While Not EOF(20)
|
||
Line Input #20, 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 #20
|
||
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 #21 'using #21
|
||
sm = 0
|
||
Do While Not EOF(21)
|
||
Line Input #21, 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 >= 1000 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 #21
|
||
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"
|
||
TogCount = TogCount + 1
|
||
If TogCount > 999 Then TogCount = 0
|
||
frmMain.lblTog.Caption = Str(TogCount)
|
||
Tog$ = Trim(Str(TogCount)) + ".ps"
|
||
' If Tog$ = ".1" Then Tog$ = ".2" Else Tog$ = ".1"
|
||
PrintBufferfileName$ = BufferName$ + 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 'using #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$(1000,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 (ExistsNew(COMPLETE$) And ExistsNew(INCOME$)) Or (frmMain.lstIncome.ListCount > 0) Then
|
||
If ExistsNew(INCOME$) Then
|
||
PrintLog "'Complete File' exists translating commands"
|
||
On Error GoTo StartError_Error
|
||
StepNo$ = "Open Income$" 'Debug Var
|
||
Open INCOME$ For Input As #5
|
||
Do While Not EOF(5)
|
||
Line Input #5, cmd$
|
||
frmMain.lstIncome.AddItem cmd$
|
||
Loop
|
||
Close #5
|
||
StepNo$ = "?" 'Debug Var
|
||
|
||
PrintLog "reseting the semephore files and looping to top"
|
||
StepNo$ = "Kill INCOME$ 1" 'Debug Var
|
||
If Not KillIt(INCOME$) Then PrintLog "---------- Failed to delete " + INCOME$ + " " + StepNo$
|
||
StepNo$ = "Kill Complete$ 1" 'Debug Var
|
||
If Not KillIt(COMPLETE$) Then PrintLog "---------- Failed to delete " + COMPLETE$ + " " + StepNo$
|
||
Pause 2
|
||
StepNo$ = "Kill INCOME$ 2" 'Debug Var
|
||
If Not KillIt(INCOME$) Then PrintLog "---------- Failed to delete " + INCOME$ + " " + StepNo$
|
||
StepNo$ = "Kill Complete$ 2" 'Debug Var
|
||
If Not KillIt(COMPLETE$) Then PrintLog "---------- Failed to delete " + COMPLETE$ + " " + StepNo$
|
||
StepNo$ = "Enter Kill Loop" 'Debug Var
|
||
ccnt = 0
|
||
Do While (ExistsNew(COMPLETE$) Or ExistsNew(INCOME$))
|
||
'Beep& 800&, 500&
|
||
'Beep& 700&, 500&
|
||
If ccnt < 10 Then
|
||
frmMain.lstError.AddItem "******* did not kill complete or income file retrying in 2 secs" + Time$ + " " + Date$
|
||
PrintLog "******* did not kill complete or income file retrying in 2 secs"
|
||
Else
|
||
PrintLog "******* did not kill complete or income file 10 retries failed"
|
||
Exit Do
|
||
End If
|
||
cnt = cnt + 1
|
||
Pause (2)
|
||
If Not KillIt(INCOME$) Then PrintLog "---------- Failed to delete " + INCOME$ + " " + StepNo$
|
||
If Not KillIt(COMPLETE$) Then PrintLog "---------- Failed to delete " + COMPLETE$ + " " + StepNo$
|
||
Loop
|
||
StepNo$ = "Exit Kill Loop" 'Debug Var
|
||
End If
|
||
|
||
Do
|
||
If replies <> 0 Then
|
||
GoSub GetCmd
|
||
Else
|
||
If frmMain.lstIncome.ListCount > 0 Then
|
||
cmd$ = Trim(frmMain.lstIncome.List(0))
|
||
frmMain.lstIncome.RemoveItem (0)
|
||
Else
|
||
Exit Do
|
||
End If
|
||
' Line Input #5, 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
|
||
Loop
|
||
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.picCount(PrintGroup).BackColor <> &HFF Then '02-aug-2012 this queue paused
|
||
If frmMain.lstPGroup(PrintGroup).ListCount <> 0 Then
|
||
cmd$ = frmMain.lstPGroup(PrintGroup).List(0)
|
||
frmMain.lstPGroup(PrintGroup).RemoveItem (0)
|
||
Exit For
|
||
End If
|
||
End If '02-aug-2012 this queue paused
|
||
Next
|
||
If cmd = "" Then
|
||
PrintGroup = 0
|
||
If frmMain.picCount(PrintGroup).BackColor <> &HFF Then '02-aug-2012 this queue paused
|
||
If frmMain.lstPGroup(PrintGroup).ListCount <> 0 Then
|
||
cmd$ = frmMain.lstPGroup(PrintGroup).List(0)
|
||
frmMain.lstPGroup(PrintGroup).RemoveItem (0)
|
||
End If
|
||
End If '02-aug-2012 this queue paused
|
||
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 (ExistsNew(COMPLETE$) And (Not (ExistsNew(INCOME$)))) Then
|
||
frmMain.lstError.AddItem "******* An odd condition has occured RETRYCNT=" + Trim(Str(OddCondition))
|
||
OddCondition = OddCondition - 1
|
||
Pause 1
|
||
If OddCondition < 1 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
|
||
If Not KillIt(COMPLETE$) Then PrintLog "---------- Failed to delete " + COMPLETE$ + " " + StepNo$
|
||
OddCondition = 10
|
||
End If
|
||
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
|
||
''''''
|
||
''''''textprt T Serial No Printer
|
||
'''''' 1<---10---><---10--->
|
||
''''''
|
||
'''''' 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)
|
||
|
||
'' rob
|
||
type130 = False
|
||
If func$ = "P" Then
|
||
If Mid$(cmd$, 44, 3) = "130" Then
|
||
type130 = True
|
||
source$ = Mid$(cmd$, 44, 10)
|
||
End If
|
||
End If
|
||
''end rob
|
||
Call subsearch(source$, subdirect$)
|
||
Destin$ = Mid$(cmd$, 10, 10)
|
||
USER01$ = Mid$(cmd$, 20, 10)
|
||
USER02$ = Mid$(cmd$, 30, 14)
|
||
IFSFolder$ = Mid$(cmd$, 44, 15)
|
||
|
||
textSerialNo = Mid$(cmd$, 2, 10)
|
||
'' rob
|
||
If type130 Then
|
||
textSerialNo = Mid$(cmd$, 44, 10)
|
||
End If
|
||
''end rob
|
||
textPrinter = Mid$(cmd$, 12, 10)
|
||
|
||
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)
|
||
'' rob
|
||
If type130 Then
|
||
textSerialNo = Mid$(cmd$, 44, 10)
|
||
End If
|
||
'' end rob
|
||
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$
|
||
Select Case func$
|
||
Case "P"
|
||
dddttt$ = Mid(cmd$, 30)
|
||
Case "X"
|
||
dddttt$ = Mid(cmd$, 35)
|
||
Case Else
|
||
dddttt$ = Mid(cmd$, 43)
|
||
End Select
|
||
dddttt$ = Mid(dddttt$, 5, 2) + "-" + Mid(dddttt$, 7, 2) + "-" + left$(dddttt$, 4) + " " + Mid(dddttt$, 9, 2) + ":" + Mid(dddttt$, 11, 2) + ":" + Mid(dddttt$, 13, 2)
|
||
PrintLog "Function:" + func$ + " - Part No: " + source$ + " - Date " + dddttt$
|
||
|
||
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 "T"
|
||
GoSub PrintTextFile ' print a text file
|
||
Case "X"
|
||
GoSub KillMarkUp
|
||
Case Else
|
||
Errors$ = "E99" ' invalid command
|
||
End Select
|
||
GoSub FormatReply
|
||
|
||
GM$ = RPad$("*CAD*S" + frmMain.MakePGroupPacket, CQueSize%)
|
||
frmMain.lblPkt.Caption = GM$
|
||
|
||
'-USE ITC------------------------------------------------------------------------
|
||
If frmMain.chkUseITC.value = 1 Then
|
||
frmMain.lstSend.AddItem GM$
|
||
Else
|
||
replies2 = replies2 + 1
|
||
replys2$(replies2) = GM$
|
||
frmMain.lstReply2.AddItem GM$
|
||
End If
|
||
'--------------------------------------------------------------------------------
|
||
If (pgs% >= 0) Or (pgs% = -2) Then
|
||
'-USE ITC------------------------------------------------------------------------
|
||
If frmMain.chkUseITC.value = 1 Then
|
||
frmMain.lstSend.AddItem ReplyMsg$
|
||
Else
|
||
PrintLog "REPLY>>>" + ReplyMsg$ + "<<<"
|
||
replies2 = replies2 + 1
|
||
replys2$(replies2) = ReplyMsg$
|
||
frmMain.lstReply2.AddItem ReplyMsg$
|
||
End If
|
||
'--------------------------------------------------------------------------------
|
||
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
|
||
PrintTextFile:
|
||
fln$ = IEDrive$ + "\supertester\testlog\" + textSerialNo + ".txt"
|
||
If ExistsNew(fln$) Then
|
||
frmPSSpooler.lstFiles.AddItem Trim(textPrinter) + "|" + fln$
|
||
End If
|
||
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
|
||
|
||
'
|
||
' Select Type of print
|
||
'
|
||
mov$ = EngrDrive$ + subdirect$ + Trim$(source$)
|
||
movplt$ = mov$ + ".plt"
|
||
movps$ = mov$ + ".ps"
|
||
Movdwg$ = mov$ + ".dwg"
|
||
movEps$ = mov$ + ".eps"
|
||
movpdf$ = mov$ + "\" + Trim$(source$) + ".pdf"
|
||
movpdf2$ = mov$ + ".pdf"
|
||
If (Trim(Destin$) = "FTPCHINA") Then
|
||
' Handle Foshan\Drawings\ //////////////////////////////////////////////////////////////////
|
||
PrintLog "Moving file:" + source$
|
||
PrintLog " From:" + movpdf$
|
||
PrintLog " or From:" + movpdf2$
|
||
China1$ = "\\qhal\root\Foshan\Drawings\"
|
||
If Trim(IFSFolder$) = "" Then
|
||
Else
|
||
China1$ = China1$ + Trim(IFSFolder$)
|
||
If Not (ExistsPath(China1$)) Then
|
||
Call CreatePath(China1$)
|
||
End If
|
||
End If
|
||
China1$ = pathCheck(China1$) + Trim(source$) + ".pdf"
|
||
PrintLog " to File:" + China1$
|
||
Call Fcopy(movpdf$, China1$, RC%)
|
||
rcx% = RC%
|
||
If RC% = 0 Then
|
||
PrintLog "Moved file:" + source$
|
||
PrintLog " to FTP folder:" + IFSFolder
|
||
End If
|
||
Call Fcopy(movpdf2$, China1$, RC%)
|
||
rcx = rcx + RC%
|
||
If RC% = 0 Then
|
||
PrintLog "Moved file:" + source$
|
||
PrintLog " to FTP folder:" + IFSFolder
|
||
End If
|
||
If rcx% > 1 Then
|
||
Errors$ = "P01" ' error
|
||
Else
|
||
Errors$ = " "
|
||
End If
|
||
ElseIf (Trim(Destin$) = "FTPENG") Then
|
||
' Handle DrawTemp\ //////////////////////////////////////////////////////////////////
|
||
PrintLog "Moving file:" + source$
|
||
PrintLog " From:" + movpdf$
|
||
PrintLog " or From:" + movpdf2$
|
||
DTfldr1$ = "\\qhal\root\DrawTemp\"
|
||
If Trim(IFSFolder$) = "" Then
|
||
Else
|
||
DTfldr1$ = DTfldr1$ + Trim(IFSFolder$)
|
||
If Not (ExistsPath(DTfldr1$)) Then
|
||
Call CreatePath(DTfldr1$)
|
||
End If
|
||
End If
|
||
DTfldr1$ = pathCheck(DTfldr1$) + Trim(source$) + ".pdf"
|
||
PrintLog " to File:" + DTfldr1$
|
||
Call Fcopy(movpdf$, DTfldr1$, RC%)
|
||
rcx% = RC%
|
||
If RC% = 0 Then
|
||
PrintLog "Moved file:" + source$
|
||
PrintLog " to FTP folder:" + IFSFolder
|
||
End If
|
||
Call Fcopy(movpdf2$, DTfldr1$, RC%)
|
||
rcx = rcx + RC%
|
||
If RC% = 0 Then
|
||
PrintLog "Moved file:" + source$
|
||
PrintLog " to FTP folder:" + IFSFolder
|
||
End If
|
||
If rcx% > 1 Then
|
||
Errors$ = "P01" ' error
|
||
Else
|
||
Errors$ = " "
|
||
End If
|
||
Else
|
||
'/////////////////////////////////////////////////////////////////////////////////
|
||
If (ExistsNew(movpdf$) Or ExistsNew(movpdf2$)) Then
|
||
'
|
||
' PDF Exist
|
||
'
|
||
mov$ = ""
|
||
lp$ = Lpt$(que)
|
||
If ExistsNew(movpdf2$) Then
|
||
Call frmPDF.PrintAPDF(movpdf2$, lp$, Namer$, TypPrint$)
|
||
Else
|
||
Call frmPDF.PrintAPDF(movpdf$, lp$, Namer$, TypPrint$)
|
||
End If
|
||
pgs% = 1
|
||
|
||
ElseIf ExistsNew(movplt$) Then
|
||
'
|
||
' Pro-E Exists - Two pages to print
|
||
'
|
||
mov$ = movplt$
|
||
pgs% = 2
|
||
Else
|
||
'
|
||
' No, Nothing exists --- ERROR !!!
|
||
'
|
||
mov$ = ""
|
||
pgs% = 0
|
||
End If
|
||
|
||
If pgs% <> -1 Then ' -1 means it was passed to another server
|
||
Errors$ = " " ' no error
|
||
PrintLog "Mov$=" + mov$
|
||
If ExistsNew(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
|
||
If Trim(mov$) <> "" Then
|
||
Errors$ = "P01"
|
||
End If
|
||
End If
|
||
End If
|
||
End If
|
||
Return
|
||
|
||
|
||
MoveOUT:
|
||
'
|
||
' Moves the Drawing from the Main CAD Directory to the User
|
||
'
|
||
If left$(source$, 2) = "PD" Then
|
||
RefExt$ = INIorTXT(EngrDrive$ + subdirect$ + Trim$(source$))
|
||
End If
|
||
|
||
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") And (FrommExt$ <> "INI") Then FromM$ = fromm1$
|
||
|
||
Too$ = UserDrive$(Directry$) + Trim$(NewName$) + "." + FrommExt$
|
||
Too1$ = Trim$(NewName$)
|
||
Too1$ = UserDrive$(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$
|
||
If (left(source$, 2) = "SW") Or (left(Destin$, 2) = "SW") Or (left(source$, 2) = "AI") Or (left(Destin$, 2) = "AI") Then 'This is special copy (Folder)
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
|
||
ElseIf ItIsAnAltium(FromM$) Then
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
ElseIf ItIsACBR(FromCBR$) Then
|
||
PrintLog "it is a CBR Menu folder"
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
PrintLog "CBR FromM$ - " + FromCBR$
|
||
PrintLog "CBR Too$ - " + Too$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
PrintLog "CBR rccc% - " + Str(rccc%)
|
||
ElseIf ItIsAManual(FromM$) Then
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
ElseIf ItIsASolidWorksFolder(FromM$ + "\" + Trim$(source$) + ".SLDDRW") Then
|
||
PrintLog "it is a Solid Works folder"
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
PrintLog "SW FromM$ - " + FromM$
|
||
PrintLog "SW Too$ - " + Too$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
PrintLog "SW rccc% - " + Str(rccc%)
|
||
ElseIf ItIsAnOCD(FromM$) Then
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
ElseIf ItIsAMENUFolder(FromM$) Then
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
|
||
Else
|
||
GoSub CopyWithCount
|
||
End If
|
||
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$(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$(Directry$) + Trim$(NewName$)
|
||
Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
TooIE$ = IEDrive$ + "\IGES\" + Trim$(NewName$)
|
||
FrommPE$ = Trim$(NewName$)
|
||
FrommPE$ = left$(FrommPE$, Len(FrommPE$) - 1)
|
||
FrommPE$ = UserDrive$(Directry$) + Trim$(FrommPE$)
|
||
PrintLog "Is this a Pro-E?"
|
||
If ThisIsProE(FromM$) Then
|
||
PrintLog "This a Pro-E!"
|
||
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$(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
|
||
Else
|
||
'
|
||
' It is not a PRO-e
|
||
'
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
|
||
FromMenu$ = FromD$ + ".xlsx"
|
||
FromINI$ = FromD$ + ".ini"
|
||
FromCBR$ = FromD$ + ".cbr"
|
||
FromPDF$ = FromD$ + ".pdf"
|
||
|
||
PrintLog "Is this a Menu? - FromM$" + FromM$
|
||
If ItIsAMENUFolder(FromM$) Then
|
||
PrintLog "This is a Menu!"
|
||
'
|
||
' A menu must have a .xlsx and a .pdf file inside its folder
|
||
'
|
||
bad = 0
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
|
||
FromM$ = FromD$ + ".pdf"
|
||
FromMenu$ = FromD$ + ".xlsx"
|
||
FromINI$ = FromD$ + ".ini"
|
||
FromCBR$ = FromD$ + ".cbr"
|
||
TooMenu$ = "C:\MenuFolder\in\" + Trim$(NewName$) + ".xlsx"
|
||
|
||
If (ExistsNew(FromM$)) And (ExistsNew(FromMenu$)) And (ExistsNew(FromINI$) Or (ExistsNew(FromCBR$))) Then ' it has a pdf and a xlsx file so it is a menu
|
||
Foldertype$ = "Menu"
|
||
PrintLog "Menu - CopyFolder"
|
||
PrintLog "FromF$ >" + FromF$
|
||
PrintLog "Too$ >" + Too$
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
|
||
Call Fcopy(FromMenu$, TooMenu$, Rcm%)
|
||
|
||
cadflag$ = "L"
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I18" ' bad menu
|
||
End If
|
||
ElseIf ItIsAnAutoCad(FromM$) Then
|
||
PrintLog "This is an AutoCad!"
|
||
bad = 0
|
||
|
||
' Fromm$ = UserDrive$(Directry$) + Trim$(NewName$)
|
||
' Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
|
||
If (ExistsNew(FromM$ + ".DWG")) And (ExistsNew(FromM$ + ".PDF")) Then
|
||
RC1% = 0
|
||
Too$ = EngrDrive$ + subdirect + Trim$(NewName$)
|
||
Call Fcopy(FromM$ + ".DWG", Too$ + ".DWG", RC%): RC1% = RC1% + RC%
|
||
Call Fcopy(FromM$ + ".PDF", Too$ + ".PDF", RC%): RC1% = RC1% + RC%
|
||
If RC1% = 0 Then
|
||
Call KillIt(FromM$ + ".DWG")
|
||
Call KillIt(FromM$ + ".PDF")
|
||
End If
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I18" ' bad File
|
||
End If
|
||
|
||
ElseIf ItIsAManual(FromM$) Then
|
||
PrintLog "This is a Manual!"
|
||
bad = 0
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
FromM$ = FromD$ + ".pdf"
|
||
|
||
If (ExistsNew(FromM$)) Then ' it has a pdf file so it is a manual
|
||
Foldertype$ = "Manual"
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
cadflag$ = "L"
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I18" ' bad manual
|
||
End If
|
||
|
||
ElseIf ItIsASolidWorksFolder(FromM$ + "\" + left$(Trim$(source$), 7) + ".SLDDRW") Then
|
||
PrintLog "This is a Solid Works Folder!"
|
||
bad = 0
|
||
Foldertype$ = "SolidWorks"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
|
||
FromSolid$ = FromM$ + "\" + left$(Trim$(source$), 7) + ".SLDDRW"
|
||
FromM$ = FromD$ + ".pdf"
|
||
PrintLog "Solid Works must have " + FromM$ + " and "
|
||
PrintLog " FromSolid - " + FromSolid$
|
||
If (ExistsNew(FromM$)) And (ExistsNew(FromSolid$)) Then ' it has a pdf and a slddrw file so it is a SolidWorks File
|
||
Foldertype$ = "Unknown"
|
||
PrintLog "Solid Works is good"
|
||
PrintLog "copying FromF$ to Too$"
|
||
PrintLog "FromF$ >" + FromF$
|
||
PrintLog "Too$ >" + Too$
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
PrintLog "Is there a BOM File?"
|
||
If ExistsNew(Too$ + "\" + Trim$(NewName$) + ".BOM") Then
|
||
PrintLog "Yes: --" + Too$ + "\" + Trim$(NewName$) + ".BOM"
|
||
|
||
frmBOM.txtGood.Text = "False"
|
||
frmBOM.txtAssembly = NewName$
|
||
frmBOM.txtBOM = Too$ + "\" + left$(Trim$(NewName$), 8) + ".BOM"
|
||
Call frmBOM.cmdClearBOM_Click ' clear the old assembly
|
||
Call frmBOM.ReadSolidBOM ' read in the new assembly
|
||
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
|
||
PrintLog "Nope: --" + Too$ + "\" + Trim$(NewName$) + ".BOM"
|
||
End If
|
||
|
||
cadflag$ = "W" 'Solid works Folder
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I17" ' bad solid works folder
|
||
End If
|
||
ElseIf ItIsACBR(FromM$) Then
|
||
PrintLog "This is a CBR Menu Folder!"
|
||
bad = 0
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
FromM$ = FromD$ + ".cbr"
|
||
|
||
If (ExistsNew(FromM$)) Then ' it has a cbr file so it is a good ocb
|
||
Foldertype$ = "CBR"
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
cadflag$ = "L"
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I19" ' bad manual
|
||
End If
|
||
|
||
|
||
ElseIf ItIsAnOCD(FromM$) Then
|
||
PrintLog "This is an OCD!"
|
||
bad = 0
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
FromM$ = FromD$ + ".xlsx"
|
||
Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
|
||
If (ExistsNew(FromM$)) Then ' it has a xlsx file so it is a good OCD folder
|
||
Foldertype$ = "OCD"
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
cadflag$ = "L"
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I18" ' bad ocd
|
||
End If
|
||
ElseIf ItIsAPurchasePart(FromM$) Then
|
||
PrintLog "This is a Purchase Part!"
|
||
bad = 0
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
FromM$ = FromD$ + ".pdf"
|
||
Too$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
|
||
If (ExistsNew(FromM$)) Then ' it has a pdf file so it is a good Purchase Part folder
|
||
Foldertype$ = "Purchase"
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
cadflag$ = ""
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
bad = 1
|
||
Errors$ = "I18" ' bad ocd
|
||
End If
|
||
Else
|
||
PrintLog "Dunno what this is?"
|
||
|
||
PrintLog "FromM$ - " + FromM$
|
||
PrintLog " \Source - " + "\" + Trim$(source$)
|
||
PrintLog ".SLDDRW - " + ".SLDDRW"
|
||
|
||
If ItIsAnAltium(FromM$) Then
|
||
PrintLog "This is an Altium Folder!"
|
||
Foldertype$ = "Unknown"
|
||
FromD$ = FromM$ + "\" + Trim$(NewName$)
|
||
FromF$ = FromM$
|
||
'For an Altium part/board check-in the following files required:
|
||
'
|
||
' folder named for the board
|
||
'
|
||
' U:\8074936D
|
||
'
|
||
' and the files
|
||
' 8074932D.pdf
|
||
' 8074932D.PCBDOC
|
||
' 8074932D.PRJPCB
|
||
'
|
||
' This will place the folder on the Qdrive at<61>
|
||
' Q:\8\8074000\8074936D
|
||
'
|
||
'For an Altium assembly check-in the following files will be required:
|
||
'
|
||
' folder named for the assembly
|
||
'
|
||
' U:\4060007B
|
||
'
|
||
' and the files
|
||
' 4060007B.pdf
|
||
' 4060007B.csv
|
||
'
|
||
' This will place the folder on the Qdrive at<61>
|
||
' Q:\4\4060000\4060007B
|
||
'
|
||
bad = 0
|
||
'decide if this an assembly
|
||
FromM$ = FromD$ + ".csv"
|
||
If (ExistsNew(FromM$)) Then ' it has a csv file so it must be an assembly
|
||
'
|
||
'This is an assembly
|
||
'
|
||
Foldertype$ = "Altium Assembly"
|
||
FromM$ = FromD$ + ".pdf"
|
||
If Not (ExistsNew(FromM$)) Then
|
||
bad = bad + 1
|
||
Errors$ = "I14" ' bad assembly
|
||
Else
|
||
frmBOM.txtGood.Text = "False"
|
||
frmBOM.txtAssembly = NewName$ ' part name
|
||
frmBOM.txtBOM = FromD$ + ".CSV"
|
||
|
||
Call frmBOM.cmdClearBOM_Click ' clear the old assembly
|
||
Call frmBOM.cmdReadAltimaBOM_Click ' read in the new assembly
|
||
|
||
Select Case frmBOM.txtGood.Text
|
||
Case "0" ' good bom
|
||
Case "1" ' bad bom
|
||
bad = bad + 1
|
||
Errors$ = "I16"
|
||
Case "2" ' no bom
|
||
bad = bad + 1
|
||
Errors$ = "I15"
|
||
Case Else ' unknown bom
|
||
bad = bad + 1
|
||
Errors$ = "I16"
|
||
End Select
|
||
End If
|
||
Else
|
||
'
|
||
'This may be a board
|
||
'
|
||
FromM$ = FromD$ + ".pdf"
|
||
If Not (ExistsNew(FromM$)) Then
|
||
bad = bad + 1
|
||
End If
|
||
FromM$ = FromD$ + ".PCBDOC"
|
||
If Not (ExistsNew(FromM$)) Then
|
||
bad = bad + 1
|
||
End If
|
||
FromM$ = FromD$ + ".PRJPCB"
|
||
If Not (ExistsNew(FromM$)) Then
|
||
bad = bad + 1
|
||
End If
|
||
If bad > 0 Then
|
||
Errors$ = "I17" '- missing required files from folder
|
||
Else
|
||
Foldertype$ = "Altium Board"
|
||
End If
|
||
End If
|
||
|
||
If bad = 0 Then
|
||
Call frmFolderCopy.Copydir(FromF$, Too$, rccc%)
|
||
cadflag$ = "L"
|
||
FromM$ = FromF$
|
||
GoSub DeleteIt
|
||
Errors$ = "Copied" ' - already copied it
|
||
Else
|
||
Errors$ = "I14" '- bad assembly
|
||
Errors$ = "I15" '- bad no bom
|
||
Errors$ = "I16" '- bad bom
|
||
End If
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
PrintLog "Move IN Done"
|
||
If Errors$ = "" Then
|
||
Killr$ = Too$
|
||
Tailn$ = ""
|
||
GoSub CopyIt
|
||
|
||
GoSub DeleteIt
|
||
Killr$ = ""
|
||
ElseIf Errors$ = "Copied" Then
|
||
Errors$ = "" ' - already copied it
|
||
End If
|
||
Return
|
||
|
||
MoveBACK:
|
||
'
|
||
' Moves the Drawing from the Main CAD Directory to the User
|
||
'
|
||
Call subsearch(NewName$, subdirect$)
|
||
Too$ = UserDrive$(Directry$) + Trim$(NewName$)
|
||
FromM$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
Killr$ = Too$
|
||
Tailn$ = ".1"
|
||
|
||
PrintLog "MOVE BACK COMMAND (Kick Back)"
|
||
PrintLog "Too$ >" + Too$
|
||
PrintLog "FromM$ >" + FromM$
|
||
PrintLog "Killr$ >" + Killr$
|
||
|
||
PrintLog "Copyit"
|
||
GoSub CopyIt
|
||
|
||
FromM$ = EngrDrive$ + subdirect$ + Trim$(NewName$)
|
||
PrintLog "FromM$ >" + FromM$
|
||
PrintLog "Deleteit"
|
||
GoSub DeleteIt
|
||
|
||
PrintLog "cadflag$ >" + cadflag$
|
||
PrintLog "Lev$ >" + Lev$
|
||
PrintLog "plev$ >" + plev$
|
||
'If ThisIsProE(fromm$) Then
|
||
If cadflag$ <> "F" 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
|
||
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 ExistsNew(kll$ + ".zip") Then
|
||
On Error Resume Next
|
||
Kill kll$ + ".zip"
|
||
On Error GoTo 0
|
||
End If
|
||
If ExistsNew(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
|
||
PrintLog "Deleteit: - subroutine -"
|
||
PrintLog "cadflag$ >" + cadflag$
|
||
If cadflag$ = "P" Then 'P = Proe
|
||
fromm1$ = left$(FromM$, Len(FromM$) - 1)
|
||
PrintLog " Purging Eight files -> "
|
||
PrintLog FromM$ + ".PLT and"
|
||
PrintLog fromm1$ + ".DRW and"
|
||
PrintLog fromm1$ + ".BOM and"
|
||
PrintLog fromm1$ + ".PTD and"
|
||
PrintLog fromm1$ + ".ASM and"
|
||
PrintLog fromm1$ + ".PRT and"
|
||
PrintLog FromM$ + ".PDF"
|
||
PrintLog "<-"
|
||
PurgeIt (FromM$ + ".PLT")
|
||
PurgeIt (fromm1$ + ".DRW")
|
||
PurgeIt (fromm1$ + ".PTD")
|
||
PurgeIt (fromm1$ + ".PRT")
|
||
PurgeIt (fromm1$ + ".BOM")
|
||
PurgeIt (fromm1$ + ".ASM")
|
||
PurgeIt (FromM$ + ".PDF")
|
||
ElseIf cadflag$ = "E" Then 'E = text
|
||
PurgeIt (FromM$ + ".TXT")
|
||
PurgeIt (FromM$ + ".INI")
|
||
ElseIf cadflag$ = "L" Then 'L = Altium
|
||
Call frmFolderCopy.KillDir(FromM$, rccc%)
|
||
ElseIf (cadflag$ = "S") Or (cadflag = "W") Then 'S = Software
|
||
PrintLog " Deleting -> FromM$ >" + FromM$ 'W = Solidworks
|
||
Call frmFolderCopy.KillDir(FromM$, rccc%)
|
||
PrintLog " Deleting -> rccc% >" + Str(rccc%)
|
||
ElseIf cadflag$ = "F" Then 'F = Folder
|
||
Else
|
||
PrintLog " Purging two files -> " + FromM$ + ".DWG and " + FromM$ + ".PDF <-"
|
||
PurgeIt (FromM$ + ".DWG") ' otherwise it is an AutoCad
|
||
PurgeIt (FromM$ + ".PDF")
|
||
|
||
End If
|
||
If (left(source$, 2) = "SW") Or (left(Destin$, 2) = "SW") Or (left(source$, 2) = "AI") Or (left(Destin$, 2) = "AI") Then 'This is special copy (Folder)
|
||
Call frmFolderCopy.KillDir(FromM$, rccc%)
|
||
ElseIf (left(source$, 2) = "PM") Then
|
||
PrintLog " Purging CBR Directory ->"
|
||
PrintLog " Deleting -> FromM$ >" + FromM$
|
||
Call frmFolderCopy.KillDir(FromM$, rccc%) 'CBR Menu
|
||
PrintLog "<-"
|
||
PrintLog " Deleting -> rccc% >" + Str(rccc%)
|
||
End If
|
||
|
||
PrintLog "Main - DeleteIt... deleting file " + FromM$
|
||
' End If
|
||
PrintLog "Deleteit: - return -"
|
||
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" or "W"
|
||
'
|
||
'
|
||
PrintLog "Copyit: - subroutine -"
|
||
PrintLog "cadflag$ >" + cadflag$
|
||
|
||
NoOfFilesMoved = 0
|
||
FileExtCopied$ = ""
|
||
cadflag$ = ""
|
||
HFromm$ = FromM$
|
||
HToo$ = Too$
|
||
|
||
If ExistsNew(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
|
||
GoSub CopyWithCount
|
||
ElseIf (left$(source$, 2) = "PD") Or (left(Destin$, 2) = "PD") Then
|
||
|
||
ExtIT$ = INIorTXT(FromM$)
|
||
|
||
cadflag$ = "E" ' Parameter Data File
|
||
FromM$ = FromM$ + "." + ExtIT$
|
||
Too$ = Too$ + "." + ExtIT$
|
||
|
||
GoSub CopyWithCount
|
||
|
||
ElseIf (left(source$, 2) = "SW") Or (left(Destin$, 2) = "SW") Or (left(source$, 2) = "AI") Or (left(Destin$, 2) = "AI") Then 'This is special copy (Folder)
|
||
cadflag$ = "F" ' Folder Files
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
|
||
ElseIf ItIsACBR(FromM$) Then 'This is CBR copy (Folder)
|
||
cadflag$ = "F" ' Folder Files
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
ElseIf ItIsAnAltium(FromM$) Then
|
||
cadflag$ = "L" ' aLtium file check in
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
ElseIf ItIsASolidWorksFolder(FromM$) Then
|
||
cadflag$ = "W"
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
ElseIf ItIsAManual(FromM$) Then
|
||
cadflag$ = "L" ' Manual check in
|
||
RC% = 0
|
||
FileExtCopied$ = " FLD"
|
||
Else
|
||
cadflag$ = "A" ' Autocad Files
|
||
FromM$ = FromM$ + ".DWG"
|
||
Too$ = Too$ + ".DWG"
|
||
If Killr$ <> "" Then
|
||
Killr$ = Killr$ + ".PS"
|
||
If Not KillIt(Killr$) Then PrintLog "---------- Failed to delete " + Killr$ + " Killing .ps file"
|
||
End If
|
||
If Killr$ <> "" Then
|
||
Killr$ = Killr$ + ".PDF"
|
||
If Not KillIt(Killr$) Then PrintLog "---------- Failed to delete " + Killr$ + " Killing .pdf file"
|
||
End If
|
||
GoSub CopyWithCount
|
||
End If
|
||
|
||
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!!!!!!
|
||
'
|
||
Fromm2$ = fromm1$
|
||
Too2$ = Too1$
|
||
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$ = Fromm2$ + ".PDF" 'with revision
|
||
Too$ = Too2$ + ".PDF" 'no tail
|
||
GoSub CopyWithCount
|
||
|
||
FromM$ = fromm1$ + ".BOM"
|
||
Too$ = Too1$ + ".BOM" + Tailn$
|
||
GoSub CopyWithCount
|
||
|
||
FromM$ = fromm1$ + ".ASM"
|
||
Too$ = Too1$ + ".ASM" + Tailn$
|
||
GoSub CopyWithCount
|
||
Case "F"
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
If rccc% <> 0 Then
|
||
Errors$ = "C01"
|
||
End If
|
||
|
||
Case "L", "S", "W" ' this is an altium copy or Solid works Folder
|
||
FromM$ = HFromm$
|
||
Too$ = HToo$
|
||
Call frmFolderCopy.Copydir(FromM$, Too$, rccc%)
|
||
|
||
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
|
||
PrintLog "CopyWCount frm->" + FromM$
|
||
PrintLog " to->" + Too$
|
||
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 #14 'using #14
|
||
Print #14, " I HAVE BEEN TERMINATED"
|
||
Close #14
|
||
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 (ExistsNew(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 ExistsNew(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$
|
||
frmMain.lstError.AddItem Err.Description
|
||
frmMain.lstError.AddItem Trim(Str(Err.Number))
|
||
Resume StartError_Exit
|
||
|
||
End Sub
|
||
Private Function ItIsAnAltium(fldr$) As Boolean
|
||
isit = False
|
||
If ItIsAFolder(fldr$) Then 'This might be an altium file
|
||
If (left(source$, 2) = "SW") Or (left(Destin$, 2) = "SW") Or (left(source$, 2) = "AI") Or (left(Destin$, 2) = "AI") Then 'This is special copy (Folder)
|
||
isit = False
|
||
Else
|
||
isit = True
|
||
End If
|
||
End If
|
||
ItIsAnAltium = isit
|
||
End Function
|
||
Private Function ItIsACBR(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this an CBR(PM) folder? - " + fldr$
|
||
If ItIsAFolder(fldr$) Then 'This might be an CBR folder
|
||
If InStr(fldr$, "\PM") <> 0 Then 'This is CBR (Folder)
|
||
isit = True
|
||
Else
|
||
isit = False
|
||
End If
|
||
End If
|
||
ItIsACBR = isit
|
||
End Function
|
||
Private Function ItIsAManual(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this an Manual? - " + fldr$
|
||
If ItIsAFolder(fldr$) Then 'This might be a manual
|
||
If (left(source$, 3) = "819") Then 'This is special copy (Folder)
|
||
isit = True
|
||
End If
|
||
End If
|
||
ItIsAManual = isit
|
||
|
||
End Function
|
||
Private Function ItIsAnOCD(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this an OCD? - " + fldr$
|
||
If ItIsAFolder(fldr$) Then 'This might be an OCD folder
|
||
If (left(source$, 3) = "OCD") Then 'This is special copy (Folder)
|
||
isit = True
|
||
End If
|
||
End If
|
||
ItIsAnOCD = isit
|
||
|
||
End Function
|
||
Private Function ItIsAPurchasePart(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this a Purchase Part? - " + fldr$
|
||
PrintLog "Are there the two associated Folers? - " + fldr$ + "\CM_Mfg_Pkg and " + fldr$ + "\FRY_Proj_Pkg"
|
||
|
||
If ItIsAFolder(fldr$) Then 'This might be an OCD folder
|
||
If (ItIsAFolder(fldr$ + "\CM_Mfg_Pkg")) And (ItIsAFolder(fldr$ + "\FRY_Proj_Pkg")) Then
|
||
isit = True
|
||
PrintLog ("YEP!")
|
||
End If
|
||
End If
|
||
|
||
ItIsAPurchasePart = isit
|
||
|
||
End Function
|
||
Private Function ItIsAnAutoCad(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this an AUTOCAD? - " + fldr$ + ".DWG"
|
||
|
||
If ExistsNew(fldr$ + ".DWG") Then
|
||
isit = True
|
||
PrintLog "It is an AUTOCAD! - " + fldr$ + ".DWG"
|
||
End If
|
||
ItIsAnAutoCad = isit
|
||
|
||
End Function
|
||
Private Function ItIsAMENUFolder(fldr$) As Boolean
|
||
isit = False
|
||
PrintLog "is this a Menu? - " + fldr$
|
||
If ItIsAFolder(fldr$) Then 'This might be a manual
|
||
If (left(source$, 2) = "MN") Then 'This is special copy (Folder)
|
||
isit = True
|
||
End If
|
||
End If
|
||
ItIsAMENUFolder = isit
|
||
|
||
End Function
|
||
Private Function ItIsASolidWorksFolder(fln$) As Boolean
|
||
isit = False
|
||
PrintLog "is this a SolidWorks? - " + fln$
|
||
|
||
fldr$ = BreakFileName(fln$, 1)
|
||
PrintLog "fldr$ - " + fldr$
|
||
If ItIsAFolder(fldr$) Then 'This might be a manual
|
||
If ExistsNew(fln$) Then 'This is special copy (Folder)
|
||
isit = True
|
||
End If
|
||
End If
|
||
ItIsASolidWorksFolder = isit
|
||
|
||
End Function
|
||
Private Function ItIsAFolder(fldr$) As Boolean
|
||
Dim fsosub As New FileSystemObject
|
||
ItIsAFolder = fsosub.FolderExists(fldr$)
|
||
End Function
|
||
|
||
Public Sub Messages(a$)
|
||
On Error GoTo Message_Error
|
||
Open MessageLogName$ For Append As #10 ' using #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 Function UserDrive$(UserNam$)
|
||
' UD$ = "\\fm1\eng\users\" + Trim(UserNam$) + "\"
|
||
UD$ = NETDRV + "\eng\users\" + Trim(UserNam$) + "\"
|
||
For ExN% = 0 To Exusers%
|
||
If ExNames$(ExN%, 1) = UCase(UserNam$) Then
|
||
UD$ = pathCheck(ExNames$(ExN%, 2)) + Trim(UserNam$) + "\"
|
||
Exit For
|
||
End If
|
||
Next
|
||
UserDrive$ = UD$
|
||
End Function
|
||
|
||
Public Sub InitVars()
|
||
frmMain.Caption = "Command Processor"
|
||
frmMain.lblfrmMain.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
|
||
' EngrDrive$ = "\\fm1\eng\eng\drawings"
|
||
' IEDrive$ = "\\fm1\eng\depts\IE"
|
||
' 'MainPath$ = ""
|
||
' temppath$ = "C:\"
|
||
' PROEPath$ = "\\fm1\eng\users\286\proe\"
|
||
|
||
NetWPath$ = NETDRV + "\eng\users\cadprint\"
|
||
MainPath$ = "C:\Work"
|
||
ChDir MainPath$
|
||
MainPath$ = MainPath$ + "\"
|
||
CQueSize% = 250
|
||
Constipation% = 0
|
||
|
||
EngrDrive$ = NETDRAW
|
||
|
||
IEDrive$ = NETDRV + "\eng\depts\IE"
|
||
|
||
'MainPath$ = ""
|
||
temppath$ = "C:\Files\buffers\"
|
||
PROEPath$ = NETDRV + "\eng\users\286\proe\"
|
||
|
||
|
||
|
||
MessageFileName$ = NetWPath$ + "CADPRINT.MSG"
|
||
MessageLogName$ = NetWPath$ + "CADPRINT.LOG"
|
||
MessageLogName2$ = NetWPath$ + "CADPRINT2.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"
|
||
BufferName$ = temppath$ + "CMDBF"
|
||
'
|
||
PROEComplete$ = PROEPath$ + "COMPLETE.QUE"
|
||
PROEWait$ = PROEPath$ + "WAIT.QUE"
|
||
PROEIncome$ = PROEPath$ + "INCOME.QUE"
|
||
PROECH$ = PROEPath$ + "HOLD.QUE"
|
||
PROEReply$ = PROEPath$ + "REPLY.QUE"
|
||
PROERPCM$ = PROEPath$ + "RCM.Que"
|
||
'
|
||
OddCondition = 10
|
||
'
|
||
ToName = "QUEUE MANAGER" ' Application to Connect to
|
||
MyName = "Command Processor" ' This Application window
|
||
'
|
||
frmMain.lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found" 'Status message
|
||
'
|
||
' Program
|
||
'
|
||
On Error Resume Next
|
||
Open MessageFileName$ For Output As #22 'using #22
|
||
Print #22, " I AM RUNNING"
|
||
Close #22
|
||
On Error GoTo 0
|
||
lptI% = 0
|
||
pltI% = 0
|
||
|
||
Lpt$(0) = "LPT1"
|
||
PrinterGroup$(0) = "0"
|
||
Tray$(0) = "UT"
|
||
|
||
Call LoadPrinters
|
||
Call LoadPlot
|
||
Call LoadSubDirs
|
||
Call GetExternalUsersFile
|
||
Call LatestFileNumber
|
||
|
||
frmMain.cboMoveQUE.Clear
|
||
For ixtab = 0 To frmMain.SSTab1.Tabs - 1
|
||
frmMain.cboMoveQUE.AddItem frmMain.SSTab1.TabCaption(ixtab)
|
||
Next
|
||
frmMain.cboMoveQUE.Text = frmMain.SSTab1.TabCaption(0)
|
||
frmMain.lblFromTab.Caption = frmMain.SSTab1.TabCaption(0)
|
||
frmMain.lblFromTab.Tag = "0"
|
||
frmMain.Timer1.Interval = Val(frmMain.txtCheckFileFreq.Text)
|
||
|
||
|
||
frmMain.processTimer.Enabled = True ' Timer to process incoming messages
|
||
frmMain.sendTimer.Enabled = True ' Timer to send out going responses
|
||
|
||
End Sub
|
||
|
||
Public Sub PrintLog(a$)
|
||
frmMain.LstPrint.AddItem a$
|
||
If frmMain.LstPrint.ListCount > 1600 Then
|
||
frmMain.LstPrint.RemoveItem 0
|
||
End If
|
||
DoEvents
|
||
|
||
On Error GoTo Message_Error2
|
||
Open MessageLogName2$ For Append As #9 ' using #10
|
||
Print #9, UCase$(Format$(Now, "DD-MMM-YY HH:MM:SS == ")) + a$
|
||
Close #9
|
||
Message_Exit2:
|
||
Exit Sub
|
||
Message_Error2:
|
||
frmMain.lstError.AddItem Date$ + " " + Time$ + "Message Error"
|
||
Resume Message_Exit2
|
||
|
||
|
||
End Sub
|
||
Public Sub LatestFileNumber()
|
||
frmMain.filBuffers.Path = temppath$
|
||
frmMain.filBuffers.Refresh
|
||
mx = 0
|
||
For ix = 0 To frmMain.filBuffers.ListCount - 1
|
||
ax$ = frmMain.filBuffers.List(ix)
|
||
If InStr(ax$, "CMDBF") <> 0 Then
|
||
vl = Val(Mid(ax$, 6))
|
||
If vl > mx Then mx = vl
|
||
KillIt (temppath$ + ax$)
|
||
End If
|
||
Next
|
||
TogCount = mx
|
||
frmMain.lblTog.Caption = Str(TogCount)
|
||
End Sub
|
||
|
||
Public Function ThisIsProE(x$)
|
||
tx% = ExistsNew(x$ + ".PLT")
|
||
ThisIsProE = tx%
|
||
End Function
|
||
|
||
Public Function PurgeIt(a$)
|
||
On Error Resume Next
|
||
If ExistsNew(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 (ExistsNew("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()
|
||
On Error GoTo Flush_Err
|
||
If ((replies2 <> 0)) Then
|
||
If (Not (ExistsNew(ReplyComplete$))) And (Not (ExistsNew(Reply$))) Then
|
||
Open Reply$ For Output As #5
|
||
Call Dumper("------Flushing------")
|
||
For rpx = 1 To replies2
|
||
Print #5, replys2$(rpx)
|
||
Call Dumper(replys2$(rpx))
|
||
Next
|
||
Close #5
|
||
Call Dumper("--------------------")
|
||
Call Fcopy(ReplyComplete2$, ReplyComplete$, RC%)
|
||
replies2 = 0
|
||
frmMain.lstReply2.Clear
|
||
Else
|
||
If (Not (ExistsNew(ReplyComplete$))) And (ExistsNew(Reply$)) Then
|
||
Call Dumper("----for some reason replies exist and reply complete doesnt----")
|
||
Call Dumper("----so we are making a new reply complete to send the replys---")
|
||
Call Fcopy(ReplyComplete2$, ReplyComplete$, RC%)
|
||
End If
|
||
End If
|
||
|
||
End If
|
||
Flush_End:
|
||
Exit Sub
|
||
Flush_Err:
|
||
frmMain.FileErrInd = True
|
||
frmMain.ErrorCondition.Caption = "Flush Fail"
|
||
Resume Flush_End
|
||
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
|
||
|
||
Public Function INIorTXT$(fln$)
|
||
RC$ = "TXT"
|
||
If ExistsNew(fln$ + ".INI") Then
|
||
RC$ = "INI"
|
||
End If
|
||
INIorTXT$ = RC$
|
||
End Function
|
||
Public Sub Dumper(st$)
|
||
If frmMain.chkDumper.value = 1 Then
|
||
Open "C:\files\CommandP.log" For Append As #9
|
||
Print #9, Date$ + " " + Time$ + " " + st$
|
||
Close #9
|
||
End If
|
||
End Sub
|