commit 293c16e22006e707463dbea4d9b958e1c1bbb8a6 Author: Ryland Date: Wed Dec 18 13:56:36 2024 -0600 first commit diff --git a/APIGID32.BAS b/APIGID32.BAS new file mode 100644 index 0000000..afc7f2d --- /dev/null +++ b/APIGID32.BAS @@ -0,0 +1,105 @@ +Attribute VB_Name = "APIGuide32" +Option Explicit +' ------------------------------------------------------------------------ +' +' APIGID32.BAS -- APIGID32.DLL API Declarations for Visual Basic +' +' Copyright (C) 1992-1996 Desaware +' +' You have a royalty-free right to use, modify, reproduce and distribute +' this file (and/or any modified version) in any way you find useful, +' provided that you agree that Desaware and Ziff-Davis Press has no +' warranty, obligation or liability for its contents. +' Refer to the Ziff-Davis Visual Basic Programmer's Guide to the +' Win32 API for further information. +' +' ------------------------------------------------------------------------ +Type POINTS + x As Integer + y As Integer +End Type + +Private Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long +End Type + +#If Win32 Then +Declare Function agGetInstance& Lib "apigid32.dll" () +Declare Function agPOINTStoLong& Lib "apigid32.dll" (pt As POINTS) +Declare Sub agCopyData Lib "apigid32.dll" (source As Any, dest As Any, ByVal nCount&) +Declare Sub agCopyDataBynum Lib "apigid32.dll" Alias "agCopyData" (ByVal source&, ByVal dest&, ByVal nCount&) +Declare Function agGetAddressForObject& Lib "apigid32.dll" (object As Any) +Declare Function agGetAddressForInteger& Lib "apigid32.dll" Alias "agGetAddressForObject" (intnum%) +Declare Function agGetAddressForLong& Lib "apigid32.dll" Alias "agGetAddressForObject" (intnum&) +Declare Function agGetAddressForLPSTR& Lib "apigid32.dll" Alias "agGetAddressForObject" (ByVal lpstring$) ' See warning! +Declare Function agGetAddressForVBString& Lib "apigid32.dll" (vbstring$) +Declare Function agGetStringFrom2NullBuffer$ Lib "apigid32.dll" (ByVal ptr&) +Declare Function agGetStringFromLPSTR$ Lib "apigid32.dll" (ByVal src$) +Declare Function agGetStringFromPointer$ Lib "apigid32.dll" Alias "agGetStringFromLPSTR" (ByVal ptr&) +Declare Function agSwapBytes% Lib "apigid32.dll" (ByVal src%) +Declare Function agSwapWords& Lib "apigid32.dll" (ByVal src&) +Declare Function agMakeROP4& Lib "apigid32.dll" (ByVal foreground&, ByVal background&) +Declare Function agGetWndInstance& Lib "apigid32.dll" (ByVal hwnd&) +Declare Function agDWORDto2Integers& Lib "apigid32.dll" (ByVal l&, lw%, lh%) +Declare Function agIsValidName& Lib "apigid32.dll" (ByVal o As Object, ByVal lpname$) +Declare Function agInp% Lib "apigid32.dll" (ByVal portid%) +Declare Function agInpw% Lib "apigid32.dll" (ByVal portid%) +Declare Function agInpd& Lib "apigid32.dll" (ByVal portid%) +Declare Sub agOutp Lib "apigid32.dll" (ByVal portid%, ByVal outval%) +Declare Sub agOutpw Lib "apigid32.dll" (ByVal portid%, ByVal outval%) +Declare Sub agOutpd Lib "apigid32.dll" (ByVal portid%, ByVal outval&) + +' Declared As Any to allow it to be used within classes, not to mention by other +' double long structures +Declare Sub agSubtractFileTimes Lib "apigid32.dll" (f1 As Any, f2 As Any, f3 As Any) +Declare Sub agAddFileTimes Lib "apigid32.dll" (f1 As Any, f2 As Any, f3 As Any) +Declare Sub agNegateFileTime Lib "apigid32.dll" (f1 As Any) +Declare Function agConvertFileTimeToDouble Lib "apigid32.dll" (f1 As Any) As Double +Declare Sub agConvertDoubleToFileTime Lib "apigid32.dll" (ByVal d As Double, f1 As Any) + +#Else +' Note, not all 16 bit declarations have equivalent 32 bit functions +' and vice versa. Nor is their behavior always identical. +' Refer to the Visual Basic Programmer's Guide to the Windows API (16 bit) +' for documentation on the following functions + +Global Const CTLFLG_USESPALETTE% = 2 +Global Const CTLFLG_HASPALETTE% = 1 + + +Declare Function agGetControlHwnd% Lib "Apiguide.dll" (hctl As Control) +Declare Function agGetInstance% Lib "Apiguide.dll" () +Declare Sub agCopyData Lib "Apiguide.dll" (source As Any, dest As Any, ByVal nCount%) +Declare Sub agCopyDataBynum Lib "Apiguide.dll" Alias "agCopyData" (ByVal source&, ByVal dest&, ByVal nCount%) +Declare Function agGetAddressForObject& Lib "Apiguide.dll" (object As Any) +Declare Function agGetAddressForInteger& Lib "Apiguide.dll" Alias "agGetAddressForObject" (intnum%) +Declare Function agGetAddressForLong& Lib "Apiguide.dll" Alias "agGetAddressForObject" (intnum&) +Declare Function agGetAddressForLPSTR& Lib "Apiguide.dll" Alias "agGetAddressForObject" (ByVal lpstring$) +Declare Function agGetAddressForVBString& Lib "Apiguide.dll" (vbstring$) +Declare Function agGetStringFromLPSTR$ Lib "Apiguide.dll" (ByVal lpstring$) +Declare Function agGetControlName$ Lib "Apiguide.dll" (ByVal hwnd%) +Declare Function agPOINTAPItoLong& Lib "Apiguide.dll" (pt As POINTAPI) +Declare Function agPOINTStoLong& Lib "Apiguide.dll" Alias "agPOINTAPItoLong" (pt As POINTS) +Declare Sub agDWORDto2Integers Lib "Apiguide.dll" (ByVal l&, lw%, lh%) +Declare Function agXPixelsToTwips& Lib "Apiguide.dll" (ByVal pixels%) +Declare Function agYPixelsToTwips& Lib "Apiguide.dll" (ByVal pixels%) +Declare Function agXTwipsToPixels% Lib "Apiguide.dll" (ByVal twips&) +Declare Function agYTwipsToPixels% Lib "Apiguide.dll" (ByVal twips&) +Declare Function agDeviceCapabilities& Lib "Apiguide.dll" (ByVal hlib%, ByVal lpszDevice$, ByVal lpszPort$, ByVal fwCapability%, ByVal lpszOutput&, ByVal lpdm&) +Declare Function agDeviceMode% Lib "Apiguide.dll" (ByVal hwnd%, ByVal hModule%, ByVal lpszDevice$, ByVal lpszOutput$) +Declare Function agExtDeviceMode% Lib "Apiguide.dll" (ByVal hwnd%, ByVal hDriver%, ByVal lpdmOutput&, ByVal lpszDevice$, ByVal lpszPort$, ByVal lpdmInput&, ByVal lpszProfile&, ByVal fwMode%) +Declare Function agInp% Lib "Apiguide.dll" (ByVal portid%) +Declare Function agInpw% Lib "Apiguide.dll" (ByVal portid%) +Declare Sub agOutp Lib "Apiguide.dll" (ByVal portid%, ByVal outval%) +Declare Sub agOutpw Lib "Apiguide.dll" (ByVal portid%, ByVal outval%) +Declare Function agHugeOffset& Lib "Apiguide.dll" (ByVal addr&, ByVal offset&) +Declare Function agVBGetVersion% Lib "Apiguide.dll" () +Declare Function agVBSendControlMsg& Lib "Apiguide.dll" (ctl As Control, ByVal msg%, ByVal wp%, ByVal lp&) +Declare Function agVBSetControlFlags& Lib "Apiguide.dll" (ctl As Control, ByVal mask&, ByVal value&) +Declare Sub agVBScreenToClient Lib "Apiguide.dll" (ctl As Control, pap As POINTS) +Declare Sub agVBClientToScreen Lib "Apiguide.dll" (ctl As Control, pap As POINTS) +Declare Function dwVBSetControlFlags& Lib "Apiguide.dll" (ctl As Control, ByVal mask&, ByVal value&) + +#End If + diff --git a/CMNDPROC.BAS b/CMNDPROC.BAS new file mode 100644 index 0000000..050a24d --- /dev/null +++ b/CMNDPROC.BAS @@ -0,0 +1,2423 @@ +Attribute VB_Name = "Main" +DefInt A-Z +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” + ' 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” + ' 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 diff --git a/CMNDPROC.PDM b/CMNDPROC.PDM new file mode 100644 index 0000000..a3a693a --- /dev/null +++ b/CMNDPROC.PDM @@ -0,0 +1,119 @@ +[Root] +Most Recent Package=Standard Setup Package 1 + + +[Package|Standard Setup Package 1|Root] +SubWizProgID=PDWizard.SetupPkgSubWiz +BuildFolder=u:\QCOMMAND\NewCMD\setup + +[Package|Standard Setup Package 1|Configure DAO ISAMs] +Applicable=No + +[Package|Standard Setup Package 1|Configure DAO ODBC] +JetWorkspace= +ODBCDirect= + +[Package|Standard Setup Package 1|Files Found] + +[Package|Standard Setup Package 1|Files Released] +Apiguide.dll= + +[Package|Standard Setup Package 1|Missing Dependency Information] +C:\Program Files\Common Files\System\ado\msado25.tlb= +C:\WINDOWS\system32\apigid32.dll= + +[Package|Standard Setup Package 1|Out-of-Date Dependency Information] +C:\WINDOWS\system32\TABCTL32.OCX= +C:\WINDOWS\system32\scrrun.dll= +C:\WINDOWS\system32\MSSTDFMT.DLL= + +[Package|Standard Setup Package 1|Files Added] + +[Package|Standard Setup Package 1|Files Removed] + +[Package|Standard Setup Package 1|Files In Project] +C:\WINDOWS\system32\msvbvm60.dll=Yes +C:\WINDOWS\system32\oleaut32.dll=Yes +C:\WINDOWS\system32\olepro32.dll=Yes +C:\WINDOWS\system32\asycfilt.dll=Yes +C:\WINDOWS\system32\stdole2.tlb=Yes +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\Redist\COMCAT.DLL=Yes +C:\WINDOWS\system32\apigid32.dll=Yes +C:\WINDOWS\system32\MSBIND.DLL=Yes +C:\WINDOWS\system32\MSSTDFMT.DLL=Yes +C:\Program Files\Common Files\System\ado\msado25.tlb=Yes +C:\WINDOWS\system32\scrrun.dll=Yes +C:\WINDOWS\system32\msvcrt.dll=Yes +C:\WINDOWS\system32\COMCTL32.OCX=Yes +C:\WINDOWS\system32\TABCTL32.OCX=Yes +C:\WINDOWS\system32\MSADODC.OCX=Yes +C:\WINDOWS\system32\MSDatGrd.ocx=Yes +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\SETUP.EXE=Yes +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\SETUP1.EXE=Yes +C:\WINDOWS\system32\VB6STKIT.DLL=Yes +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\ST6UNST.EXE=Yes +U:\QCOMMAND\NewCMD\Cmndproc 2014-04-09.exe=Yes +C:\ccrpftv6-10\ccrpftv6.ocx=Yes + +[Package|Standard Setup Package 1|Configure Registry Files] +Applicable=No + +[Package|Standard Setup Package 1|Configure Remote Servers] +Applicable=No + +[Package|Standard Setup Package 1|Install Locations] +\\Fm1\eng\USERS\286\CMNDPROC\Cmndproc17OCT2012.exe=$(AppPath) +C:\WINDOWS\system32\msvbvm60.dll=$(WinSysPathSysFile) +C:\WINDOWS\system32\oleaut32.dll=$(WinSysPathSysFile) +C:\WINDOWS\system32\olepro32.dll=$(WinSysPathSysFile) +C:\WINDOWS\system32\asycfilt.dll=$(WinSysPathSysFile) +C:\WINDOWS\system32\stdole2.tlb=$(WinSysPathSysFile) +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\Redist\COMCAT.DLL=$(WinSysPathSysFile) +C:\WINDOWS\system32\apigid32.dll=$(WinSysPath) +C:\WINDOWS\system32\MSBIND.DLL=$(WinSysPath) +C:\WINDOWS\system32\MSSTDFMT.DLL=$(WinSysPath) +C:\Program Files\Common Files\System\ado\msado25.tlb=$(WinSysPath) +C:\WINDOWS\system32\scrrun.dll=$(WinSysPath) +C:\WINDOWS\system32\msvcrt.dll=$(WinSysPathSysFile) +C:\WINDOWS\system32\COMCTL32.OCX=$(WinSysPath) +C:\WINDOWS\system32\TABCTL32.OCX=$(WinSysPath) +C:\WINDOWS\system32\MSADODC.OCX=$(WinSysPath) +C:\WINDOWS\system32\MSDatGrd.ocx=$(WinSysPath) +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\SETUP.EXE=$(AppPath) +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\SETUP1.EXE=$(WinPath) +C:\WINDOWS\system32\VB6STKIT.DLL=$(WinSysPathSysFile) +C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\ST6UNST.EXE=$(WinPath) +U:\QCOMMAND\NewCMD\Cmndproc 2014-04-09.exe=$(AppPath) +C:\ccrpftv6-10\ccrpftv6.ocx=$(AppPath) + +[Package|Standard Setup Package 1|Configure Shared Files] +Applicable=Yes +\\Fm1\eng\USERS\286\CMNDPROC\Cmndproc17OCT2012.exe=No +U:\QCOMMAND\NewCMD\Cmndproc 2014-04-09.exe=No +C:\ccrpftv6-10\ccrpftv6.ocx=No + +[Package|Standard Setup Package 1|Distribution] +Type=single +Size= +Title=Cmndproc + +[Package|Standard Setup Package 1|IconGroups] +Group0=Cmndproc +PrivateGroup0=True +Parent0=$(Programs) + +[Package|Standard Setup Package 1|Cmndproc] +Icon1=Cmndproc17OCT2012.exe +Title1=Cmndproc +StartIn1=$(AppPath) +Key1=Icon1 + +[Package|Standard Setup Package 1|Package] +PackageFolder=u:\QCOMMAND\NewCMD\setup +ProjectFolder=U:\QCOMMAND\NewCMD +ServerSideCab= +File1=u:\QCOMMAND\NewCMD\setup\setup.exe +File2=u:\QCOMMAND\NewCMD\setup\Setup.Lst +File3=u:\QCOMMAND\NewCMD\setup\Cmndproc 2014-04-09.CAB +Handler1=PDWizard.FolderDplySubWiz +Handler2=PDWizard.WebPostDplySubWiz diff --git a/CMNDPROC.VBP b/CMNDPROC.VBP new file mode 100644 index 0000000..18051ff --- /dev/null +++ b/CMNDPROC.VBP @@ -0,0 +1,64 @@ +Type=Exe +Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#C:\Windows\System32\msbind.dll#Microsoft Data Binding Collection +Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#C:\Program Files\Common Files\System\ado\msado25.tlb#Microsoft ActiveX Data Objects 2.5 Library +Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\Windows\system32\scrrun.dll#Microsoft Scripting Runtime +Reference=*\G{19B7F2A2-1610-11D3-BF30-1AF820524153}#1.2#0#C:\Program Files\Cmndproc\ccrpftv6.ocx#CCRP FolderTreeview Control (VB6) +Object={BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0; Tabctl32.ocx +Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; MSADODC.OCX +Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; MSDATGRD.OCX +Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX +Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX +Form=Cmdproc-3.frm +Module=Main; CMNDPROC.BAS +Module=MyFunctions; ..\..\vbsubs\Myfunc.bas +Form=Cmdproc-4.frm +Form=Cmdproc-1.frm +Form=Cmdproc-2.frm +Class=dwPortInfo; DWPORT.CLS +Class=dwPrinterInfo; DWPRINFO.CLS +Class=dwPrintMonitor; DWPRMON.CLS +Class=dwSpool; DWSPOOL.CLS +Form=SPOOLER1.FRM +Module=APIGuide32; APIGID32.BAS +Module=PrinterConstants; SPPRINT.BAS +Module=dwTypes; SPTYPES.BAS +Form=filewatch.frm +Form=Cmdproc-5.frm +Form=Cmdproc-6.frm +Class=ClearBOM; ClearBom.cls +Form=Pdf.frm +Module=InnerTaskComm; ..\..\vbsubs\InnerTaskComm.bas +Form=..\..\vbsubs\frmMonitorNib.frm +IconForm="frmMain" +Startup="frmStart" +HelpFile="" +Title="Cmndproc" +ExeName32="Cmndproc 2023-05-26.exe" +Command32="" +Name="CommandProcessor" +HelpContextID="0" +CompatibleMode="0" +MajorVer=7 +MinorVer=0 +RevisionVer=73 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Enterprise Computing Services, Inc." +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/CMNDPROC.vbw b/CMNDPROC.vbw new file mode 100644 index 0000000..6583931 --- /dev/null +++ b/CMNDPROC.vbw @@ -0,0 +1,21 @@ +frmStart = 132, 132, 946, 457, , 176, 176, 1023, 674, C +Main = 83, 8, 1180, 396, +MyFunctions = 122, 4, 969, 502, +frmCheckAssembly = 0, 0, 1096, 388, , 198, 198, 1045, 696, C +frmMain = 65, 66, 1163, 454, , 110, 171, 957, 669, C +frmQueHandler = 22, 22, 1119, 410, , 220, 220, 1067, 718, C +dwPortInfo = 0, 0, 0, 0, C +dwPrinterInfo = 22, 22, 1118, 410, +dwPrintMonitor = 0, 0, 0, 0, C +dwSpool = 44, 44, 1140, 432, +frmPSSpooler = 44, 44, 1141, 432, , 242, 242, 1089, 740, C +APIGuide32 = 0, 0, 0, 0, C +PrinterConstants = 66, 66, 1162, 454, +dwTypes = 0, 0, 0, 0, C +frmFileWatch = 154, 154, 1001, 652, C, 0, 0, 847, 498, C +frmBOM = 0, 0, 0, 0, C, 22, 22, 869, 520, C +frmFolderCopy = 85, 11, 1181, 399, , 44, 44, 891, 542, C +ClearBOM = 88, 88, 1184, 476, +frmPDF = 88, 88, 935, 586, C, 66, 66, 913, 564, C +InnerTaskComm = 0, 0, 1097, 388, +frmMonitorNib = 132, 132, 925, 455, , 88, 88, 935, 586, C diff --git a/ClearBom.cls b/ClearBom.cls new file mode 100644 index 0000000..e204710 --- /dev/null +++ b/ClearBom.cls @@ -0,0 +1,95 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "ClearBOM" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'********************************************************************** +' IBM grants you a nonexclusive license to use this as an example +' from which you can generate similar function tailored to your own +' specific needs. This sample is provided in the form of source +' material which you may change and use. +' If you change the source, it is recommended that you first copy +' the source to a different directory. This will ensure that your +' changes are preserved when the tool kit contents are changed by +' IBM. +' +' DISCLAIMER +' ------------- +' +' This sample code is provided by IBM for illustrative purposes +' only. These examples have not been thoroughly tested under all +' conditions. IBM, therefore, cannot guarantee or imply reliability, +' serviceability, or function of these programs. All programs +' contained herein are provided to you "AS IS" without any +' warranties of any kind. ALL WARRANTIES, INCLUDING BUT NOT +' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +' FOR A PARTICULAR PURPOSE, ARE EXPRESSLY DISCLAIMED. +' +' Your license to this sample code provides you no right or licenses +' to any IBM patents. IBM has no obligation to defend or indemnify +' against any claim of infringement, including but not limited to: +' patents, copyright, trade secret, or intellectual property rights +' of any kind. +' +' COPYRIGHT +' --------- +' (C) Copyright IBM CORP. 1997, 1998 +' All rights reserved. +' US Government Users Restricted Rights - +' Use, duplication or disclosure restricted +' by GSA ADP Schedule Contract with IBM Corp. +' Licensed Material - Property of IBM +'********************************************************************* +Public cnRCHAS002 As New ADODB.Connection +Public cm_ACTIVEXSDK_CUSTINS As New ADODB.Command +Public Sub Connect() +Dim systemName As String + systemName = "qhal" + If systemName = "" Then + MsgBox ("No system name entered. Ending program.") + End + End If + cnRCHAS002.Open "Provider=IBMDA400;Data Source=" & systemName & ";", "EGNETLINK", "DRAWINGS" +End Sub +Public Sub Prepare() + Set cm_ACTIVEXSDK_CUSTINS.ActiveConnection = cnRCHAS002 + cm_ACTIVEXSDK_CUSTINS.CommandText = "{{call /QSYS.LIB/OBJLIB.LIB/EGR465.PGM(?,?,?)}}" + cm_ACTIVEXSDK_CUSTINS.Prepared = True + cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("PN", adChar, adParamInputOutput, 15) + cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("RV", adChar, adParamInputOutput, 1) + cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("RC", adChar, adParamInputOutput, 2) +End Sub +Public Sub OpenLinks() +Dim Rcds As Variant +Dim Parms As Variant + Const DBPROPVAL_UP_CHANGE = 1 + Const DBPROPVAL_UP_DELETE = 2 + Const DBPROPVAL_UP_INSERT = 4 +End Sub +Public Sub Execute() +Dim Rcds As Variant +Dim Parms As Variant + Parms = Array("", "", "") + cm_ACTIVEXSDK_CUSTINS.Execute Rcds, Parms, adCmdText + cnRCHAS002.Execute "{{CHGCURLIB CURLIB(ACTIVEXSDK)}}", Rcds, adCmdText +End Sub + +Private Sub Class_Initialize() + Call Connect + Call Prepare + Call OpenLinks +End Sub +Private Sub Class_Terminate() + Set cm_ACTIVEXSDK_CUSTINS = Nothing + If Not cnRCHAS002 Is Nothing Then cnRCHAS002.Close +End Sub + + diff --git a/Cmdproc-1.frm b/Cmdproc-1.frm new file mode 100644 index 0000000..66dfa78 --- /dev/null +++ b/Cmdproc-1.frm @@ -0,0 +1,1353 @@ +VERSION 5.00 +Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "Tabctl32.ocx" +Begin VB.Form frmMain + ClientHeight = 11205 + ClientLeft = 12270 + ClientTop = 915 + ClientWidth = 13110 + ControlBox = 0 'False + Icon = "Cmdproc-1.frx":0000 + LinkTopic = "Form1" + PaletteMode = 1 'UseZOrder + ScaleHeight = 11205 + ScaleWidth = 13110 + Begin VB.TextBox txtMonitor + Alignment = 2 'Center + Height = 285 + Left = 10200 + TabIndex = 80 + Text = "wdtCommandProcessor" + Top = 0 + Width = 1875 + End + Begin VB.CommandButton cmdClearSpoolFiles + Caption = "Clear Spool Files" + Height = 255 + Left = 4740 + TabIndex = 79 + Top = 7200 + Width = 1335 + End + Begin VB.FileListBox filBuffers + Height = 480 + Left = 11280 + TabIndex = 77 + Top = 8220 + Visible = 0 'False + Width = 2055 + End + Begin VB.CheckBox chkUseITC + Caption = "Use Inner Task Communications" + Height = 255 + Left = 4380 + TabIndex = 76 + Top = 9240 + Value = 1 'Checked + Width = 2715 + End + Begin VB.Timer EndTimer + Enabled = 0 'False + Interval = 100 + Left = 1320 + Top = 540 + End + Begin VB.Timer processTimer + Enabled = 0 'False + Interval = 100 + Left = 3900 + Top = 9120 + End + Begin VB.Timer sendTimer + Enabled = 0 'False + Interval = 100 + Left = 3480 + Top = 9120 + End + Begin VB.ListBox lstSend + Height = 645 + Left = 60 + TabIndex = 72 + Top = 10500 + Width = 12975 + End + Begin VB.ListBox lstRecvd + Height = 645 + Left = 60 + TabIndex = 71 + Top = 9540 + Width = 12975 + End + Begin VB.CheckBox chkDumper + Caption = "Dumper" + Height = 255 + Left = 9120 + TabIndex = 70 + Top = 4020 + Width = 975 + End + Begin VB.ListBox lstIncome + Height = 840 + Left = 60 + TabIndex = 69 + Top = 8400 + Width = 12975 + End + Begin VB.TextBox Text1 + Height = 315 + Left = 6960 + TabIndex = 64 + Text = "Text1" + Top = 7020 + Visible = 0 'False + Width = 4155 + End + Begin VB.PictureBox Picture1 + Height = 1455 + Left = 11790 + ScaleHeight = 1395 + ScaleWidth = 1095 + TabIndex = 61 + Top = 5010 + Width = 1155 + Begin VB.ComboBox cboMoveQUE + Height = 315 + ItemData = "Cmdproc-1.frx":030A + Left = 60 + List = "Cmdproc-1.frx":0326 + TabIndex = 66 + Text = "Empty2" + Top = 750 + Width = 1035 + End + Begin VB.CommandButton cmdMove2Q1 + Caption = "MOVE" + Height = 255 + Left = 60 + TabIndex = 62 + Top = 1080 + Width = 945 + End + Begin VB.Label Label4 + Caption = "Move FROM" + Height = 195 + Left = 90 + TabIndex = 67 + Top = 30 + Width = 945 + End + Begin VB.Label lblFromTab + BackColor = &H00FFFFFF& + BorderStyle = 1 'Fixed Single + Caption = "Gen" + Height = 315 + Left = 60 + TabIndex = 63 + Tag = "0" + Top = 240 + Width = 975 + WordWrap = -1 'True + End + Begin VB.Label Label6 + Caption = "To" + Height = 195 + Left = 0 + TabIndex = 68 + Top = 540 + Width = 855 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 7 + Left = 12150 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 59 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 7 + Left = -150 + TabIndex = 60 + Top = 0 + Width = 795 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 6 + Left = 10980 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 57 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 6 + Left = -150 + TabIndex = 58 + Top = 0 + Width = 795 + End + End + Begin VB.ListBox List1 + Height = 840 + ItemData = "Cmdproc-1.frx":0357 + Left = 10500 + List = "Cmdproc-1.frx":0370 + TabIndex = 52 + Top = 3390 + Width = 2535 + End + Begin VB.CommandButton cmdBottom + Caption = "Bottom" + Height = 255 + Left = 12300 + TabIndex = 51 + Top = 3120 + Width = 735 + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 5 + Left = 9720 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 48 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 5 + Left = 210 + TabIndex = 49 + Top = 0 + Width = 435 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 4 + Left = 8520 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 46 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 4 + Left = -150 + TabIndex = 47 + Top = 0 + Width = 795 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 3 + Left = 7290 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 44 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 3 + Left = -150 + TabIndex = 45 + Top = 0 + Width = 795 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 2 + Left = 6060 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 42 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 2 + Left = -120 + TabIndex = 43 + Top = 0 + Width = 765 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 1 + Left = 4890 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 41 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 1 + Left = -120 + TabIndex = 50 + Top = 0 + Width = 765 + End + End + Begin VB.PictureBox picCount + Appearance = 0 'Flat + ForeColor = &H80000008& + Height = 255 + Index = 0 + Left = 3570 + ScaleHeight = 225 + ScaleWidth = 675 + TabIndex = 39 + Top = 4440 + Width = 705 + Begin VB.Label lblCount + Alignment = 1 'Right Justify + BackColor = &H00FFFFFF& + BackStyle = 0 'Transparent + Caption = "999" + Height = 225 + Index = 0 + Left = 0 + TabIndex = 40 + Top = 0 + Width = 645 + End + End + Begin TabDlg.SSTab SSTab1 + Height = 1815 + Left = 3150 + TabIndex = 26 + Top = 4740 + Width = 9885 + _ExtentX = 17436 + _ExtentY = 3201 + _Version = 393216 + Tabs = 8 + TabsPerRow = 8 + TabHeight = 520 + TabCaption(0) = "Gen" + TabPicture(0) = "Cmdproc-1.frx":03E9 + Tab(0).ControlEnabled= -1 'True + Tab(0).Control(0)= "lblGroups(0)" + Tab(0).Control(0).Enabled= 0 'False + Tab(0).Control(1)= "lstPGroup(0)" + Tab(0).Control(1).Enabled= 0 'False + Tab(0).ControlCount= 2 + TabCaption(1) = "Svc" + TabPicture(1) = "Cmdproc-1.frx":0405 + Tab(1).ControlEnabled= 0 'False + Tab(1).Control(0)= "lblGroups(1)" + Tab(1).Control(1)= "lstPGroup(1)" + Tab(1).ControlCount= 2 + TabCaption(2) = "Engr" + TabPicture(2) = "Cmdproc-1.frx":0421 + Tab(2).ControlEnabled= 0 'False + Tab(2).Control(0)= "lblGroups(2)" + Tab(2).Control(1)= "lstPGroup(2)" + Tab(2).ControlCount= 2 + TabCaption(3) = "SP" + TabPicture(3) = "Cmdproc-1.frx":043D + Tab(3).ControlEnabled= 0 'False + Tab(3).Control(0)= "lblGroups(3)" + Tab(3).Control(1)= "lstPGroup(3)" + Tab(3).ControlCount= 2 + TabCaption(4) = "IE" + TabPicture(4) = "Cmdproc-1.frx":0459 + Tab(4).ControlEnabled= 0 'False + Tab(4).Control(0)= "lblGroups(4)" + Tab(4).Control(1)= "lstPGroup(4)" + Tab(4).ControlCount= 2 + TabCaption(5) = "FAB" + TabPicture(5) = "Cmdproc-1.frx":0475 + Tab(5).ControlEnabled= 0 'False + Tab(5).Control(0)= "lblGroups(5)" + Tab(5).Control(1)= "lstPGroup(5)" + Tab(5).ControlCount= 2 + TabCaption(6) = "Empty1" + TabPicture(6) = "Cmdproc-1.frx":0491 + Tab(6).ControlEnabled= 0 'False + Tab(6).Control(0)= "lblGroups(6)" + Tab(6).Control(1)= "lstPGroup(6)" + Tab(6).ControlCount= 2 + TabCaption(7) = "Empty2" + TabPicture(7) = "Cmdproc-1.frx":04AD + Tab(7).ControlEnabled= 0 'False + Tab(7).Control(0)= "lblGroups(7)" + Tab(7).Control(1)= "lstPGroup(7)" + Tab(7).ControlCount= 2 + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 7 + ItemData = "Cmdproc-1.frx":04C9 + Left = -74940 + List = "Cmdproc-1.frx":04CB + MultiSelect = 2 'Extended + TabIndex = 54 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 6 + ItemData = "Cmdproc-1.frx":04CD + Left = -74940 + List = "Cmdproc-1.frx":04CF + MultiSelect = 2 'Extended + TabIndex = 53 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 5 + ItemData = "Cmdproc-1.frx":04D1 + Left = -74940 + List = "Cmdproc-1.frx":04D3 + MultiSelect = 2 'Extended + TabIndex = 32 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 4 + ItemData = "Cmdproc-1.frx":04D5 + Left = -74940 + List = "Cmdproc-1.frx":04D7 + MultiSelect = 2 'Extended + TabIndex = 31 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 3 + ItemData = "Cmdproc-1.frx":04D9 + Left = -74940 + List = "Cmdproc-1.frx":04DB + MultiSelect = 2 'Extended + TabIndex = 30 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 2 + ItemData = "Cmdproc-1.frx":04DD + Left = -74940 + List = "Cmdproc-1.frx":04DF + MultiSelect = 2 'Extended + TabIndex = 29 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 1 + ItemData = "Cmdproc-1.frx":04E1 + Left = -74940 + List = "Cmdproc-1.frx":04E3 + MultiSelect = 2 'Extended + TabIndex = 28 + Top = 540 + Width = 8505 + End + Begin VB.ListBox lstPGroup + Height = 1035 + Index = 0 + ItemData = "Cmdproc-1.frx":04E5 + Left = 60 + List = "Cmdproc-1.frx":04E7 + MultiSelect = 2 'Extended + TabIndex = 27 + Top = 540 + Width = 8505 + End + Begin VB.Label lblGroups + Caption = "Not used" + Height = 195 + Index = 7 + Left = -74940 + TabIndex = 56 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "Not used" + Height = 195 + Index = 6 + Left = -74940 + TabIndex = 55 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "FAB" + Height = 195 + Index = 5 + Left = -74940 + TabIndex = 38 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "IE" + Height = 195 + Index = 4 + Left = -74940 + TabIndex = 37 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "HWFAB/ELECENG/HWQC/HWSERVICE/SPFAB/SPSVPAK/SPTPARK/SPENGPS3" + Height = 195 + Index = 3 + Left = -74940 + TabIndex = 36 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "Engr/NEWPROD" + Height = 195 + Index = 2 + Left = -74955 + TabIndex = 35 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "Recv/Super/Service/CHECKOUT/QCCAGE" + Height = 195 + Index = 1 + Left = -74940 + TabIndex = 34 + Top = 330 + Width = 4335 + End + Begin VB.Label lblGroups + Caption = "Purch/Electr/DOCKC/SUP5SI/ELECENG" + Height = 195 + Index = 0 + Left = 60 + TabIndex = 33 + Top = 330 + Width = 4335 + End + End + Begin VB.CheckBox UseSpooler + Caption = "Use Spooler" + Height = 225 + Left = 3510 + TabIndex = 23 + Top = 3150 + Value = 1 'Checked + Width = 1845 + End + Begin VB.ListBox lstError + Height = 840 + Left = 90 + TabIndex = 22 + Top = 7500 + Width = 12975 + End + Begin VB.ListBox lstCounts + Height = 840 + Left = 11430 + TabIndex = 19 + Top = 6600 + Width = 1635 + End + Begin VB.ComboBox cboPrinterList + BeginProperty Font + Name = "Courier New" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 330 + ItemData = "Cmdproc-1.frx":04E9 + Left = 90 + List = "Cmdproc-1.frx":04EB + TabIndex = 18 + Text = "Printer Names" + Top = 6570 + Width = 11265 + End + Begin VB.ListBox lstCheckIn + Height = 1815 + Left = 90 + TabIndex = 17 + Top = 4680 + Width = 3015 + End + Begin VB.CommandButton cmdEnd + Caption = "&Quit" + Height = 360 + Left = 12180 + TabIndex = 0 + Top = 0 + Width = 855 + End + Begin VB.ListBox lstReply2 + BackColor = &H00FFFFFF& + Height = 255 + Left = 465 + TabIndex = 15 + Top = 3645 + Width = 9990 + End + Begin VB.ListBox lstReply1 + Height = 255 + Left = 465 + TabIndex = 13 + Top = 3405 + Width = 10005 + End + Begin VB.OptionButton CheckACAD + Caption = "Servicing ACAD" + Height = 195 + Left = 4050 + TabIndex = 11 + Top = 4185 + Value = -1 'True + Width = 1695 + End + Begin VB.OptionButton FileErrInd + Caption = "error processing" + Height = 255 + Left = 5400 + TabIndex = 7 + Top = 3150 + Width = 1575 + End + Begin VB.Timer Timer2 + Interval = 1000 + Left = 780 + Top = 540 + End + Begin VB.CommandButton cmdClearDisplay + Caption = "Clear Display" + Height = 255 + Left = 60 + TabIndex = 6 + Top = 3135 + Width = 1575 + End + Begin VB.TextBox txtCheckFileFreq + Height = 285 + Left = 1575 + TabIndex = 3 + Text = "1000" + Top = 4275 + Width = 735 + End + Begin VB.Timer Timer1 + Interval = 5000 + Left = 240 + Top = 540 + End + Begin VB.CheckBox ChkLogging + Caption = "Logging Commands to file" + Height = 255 + Left = -15 + TabIndex = 2 + Top = 3930 + Value = 1 'Checked + Width = 2175 + End + Begin VB.ListBox LstPrint + Enabled = 0 'False + BeginProperty Font + Name = "Fixedsys" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 2760 + Left = 0 + TabIndex = 1 + Top = 360 + Width = 13050 + End + Begin VB.Label lblTog + Alignment = 1 'Right Justify + Caption = "0" + Height = 255 + Left = 6120 + TabIndex = 78 + Top = 7200 + Width = 495 + End + Begin VB.Label lblPkt + BackColor = &H00FFFFFF& + BorderStyle = 1 'Fixed Single + BeginProperty Font + Name = "Courier New" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 90 + TabIndex = 20 + Top = 6960 + Width = 4455 + End + Begin VB.Label Label3 + BackColor = &H00FFFFFF& + BorderStyle = 1 'Fixed Single + Caption = "*CAD*SYYYYMMDDHHMMSS000111222333444555666" + BeginProperty Font + Name = "Courier New" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 90 + TabIndex = 21 + Top = 7200 + Width = 4455 + End + Begin VB.Label lblfrmMain + Caption = "Command Processor" + BeginProperty Font + Name = "MS Sans Serif" + Size = 12 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 315 + Left = 0 + TabIndex = 75 + Top = 0 + Width = 10155 + End + Begin VB.Label lblToApp + Height = 255 + Left = 60 + TabIndex = 74 + Top = 10200 + Width = 12915 + End + Begin VB.Label lblITC + Caption = "Inner Task Communications" + Height = 255 + Left = 60 + TabIndex = 73 + Top = 9240 + Width = 3255 + End + Begin VB.Label Label5 + Alignment = 2 'Center + Appearance = 0 'Flat + BorderStyle = 1 'Fixed Single + Caption = "All" + ForeColor = &H80000008& + Height = 255 + Left = 3240 + TabIndex = 65 + Top = 4440 + Width = 375 + End + Begin VB.Label lblReplySt + Caption = "replycmpl.que exists" + Height = 195 + Index = 1 + Left = 5910 + TabIndex = 25 + Top = 4155 + Width = 1545 + End + Begin VB.Label lblReplySt + Caption = "reply.que exists" + Height = 195 + Index = 0 + Left = 5910 + TabIndex = 24 + Top = 3945 + Width = 1155 + End + Begin VB.Label lstReply2Cnt + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H80000005& + BorderStyle = 1 'Fixed Single + Caption = "0" + ForeColor = &H80000008& + Height = 255 + Left = 45 + TabIndex = 16 + Top = 3645 + Width = 375 + End + Begin VB.Label lstReply1Cnt + Alignment = 2 'Center + Appearance = 0 'Flat + BackColor = &H80000005& + BorderStyle = 1 'Fixed Single + Caption = "0" + ForeColor = &H80000008& + Height = 255 + Left = 45 + TabIndex = 14 + Top = 3405 + Width = 375 + End + Begin VB.Label lblReply + Height = 255 + Left = 4080 + TabIndex = 12 + Top = 3915 + Width = 1695 + End + Begin VB.Label ErrorCondition + BorderStyle = 1 'Fixed Single + Height = 255 + Left = 7020 + TabIndex = 10 + Top = 3120 + Width = 3435 + End + Begin VB.Label CADRecs + BorderStyle = 1 'Fixed Single + Height = 255 + Left = 2730 + TabIndex = 9 + Top = 3135 + Width = 735 + End + Begin VB.Label Label2 + BorderStyle = 1 'Fixed Single + Caption = "Cadprint Recs" + Height = 255 + Left = 1650 + TabIndex = 8 + Top = 3135 + Width = 1095 + End + Begin VB.Label lblScan + Height = 255 + Left = 2310 + TabIndex = 5 + Top = 3930 + Width = 1695 + End + Begin VB.Label Label1 + Caption = "Check file frequency (milliseconds)" + Height = 420 + Left = 0 + TabIndex = 4 + Top = 4185 + Width = 1575 + End +End +Attribute VB_Name = "frmMain" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + +Private Sub cmdBottom_Click() + frmMain.LstPrint.ListIndex = frmMain.LstPrint.ListCount - 1 +End Sub +Private Sub cmdClearDisplay_Click() + LstPrint.Clear +End Sub + +Private Sub cmdClearSpoolFiles_Click() + 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 + KillIt (temppath$ + ax$) + End If + Next + TogCount = mx + frmMain.lblTog.Caption = Str(TogCount) + +End Sub + +Private Sub cmdEnd_Click() +' On Error Resume Next + Unhook + Open MessageFileName$ For Output As #26 'using #26 + Print #26, "I Have Been Terminated" + Close #26 + Call PrintLog("I Have Been Terminated") + EndTimer.Enabled = True +End Sub + +Private Sub cmdMove2Q1_Click() +' +' this routine moves any command to any Queue +' + nn = Val(lblFromTab.Tag) + mm = -1 + For ixtab = 0 To SSTab1.Tabs - 1 + If cboMoveQUE.List(cboMoveQUE.ListIndex) = SSTab1.TabCaption(ixtab) Then + mm = ixtab + Exit For + End If + Next + If mm = -1 Then Exit Sub + If nn <> mm Then + imx = 0 + Do While imx <= lstPGroup(nn).ListCount - 1 + If lstPGroup(nn).Selected(imx) Then + lstPGroup(mm).AddItem lstPGroup(nn).List(imx) + lstPGroup(nn).RemoveItem (imx) + Else + imx = imx + 1 + End If + Loop + End If +End Sub +Private Sub cmdTestMessage_Click() + frmQueHandler.Show +End Sub +Private Sub EndTimer_Timer() + End +End Sub + +Private Sub ErrorCondition_DblClick() + ErrorCondition.Caption = "" +End Sub + + +Private Sub Form_Load() + ' + ' +MonitorNib + ' + frmMonitorNib.txtID.Text = "wdtCommandProcessor" + frmMonitorNib.Show + frmMonitorNib.Visible = False + ' + ' -MonitorNib + ' + Set rcvListBox = frmMain.lstRecvd + MyWnd = frmMain.hwnd + lstError.AddItem "Start Time:" + Format(Now, "hh:nn:ss yyyy/mm/dd") + Call InitVars + Hook +End Sub + +Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) + ' + ' +MonitorNib + Unload frmMonitorNib + ' -MonitorNib + ' +End Sub + +Private Sub Form_Resize() + positsize$ = " Top: " + Str(Me.top) +positsize$ = positsize$ + " Left: " + Str(Me.left) +positsize$ = positsize$ + " Width: " + Str(Me.Width) +positsize$ = positsize$ + "Height: " + Str(Me.Height) + +lblfrmMain.ToolTipText = positsize$ + +End Sub + +' +' Example Connection Requirements +' +'Private Sub Form_Load() +' Set rcvListBox = lstRecvd +' ToName = "QMGR" ' Application to Connect to +' MyName = "CMDPRC" ' This Application window +' MyWnd = Me.hwnd +' Hook +' +' Me.Show +' Me.Caption = MyName +' lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found" 'Status message +' processTimer.Enabled = True ' Timer to process incoming messages +' sendTimer.Enabled = True ' Timer to send out going responses +'End Sub +'Private Sub Form_Unload(Cancel As Integer) +' Unhook +'End Sub +' +' +'Private Sub processTimer_Timer() +'' +'' This timer checks to see if any messages have been received and need to be Processed +'' +' processTimer.Interval = 1000 ' set the timer to once a second +' Do While lstRecvd.ListCount > 0 +' Msg$ = lstRecvd.List(0) +' lstRecvd.RemoveItem (0) +' ' +' ' process the message +' ' +' Msg$ = Msg$ + " Back " + Date$ + " " + Time$ +' ' +' ' send the response +' ' +' lstSend.AddItem Msg$ +' Loop +' +'End Sub +' +'Private Sub sendTimer_Timer() +'' +'' This timer Watches for Connectivity to be able to send messages. +'' +' sendTimer.Interval = 1000 +' ToWnd = FindWindow(vbNullString, ToName) 'look for App to connect To +' If ToWnd = 0& Then +' lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found" +' lblToApp.BackColor = &HC0C0FF +' SendStatus = "Disconnected" +' Else +' lblToApp.Caption = "Connected to: " + ToName + " Status: Found " + Hex$(ToWnd) +' lblToApp.BackColor = &HC0FFC0 +' SendStatus = "Connected" +' End If +' ' +' ' if App exists then send the messages in the Send ListBox +' ' +' If SendStatus = "Connected" Then +' Do While lstSend.ListCount > 0 +' Msg$ = lstSend.List(0) +' lstSend.RemoveItem (0) +' Call SendAMessage(Msg$) +' Loop +' End If +' End Sub +' +Private Sub Label5_DblClick() + For iix = 0 To picCount.Count - 1 + If Label5.BackColor = &HFF Then + picCount(iix).BackColor = &H8000000F + picCount(iix).ToolTipText = "" + Else + picCount(iix).BackColor = &HFF + picCount(iix).ToolTipText = "Queue Paused" + End If + Next + If Label5.BackColor = &HFF Then + Label5.BackColor = &H8000000F + Else + Label5.BackColor = &HFF + End If + +End Sub + +Private Sub lblCount_DblClick(Index As Integer) +' +' pause/unpause print queue +' +'&H8000000F& clear +'&H000000FF& red +' +'picCount(Index).BackColor = &HFF +'picCount(Index).BackColor = &H8000000F + If picCount(Index).BackColor = &HFF Then + picCount(Index).BackColor = &H8000000F + picCount(Index).ToolTipText = "" + Else + picCount(Index).BackColor = &HFF + picCount(Index).ToolTipText = "Queue Paused" + End If +End Sub + +Private Sub lblPkt_Click() + lblPkt.Caption = "" +End Sub + +Private Sub List1_DblClick() + l$ = List1.List(List1.ListIndex) + Select Case l$ + Case "Show Test Message" + frmQueHandler.Show + Case "Show BOM" + frmBOM.Show + Case "Show Assem View" + frmCheckAssembly.Show + Case "Show Spooler" + frmPSSpooler.Show + Case "Show File Watcher" + frmFileWatch.Show + Case "Show Folder Copier" + frmFolderCopy.Show + Case "Show PDF Printer" + frmPDF.Show + Case Else + End Select + +End Sub + +Private Sub lstCounts_Click() + lstCounts.Clear + ict = lstCheckIn.ListCount + lstCounts.AddItem "ckin=" + Trim$(Str$(ict)) + For ixxx = 0 To lstPGroup.Count - 1 + ict = lstPGroup(ixxx).ListCount + lstCounts.AddItem "grp" + Trim$(Str$(ixxx)) + "=" + Trim$(Str$(ict)) + Next +End Sub +Function MakePGroupPacket$() + ict = lstCheckIn.ListCount + Pkt$ = LPad$(Trim$(Str$(ict)), 3) + For ixxx = 0 To lstPGroup.Count - 1 + ict = lstPGroup(ixxx).ListCount + vv$ = LPad$(Trim$(Str$(ict)), 3) + If vv$ = " " Then vv$ = " 0" + Pkt$ = Pkt$ + vv$ + Next + MakePGroupPacket$ = LPad$(Format$(Now, "yyyymmddhhmmss"), 14) + Pkt$ +End Function +Private Sub lstCounts_GotFocus() + lstCounts.Clear + ict = lstCheckIn.ListCount + lstCounts.AddItem "ckin=" + Trim$(Str$(ict)) + For ixxx = 0 To lstPGroup.Count - 1 + ict = lstPGroup(ixxx).ListCount + lstCounts.AddItem "grp" + Trim$(Str$(ixxx)) + "=" + Trim$(Str$(ict)) + Next +End Sub + +Private Sub LstPrint_DblClick() + LstPrint.Clear +End Sub + +Public Sub lstReply2Cnt_DblClick() + lstReply2Cnt.BackColor = QBColor(12) + On Error GoTo frOpps + DoEvents + + Open "C:\replies.dat" For Output As #17 'using #17 + For idre = 0 To lstReply2.ListCount - 1 + jff$ = lstReply2.List(idre) + Print #17, jff$ + Next + Close #17 + + If (Not (ExistsNew(Reply$))) And (ExistsNew(ReplyComplete$)) Then + PurgeIt (ReplyComplete$) + End If + + Call FlushReplies + lstReply2Cnt.BackColor = QBColor(15) +frOppsOut: +Exit Sub + +frOpps: + Close #17 + Resume frOppsOut +End Sub + +Private Sub processTimer_Timer() +' +' This timer checks to see if any messages have been received and need to be Processed +' + If chkUseITC.value = 1 Then + lblITC.BackColor = &HC0FFC0 + processTimer.Interval = 1000 ' set the timer to once a second + Do While lstRecvd.ListCount > 0 + Msg$ = lstRecvd.List(0) + lstRecvd.RemoveItem (0) + frmMain.lstIncome.AddItem Msg$ + Loop + Else + lblITC.BackColor = &HC0C0FF + End If +End Sub + +Private Sub sendTimer_Timer() +' +' This timer Watches for Connectivity to be able to send messages. +' + If chkUseITC.value = 1 Then + lblITC.BackColor = &HC0FFC0 + sendTimer.Interval = 1000 + ToWnd = FindWindow(vbNullString, ToName) 'look for App to connect To + If ToWnd = 0& Then + lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found" + lblToApp.BackColor = &HC0C0FF + SendStatus = "Disconnected" + Else + lblToApp.Caption = "Connected to: " + ToName + " Status: Found " + Hex$(ToWnd) + lblToApp.BackColor = &HC0FFC0 + SendStatus = "Connected" + End If + ' + ' if App exists then send the messages in the Send ListBox + ' + If SendStatus = "Connected" Then + Do While lstSend.ListCount > 0 + Msg$ = lstSend.List(0) + lstSend.RemoveItem (0) + Call SendAMessage(Msg$) + Loop + End If + Else + sendTimer.Interval = 3000 + lblToApp.BackColor = &HC0C0FF + lblToApp.Caption = "Inner Task Communications Disabled" + lblITC.BackColor = &HC0C0FF + SendStatus = "Disconnected" + End If +End Sub +' + +Private Sub SSTab1_Click(PreviousTab As Integer) + nn = SSTab1.Tab + lblFromTab.Caption = SSTab1.TabCaption(nn) + lblFromTab.Tag = Trim(Str(nn)) + +End Sub + + +Private Sub Timer1_Timer() + If Timer1.Tag = "Busy" Then Exit Sub + Timer1.Tag = "Busy" + lblScan.Caption = "Scanning" + DoEvents + Call StartSystem + lblScan.Caption = "Flush Replies" + Call FlushReplies + lblScan.Caption = "idle" + Timer1.Tag = "" +End Sub + +Private Sub Timer2_Timer() + FileTimer = FileTimer - 1 + If FileTimer <= 0 Then FileTimer = 0 +''''''''''''''''''' Call WDTServer + ' + ' +MonitorNib + ' + ' (once per second) + txtMonitor.BackColor = frmMonitorNib.BackColor + ' -MonitorNib + On Error GoTo Timer2_ERROR + xz% = 0: yz% = 0 + xz% = FileLen(ACADIncome$) + yz% = FileLen(ACADWait$) + CADRecs.Caption = Str$((xz% + yz%) \ 79) + lblReply.Caption = "replys=" + Str$(replies) + " | " + Str$(replies2) + If ExistsNew(Reply$) Then + lblReplySt(0).BackColor = QBColor(15) + Else + lblReplySt(0).BackColor = QBColor(14) + End If + If ExistsNew(ReplyComplete$) Then + lblReplySt(1).BackColor = QBColor(15) + Else + lblReplySt(1).BackColor = QBColor(14) + End If + If replies2 >= 2 Then + If (Not (ExistsNew(Reply$))) And (ExistsNew(ReplyComplete$)) Then + 'PurgeIt (ReplyComplete$) + End If + If replies2 > 60 Then + Constipation% = 1 + End If + + Else + Constipation% = 0 + End If + For ixxx = 0 To lblCount.Count - 1 + lblCount(ixxx).Caption = Trim(Str(lstPGroup(ixxx).ListCount)) + Next + lstReply1Cnt.Caption = Str$(lstReply1.ListCount) + lstReply2Cnt.Caption = Str$(lstReply2.ListCount) + DoEvents + Exit Sub +Timer2_ERROR: + Resume Next +End Sub + + +Private Sub txtCheckFileFreq_Change() + Tl% = Val(txtCheckFileFreq.Text) + If Tl% > 200 Then + Timer1.Interval = Tl% + Else + Timer1.Interval = 500 + End If +End Sub + + +Private Sub txtMonitor_DblClick() + ' + ' +MonitorNib + frmMonitorNib.Visible = True + ' -MonitorNib + +End Sub diff --git a/Cmdproc-1.frx b/Cmdproc-1.frx new file mode 100644 index 0000000..3a09513 Binary files /dev/null and b/Cmdproc-1.frx differ diff --git a/Cmdproc-1.log b/Cmdproc-1.log new file mode 100644 index 0000000..269e8de --- /dev/null +++ b/Cmdproc-1.log @@ -0,0 +1 @@ +Line 368: Class TabDlg.SSTab of control SSTab1 was not a loaded control class. diff --git a/Cmdproc-2.frm b/Cmdproc-2.frm new file mode 100644 index 0000000..1eec010 --- /dev/null +++ b/Cmdproc-2.frm @@ -0,0 +1,295 @@ +VERSION 5.00 +Begin VB.Form frmQueHandler + BackColor = &H00C0C0C0& + Caption = "Que Test Messages" + ClientHeight = 1575 + ClientLeft = 90 + ClientTop = 5355 + ClientWidth = 11865 + LinkTopic = "Form1" + PaletteMode = 1 'UseZOrder + ScaleHeight = 1575 + ScaleWidth = 11865 + Begin VB.CommandButton cmdPrintText + Caption = "PrintText" + Height = 195 + Left = 10320 + TabIndex = 17 + Top = 510 + Width = 975 + End + Begin VB.CommandButton Command1 + Caption = "Move Ref" + Height = 225 + Left = 9210 + TabIndex = 16 + Top = 480 + Width = 975 + End + Begin VB.TextBox StatusBar1 + BackColor = &H00C0C0C0& + BeginProperty Font + Name = "Fixedsys" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 375 + Left = 0 + TabIndex = 15 + Text = "StatusBar1" + Top = 1200 + Width = 11775 + End + Begin VB.CommandButton cmdWire + Caption = "Wire Diag." + Height = 195 + Left = 8160 + TabIndex = 14 + Top = 480 + Width = 975 + End + Begin VB.TextBox UserName + Height = 285 + Left = 2280 + TabIndex = 13 + Text = "FEDUCIA" + Top = 360 + Width = 1455 + End + Begin VB.CommandButton cmdSend + Appearance = 0 'Flat + BackColor = &H80000005& + Caption = "SEND COMMAND" + Height = 495 + Left = 10320 + TabIndex = 11 + Top = 0 + Width = 1455 + End + Begin VB.CommandButton cmdQuit + Caption = "&Cancel" + Height = 375 + Left = 0 + TabIndex = 10 + Top = 0 + Width = 615 + End + Begin VB.TextBox XmitCommand + BeginProperty Font + Name = "Fixedsys" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 330 + Left = 0 + TabIndex = 9 + Text = "Text2" + Top = 840 + Width = 11775 + End + Begin VB.CommandButton cmdMoveBack + Caption = "Move Back" + Height = 195 + Left = 9240 + TabIndex = 8 + Top = 240 + Width = 975 + End + Begin VB.CommandButton cmdMoveOut + Caption = "Move Out" + Height = 195 + Left = 9240 + TabIndex = 7 + Top = 0 + Width = 975 + End + Begin VB.CommandButton cmdMoveIn + Caption = "Move In" + Height = 195 + Left = 8160 + TabIndex = 6 + Top = 240 + Width = 975 + End + Begin VB.CommandButton cmdPrint + Caption = "Print File" + Height = 195 + Left = 8160 + TabIndex = 5 + Top = 0 + Width = 975 + End + Begin VB.TextBox PrinterName + Height = 285 + Left = 6240 + TabIndex = 4 + Text = "PrinterName" + Top = 0 + Width = 1815 + End + Begin VB.TextBox FileToActOn + Height = 285 + Left = 2280 + TabIndex = 1 + Text = "9002028C" + Top = 0 + Width = 1455 + End + Begin VB.ListBox lstPrinters + Height = 255 + Left = 6240 + TabIndex = 0 + Top = 360 + Width = 1815 + End + Begin VB.Label Label3 + Alignment = 1 'Right Justify + Caption = "User Name" + Height = 255 + Left = 720 + TabIndex = 12 + Top = 360 + Width = 1455 + End + Begin VB.Label Label2 + Alignment = 1 'Right Justify + Caption = "Printer Name" + Height = 255 + Left = 4680 + TabIndex = 3 + Top = 0 + Width = 1455 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "File To Act On" + Height = 255 + Left = 720 + TabIndex = 2 + Top = 0 + Width = 1455 + End +End +Attribute VB_Name = "frmQueHandler" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + +Private Sub cmdMoveBack_Click() + XmitCommand.Text = MakeCmd$("B") +End Sub + +Private Sub cmdMoveIn_Click() + XmitCommand.Text = MakeCmd$("I") +End Sub + +Private Sub cmdMoveOut_Click() + XmitCommand.Text = MakeCmd$("O") + +End Sub + + +Private Sub cmdPrint_Click() + XmitCommand.Text = MakeCmd$("P") +End Sub + +Private Sub cmdPrintText_Click() + XmitCommand.Text = MakeCmd$("T") + +End Sub + +Private Sub cmdQuit_Click() + frmQueHandler.Hide +End Sub + + +Private Sub cmdSend_Click() + StatusBar1.Text = "Creating Income File" + DoEvents + Open INCOME$ For Output As #4 'using #4 + p$ = RPad$(XmitCommand.Text, CQueSize%) + Print #4, p$ + Close #4 + StatusBar1.Text = "Income File Created" + DoEvents + StatusBar1.Text = "Activating Handshake File" + Call Fcopy(COMPLETE2$, COMPLETE$, Rc%) + DoEvents + StatusBar1.Text = "Idle" +End Sub + +Private Sub Command1_Click() + XmitCommand.Text = MakeCmd$("R") +End Sub + +Private Sub cmdWire_Click() + XmitCommand.Text = MakeCmd$("W") +End Sub + +Private Sub Form_Load() + For i = 1 To lptI% + lstPrinters.AddItem Place$(i) + Next + PrinterName.Text = Place$(1) +End Sub + + +Private Sub lstPrinters_DblClick() + t$ = lstPrinters.Text + PrinterName.Text = t$ +End Sub + + + +Public Function MakeCmd$(TypeOfCmd$) +WhoEver$ = UserName.Text +M$ = TypeOfCmd$ +Select Case TypeOfCmd$ + Case "P", "W" +''''''print P Part Printer Banner1 Date Product Number mesg type +'''''' 1<---8--><---10---><---10---><-----14-----><------15----->X + M$ = M$ + RPad$(FileToActOn.Text, 8) ' PART + M$ = M$ + RPad$(PrinterName.Text, 10) ' PRINTER + M$ = M$ + RPad$(WhoEver$, 10) ' BANNER + M$ = M$ + RPad$(Format$(Now, "YYYYMMDDHHMMSS"), 14) + M$ = M$ + RPad$(FileToActOn.Text, 15) ' PRODUCT NO + If TypeOfCmd$ = "W" Then + M$ = M$ + "6" ' MESSAGE TYPE + Else + M$ = M$ + "1" ' MESSAGE TYPE + End If + Case "I", "O", "B", "R" +''''''ck out O Part# Product # Directory New Name Date +'''''' in 1<---8--><------15-----><---10---><--8---><-----14-----> +'''''' back + M$ = M$ + RPad$(FileToActOn.Text, 8) ' PART + M$ = M$ + RPad$(FileToActOn.Text, 15) ' PRODUCT NO + M$ = M$ + RPad$(WhoEver$, 10) ' BANNER + M$ = M$ + RPad$(FileToActOn.Text, 8) ' PART + M$ = M$ + RPad$(Format$(Now, "YYYYMMDDHHMMSS"), 14) + Case "E" +''''''ie move E Part# Product # Directory IE Dir Date +'''''' 1<---8--><------15-----><---10---><--10----><-----14-----> + M$ = M$ + RPad$(FileToActOn.Text, 8) ' PART + M$ = M$ + RPad$(FileToActOn.Text, 15) ' PRODUCT NO + M$ = M$ + RPad$(WhoEver$, 10) ' BANNER + M$ = M$ + RPad$(WhoEver$, 10) ' BANNER + M$ = M$ + RPad$(Format$(Now, "YYYYMMDDHHMMSS"), 14) + Case "T" + M$ = M$ + RPad$(FileToActOn.Text, 10) ' PART + M$ = M$ + RPad$(PrinterName.Text, 10) ' PRINTER + + Case Else +End Select +MakeCmd$ = M$ +End Function + diff --git a/Cmdproc-3.frm b/Cmdproc-3.frm new file mode 100644 index 0000000..a155099 --- /dev/null +++ b/Cmdproc-3.frm @@ -0,0 +1,175 @@ +VERSION 5.00 +Begin VB.Form frmStart + Caption = "CMNDPROC - Startup" + ClientHeight = 5895 + ClientLeft = 1095 + ClientTop = 1515 + ClientWidth = 10035 + LinkTopic = "Form1" + PaletteMode = 1 'UseZOrder + ScaleHeight = 5895 + ScaleWidth = 10035 + Begin VB.CommandButton Command2 + Caption = "Cancel StartUp" + Height = 495 + Left = 240 + TabIndex = 7 + Top = 120 + Width = 9615 + End + Begin VB.CommandButton Command1 + Caption = "Press this button to start program immediately or it will start in 30 seconds." + Height = 495 + Left = 240 + TabIndex = 4 + Top = 5280 + Width = 9615 + End + Begin VB.Timer Timer1 + Interval = 1000 + Left = 360 + Top = 1800 + End + Begin VB.Label Label6 + Caption = $"Cmdproc-3.frx":0000 + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 1200 + TabIndex = 6 + Top = 3600 + Width = 8055 + End + Begin VB.Label Label5 + Caption = $"Cmdproc-3.frx":00BD + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 1200 + TabIndex = 5 + Top = 2880 + Width = 8055 + End + Begin VB.Label Label4 + Caption = $"Cmdproc-3.frx":0174 + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 1200 + TabIndex = 3 + Top = 1440 + Width = 8055 + End + Begin VB.Label Label3 + Caption = $"Cmdproc-3.frx":0220 + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 1200 + TabIndex = 2 + Top = 4320 + Width = 8055 + End + Begin VB.Label Label2 + Caption = $"Cmdproc-3.frx":02C5 + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 615 + Left = 1200 + TabIndex = 1 + Top = 2160 + Width = 8055 + End + Begin VB.Label Label1 + Caption = "During Startup this program must have available its C:\Work\ directory and three mapped network drives:" + BeginProperty Font + Name = "Arial" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 495 + Left = 480 + TabIndex = 0 + Top = 840 + Width = 9015 + End +End +Attribute VB_Name = "frmStart" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Sub Command1_Click() + frmMain.Show + Unload frmStart +End Sub + +Private Sub Command2_Click() + End +End Sub + +Private Sub Form_Load() + frmStart.Caption = "Command Processor Version: " + AppRevision$ + NETDRV = "\\fryfs001v.manitowocfs.com" + NETDRAW = "\\fryfs001v.manitowocfs.com\drawings" + NETHAL = "\\qhal" + +' NETDRV = "\\fm1" +' NETDRAW = "\\fm1\eng\eng\drawings" +' NETHAL = "\\qhal" +End Sub + +Private Static Sub Timer1_Timer() + timit = timit + 1 + tm$ = Trim$(Str$(31 - timit)) + tx$ = tm$ + tm$ = "Press this button to start program immediately or it will start in " + tm$ + " seconds." + frmStart.Command1.Caption = tm$ + frmStart.Caption = "CMNDPROC - START " + tx$ + " Version: " + AppRevision$ + + If timit > 30 Then + frmMain.Show + Unload frmStart + End If +End Sub + + diff --git a/Cmdproc-3.frx b/Cmdproc-3.frx new file mode 100644 index 0000000..1cacdd0 Binary files /dev/null and b/Cmdproc-3.frx differ diff --git a/Cmdproc-4.frm b/Cmdproc-4.frm new file mode 100644 index 0000000..e9b8eab --- /dev/null +++ b/Cmdproc-4.frm @@ -0,0 +1,531 @@ +VERSION 5.00 +Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX" +Begin VB.Form frmCheckAssembly + Caption = "Form1" + ClientHeight = 4755 + ClientLeft = 1455 + ClientTop = 3180 + ClientWidth = 11565 + LinkTopic = "Form1" + PaletteMode = 1 'UseZOrder + ScaleHeight = 4755 + ScaleWidth = 11565 + Begin VB.CheckBox chkNoCheck + Caption = "No Check" + Height = 375 + Left = 3780 + TabIndex = 7 + Top = 3330 + Value = 1 'Checked + Width = 1200 + End + Begin VB.CommandButton cmdHide + Caption = "Hide" + Height = 330 + Left = 5190 + TabIndex = 4 + Top = 3240 + Width = 1410 + End + Begin VB.ListBox lstIModels + Height = 1035 + Left = 1920 + TabIndex = 2 + Top = 1080 + Width = 9615 + End + Begin VB.ListBox lstParts + Height = 1035 + Left = 1920 + TabIndex = 1 + Top = 2160 + Width = 9615 + End + Begin VB.ListBox lstSearchAsm + Height = 1035 + Left = 1920 + TabIndex = 0 + Top = 0 + Width = 9615 + End + Begin ComctlLib.TreeView TreeView1 + Height = 3135 + Left = 120 + TabIndex = 3 + Top = 120 + Width = 1695 + _ExtentX = 2990 + _ExtentY = 5530 + _Version = 327682 + Style = 7 + Appearance = 1 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + End + Begin VB.Label Label1 + Caption = "Return Code" + Height = 225 + Left = 210 + TabIndex = 6 + Top = 3270 + Width = 3465 + End + Begin VB.Label lblErrorLevel + Height = 255 + Left = 195 + TabIndex = 5 + Top = 3525 + Width = 3540 + End +End +Attribute VB_Name = "frmCheckAssembly" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + + + +Sub FillIModels(lst As ListBox) + Dim specialSearch$(100) +' specialSearch(0) = "\\fm1\eng\depts\eng\Models\" +' specialSearch(1) = "\\fm1\eng\depts\eng\Models\contacttoasterwiring\" +' specialSearch(2) = "\\fm1\eng\depts\eng\Models\IE-SYMBOLS\" +' specialSearch(3) = "\\fm1\eng\depts\eng\Models\translation symbols\" +' specialSearch(4) = "\\fm1\eng\depts\eng\Models\wire-fully modelled with datum curve\" +' specialSearch(5) = "\\fm1\eng\depts\eng\Models\wiresIbarnesapc\" +' specialSearch(6) = "\\fm1\eng\depts\eng\Models\WiresOwens\" + specialSearch(0) = NETDRV + "\eng\depts\eng\Models\" + specialSearch(1) = NETDRV + "\eng\depts\eng\Models\contacttoasterwiring\" + specialSearch(2) = NETDRV + "\eng\depts\eng\Models\IE-SYMBOLS\" + specialSearch(3) = NETDRV + "\eng\depts\eng\Models\translation symbols\" + specialSearch(4) = NETDRV + "\eng\depts\eng\Models\wire-fully modelled with datum curve\" + specialSearch(5) = NETDRV + "\eng\depts\eng\Models\wiresIbarnesapc\" + specialSearch(6) = NETDRV + "\eng\depts\eng\Models\WiresOwens\" + specialS = 6 + lst.Clear + For i = 0 To specialS + fl$ = Dir$(specialSearch(i) + "*.*") + Do While fl$ <> "" ' Start the loop. + If (fl$ <> ".") And (fl$ <> "..") Then + ex = LastStr%(fl$, ".") + rev$ = UCase$(Mid$(fl$, ex + 1)) + nfl$ = left$(fl$, ex - 1) + If Val(rev$) <> 0 Then + lst.AddItem nfl$ + "|" + specialSearch$(i) + "|" + rev$ + Else + If (rev$ = "PRT") Or (rev$ = "ASM") Or (rev$ = "DRW") Then + lst.AddItem fl$ + "|" + specialSearch$(i) + "|" + End If + End If + End If + fl$ = Dir$ + Loop + Next +End Sub + +Private Sub Command1_Click() + +End Sub + + +Public Function Execute%(ass$) + Dim lookfor$(100), LookRev$(100) + Dim indata As Byte + Dim nodX As Node + On Error GoTo Ender + perr = 1 + + lblErrorLevel.Caption = "Scanning assembly" + Call FillIModels(lstIModels) + + lstSearchAsm.Clear + lstSearchAsm.AddItem ass$ + + If lstSearchAsm.ListCount = 0 Then + Execute% = -1 + Exit Function + End If + + errorlevel = 0 + TreeView1.Nodes.Clear + StopTransfer = False + + lstParts.Clear + lf% = 1 + lookfor$(1) = "@model_name" + lr% = 1 + LookRev$(1) = "@revnum" +' todr$ = pathCheck$(Dir2.SelectedFolder) +''''''''''''+revnum + revnum = 0 +''''''''''''-revnum + assm = 0: lvl$ = "0" + Filename$ = lstSearchAsm.List(assm) + x$ = Filename$ + x$ = Mid$(x$, LastStr(x$, "\") + 1) + Rootasm$ = x$ + x$ = left$(x$, LastStr(x$, ".") - 1) + Parent$ = "" + Rootname$ = x$ + TreeView1.LineStyle = tvwRootLines ' Linestyle 1 ' Add Node objects. + + Parent$ = "X" + x$ + Set nodX = TreeView1.Nodes.Add(, , Parent$, x$ + ".asm") + i = TreeView1.Nodes.Count + TreeView1.Nodes(i).Expanded = True + TreeView1.Nodes(i).Tag = lvl$ + + + x$ = StrRemove$(x$, Chr$(13)) + GoSub AddToList + If ExistsNew(Filename$) Then + Do While assm <= lstSearchAsm.ListCount - 1 + Filename$ = lstSearchAsm.List(assm) + DoEvents + u$ = "" + lineno = 0 + lf% = 1 + lr% = 1 + pt$ = Filename$ + pt$ = Mid$(pt$, LastStr(pt$, "\") + 1) + pt$ = left$(pt$, LastStr(pt$, ".") - 1) + Parent$ = "X" + pt$ + On Error GoTo Ender + Open Filename$ For Binary As #25 'using #25 + Do While Not EOF(25) + Get #25, , indata + If EOF(25) Then Exit Do + ax% = indata + ax% = ax% And &HFF + x$ = Chr$(ax%) + If ax% <> 10 Then + u$ = u$ + x$ + Else + lineno = lineno + 1 +Call WDTServer + If getlookfor <> 0 Then + Z = InStr(u$, " ") + t = Z + InStr(Mid$(u$, Z + 1), " ") + 1 + x$ = Mid$(u$, t) + x$ = StrRemove$(x$, Chr$(13)) + GoSub AddToList + y$ = left$(u$, t - 1) + lf% = lf% + 1 + lookfor$(lf%) = y$ + getlookfor = 0 + DoEvents + Else + If left$(u$, 16) = "#END_OF_P_OBJECT" Then + Exit Do + End If + For i = 1 To lf% + lflen% = Len(lookfor$(i)) + If left$(u$, lflen%) = lookfor$(i) Then + If i = 1 Then + getlookfor = i + Else + Z = InStr(u$, " ") + t = Z + InStr(Mid$(u$, Z + 1), " ") + 1 + x$ = Mid$(u$, t) + x$ = StrRemove$(x$, Chr$(13)) + GoSub AddToList + Exit For + End If + End If + DoEvents +Call WDTServer + Next +''''''''''''+revnum + If revnum = 1 Then + revnum = 0 + Z = InStr(u$, " ") + t = Z + InStr(Mid$(u$, Z + 1), " ") + 1 + x$ = Trim$(Mid$(u$, t)) + If x$ = "-1" Then + GoSub RemoveLastAssembly + y$ = left$(u$, t - 1) + lr = lr + 1 + LookRev$(lr) = y$ + End If + Else + For i = 1 To lr + lrlen% = Len(LookRev$(i)) + If left$(u$, lrlen%) = LookRev$(i) Then + If i = 1 Then + revnum = 1 + Else + Z = InStr(u$, " ") + t = Z + InStr(Mid$(u$, Z + 1), " ") + 1 + x$ = Trim$(Mid$(u$, t)) + If x$ = "-1" Then + GoSub RemoveLastAssembly + End If + End If + End If + Next + End If +''''''''''''-revnum + End If + u$ = "" + End If +GoSub RefreshDisp + If StopTransfer Then Exit Do + Loop + Close #25 + assm = assm + 1 + If StopTransfer Then Exit Do + Loop + End If + + For i = 1 To TreeView1.Nodes.Count + TreeView1.Nodes(i).Expanded = True + Next +GoSub RefreshDisp + errorlevel = 0 + For i = 0 To lstParts.ListCount - 1 + lstp$ = lstParts.List(i) + If Val(right$(lstp$, Len(lstp$) - LastInStr(lstp$, "|"))) <> 0 Then + errorlevel = 99 + Exit For + End If + Next + +' cmdCancelTransfer.Visible = False +exitender: +Execute% = errorlevel +lblErrorLevel.Caption = Str$(errorlevel) +Close +Exit Function +Ender: +errorlevel = perr +Resume exitender +' +' Add a part or assembly to the list of pars to transfer +' +AddToList: + AsmScanFnd = False + If InStr(x$, "_") Then + x$ = left$(x$, InStr(x$, "_") - 1) + End If + If InStr(x$, "#") Then + x$ = left$(x$, InStr(x$, "#") - 1) + End If + If x$ <> Rootname$ Then + +''''''''''''+revnum + lastpartadded$ = x$ +''''''''''''-revnum + For imx = 0 To lstParts.ListCount - 1 + lstpt$ = lstParts.List(imx) + lstpt$ = left$(lstpt$, InStr(lstpt$, "|") - 1) + If x$ = lstpt$ Then + AsmScanFnd = True + Exit For + End If + Next + If Not (AsmScanFnd) Then + y$ = x$ + "| " + Filename$ + + asm$ = AddSubdirectory$(x$) + ".asm" + prt$ = AddSubdirectory$(x$) + ".prt" + drw$ = AddSubdirectory$(x$) + ".drw" + + GoSub RefreshDisp + If ExistsNew(asm$) Then + ' + ' Is this assembly already in the list of assemblies to scan? + ' + If right$(asm$, Len(Rootasm$)) = Rootasm$ Then + lsafnd = True + Else + lsafnd = False + For iv = 0 To lstSearchAsm.ListCount - 1 + If lstSearchAsm.List(iv) = asm$ Then + lsafnd = True + Exit For + End If + Next + End If + If Not (lsafnd) Then +' lstSearchAsm.AddItem asm$ +' perr = 97 +' On Error GoTo Ender +' Set nodX = TreeView1.Nodes.Add(Parent$, tvwChild, "X" + x$, x$ + ".asm") +' On Error GoTo 0 +' perr = 0 +' GoSub GetLevel + End If + GoSub RefreshDisp + If Not (ExistsNew(drw$)) Then + y$ = y$ + "|ERROR Assembly file found without drw file|0" + Else + y$ = y$ + "|Assembly file found|0" + End If + Else + ' + ' Is this part the root assembly? + ' + If right$(asm$, Len(Rootasm$)) = Rootasm$ Then + y$ = y$ + "|ERROR This Part file is the root assembly|0" + Else + If ExistsNew(prt$) Then + GoSub RefreshDisp + If Not ExistsNew(drw$) Then + y$ = y$ + "|ERROR Part file found without drw file|0" + Else + y$ = y$ + "|Part file found|0" + End If + perr = 96 + On Error GoTo Ender + Set nodX = TreeView1.Nodes.Add(Parent$, tvwChild, "X" + x$, x$ + ".prt") + On Error GoTo 0 + perr = 0 + GoSub GetLevel + Else + ' + 'I Model Search + ' + fndSps = False + Call WDTServer + For ext = 0 To lstIModels.ListCount - 1 + im$ = lstIModels.List(ext) + ipt$ = left$(im$, InStr(im$, ".") - 1) + If UCase$(ipt$) = UCase$(x$) Then + fndSps = True + End If + Next + + If fndSps Then + y$ = y$ + "|ERROR Part Found in Imodels|0" + On Error Resume Next + Set nodX = TreeView1.Nodes.Add(Parent$, tvwChild, "X" + x$, x$ + ".prt") + On Error GoTo 0 + + GoSub GetLevel + Else + If right$(asm$, Len(Rootasm$)) = Rootasm$ Then + y$ = y$ + "|Root Assembly file|0" + Else + y$ = y$ + "|ERROR No part file found|99" + End If + End If + End If + End If + End If + lstParts.AddItem y$ + End If + End If +Return +' +' Update all counters and timers on the form +' +RefreshDisp: +' lblAssembyCount.Caption = "cnt:" + Str$(lstSearchAsm.ListCount) + " Time: " + Format$((Timer - starttime!) / 60, "##0.00") + " mins" +' lblPartCount.Caption = lstParts.ListCount +' lstParts.ListIndex = lstParts.ListCount - 1 +' lstSearchAsm.ListIndex = lstSearchAsm.ListCount - 1 +DoEvents + +Return +' +' Find the parent node and get level number +' +GetLevel: + ixt = TreeView1.Nodes.Count + lvl$ = "" + parfnd = False + For ijx = 1 To TreeView1.Nodes.Count + If TreeView1.Nodes(ijx).Key = Parent$ Then + lvl$ = Trim$(Str$(Val(TreeView1.Nodes(ijx).Tag) + 1)) + parfnd = True + Exit For + End If + Next + TreeView1.Nodes(ixt).Tag = lvl$ +Return +''''''''''''+revnum +RemoveLastAssembly: + If lastpartadded$ <> "" Then + For imx = 0 To lstParts.ListCount - 1 + lstpt$ = lstParts.List(imx) + lstpt$ = left$(lstpt$, InStr(lstpt$, "|") - 1) + If lastpartadded$ = lstpt$ Then + lstParts.RemoveItem imx + Exit For + End If + Next + For i = 1 To TreeView1.Nodes.Count + If TreeView1.Nodes(i).Key = "X" + lastpartadded$ Then + TreeView1.Nodes.Remove (i) + Exit For + End If + Next + For i = 0 To lstSearchAsm.ListCount - 1 + If InStr(lstSearchAsm.List(i), lastpartadded$) <> 0 Then + lstSearchAsm.RemoveItem (i) + Exit For + End If + Next + + lastpartadded$ = "" + End If +Return +''''''''''''-revnum + +End Function + +Private Sub cmdHide_Click() + frmCheckAssembly.Hide +End Sub + +Private Sub Form_Load() + + frmCheckAssembly.Caption = App.Title + " Version " + AppRevision$ +' SUBSCFG$ = "\\fm1\eng\users\cadprint\subs.cfg" + Call LoadSubDirs + Call FillIModels(lstIModels) + +End Sub + + +Function AddSubdirectory$(p$) + AddSubdirectory$ = Subdirectory$(p$) + p$ +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 +' +Function Subdirectory$(part$) + subd$ = "" + If Len(part$) < 7 Then + Subdirectory$ = "" + Exit Function + End If + 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 +' Subdirectory$ = "\\fm1\eng\eng\drawings" + subd$ + Subdirectory$ = NETDRAW + subd$ + Subdirectory$ = NETDRAW + subd$ +End Function + + diff --git a/Cmdproc-4.log b/Cmdproc-4.log new file mode 100644 index 0000000..e56b83b --- /dev/null +++ b/Cmdproc-4.log @@ -0,0 +1 @@ +Line 51: Class ComctlLib.TreeView of control TreeView1 was not a loaded control class. diff --git a/Cmdproc-5.frm b/Cmdproc-5.frm new file mode 100644 index 0000000..df9e292 --- /dev/null +++ b/Cmdproc-5.frm @@ -0,0 +1,625 @@ +VERSION 5.00 +Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX" +Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX" +Begin VB.Form frmBOM + Caption = "BOM" + ClientHeight = 5085 + ClientLeft = 60 + ClientTop = 450 + ClientWidth = 9990 + ControlBox = 0 'False + LinkTopic = "Form1" + ScaleHeight = 5085 + ScaleWidth = 9990 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdReadSolidBOM + Caption = "Read SolidWorks BOM" + Height = 615 + Left = 5850 + TabIndex = 13 + Top = 3240 + Width = 1815 + End + Begin VB.CommandButton cmdReadAltimaBOM + Caption = "Read Altima BOM" + Height = 615 + Left = 4320 + TabIndex = 10 + Top = 3240 + Width = 1515 + End + Begin VB.ListBox lstStatus + Height = 1035 + Left = 540 + TabIndex = 9 + Top = 3870 + Width = 9405 + End + Begin VB.CommandButton cmdShow + Caption = "Show Loaded BOM" + Height = 615 + Left = 2670 + TabIndex = 8 + Top = 3240 + Width = 1635 + End + Begin VB.CommandButton cmdClearBOM + Caption = "Clear BOM" + Height = 615 + Left = 1620 + TabIndex = 7 + Top = 3240 + Width = 1035 + End + Begin VB.CommandButton cmdHide + Caption = "Close" + Height = 345 + Left = 8250 + TabIndex = 5 + Top = 60 + Width = 1635 + End + Begin VB.TextBox txtGood + Height = 255 + Left = 480 + TabIndex = 4 + Top = 2880 + Width = 1215 + End + Begin VB.CommandButton cmdReadBOM + Caption = "Read BOM" + Height = 615 + Left = 540 + TabIndex = 3 + Top = 3240 + Width = 1065 + End + Begin VB.TextBox txtBOM + Height = 255 + Left = 1200 + TabIndex = 2 + Text = "J:\Broyles\8235482.bom.1" + ToolTipText = "Full path and file name" + Top = 480 + Width = 8745 + End + Begin MSDataGridLib.DataGrid DataGrid1 + Bindings = "Cmdproc-5.frx":0000 + Height = 1575 + Left = 480 + TabIndex = 1 + Top = 840 + Width = 7155 + _ExtentX = 12621 + _ExtentY = 2778 + _Version = 393216 + HeadLines = 1 + RowHeight = 15 + FormatLocked = -1 'True + BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ColumnCount = 5 + BeginProperty Column00 + DataField = "WASM#" + Caption = "WASM#" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column01 + DataField = "WASMR" + Caption = "WASMR" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column02 + DataField = "WCMP#" + Caption = "WCMP#" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column03 + DataField = "WQTY" + Caption = "WQTY" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column04 + DataField = "WENTD" + Caption = "WENTD" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + SplitCount = 1 + BeginProperty Split0 + BeginProperty Column00 + EndProperty + BeginProperty Column01 + ColumnWidth = 645.165 + EndProperty + BeginProperty Column02 + EndProperty + BeginProperty Column03 + ColumnWidth = 1065.26 + EndProperty + BeginProperty Column04 + ColumnWidth = 1590.236 + EndProperty + EndProperty + End + Begin MSAdodcLib.Adodc Adodc1 + Height = 330 + Left = 480 + Top = 2460 + Width = 7155 + _ExtentX = 12621 + _ExtentY = 582 + ConnectMode = 0 + CursorLocation = 3 + IsolationLevel = -1 + ConnectionTimeout= 15 + CommandTimeout = 30 + CursorType = 3 + LockType = 3 + CommandType = 2 + CursorOptions = 0 + CacheSize = 50 + MaxRecords = 0 + BOFAction = 0 + EOFAction = 0 + ConnectStringType= 3 + Appearance = 1 + BackColor = -2147483643 + ForeColor = -2147483640 + Orientation = 0 + Enabled = -1 + Connect = "DSN=ODBCrms" + OLEDBString = "" + OLEDBFile = "" + DataSourceName = "ODBCrms" + OtherAttributes = "" + UserName = "EGNETLINK" + Password = "DRAWINGS" + RecordSource = "EGBWP1A0" + Caption = "Adodc1" + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + _Version = 393216 + End + Begin VB.TextBox txtAssembly + Height = 285 + Left = 1200 + TabIndex = 0 + Text = "82354821" + ToolTipText = "Must be 8 characters PN and rev" + Top = 120 + Width = 3255 + End + Begin VB.Label Label2 + Caption = "BOM File" + Height = 255 + Left = 450 + TabIndex = 12 + Top = 480 + Width = 855 + End + Begin VB.Label Label1 + Caption = "Assembly" + Height = 255 + Left = 450 + TabIndex = 11 + Top = 120 + Width = 855 + End + Begin VB.Label lblStat + Height = 195 + Left = 2340 + TabIndex = 6 + Top = 3000 + Width = 4635 + End +End +Attribute VB_Name = "frmBOM" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + +Public Sub cmdClearBOM_Click() + Dim Rcds As Variant + Dim Parms As Variant + + If cmdClearBOM.Tag <> "X" Then + cmdClearBOM.Tag = "X" + Set Links = New ClearBOM + ass$ = left(txtAssembly, 7) + rev$ = right(left(Trim(txtAssembly) + " ", 8), 1) + loglist ("StartClear - " + ass$ + " " + rev$) +' + p1$ = left$(ass$ + Space$(15), 15) 'partnumber to get + P2$ = left$(rev$ + Space$(1), 1) 'filename + p3$ = Space$(2) 'status +' + Parms = Array(p1$, P2$, p3$) + Links.cm_ACTIVEXSDK_CUSTINS.Execute Rcds, Parms, adCmdText + retcd$ = Links.cm_ACTIVEXSDK_CUSTINS.Parameters(2).value +' On Error GoTo BadCBom +'' +'' Clear out the old records +'' +' loglist ("clear rec " + "(([WASM#] = '" + ass$ + "') and ([WASMR] = '" + rev$ + "'))") +' Adodc1.Recordset.Filter = "(([WASM#] = '" + ass$ + "') and ([WASMR] = '" + rev$ + "'))" +' ix = 1 +' Adodc1.Recordset.MoveFirst +' Do While Adodc1.Recordset.RecordCount > 0 +' loglist "deleting rec rcnt: " + Str(ix) +' If ((UCase(Trim(Adodc1.Recordset![WASM#])) = Trim(UCase(ass$))) And (UCase(Trim(Adodc1.Recordset![WASMR])) = Trim(UCase(rev$)))) Then +' Adodc1.Recordset.Delete +' Adodc1.Recordset.MoveFirst +' Else +' Adodc1.Recordset.MoveNext +' End If +' ix = ix + 1 +' If Adodc1.Recordset.EOF Then Exit Do +' Loop + loglist "clear done! RC=" + retcd$ + cmdClearBOM.Tag = "" + Else + loglist "clear FAILED! BOM BUSY" + End If +' +Exit Sub +BadCBom: + Resume Next + ' Adodc1.Refresh +End Sub + +Private Sub cmdHide_Click() + frmBOM.Hide +End Sub + +Public Sub cmdReadAltimaBOM_Click() + If cmdReadAltimaBOM.Tag <> "X" Then + cmdReadAltimaBOM.Tag = "X" + + fln$ = txtBOM + ass$ = left(txtAssembly, 7) + rev$ = right(left(Trim(txtAssembly) + " ", 8), 1) + goodread = 0 + loglist ("StartRead alt - " + ass$) + loglist (" from file - " + fln$) +' lblStat.Caption = "StartRead" + If ExistsNew(fln$) Then + On Error GoTo BadAltBom +' +' parse the file +' + loglist "Parsing file " + fln$ + fl = FreeFile + BomRecs = 0 + Open fln$ For Input As #fl + ' + ' skip first two records + ' + Line Input #fl, a$ ' column headers + Line Input #fl, a$ ' blank line + + flstate = 0 + Do While Not EOF(fl) + Line Input #fl, a$ + ax$ = UCase(a$) + If Trim(ax$) <> "" Then + Call PARSE(ax$, qty$, ",", RC%): qty$ = ReplaceStr(qty$, Chr$(34), "") + Call PARSE(ax$, Pn$, ",", RC%): Pn$ = left(ReplaceStr(Pn$, Chr$(34), ""), 7) + + If Pn$ <> "" Then + 'Pn$ = prt$ + loglist "Adding rec:" + ass$ + Pn$ + qut$ = Format(qty, "#.0") + Adodc1.Recordset.AddNew + Adodc1.Recordset![WASM#] = UCase(ass$) + Adodc1.Recordset!WASMR = UCase(rev$) + Adodc1.Recordset![WCMP#] = Pn$ + Adodc1.Recordset!WQTY = LPad(Format(Val(qut$), "####.000"), 8) + Adodc1.Recordset!WENTD = Format(Now, "YYYYMMDDHHNNSS") + Adodc1.Recordset.Update + BomRecs = BomRecs + 1 + End If + End If + Loop + Close #fl + loglist "Done!" + If BomRecs = 0 Then + goodread = 1 ' bad bom + loglist "BAD altBOM No Records added" + End If + Else + loglist "BAD altBOM Didn't find BOM - " + fln$ + goodread = 2 ' No bom + End If + txtGood.Text = goodread + txtBOM = "" + txtAssembly = "" + Adodc1.Refresh + cmdReadAltimaBOM.Tag = "" + Else + loglist "altBOM BUSY" + End If + On Error GoTo 0 +AltBOMDIE: +Exit Sub +BadAltBom: + txtGood.Text = 1 ' bad bom + txtBOM = "" + txtAssembly = "" + loglist "BAD altBOM On ERROR Kick out" +' Adodc1.Refresh + cmdReadAltimaBOM.Tag = "" + Resume AltBOMDIE +End Sub +Public Sub cmdReadSolidBOM_Click() + Call ReadSolidBOM +End Sub + +Public Sub ReadSolidBOM() + If cmdReadSolidBOM.Tag <> "X" Then + cmdReadSolidBOM.Tag = "X" + + fln$ = txtBOM + ass$ = left(txtAssembly, 7) + rev$ = right(left(Trim(txtAssembly) + " ", 8), 1) + goodread = 0 + loglist ("StartRead SW - " + ass$ + " " + rev$) + loglist (" from file - " + fln$) + +' lblStat.Caption = "StartRead" + If ExistsNew(fln$) Then +' +' parse the file +' +' Tab Delimited ignore first line +' +' ItemNoPartNoQtyDescr +' + loglist "File Exists " + fl = FreeFile + BomRecs = 0 + Open fln$ For Input As #fl + flstate = 0 + If Not EOF(fl) Then + bad = False + For ix = 1 To Len(a$) + b = Asc(Mid(a$, ix, 1)) + If b >= 255 Then + bad = True + Exit For + End If + Next + End If + Close fl + If bad Then + goodread = 1 'bad bom + txtGood.Text = goodread + txtBOM = "" + txtAssembly = "" + loglist "BOM BAD" + Else + Open fln$ For Input As #fl + Do While Not EOF(fl) + Line Input #fl, a$ + ax$ = UCase(a$) + loglist "Number of Tabs in rec: " + Str(Howmany%(ax$, Chr(9))) + If left(ax$, 4) = "ITEM" Then ax$ = "" 'ignore heading + If Trim(ax$) <> "" Then + Call PARSE(ax$, itm$, Chr(9), rcx%) + Call PARSE(ax$, Pn$, Chr(9), rcx%) + Call PARSE(ax$, quty$, Chr(9), rcx%) + loglist "Adding rec:" + ass$ + Pn$ + qut$ = Format(Val(quty$), "#.0") + Adodc1.Recordset.AddNew + Adodc1.Recordset![WASM#] = UCase(ass$) + loglist UCase(ass$) + Adodc1.Recordset!WASMR = UCase(rev$) + loglist UCase(rev$) + Adodc1.Recordset![WCMP#] = Pn$ + loglist Pn$ + Adodc1.Recordset!WQTY = LPad(Format(Val(qut$), "####.000"), 8) + loglist LPad(Format(Val(qut$), "####.000"), 8) + Adodc1.Recordset!WENTD = Format(Now, "YYYYMMDDHHNNSS") + loglist Format(Now, "YYYYMMDDHHNNSS") + Adodc1.Recordset.Update + loglist "----------" + BomRecs = BomRecs + 1 + End If + Loop + Close #fl + End If + End If + txtGood.Text = goodread + txtBOM = "" + txtAssembly = "" + Adodc1.Refresh + loglist "----------complete----------" + cmdReadSolidBOM.Tag = "" + Else + loglist "BOM BUSY" + End If + On Error GoTo 0 +End Sub + +Public Sub cmdReadBOM_Click() + If cmdReadBOM.Tag <> "X" Then + cmdReadBOM.Tag = "X" + + fln$ = txtBOM + ass$ = left(txtAssembly, 7) + rev$ = right(left(Trim(txtAssembly) + " ", 8), 1) + goodread = 0 + loglist ("StartRead - " + ass$) +' lblStat.Caption = "StartRead" + If ExistsNew(fln$) Then + On Error GoTo BadBom +' +' parse the file +' +' 1 Sub-Assembly 8241378 +'--qty-|----descr----|---PN-- +'123456789012345678901234567890 +' 12345678901234 +' 1-6 8-20 22-> +' left(ax$,6):mid(ax$,8,24):mid(ax$,22) +' + loglist "Parsing file " + fln$ + fl = FreeFile + BomRecs = 0 + Open fln$ For Input As #fl + flstate = 0 + Do While Not EOF(fl) + Line Input #fl, a$ + ax$ = UCase(a$) + Select Case flstate + Case 0 + If InStr(ax$, "ASSEMBLY") <> 0 Then + flstate = 1 + End If + Case 1 + If Trim(ax$) = "" Then + flstate = 2 + Else + dsc$ = Trim(Mid(ax$, 8, 14)): prt$ = Mid(ax$, 22) + qty = Val(Trim(left(ax$, 6))) + Pn$ = "" + + d = 0 + If (dsc$ <> "PART") And (dsc$ <> "SUB-ASSEMBLY") Then + loglist "BAD BOM dsc wasn't right - " + dsc$ + goodread = 1 ' bad bom + flstate = 2 + Else + Pn$ = prt$ + loglist "Adding rec:" + ass$ + Pn$ + qut$ = Format(qty, "#.0") + Adodc1.Recordset.AddNew + Adodc1.Recordset![WASM#] = UCase(ass$) + Adodc1.Recordset!WASMR = UCase(rev$) + Adodc1.Recordset![WCMP#] = Pn$ + Adodc1.Recordset!WQTY = LPad(Format(Val(qut$), "####.000"), 8) + Adodc1.Recordset!WENTD = Format(Now, "YYYYMMDDHHNNSS") + Adodc1.Recordset.Update + BomRecs = BomRecs + 1 + End If + End If + Case Else + Exit Do + End Select + Loop + Close #fl + loglist "Done!" + If BomRecs = 0 Then + goodread = 1 ' bad bom + loglist "BAD BOM No Records added" + End If + Else + loglist "BAD BOM Didn't find BOM - " + fln$ + goodread = 2 ' No bom + End If + txtGood.Text = goodread + txtBOM = "" + txtAssembly = "" + Adodc1.Refresh + cmdReadBOM.Tag = "" + Else + loglist "BOM BUSY" + End If + On Error GoTo 0 +BOMDIE: +Exit Sub +BadBom: + txtGood.Text = 1 ' bad bom + txtBOM = "" + txtAssembly = "" + loglist "BAD BOM On ERROR Kick out" +' Adodc1.Refresh + cmdReadBOM.Tag = "" + Resume BOMDIE +End Sub + +Private Sub cmdShow_Click() + ass$ = left(txtAssembly, 7) + rev$ = right(left(Trim(txtAssembly) + " ", 8), 1) + loglist "Start Display of BOM - " + ass$ + " " + rev$ + On Error Resume Next +' +' Clear out the old records +' + loglist "clear rec " + "(([WASM#] = '" + ass$ + "') and ([WASMR] = '" + rev$ + "'))" + Adodc1.Recordset.Filter = "(([WASM#] = '" + ass$ + "') and ([WASMR] = '" + rev$ + "'))" + +End Sub + +Private Sub loglist(xxx$) + lblStat.Caption = xxx$ + lstStatus.AddItem xxx$ + While lstStatus.ListCount > 600 + lstStatus.RemoveItem (0) + Wend + +End Sub + diff --git a/Cmdproc-5.frx b/Cmdproc-5.frx new file mode 100644 index 0000000..9f293d8 Binary files /dev/null and b/Cmdproc-5.frx differ diff --git a/Cmdproc-5.log b/Cmdproc-5.log new file mode 100644 index 0000000..68dad60 --- /dev/null +++ b/Cmdproc-5.log @@ -0,0 +1 @@ +Line 86: Class MSDataGridLib.DataGrid of control DataGrid1 was not a loaded control class. diff --git a/Cmdproc-6.frm b/Cmdproc-6.frm new file mode 100644 index 0000000..69f6570 --- /dev/null +++ b/Cmdproc-6.frm @@ -0,0 +1,406 @@ +VERSION 5.00 +Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX" +Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDatGrd.ocx" +Begin VB.Form frmFolderCopy + Caption = "Folder Copy" + ClientHeight = 7335 + ClientLeft = 60 + ClientTop = 450 + ClientWidth = 8400 + LinkTopic = "Form1" + ScaleHeight = 7335 + ScaleWidth = 8400 + StartUpPosition = 3 'Windows Default + Begin MSDataGridLib.DataGrid DataGrid1 + Bindings = "Cmdproc-6.frx":0000 + Height = 915 + Left = 300 + TabIndex = 7 + Top = 5370 + Width = 8025 + _ExtentX = 14155 + _ExtentY = 1614 + _Version = 393216 + HeadLines = 1 + RowHeight = 15 + FormatLocked = -1 'True + BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ColumnCount = 4 + BeginProperty Column00 + DataField = "HFLD#" + Caption = "HFLD#" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column01 + DataField = "HPRD#" + Caption = "HPRD#" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column02 + DataField = "HHEX" + Caption = "HHEX" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + BeginProperty Column03 + DataField = "HENTD" + Caption = "HENTD" + BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} + Type = 0 + Format = "" + HaveTrueFalseNull= 0 + FirstDayOfWeek = 0 + FirstWeekOfYear = 0 + LCID = 1033 + SubFormatType = 0 + EndProperty + EndProperty + SplitCount = 1 + BeginProperty Split0 + BeginProperty Column00 + ColumnWidth = 1275.024 + EndProperty + BeginProperty Column01 + ColumnWidth = 1260.284 + EndProperty + BeginProperty Column02 + ColumnWidth = 3209.953 + EndProperty + BeginProperty Column03 + ColumnWidth = 1590.236 + EndProperty + EndProperty + End + Begin VB.ListBox List2 + Height = 1425 + Left = 300 + TabIndex = 6 + Top = 3870 + Width = 8025 + End + Begin VB.CommandButton cmdReadFileNames + Caption = "Read File Names" + Height = 345 + Left = 4620 + TabIndex = 5 + Top = 60 + Width = 3675 + End + Begin VB.FileListBox File1 + Height = 3015 + Left = 4650 + TabIndex = 4 + Top = 450 + Width = 3645 + End + Begin VB.ListBox List1 + Height = 1815 + Left = 300 + TabIndex = 3 + Top = 1560 + Width = 4095 + End + Begin VB.CommandButton Command1 + Caption = "Copy Folder" + Height = 435 + Left = 690 + TabIndex = 2 + Top = 900 + Width = 2955 + End + Begin VB.TextBox pthDst + Height = 285 + Left = 120 + TabIndex = 1 + Text = "Q:\A\8074932D" + Top = 420 + Width = 4335 + End + Begin VB.TextBox pthSrc + Height = 285 + Left = 120 + TabIndex = 0 + Text = "\\fryfs001v\eng\users\FEDUCIA\8074932D" + Top = 90 + Width = 4335 + End + Begin MSAdodcLib.Adodc Adodc1 + Height = 330 + Left = 360 + Top = 3540 + Visible = 0 'False + Width = 8025 + _ExtentX = 14155 + _ExtentY = 582 + ConnectMode = 0 + CursorLocation = 3 + IsolationLevel = -1 + ConnectionTimeout= 15 + CommandTimeout = 30 + CursorType = 3 + LockType = 3 + CommandType = 2 + CursorOptions = 0 + CacheSize = 50 + MaxRecords = 0 + BOFAction = 0 + EOFAction = 0 + ConnectStringType= 3 + Appearance = 1 + BackColor = -2147483643 + ForeColor = -2147483640 + Orientation = 0 + Enabled = -1 + Connect = "DSN=ODBCrms" + OLEDBString = "" + OLEDBFile = "" + DataSourceName = "ODBCrms" + OtherAttributes = "" + UserName = "EGNETLINK" + Password = "DRAWINGS" + RecordSource = "EGSHP1A0" + Caption = "Adodc1" + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + _Version = 393216 + End +End +Attribute VB_Name = "frmFolderCopy" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved. +' Some pages may also contain other copyrights by the author. +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +' Distribution: You can freely use this code in your own +' applications, but you may not reproduce +' or publish this code on any web site, +' online service, or distribute as source +' on any media without express permission. +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +Private Const INVALID_HANDLE_VALUE = -1 +Private Const MAX_PATH As Long = 260 + +Private Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long + End Type + +Private Type WIN32_FIND_DATA + dwFileAttributes As Long + ftCreationTime As FILETIME + ftLastAccessTime As FILETIME + ftLastWriteTime As FILETIME + nFileSizeHigh As Long + nFileSizeLow As Long + dwReserved0 As Long + dwReserved1 As Long + cFileName As String * MAX_PATH + cAlternate As String * 14 +End Type + +Private Type SECURITY_ATTRIBUTES + nLength As Long + lpSecurityDescriptor As Long + bInheritHandle As Long +End Type + +Private Declare Function CreateDirectory Lib "kernel32" _ + Alias "CreateDirectoryA" _ + (ByVal lpPathName As String, _ + lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long + +Private Declare Function CopyFile Lib "kernel32" _ + Alias "CopyFileA" _ + (ByVal lpExistingFileName As String, _ + ByVal lpNewFileName As String, _ + ByVal bFailIfExists As Long) As Long + +Private Declare Function FindFirstFile Lib "kernel32" _ + Alias "FindFirstFileA" _ + (ByVal lpFileName As String, _ + lpFindFileData As WIN32_FIND_DATA) As Long + +Private Declare Function FindNextFile Lib "kernel32" _ + Alias "FindNextFileA" _ + (ByVal hFindFile As Long, _ + lpFindFileData As WIN32_FIND_DATA) As Long + +Private Declare Function FindClose Lib "kernel32" _ + (ByVal hFindFile As Long) As Long + +Dim fsoMain As FileSystemObject + + +Private Sub cmdReadFileNames_Click() + cmdReadFileNames.Enabled = False + + On Error Resume Next + pthd$ = pthDst.Text + 'SW00007C + List2.Clear + File1.Path = pthd$ + fldr$ = UCase(Mid(pthd$, LastStr(pthd$, "\") + 1)) + Pn$ = UCase(left(fldr$, 7)) + File1.Refresh + + If File1.Path = pthd$ Then + + Recname$ = pthd$ + recn# = 0 + retry# = 0 + If (Adodc1.Recordset.RecordCount <> 0) Then Adodc1.Recordset.MoveFirst + Do While (Not (Adodc1.Recordset.EOF)) And (Adodc1.Recordset.RecordCount <> 0) + + rfld$ = UCase(Trim(Adodc1.Recordset![HFLD#])) + If rfld$ = fldr$ Then + Adodc1.Recordset.Delete + Pause (1) + retry# = retry# + 1 + Else + recn# = recn# + 1 + Adodc1.Recordset.MoveNext + End If + cmdReadFileNames.Caption = "retry=" + Str(retry#) + " - Recnum=" + Str(recn#) + Loop + cmdReadFileNames.Caption = "delete complete" + On Error GoTo 0 + If File1.ListCount > 0 Then + For ixc = 0 To File1.ListCount - 1 + nw$ = Format(Now, "yyyymmddhhnnss") + d# = Val(nw$) + flx$ = File1.List(ixc) + ' + ' add the record + List2.AddItem fldr$ + "|" + Pn$ + "|" + nw$ + "|" + flx$ + Adodc1.Recordset.AddNew + Adodc1.Recordset![HFLD#] = fldr$ + Adodc1.Recordset![HPRD#] = Pn$ + Adodc1.Recordset!HHEX = RPad(flx$, 70) + Adodc1.Recordset!HENTD = d# + Adodc1.Recordset.Update + ' + Next + End If + End If + cmdReadFileNames.Caption = "Read File Names" + cmdReadFileNames.Enabled = True + +End Sub + +Private Sub Command1_Click() + + Dim sSourcePath As String + Dim sDestination As String + Dim sFiles As String + Dim numCopied As Long + + 'set the appropriate initializing values + sSourcePath = pathCheck(pthSrc) + sDestination = pathCheck(pthDst) + sFiles = "*.*" + + 'perform the copy and return the copied file count + numCopied = 0 + Call Copydir(sSourcePath, sDestination, Rc%) + numCopied = Rc% + Call DeleteDir(sSourcePath) +End Sub +Public Sub Copydir(sSourcePath As String, sDestination As String, iRetCd As Integer) + + Dim numCopied, numDeleted As Long + Dim fsosub As New FileSystemObject + + 'set the appropriate initializing values + + pthDst = pathCheck(sDestination) + pthSrc = pathCheck(sSourcePath) + pthDst = left(pthDst, Len(pthDst) - 1) + pthSrc = left(pthSrc, Len(pthSrc) - 1) + + ce = 0: On Error GoTo erretcopy + + Call fsosub.CopyFolder(pthSrc, pthDst, True) + On Error GoTo 0 + ' + 'place filenames in folder into the as400 + ' + If ce = 0 Then + Call cmdReadFileNames_Click + End If + + iRetCd = ce + Pause (2) +Exit Sub +erretcopy: + ce = 1 + Resume Next +End Sub +Public Sub KillDir(sSourcePath As String, iRetCd As Integer) + + Dim sFiles As String + Dim numCopied, numDeleted As Long + + 'set the appropriate initializing values + sSourcePath = pathCheck(sSourcePath) + 'MsgBox numCopied & " files copied to " & sDestination + Call DeleteDir(sSourcePath) + iRetCd = 0 +End Sub +Private Sub DeleteDir(sSourcePath As String) +On Error Resume Next + Dim fsosub As New FileSystemObject + pthn$ = pathCheck(sSourcePath) + pthn$ = left(pthn$, Len(pthn$) - 1) + Call fsosub.DeleteFolder(pthn$, True) +End Sub + diff --git a/Cmdproc-6.frx b/Cmdproc-6.frx new file mode 100644 index 0000000..9f293d8 Binary files /dev/null and b/Cmdproc-6.frx differ diff --git a/Cmdproc-6.log b/Cmdproc-6.log new file mode 100644 index 0000000..03aad73 --- /dev/null +++ b/Cmdproc-6.log @@ -0,0 +1 @@ +Line 14: Class MSDataGridLib.DataGrid of control DataGrid1 was not a loaded control class. diff --git a/DWPORT.CLS b/DWPORT.CLS new file mode 100644 index 0000000..0ea8de9 --- /dev/null +++ b/DWPORT.CLS @@ -0,0 +1,77 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "dwPortInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' Desaware API Class library +' Copyright (c) 1995-1997 by Desaware Inc. +' All rights reserved + +' Preliminary demonstration edition + +Option Explicit + +Private Type PORT_INFO_1 + pName As Long +End Type + +Private Type PORT_INFO_2 + pPortName As Long + pMonitorName As Long + pDescription As Long + fPortType As Long + Reserved As Long +End Type + +Public pName$ +Public pMonitorName$ +Public pDescription$ +Public fPortType& +Public Level& + + + +Public Sub LoadInfo(Buf As Byte, pLevel&, x&) + Level = pLevel + Select Case Level + Case 1 + LoadPortInfo1 Buf, x& + Case 2 + LoadPortInfo2 Buf, x& + End Select +End Sub + +Public Sub LoadPortInfo1(Buf As Byte, x&) + Dim pi As PORT_INFO_1 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + If (pi.pName <> 0) Then pName = agGetStringFromPointer(pi.pName) +End Sub +Public Sub LoadPortInfo2(Buf As Byte, x&) + Dim pi As PORT_INFO_2 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + pPortName = agGetStringFromPointer(pi.pPortName) + pMonitorName = agGetStringFromPointer(pi.pMonitorName) + pDescription = agGetStringFromPointer(pi.pDescription) + fPortType = pi.fPortType +End Sub + +' pPortName is an alias for pName +Public Property Get pPortName() As String + pPortName = pName +End Property + +Public Property Let pPortName(ByVal vNewValue$) + pName = vNewValue +End Property diff --git a/DWPRINFO.CLS b/DWPRINFO.CLS new file mode 100644 index 0000000..d01b7c4 --- /dev/null +++ b/DWPRINFO.CLS @@ -0,0 +1,206 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "dwPrinterInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' Desaware API Class library +' Copyright (c) 1995-1997 by Desaware +' All rights reserved + +' Preliminary demonstration edition + +Option Explicit +Private Type PRINTER_INFO_1 + Flags As Long + pDescription As Long + pName As Long + pComment As Long +End Type + +Private Type PRINTER_INFO_2 + pServerName As Long + pPrinterName As Long + pShareName As Long + pPortName As Long + pDriverName As Long + pComment As Long + pLocation As Long + pDevMode As Long ' Pointer to DEVMODE + pSepFile As String + pPrintProcessor As Long + pDatatype As Long + pParameters As Long + pSecurityDescriptor As Long ' Pointer to SECURITY_DESCRIPTOR + Attributes As Long + Priority As Long + DefaultPriority As Long + StartTime As Long + UntilTime As Long + Status As Long + cJobs As Long + AveragePPM As Long +End Type + +Private Type PRINTER_INFO_3 + pSecurityDescriptor As Long ' Pointer to SECURITY_DESCRIPTOR +End Type + +Private Type PRINTER_INFO_4 + pPrinterName As Long + pServerName As Long + Attributes As Long +End Type + +Private Type PRINTER_INFO_5 + pPrinterName As Long + pPortName As Long + Attributes As Long + DeviceNotSelectedTimeout As Long + TransmissionRetryTimeout As Long +End Type + +Public Flags& +Public pDescription$ +Public pName$ +Public pComment$ +Public pServerName$ +Public pPrinterName$ +Public pShareName$ +Public pPortName$ +Public pDriverName$ +Public pLocation$ +Private pDevMode As DEVMODE +Public pSepFile$ +Public pPrintProcessor$ +Public pDatatype$ +Public pParameters$ +Public Attributes& +Public Priority& +Public DefaultPriority& +Public StartTime& +Public UntilTime& +Public Status& +Public cJobs& +Public AveragePPM& +Public DeviceNotSelectedTimeout& +Public TransmissionRetryTimeout& +Private pSecurityDescriptor As SECURITY_DESCRIPTOR +Public Level& ' Level for which this object was created + +Public Sub ResetContents() + Flags = 0 + pDescription$ = "" + pName$ = "" + pComment$ = "" + pServerName$ = "" + pPrinterName$ = "" + pShareName$ = "" + pPortName$ = "" + pDriverName$ = "" + pLocation$ = "" + pSepFile$ = "" + pPrintProcessor$ = "" + pDatatype$ = "" + pParameters$ = "" + Attributes& = 0 + Priority& = 0 + DefaultPriority& = 0 + StartTime& = 0 + UntilTime& = 0 + Status& = 0 + cJobs& = 0 + AveragePPM& = 0 + DeviceNotSelectedTimeout& = 0 + TransmissionRetryTimeout& = 0 +End Sub + +' Load information from a byte structure +Public Sub LoadInfo(Buf As Byte, pLevel&, x&) + Level = pLevel + Select Case Level + Case 1 + LoadPrinterInfo1 Buf, x& + Case 2 + LoadPrinterInfo2 Buf, x& + Case 4 + LoadPrinterInfo4 Buf, x& + Case 5 + LoadPrinterInfo5 Buf, x& + End Select +End Sub +' Load from PRINTER_INFO_1 +Public Sub LoadPrinterInfo1(Buf As Byte, x&) + Dim pi As PRINTER_INFO_1 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + Flags = pi.Flags + pDescription = agGetStringFromPointer(pi.pDescription) + pName = agGetStringFromPointer(pi.pName) + pComment = agGetStringFromPointer(pi.pComment) +End Sub + +' Load from PRINTER_INFO_2 +Public Sub LoadPrinterInfo2(Buf As Byte, x&) + Dim pi As PRINTER_INFO_2 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + + pServerName = agGetStringFromPointer(pi.pServerName) + pPrinterName = agGetStringFromPointer(pi.pPrinterName) + pShareName = agGetStringFromPointer(pi.pShareName) + pPortName = agGetStringFromPointer(pi.pPortName) + pDriverName = agGetStringFromPointer(pi.pDriverName) + pComment = agGetStringFromPointer(pi.pComment) + pLocation = agGetStringFromPointer(pi.pLocation) + agCopyData ByVal pi.pDevMode, pDevMode, Len(pDevMode) + agCopyData ByVal pi.pSecurityDescriptor, pSecurityDescriptor, Len(pSecurityDescriptor) + pSepFile = agGetStringFromPointer(pi.pSepFile) + pPrintProcessor = agGetStringFromPointer(pi.pPrintProcessor) + pDatatype = agGetStringFromPointer(pi.pDatatype) + pParameters = agGetStringFromPointer(pi.pParameters) + Attributes = pi.Attributes + Priority = pi.Priority + DefaultPriority = pi.DefaultPriority + StartTime = pi.StartTime + UntilTime = pi.UntilTime + Status = pi.Status + cJobs = pi.cJobs + AveragePPM = pi.AveragePPM +End Sub +' Load from PRINTER_INFO_4 +Public Sub LoadPrinterInfo4(Buf As Byte, x&) + Dim pi As PRINTER_INFO_4 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + pPrinterName = agGetStringFromPointer(pi.pPrinterName) + pServerName = agGetStringFromPointer(pi.pServerName) + Attributes = pi.Attributes +End Sub + +Public Sub LoadPrinterInfo5(Buf As Byte, x&) + Dim pi As PRINTER_INFO_5 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + pPrinterName = agGetStringFromPointer(pi.pPrinterName) + pPortName = agGetStringFromPointer(pi.pPortName) + Attributes = pi.Attributes + DeviceNotSelectedTimeout = pi.DeviceNotSelectedTimeout + TransmissionRetryTimeout = pi.TransmissionRetryTimeout +End Sub + diff --git a/DWPRMON.CLS b/DWPRMON.CLS new file mode 100644 index 0000000..de4125b --- /dev/null +++ b/DWPRMON.CLS @@ -0,0 +1,65 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "dwPrintMonitor" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' Desaware API Class library +' Copyright (c) 1995-1997 by Desaware +' All rights reserved + +' Preliminary demonstration edition + + +Option Explicit + +Public pName$ ' Print monitor name +Public pEnvironment$ ' Environment for monitor +Public pDLLName$ ' DLL name of print monitor +Public Level& + +Private Type MONITOR_INFO_1 + pName As Long +End Type + +Private Type MONITOR_INFO_2 + pName As Long + pEnvironment As Long + pDLLName As Long +End Type + +Public Sub LoadInfo(Buf As Byte, pLevel&, x&) + Level = pLevel + Select Case Level + Case 1 + LoadMonitorInfo1 Buf, x& + Case 2 + LoadMonitorInfo2 Buf, x& + End Select +End Sub + +Public Sub LoadMonitorInfo1(Buf As Byte, x&) + Dim pi As MONITOR_INFO_1 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + If (pi.pName <> 0) Then pName = agGetStringFromPointer(pi.pName) +End Sub + +Public Sub LoadMonitorInfo2(Buf As Byte, x&) + Dim pi As MONITOR_INFO_2 + Dim offset& + Dim useaddr& + offset& = x * Len(pi) + useaddr& = agGetAddressForObject(Buf) + offset + Call agCopyData(ByVal useaddr, pi, Len(pi)) + If (pi.pName <> 0) Then pName = agGetStringFromPointer(pi.pName) + If (pi.pEnvironment <> 0) Then pEnvironment = agGetStringFromPointer(pi.pEnvironment) + If (pi.pDLLName <> 0) Then pDLLName = agGetStringFromPointer(pi.pDLLName) +End Sub + diff --git a/DWSPOOL.CLS b/DWSPOOL.CLS new file mode 100644 index 0000000..22feea6 --- /dev/null +++ b/DWSPOOL.CLS @@ -0,0 +1,110 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "dwSpool" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' Desaware API Class library +' Copyright (c) 1995-1997 by Desaware +' All rights reserved + +' Preliminary demonstration edition + +Option Explicit + +Private Declare Function apiEnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal Flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long +Private Declare Function apiEnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, lpbPorts As Byte, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long +Private Declare Function apiEnumMonitors Lib "winspool.drv" Alias "EnumMonitorsA" (ByVal pName As String, ByVal Level As Long, pMonitors As Byte, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long + +Private Declare Function GetLastError Lib "kernel32" () As Long + + + + +' Retrieves a collection of printer objects +Public Function EnumPrinters(Flags As Long, Name As String, Level As Long) As Collection + Dim needed& + Dim returned& + Dim res& + Dim tbt As Byte + Dim usename$ + Dim cprinters As New Collection + Dim x& + Dim ppi As dwPrinterInfo + If Name$ = "" Then usename$ = vbNullString Else usename$ = Name + res& = apiEnumPrinters(Flags, usename$, Level, tbt, 0, needed, returned) + If needed& = 0 Then + Set EnumPrinters = cprinters + Exit Function + End If + ReDim ResultBuffer(needed) As Byte + res& = apiEnumPrinters(Flags, usename$, Level, ResultBuffer(0), needed, needed, returned) + + ' Now enumerate create an object for each printer structure + For x = 1 To returned + Set ppi = New dwPrinterInfo + Call ppi.LoadInfo(ResultBuffer(0), Level, x - 1) + cprinters.Add ppi + Next x + Set EnumPrinters = cprinters +End Function + +' Retrieves a collection of printer objects +Public Function EnumPorts(Server As String, Level As Long) As Collection + Dim needed& + Dim returned& + Dim res& + Dim tbt As Byte + Dim useserver$ + Dim cports As New Collection + Dim x& + Dim ppi As dwPortInfo + If Server$ = "" Then useserver$ = vbNullString Else useserver$ = Server + res& = apiEnumPorts(useserver, Level, tbt, 0, needed, returned) + If needed& = 0 Then + Set EnumPorts = cports + Exit Function + End If + ReDim ResultBuffer(needed) As Byte + res& = apiEnumPorts(useserver, Level, ResultBuffer(0), needed, needed, returned) + Debug.Print GetLastError() + ' Now enumerate create an object for each printer structure + For x = 1 To returned + Set ppi = New dwPortInfo + Call ppi.LoadInfo(ResultBuffer(0), Level, x - 1) + cports.Add ppi + Next x + Set EnumPorts = cports +End Function + +' Retrieves a collection of monitor objects +Public Function EnumMonitors(Server As String, Level As Long) As Collection + Dim needed& + Dim returned& + Dim res& + Dim tbt As Byte + Dim useserver$ + Dim cmonitors As New Collection + Dim x& + Dim ppi As dwPrintMonitor + If Server$ = "" Then useserver$ = vbNullString Else useserver$ = Server + res& = apiEnumPorts(useserver, Level, tbt, 0, needed, returned) + If needed& = 0 Then + Set EnumMonitors = cmonitors + Exit Function + End If + ReDim ResultBuffer(needed) As Byte + res& = apiEnumMonitors(useserver, Level, ResultBuffer(0), needed, needed, returned) + Debug.Print GetLastError() + ' Now enumerate create an object for each printer structure + For x = 1 To returned + Set ppi = New dwPrintMonitor + Call ppi.LoadInfo(ResultBuffer(0), Level, x - 1) + cmonitors.Add ppi + Next x + Set EnumMonitors = cmonitors +End Function + diff --git a/MSSCCPRJ.SCC b/MSSCCPRJ.SCC new file mode 100644 index 0000000..1cf9a6c --- /dev/null +++ b/MSSCCPRJ.SCC @@ -0,0 +1,11 @@ +[SCC] +SCC=This is a source code control file +[Cmndproc.vbp] +SCC_Project_Name=this project is not under source code control +SCC_Aux_Path= +[SPOOLER.VBP] +SCC_Project_Name=this project is not under source code control +SCC_Aux_Path= +[TestFolder.VBP] +SCC_Project_Name=this project is not under source code control +SCC_Aux_Path= diff --git a/Makeps.BAT b/Makeps.BAT new file mode 100644 index 0000000..c76a43d --- /dev/null +++ b/Makeps.BAT @@ -0,0 +1,2 @@ +PSMODE Q:\2\2000000\2000768B.plt C:\t2.fil C:\T.FIL C:\CMDPBUFF.1 Y +copy c:\work\shelwait.hld c:\work\shelwait.go diff --git a/PRINTCFG.BAT b/PRINTCFG.BAT new file mode 100644 index 0000000..1df4176 --- /dev/null +++ b/PRINTCFG.BAT @@ -0,0 +1,2 @@ +NPRINT C:\CMDPBUFF.1 /NAM=2000768B_KEL /Q=Q-FAB NT NB NFF NNOTI +copy c:\work\shelwait.hld c:\work\shelwait.go diff --git a/Pdf.frm b/Pdf.frm new file mode 100644 index 0000000..820acb2 --- /dev/null +++ b/Pdf.frm @@ -0,0 +1,309 @@ +VERSION 5.00 +Begin VB.Form frmPDF + Caption = "PDF Printer" + ClientHeight = 7380 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 11355 + LinkTopic = "Form1" + ScaleHeight = 7380 + ScaleWidth = 11355 + StartUpPosition = 3 'Windows Default + Begin VB.TextBox txtPrintedBy + Height = 285 + Left = 1920 + TabIndex = 14 + Text = "FEDUCIA" + Top = 1200 + Width = 5730 + End + Begin VB.TextBox txtBanner + Height = 285 + Left = 1920 + TabIndex = 13 + Text = "Official Production Print" + Top = 1515 + Width = 5730 + End + Begin VB.ListBox List5 + Height = 3765 + Left = 5760 + TabIndex = 12 + Top = 3195 + Width = 1635 + End + Begin VB.ListBox List4 + Height = 3765 + Left = 4050 + TabIndex = 11 + Top = 3195 + Width = 1635 + End + Begin VB.ListBox List3 + Height = 3765 + Left = 2340 + TabIndex = 10 + Top = 3195 + Width = 1635 + End + Begin VB.ListBox List2 + Height = 3765 + Left = 630 + TabIndex = 9 + Top = 3195 + Width = 1635 + End + Begin VB.ListBox List1 + Height = 2790 + Left = 7785 + TabIndex = 8 + Top = 225 + Width = 3390 + End + Begin VB.Timer Timer1 + Left = 9960 + Top = 6000 + End + Begin VB.TextBox Text1 + Height = 735 + Left = 90 + MultiLine = -1 'True + TabIndex = 7 + Text = "Pdf.frx":0000 + Top = 2400 + Width = 7575 + End + Begin VB.TextBox txtPDFPrinter + Height = 285 + Left = 1890 + TabIndex = 6 + Text = "MIS LJ4000" + Top = 855 + Width = 5730 + End + Begin VB.CommandButton cmdPrintPDF + Caption = "Print PDF" + Height = 405 + Left = 120 + TabIndex = 4 + Top = 1920 + Width = 2040 + End + Begin VB.TextBox txtPDFtoPrint + Height = 285 + Left = 1890 + TabIndex = 3 + Text = "c:\files\test.pdf" + Top = 540 + Width = 5730 + End + Begin VB.TextBox txtAdobeStr + Height = 285 + Left = 1920 + TabIndex = 1 + Text = "C:\Program Files\Adobe\Acrobat 5.0\Acrobat\Acrobat.exe" + Top = 225 + Width = 5730 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "Printed By: " + Height = 240 + Index = 4 + Left = 120 + TabIndex = 16 + Top = 1245 + Width = 1725 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "Banner: " + Height = 240 + Index = 3 + Left = 120 + TabIndex = 15 + Top = 1560 + Width = 1725 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "Printer to Print to:" + Height = 240 + Index = 2 + Left = 90 + TabIndex = 5 + Top = 900 + Width = 1725 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "File To Print:" + Height = 240 + Index = 1 + Left = 90 + TabIndex = 2 + Top = 585 + Width = 1725 + End + Begin VB.Label Label1 + Alignment = 1 'Right Justify + Caption = "Adobe Start up string:" + Height = 240 + Index = 0 + Left = 90 + TabIndex = 0 + Top = 270 + Width = 1725 + End +End +Attribute VB_Name = "frmPDF" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Sub cmdPrintPDF_Click() +' cmdstr$ = "%Start% " + Chr$(34) + "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe" + Chr$(34) + " /N /T " + Chr$(34) + "%~1" + Chr$(34) + " " + Chr$(34) + "%~2" + Chr$(34) + "" + FileToPrint$ = txtPDFtoPrint.Text + PrinterToUse$ = txtPDFPrinter.Text + PrintedBy$ = txtPrintedBy.Text + Banner$ = txtBanner.Text + Call PrintAPDF(FileToPrint$, PrinterToUse$, PrintedBy$, Banner$) + +End Sub + +Private Sub Form_Load() + ppp$ = GetAdobeShellStr + If ppp$ <> "" Then + txtAdobeStr.Text = GetAdobeShellStr + End If + +End Sub + +Public Sub PrintAPDF(FileToPrint$, PrinterToUse$, PrintedBy$, Banner$) + txtPDFtoPrint.Text = FileToPrint$ + txtPDFPrinter.Text = PrinterToUse$ + txtPrintedBy.Text = PrintedBy$ + txtBanner.Text = Banner$ + + cmdstr$ = "C:\files\exefolder\printrequest " + Chr$(34) + "sendto=pdfPrinter mesg=" + FileToPrint$ + "|" + PrinterToUse$ + "|" + PrintedBy$ + "|" + Banner$ + Chr$(34) +' cmdstr$ = "cmd /c " + Chr$(34) + "START /MIN " + Chr$(34) + Chr$(34) + " " + Chr$(34) + txtAdobeStr + Chr$(34) + " /N /T " + Chr$(34) + FileToPrint$ + Chr$(34) + " " + Chr$(34) + PrinterToUse$ + Chr$(34) + "" + Chr$(34) + Text1.Text = cmdstr$ + + pid = Shell(cmdstr$, vbMinimizedNoFocus) + + Pause 2 + Do + Call LookForAndKillAdobeErrors + If List5.ListCount > 0 Then + Pause 2 + a = a + Else + Exit Do + End If + Loop + haldataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS" + chinadataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\CHINADRAWINGS" + MCFdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\MCFDRAWINGS" + HZdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\HZDRAWINGS" + + If PrintedBy$ = "CHINA" Then + fln$ = BreakFileName(FileToPrint, 3) + Call Fcopy(FileToPrint$, pathCheck$(chinadataarea$) + fln$, RC%) + Call PrintLog("Copy File - " + FileToPrint + " -> ") + Call PrintLog(" To -> " + pathCheck(chinadataarea) + fln) + Call PrintLog(" Results = " + Str(RC%)) + End If + + If PrintedBy$ = "MCF" Then + fln$ = BreakFileName(FileToPrint, 3) + Call Fcopy(FileToPrint$, pathCheck$(MCFdataarea$) + fln$, RC%) + Call PrintLog("Copy File - " + FileToPrint + " -> ") + Call PrintLog(" To -> " + pathCheck(MCFdataarea) + fln) + Call PrintLog(" Results = " + Str(RC%)) + End If + + If PrintedBy$ = "HZ" Then + fln$ = BreakFileName(FileToPrint, 3) + Call Fcopy(FileToPrint$, pathCheck$(HZdataarea$) + fln$, RC%) + Call PrintLog("Copy File - " + FileToPrint + " -> ") + Call PrintLog(" To -> " + pathCheck(HZdataarea) + fln) + Call PrintLog(" Results = " + Str(RC%)) + End If + + If PrintedBy$ = "QHAL" Then + fln$ = BreakFileName(FileToPrint, 3) + Call Fcopy(FileToPrint$, pathCheck$(haldataarea$) + fln$, RC%) + Call PrintLog("Copy File - " + FileToPrint + " -> ") + Call PrintLog(" To -> " + pathCheck(haldataarea) + fln) + Call PrintLog(" Results = " + Str(RC%)) + End If + + +End Sub + +Public Sub LookForAndKillAdobeErrors() +' +' this subroutine requires +' list2, list3,list4,list5 +' + List2.Clear +' Call findalllevel(0&, "Adobe Reader", List2) + Call findalllevel(0&, "Adobe Acrobat", List2) + ' + ' find children with error + ' + List5.Clear + For ix = 0 To List2.ListCount - 1 + zzz& = Val(Trim(List2.List(ix))) + List3.Clear + Call findalllevel(zzz&, "", List3) + If List3.ListCount > 0 Then + zzc& = Val(Trim(List3.List(0))) + List4.Clear + Call findalllevel(zzc&, "There was an error", List4) + If List4.ListCount > 0 Then + List4.Clear + Call findalllevel(zzc&, "OK", List4) + If List4.ListCount > 0 Then + List5.AddItem Trim(List4.List(0)) + End If + End If + End If + Next + For ix = 0 To List5.ListCount - 1 + pid$ = List5.List(ix) + zzc& = Val(Trim(pid$)) + ck& = SetForegroundWindow(zzc&) + ck& = SetFocusAPI(zzc&) + Pause (0.2) + Call SendKeys("~") + Next +End Sub +Private Sub findalllevel(lvl&, WindowString$, List1 As ListBox) +' +xxt& = lvl& +hdl& = 0 +Do + hdl& = FindWindowEx&(xxt&, hdl&, vbNullString, vbNullString) + If WindowString$ = "" Then + List1.AddItem Str(hdl&) + Else + wn$ = left(WindowName$(hdl&), Len(WindowString$)) + If wn$ = WindowString$ Then + List1.AddItem Str(hdl&) + End If + End If + If hdl& = 0 Then Exit Do + Loop + +End Sub + +Private Function WindowName$(wnd&) + If wnd& <> 0 Then + BufferA$ = Space(300) + winlen& = GetWindowText(wnd&, BufferA$, 250) + BufferA$ = left$(BufferA$, winlen&) + WindowName$ = BufferA$ + End If +End Function + diff --git a/Pdf.frx b/Pdf.frx new file mode 100644 index 0000000..da8c0d9 --- /dev/null +++ b/Pdf.frx @@ -0,0 +1 @@ +Text1 \ No newline at end of file diff --git a/SPOOLER.VBP b/SPOOLER.VBP new file mode 100644 index 0000000..e07027a --- /dev/null +++ b/SPOOLER.VBP @@ -0,0 +1,47 @@ +Type=Exe +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#Standard OLE Types +Form=Spooler1.frm +Module=MyFunctions; ..\vbsubs\MYFUNC.BAS +Class=dwPrinterInfo; dwPRInfo.cls +Class=dwSpool; dwSpool.cls +Class=dwPrintMonitor; dwPrMon.cls +Class=dwPortInfo; dwPort.cls +Module=dwTypes; spTypes.bas +Module=APIGuide32; APIGID32.BAS +Module=PrinterConstants; spPrint.bas +IconForm="frmPSSpooler" +Startup="frmPSSpooler" +HelpFile="" +Title="Spooler" +ExeName32="Spooler.exe" +Command32="" +Name="Project1" +HelpContextID="0" +CompatibleMode="0" +MajorVer=2 +MinorVer=0 +RevisionVer=3 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Desaware Inc." +VersionFileDescription="Chapter 12 - Miscellaneous Examples" +VersionLegalCopyright="Copyright (c) 1997, By Desaware" +VersionProductName="Visual Basic Programmer's Guide to the Win32 API" +CompilationType=-1 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/SPOOLER.VBW b/SPOOLER.VBW new file mode 100644 index 0000000..a931d70 --- /dev/null +++ b/SPOOLER.VBW @@ -0,0 +1,9 @@ +frmPSSpooler = 146, 129, 693, 493, , 5, 18, 850, 540, C +dwPrinterInfo = 56, 65, 776, 429, +dwSpool = 154, 154, 741, 566, C +dwPrintMonitor = 0, 0, 0, 0, C +dwPortInfo = 0, 0, 0, 0, C +dwTypes = 110, 110, 944, 474, +APIGuide32 = 0, 0, 0, 0, C +PrinterConstants = 0, 0, 0, 0, C +MyFunctions = 0, 0, 0, 0, C diff --git a/SPOOLER1.FRM b/SPOOLER1.FRM new file mode 100644 index 0000000..45dd887 --- /dev/null +++ b/SPOOLER1.FRM @@ -0,0 +1,689 @@ +VERSION 5.00 +Begin VB.Form frmPSSpooler + Caption = "Post Script File Spooler" + ClientHeight = 7950 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 11205 + Icon = "SPOOLER1.frx":0000 + LinkTopic = "Form1" + ScaleHeight = 7950 + ScaleWidth = 11205 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdClearlstLog + Caption = "clear" + Height = 195 + Left = 1320 + TabIndex = 16 + Top = 4200 + Width = 735 + End + Begin VB.FileListBox filDistilled + Height = 675 + Left = 90 + Pattern = "*.pdf" + TabIndex = 15 + Top = 6540 + Width = 5295 + End + Begin VB.CommandButton cmdHide + Caption = "Hide" + Height = 255 + Left = 10020 + TabIndex = 14 + Top = 60 + Width = 945 + End + Begin VB.ListBox lstDistilled + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 780 + ItemData = "SPOOLER1.frx":27A2 + Left = 5430 + List = "SPOOLER1.frx":27A4 + TabIndex = 13 + Top = 5700 + Width = 5295 + End + Begin VB.ListBox lstDistiller + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 780 + ItemData = "SPOOLER1.frx":27A6 + Left = 180 + List = "SPOOLER1.frx":27A8 + TabIndex = 11 + Top = 5700 + Width = 5295 + End + Begin VB.CheckBox Scanning + Caption = "Scanning" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 7230 + TabIndex = 10 + Top = 60 + Value = 1 'Checked + Width = 1545 + End + Begin VB.ListBox lstLog + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 1020 + ItemData = "SPOOLER1.frx":27AA + Left = 180 + List = "SPOOLER1.frx":27AC + TabIndex = 8 + Top = 4380 + Width = 18495 + End + Begin VB.CommandButton cmdTest + Caption = "Test Print" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 675 + Left = 7200 + TabIndex = 7 + Top = 390 + Width = 1665 + End + Begin VB.ListBox lstLocalQs + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 2460 + Left = 3330 + TabIndex = 5 + Top = 330 + Width = 3825 + End + Begin VB.Timer Timer1 + Interval = 1000 + Left = 2490 + Top = 60 + End + Begin VB.CommandButton cmdPrintFromList + Caption = "Print File From List" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 675 + Left = 7200 + TabIndex = 4 + Top = 1080 + Width = 1665 + End + Begin VB.ListBox lstFiles + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 1020 + ItemData = "SPOOLER1.frx":27AE + Left = 60 + List = "SPOOLER1.frx":27B0 + TabIndex = 2 + Top = 3090 + Width = 18555 + End + Begin VB.ListBox lstPrintQs + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 2460 + Left = 120 + TabIndex = 0 + Top = 330 + Width = 3165 + End + Begin VB.Label Label5 + Caption = "Files to Distill" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 120 + TabIndex = 12 + Top = 5430 + Width = 4815 + End + Begin VB.Label Label4 + Caption = "Error Log double click to copy buffer " + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 120 + TabIndex = 9 + Top = 4110 + Width = 5955 + End + Begin VB.Label Label3 + Caption = "Local Printers Loaded" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 3360 + TabIndex = 6 + Top = 60 + Width = 3825 + End + Begin VB.Label Label2 + Caption = "Files to Print" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 285 + Left = 120 + TabIndex = 3 + Top = 2820 + Width = 4815 + End + Begin VB.Label Label1 + Caption = "Printer Queues" + BeginProperty Font + Name = "Courier New" + Size = 9.75 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 255 + Left = 120 + TabIndex = 1 + Top = 60 + Width = 2235 + End +End +Attribute VB_Name = "frmPSSpooler" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +' Copyright © 1997 by Desaware Inc. All Rights Reserved. + +'********************************** +'** Type Definitions: + +#If Win32 Then +Private Type DOC_INFO_1 + pDocName As String + pOutputFile As String + pDatatype As String +End Type + +#End If 'WIN32 Types + +'********************************** +'** Function Declarations: + +#If Win32 Then +Private Declare Function OpenPrinter& Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) ' Third param changed to long +Private Declare Function StartDocPrinter& Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) +Private Declare Function StartPagePrinter& Lib "winspool.drv" (ByVal hPrinter As Long) +Private Declare Function WritePrinter& Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) +Private Declare Function EndDocPrinter& Lib "winspool.drv" (ByVal hPrinter As Long) +Private Declare Function EndPagePrinter& Lib "winspool.drv" (ByVal hPrinter As Long) +Private Declare Function ClosePrinter& Lib "winspool.drv" (ByVal hPrinter As Long) +#End If 'WIN32 + +Dim DistillPathIn$, DistillPathOut$, userdataarea$, haldataarea$, engrdataarea$, svcdataarea$, bdvdataarea$, anyonedataarea$ +Dim chinadataarea$, MCFdataarea$, HZdataarea$ + + +Private Sub cmdClearlstLog_Click() + lstLog.Clear +End Sub + +Private Sub cmdHide_Click() + frmPSSpooler.Hide +End Sub + +Private Sub cmdPrintFromList_Click() + Call PrintFile +End Sub +Private Sub addlstLog(st$) + lstLog.AddItem st$ + "|" + Date$ + " " + Time$ +End Sub + +Private Sub cmdResendtoLst_Click() + +End Sub + +Private Sub cmdTest_Click() + a$ = "|c:\files\buffers\cmdpbuff.ps" + pr$ = lstPrintQs.List(lstPrintQs.ListIndex) + If pr$ <> "" Then + If left(pr$, 7) = "DISTILL" Then + lstDistiller.AddItem "DONLEY-9109999" + a$ + Else + If InStr(pr$, "queue not available") <> 0 Then + a$ = pr$ + a$ + "|Printer Selected for TEST not available" + Call addlstLog(a$) + Else + pr$ = pr$ + a$ + lstFiles.AddItem pr$ + End If + End If + Else + a$ = a$ + "|No Printer Selected for TEST" + Call addlstLog(a$) + End If +End Sub + +Private Sub Command1_Click() + +End Sub + +Private Sub Form_Load() +frmPSSpooler.Caption = "Post Script File Spooler Version " + AppRevision$ +Dim c As Collection +Dim sp As New dwSpool +Dim obj As Object + +'DistillPathIn$ = "\\fm1\eng\users\286\CMNDPROC\in\" +'DistillPathOut$ = "\\fm1\eng\users\286\CMNDPROC\out\" +'filDistilled.Path = DistillPathOut$ +'userdataarea$ = "\\fm1\DATA\DEPTS\PURCH\PDFDrawings\" +'engrdataarea$ = "\\fm1\eng\users\" +'svcdataarea$ = "\\fm1\service\USERS\" +'bdvdataarea$ = "\\fm1\DATA\DEPTS\BUSDEV\" +'anyonedataarea$ = "\\fm1\DATA\USERS\" +'haldataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS" +'chinadataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS\CHINADRAWINGS" +'MCFdataarea$ = "\\qhal\wwwroot\EMAILDRAWINGS\MCFDRAWINGS" +'Open "\\fm1\eng\users\cadprint\printer.cfg" For Input As #13 'using #13 + +DistillPathIn$ = NETDRV + "\eng\users\286\CMNDPROC\in\" +DistillPathOut$ = NETDRV + "\eng\users\286\CMNDPROC\out\" +filDistilled.Path = DistillPathOut$ +userdataarea$ = NETDRV + "\DATA\DEPTS\PURCH\PDFDrawings\" +engrdataarea$ = NETDRV + "\eng\users\" +svcdataarea$ = NETDRV + "\service\USERS\" +bdvdataarea$ = NETDRV + "\DATA\DEPTS\BUSDEV\" +anyonedataarea$ = NETDRV + "\DATA\USERS\" +haldataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS" +chinadataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\CHINADRAWINGS" +MCFdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\MCFDRAWINGS" +HZdataarea$ = NETHAL + "\wwwroot\EMAILDRAWINGS\HZDRAWINGS" +Open NETDRV + "\eng\users\cadprint\printer.cfg" For Input As #13 'using #13 +While Not EOF(13) + Line Input #13, prt$ + If left$(prt$, 1) <> ";" Then + prt$ = Trim$(Mid$(prt$, 19, 15)) + lstPrintQs.AddItem prt$ + End If +Wend +Close #13 +lstLocalQs.Clear +lstDistiller.Clear +Set c = sp.EnumPrinters(PRINTER_ENUM_LOCAL, "", 1) +For Each obj In c + lstLocalQs.AddItem obj.pName +Next + +For i = 0 To lstPrintQs.ListCount - 1 + prt$ = lstPrintQs.List(i) + fnd = False + For j = 0 To lstLocalQs.ListCount - 1 + If UCase(prt$) = UCase(lstLocalQs.List(j)) Then + fnd = True + Exit For + End If + Next + If fnd = False Then + lstPrintQs.List(i) = prt$ + " - queue not available" + End If +Next +End Sub +Private Sub PrintFile() + If lstFiles.ListCount > 0 Then + fln$ = lstFiles.List(0) + Req$ = fln$ + lstFiles.RemoveItem 0 + q = InStr(fln$, "|") + queue$ = UCase$(left(fln$, q - 1)) + fln$ = Mid(fln$, q + 1) + + Prntr$ = "" + For i = 0 To lstPrintQs.ListCount - 1 + If queue$ = UCase(lstPrintQs.List(i)) Then + Prntr$ = queue$ + Exit For + End If + Next + + If Prntr$ <> "" Then + If Not (ExistsNew(fln$)) Then + Pause 3 + End If + If ExistsNew(fln$) Then + Call PrintIt(Prntr$, fln$, RC%) + If RC <> 0 Then + Call addlstLog(Req$ + "|print error" + Str(RC%)) + End If + Else + Call addlstLog(Req$ + "|file does not exist") + End If + Else + Call addlstLog(Req$ + "|no such printer") + End If + End If + + + If lstDistiller.ListCount > 0 Then + + fln$ = lstDistiller.List(0) + Req$ = fln$ + lstDistiller.RemoveItem 0 + q = InStr(fln$, "|") + Who$ = UCase$(left(fln$, q - 1)) + fln$ = Mid(fln$, q + 1) + If Not (ExistsNew(fln$)) Then + Pause 3 + End If + If ExistsNew(fln$) Then + Call Fcopy(fln$, DistillPathIn$ + Who$ + ".ps", RC%) + If RC <> 0 Then + Pause 3 + Call Fcopy(fln$, DistillPathIn$ + Who$ + ".ps", RC%) + If RC <> 0 Then + Call addlstLog(Req$ + "|copy error" + Str(RC%)) + End If + End If + Else + Call addlstLog(Req$ + "|file does not exist") + End If + End If + + filDistilled.Refresh + For idx = 0 To filDistilled.ListCount - 1 + fl$ = UCase(filDistilled.List(idx)) + fndfl = False + For icx = 0 To lstDistilled.ListCount - 1 + xxx$ = lstDistilled.List(icx) + q = InStr(xxx$, "|") + xy$ = UCase$(left(xxx$, q - 1)) + tg$ = UCase$(Mid(xxx$, q + 1)) + If xy$ = fl$ Then + fndfl = True + Exit For + End If + Next + If Not (fndfl) Then + lstDistilled.AddItem fl$ + "|15" + End If + Next + icx = 0 + Do While icx <= lstDistilled.ListCount - 1 + xxx$ = lstDistilled.List(icx) + q = InStr(xxx$, "|") + xy$ = UCase$(left(xxx$, q - 1)) + cnt = Val(UCase$(Mid(xxx$, q + 1))) - 1 + If cnt <= 0 Then + f$ = DistillPathOut$ + xy$ + q = InStr(xxx$, "-") + If q > 0 Then + WhoGetsIt$ = Trim(UCase$(left(xxx$, q - 1))) + If (WhoGetsIt$ = "QHAL") Or (WhoGetsIt$ = "CHINA") Or (WhoGetsIt$ = "MCF") Then + Select Case WhoGetsIt$ + Case "QHAL" + usrs$ = haldataarea$ + "\" + Case "CHINA" + usrs$ = chinadataarea$ + "\" + Case "MCF" + usrs$ = MCFdataarea$ + "\" + Case "HZ" + usrs$ = HZdataarea$ + "\" + Case Else + usrs$ = haldataarea$ + "\" + End Select + Else + If left$(WhoGetsIt$, 10) = "DISTILLENG" Then + usrs$ = engrdataarea$ + Mid(WhoGetsIt$, 11) + "\" + ElseIf left$(WhoGetsIt$, 10) = "DISTILLSVC" Then + usrs$ = svcdataarea$ + Mid(WhoGetsIt$, 11) + "\" + ElseIf left$(WhoGetsIt$, 10) = "DISTILLBDV" Then + usrs$ = bdvdataarea$ + Mid(WhoGetsIt$, 11) + "\" + ElseIf left$(WhoGetsIt$, 10) = "DISTILLANY" Then + usrs$ = anyonedataarea$ + Mid(WhoGetsIt$, 11) + "\" + Else + usrs$ = userdataarea$ + WhoGetsIt$ + "\" + End If + End If + t$ = usrs$ + UCase$(Mid(xxx$, q + 1)) + t$ = left(t$, Len(t$) - 2) + Call Fcopy(f$, t$, RC%) + If RC% <> 0 Then + If InStr(usrs$, "AUTHORIZED") = 0 Then + Pause 2 + Call Fcopy(f$, t$, RC%) + Pause 3 + If RC% <> 0 Then + Call addlstLog(f$ + "|from copy to user failed|" + Str(RC%)) + Call addlstLog(t$ + "|to copy to user failed|" + Str(RC%)) + End If + End If + End If + Else + Call addlstLog(f$ + "|File name format invalid|-1") + + Select Case WhoGetsIt$ + Case "QHAL" + usrs$ = haldataarea$ + "\" + Case "CHINA" + usrs$ = chinadataarea$ + "\" + Case "MCF" + usrs$ = MCFdataarea$ + "\" + Case "HZ" + usrs$ = HZdataarea$ + "\" + Case Else + usrs$ = haldataarea$ + "\" + End Select + + t$ = usrs$ + UCase$(Mid(xxx$, q + 1)) + t$ = left(t$, Len(t$) - 2) + Call Fcopy(f$, t$, RC%) + If RC% <> 0 Then + Pause 2 + Call Fcopy(f$, t$, RC%) + Pause 3 + If RC% <> 0 Then + Call addlstLog(f$ + "|from copy to user failed|" + Str(RC%)) + Call addlstLog(t$ + "|to copy to user failed|" + Str(RC%)) + End If + End If + End If + If Not KillIt(f$) Then PrintLog "---------- Failed to delete " + f$ + " Removing distiller file" + lstDistilled.RemoveItem (icx) + Else + lstDistilled.List(icx) = xy$ + "|" + Trim(Str(cnt)) + icx = icx + 1 + End If + Loop + +End Sub +Private Sub PrintIt(Prntr$, fln$, RC%) + Dim hPrinter& + Dim jobid& + Dim res&, itsaText + Dim written& + Dim printdata$ + Dim docinfo As DOC_INFO_1 + + If UCase(right(fln, 3)) = "TXT" Then + itsaText = True + Else + itsaText = False + End If + RC% = 0 + res& = OpenPrinter(Prntr$, hPrinter, 0) + If res = 0 Then + RC% = 1 'unable to open printer + Exit Sub + End If + spname$ = UCase(BreakFileName(fln$, 4)) + If spname$ = "" Then spname$ = "Spooler" + docinfo.pDocName = spname$ + docinfo.pOutputFile = vbNullString + docinfo.pDatatype = vbNullString + jobid = StartDocPrinter(hPrinter, 1, docinfo) + Call StartPagePrinter(hPrinter) + + Open fln$ For Input As #27 'using #27 + While Not EOF(27) + Line Input #27, printdata$ + If itsaText = True Then + printdata$ = printdata$ + vbCrLf + Else + printdata$ = printdata$ + Chr$(10) + End If + + Call WritePrinter(hPrinter, ByVal printdata$, Len(printdata$), written) + Wend + Close #27 + Call EndPagePrinter(hPrinter) + Call EndDocPrinter(hPrinter) + Call ClosePrinter(hPrinter) ' Close when done +End Sub + +Private Sub PrintItText(Prntr$, fln$, RC%) + Dim hPrinter& + Dim jobid& + Dim res& + Dim written& + Dim printdata$ + Dim docinfo As DOC_INFO_1 + RC% = 0 + res& = OpenPrinter(Prntr$, hPrinter, 0) + If res = 0 Then + RC% = 1 'unable to open printer + Exit Sub + End If + spname$ = UCase(left$(right$(fln$, 10), 8)) + If spname$ = "" Then spname$ = "Spooler" + docinfo.pDocName = spname$ + docinfo.pOutputFile = vbNullString + docinfo.pDatatype = vbNullString + jobid = StartDocPrinter(hPrinter, 1, docinfo) + Call StartPagePrinter(hPrinter) + + Open fln$ For Input As #26 'using #26 + While Not EOF(26) + Line Input #26, printdata$ + printdata$ = printdata$ + vbCrLf + Call WritePrinter(hPrinter, ByVal printdata$, Len(printdata$), written) + Wend + Close #26 + Call EndPagePrinter(hPrinter) + Call EndDocPrinter(hPrinter) + Call ClosePrinter(hPrinter) ' Close when done +End Sub + + +Private Sub lstLog_DblClick() + Clipboard.Clear + Z$ = lstLog.List(lstLog.ListIndex) + Clipboard.SetText (Z$) + +End Sub + +Private Sub Timer1_Timer() + If Timer1.Tag = "" Then + Timer1.Tag = "Busy" + If Scanning = 1 Then + Call PrintFile + End If + If lstLog.ListCount > 1000 Then + lstLog.RemoveItem (0) + End If + Timer1.Tag = "" + End If +End Sub + diff --git a/SPOOLER1.frx b/SPOOLER1.frx new file mode 100644 index 0000000..880cb8f Binary files /dev/null and b/SPOOLER1.frx differ diff --git a/SPPRINT.BAS b/SPPRINT.BAS new file mode 100644 index 0000000..102bc3c --- /dev/null +++ b/SPPRINT.BAS @@ -0,0 +1,13 @@ +Attribute VB_Name = "PrinterConstants" +Option Explicit +' Copyright © 1997 by Desaware Inc. All Rights Reserved. + +Public Const PRINTER_ENUM_DEFAULT = &H1 +Public Const PRINTER_ENUM_LOCAL = &H2 +Public Const PRINTER_ENUM_CONNECTIONS = &H4 +Public Const PRINTER_ENUM_FAVORITE = &H4 +Public Const PRINTER_ENUM_NAME = &H8 +Public Const PRINTER_ENUM_REMOTE = &H10 +Public Const PRINTER_ENUM_SHARED = &H20 +Public Const PRINTER_ENUM_NETWORK = &H40 + diff --git a/SPTYPES.BAS b/SPTYPES.BAS new file mode 100644 index 0000000..483a70d --- /dev/null +++ b/SPTYPES.BAS @@ -0,0 +1,47 @@ +Attribute VB_Name = "dwTypes" +' Desaware API Class library +' Copyright (c) 1995-1997 by Desaware Inc. +' All rights reserved + + +Option Explicit + +#If Win32 Then +Public Type RECT + left As Long + top As Long + right As Long + bottom As Long +End Type + +#Else +Public Type RECT + left As Integer + top As Integer + right As Integer + bottom As Integer +End Type + +#End If 'WIN32 Types + + +#If Win32 Then + +Type ACL + AclRevision As Byte + Sbz1 As Byte + AclSize As Integer + AceCount As Integer + Sbz2 As Integer +End Type + +Type SECURITY_DESCRIPTOR + Revision As Byte + Sbz1 As Byte + Control As Long + Owner As Long + Group As Long + Sacl As ACL + Dacl As ACL +End Type +#End If diff --git a/TEST.VBP b/TEST.VBP new file mode 100644 index 0000000..36943ca --- /dev/null +++ b/TEST.VBP @@ -0,0 +1,51 @@ +Type=Exe +Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#C:\WINDOWS\system32\MSBIND.DLL#Microsoft Data Binding Collection +Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#C:\Program Files\Common Files\system\ado\msado25.tlb#Microsoft ActiveX Data Objects 2.5 Library +Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX +Object={BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0; TABCTL32.OCX +Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; MSADODC.OCX +Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; MSDATGRD.OCX +Module=Main; CMNDPROC.BAS +Module=MyFunctions; ..\..\vbsubs\Myfunc.bas +Class=dwPortInfo; DWPORT.CLS +Class=dwPrinterInfo; DWPRINFO.CLS +Class=dwPrintMonitor; DWPRMON.CLS +Class=dwSpool; DWSPOOL.CLS +Module=APIGuide32; APIGID32.BAS +Module=PrinterConstants; SPPRINT.BAS +Module=dwTypes; SPTYPES.BAS +Form=Cmdproc-6.frm +Class=ClearBOM; ClearBom.cls +Startup="frmFolderCopy" +HelpFile="" +Title="Cmndproc" +ExeName32="Cmndproc1FEB2008.exe" +Path32="\\Fm1\eng\USERS\286\CMNDPROC" +Command32="" +Name="test" +HelpContextID="0" +CompatibleMode="0" +MajorVer=4 +MinorVer=0 +RevisionVer=61 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Enterprise Computing Services, Inc." +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/TEST.vbw b/TEST.vbw new file mode 100644 index 0000000..cee5aaf --- /dev/null +++ b/TEST.vbw @@ -0,0 +1,11 @@ +Main = 57, 13, 694, 567, C +MyFunctions = 23, -11, 780, 358, +dwPortInfo = 0, 0, 0, 0, C +dwPrinterInfo = -38, 129, 558, 493, C +dwPrintMonitor = 0, 0, 0, 0, C +dwSpool = 0, 0, 0, 0, C +APIGuide32 = -31, 69, 803, 433, C +PrinterConstants = 154, 154, 741, 566, C +dwTypes = 0, 0, 0, 0, C +frmFolderCopy = 11, 9, 772, 604, , 95, 13, 756, 616, C +ClearBOM = -65, -10, 644, 483, C diff --git a/TestFolder.VBP b/TestFolder.VBP new file mode 100644 index 0000000..f42bffb --- /dev/null +++ b/TestFolder.VBP @@ -0,0 +1,43 @@ +Type=Exe +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\system32\stdole2.tlb#Standard OLE Types +Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINNT\System32\scrrun.dll#Microsoft Scripting Runtime +Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; MSADODC.OCX +Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; MSDATGRD.OCX +Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#C:\WINNT\System32\MSBIND.DLL#Microsoft Data Binding Collection +Module=MyFunctions; ..\..\vbsubs\MYFUNC.BAS +Form=Pdf.frm +Startup="frmPDF" +HelpFile="" +Title="Spooler" +ExeName32="Spooler.exe" +Command32="" +Name="Project1" +HelpContextID="0" +CompatibleMode="0" +MajorVer=2 +MinorVer=0 +RevisionVer=3 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Desaware Inc." +VersionFileDescription="Chapter 12 - Miscellaneous Examples" +VersionLegalCopyright="Copyright (c) 1997, By Desaware" +VersionProductName="Visual Basic Programmer's Guide to the Win32 API" +CompilationType=-1 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/TestFolder.vbw b/TestFolder.vbw new file mode 100644 index 0000000..176aa79 --- /dev/null +++ b/TestFolder.vbw @@ -0,0 +1,2 @@ +MyFunctions = 274, 111, 1024, 546, C +frmPDF = 145, 44, 979, 596, , 110, 145, 944, 697, C diff --git a/filewatch.frm b/filewatch.frm new file mode 100644 index 0000000..2df515f --- /dev/null +++ b/filewatch.frm @@ -0,0 +1,129 @@ +VERSION 5.00 +Begin VB.Form frmFileWatch + Caption = "File Watch" + ClientHeight = 7005 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 10875 + BeginProperty Font + Name = "Courier New" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ScaleHeight = 7005 + ScaleWidth = 10875 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdClose + Caption = "Close" + Height = 285 + Left = 1680 + TabIndex = 1 + Top = 6720 + Width = 1515 + End + Begin VB.Timer Timer1 + Interval = 1000 + Left = 5550 + Top = 210 + End + Begin VB.ListBox lstFileWatch + Height = 6570 + Left = 60 + TabIndex = 0 + Top = 60 + Width = 10455 + End +End +Attribute VB_Name = "frmFileWatch" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Sub cmdClose_Click() + Unload frmFileWatch +End Sub + +Private Sub Form_Load() + lstFileWatch.AddItem doesit$(MessageFileName$, "0") + lstFileWatch.AddItem doesit$(MessageLogName$, "0") + lstFileWatch.AddItem doesit$(MessageLogName2$, "0") + lstFileWatch.AddItem doesit$(COMPLETE$, "1") + lstFileWatch.AddItem doesit$(COMPLETE2$, "0") + lstFileWatch.AddItem doesit$(INCOME$, "1") + lstFileWatch.AddItem doesit$(Reply$, "1") + lstFileWatch.AddItem doesit$(ReplyComplete$, "1") + lstFileWatch.AddItem doesit$(ReplyComplete2$, "0") + lstFileWatch.AddItem doesit$(CADPRINT$, "0") + lstFileWatch.AddItem doesit$(QUEHANDL, "0") + lstFileWatch.AddItem doesit$(CADPRNT2, "1") + lstFileWatch.AddItem doesit$(PLOTCFG$, "0") + lstFileWatch.AddItem doesit$(PrinterCFG$, "0") + lstFileWatch.AddItem doesit$(SUBSCFG$, "0") + + lstFileWatch.AddItem doesit$(PrintCfg$, "0") + lstFileWatch.AddItem doesit$(MAKEPS$, "0") + lstFileWatch.AddItem doesit$(TFIL$, "0") + lstFileWatch.AddItem doesit$(BufferName$, "1") + + lstFileWatch.AddItem doesit$(ACADComplete$, "1") + lstFileWatch.AddItem doesit$(ACADWait$, "1") + lstFileWatch.AddItem doesit$(ACADIncome$, "1") + lstFileWatch.AddItem doesit$(ACADCH$, "0") + lstFileWatch.AddItem doesit$(ACADReply$, "1") +' + lstFileWatch.AddItem doesit$(PROEComplete$, "1") + lstFileWatch.AddItem doesit$(PROEWait$, "1") + lstFileWatch.AddItem doesit$(PROEIncome$, "1") + lstFileWatch.AddItem doesit$(PROECH$, "0") + lstFileWatch.AddItem doesit$(PROEReply$, "1") + lstFileWatch.AddItem doesit$(PROERPCM$, "1") + + +End Sub + +Private Sub Timer1_Timer() + For i = 0 To lstFileWatch.ListCount - 1 + xx$ = lstFileWatch.List(i) + Call PARSE(xx$, stat$, "|", RC%) + Call PARSE(xx$, mode$, "|", RC%) + Call PARSE(xx$, ffl$, "|", RC%) + lstFileWatch.List(i) = doesit$(ffl$, mode$) + Next + +End Sub +Function doesit$(fl$, mode$) + d$ = "" + Select Case mode$ + Case "0" + If ExistsNew(fl$) Then + d$ = "Normal Exists" + "|" + mode$ + "|" + fl$ + Else + d$ = "--Warn Not Exists" + "|" + mode$ + "|" + fl$ + End If + Case "1" + If ExistsNew(fl$) Then + d$ = "--Warn Exists" + "|" + mode$ + "|" + fl$ + Else + d$ = "Normal Not Exists" + "|" + mode$ + "|" + fl$ + End If + Case "2" + If ExistsNew(fl$) Then + d$ = "ERROR Exists" + "|" + mode$ + "|" + fl$ + Else + d$ = "Normal Not Exists" + "|" + mode$ + "|" + fl$ + End If + Case "3" + If ExistsNew(fl$) Then + d$ = "Normal Exists" + "|" + mode$ + "|" + fl$ + Else + d$ = "ERROR Not Exists" + "|" + mode$ + "|" + fl$ + End If + Case Else + End Select + doesit$ = d$ +End Function + diff --git a/oldCMNDPROC.BAS b/oldCMNDPROC.BAS new file mode 100644 index 0000000..8e1055c --- /dev/null +++ b/oldCMNDPROC.BAS @@ -0,0 +1,1885 @@ +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 + diff --git a/pdfMod.bas b/pdfMod.bas new file mode 100644 index 0000000..4f00ab1 --- /dev/null +++ b/pdfMod.bas @@ -0,0 +1,469 @@ +Attribute VB_Name = "pdfMod" +Global PlaceFile$, ConfigFile$, Steps%, Processing%, cntlTask As Variant, KeyWait%, taskname$, useAPIFocus +Global adminUser$, adminPass$, userUser$, userPass$, Program$, ListDocFile$, UserNameFile$, userFullName$ +Public Const NoOfData = 2 + + 'Windows desktop virtual folder at the root of the name space + Public Const CSIDL_DESKTOP = &H0 + + 'File system directory that contains the + 'user's program groups (which are also file + 'system directories) + Public Const CSIDL_PROGRAMS = &H2 + + 'Control Panel - virtual folder containing + 'icons for the control panel applications + Public Const CSIDL_CONTROLS = &H3 + + 'Printers folder - virtual folder containing + 'installed printers. + Public Const CSIDL_PRINTERS = &H4 + + 'File system directory that serves as a + 'common repository for documents (Documents folder) + Public Const CSIDL_PERSONAL = &H5 + + 'File system directory that contains the + 'user's favorite Internet Explorer URLs + Public Const CSIDL_FAVORITES = &H6 + + 'File system directory that corresponds to the + 'user's Startup program group + Public Const CSIDL_STARTUP = &H7 + + 'File system directory that contains the + 'user's most recently used documents (Recent folder) + Public Const CSIDL_RECENT = &H8 + + 'File system directory that contains + 'Send To menu items + Public Const CSIDL_SENDTO = &H9 + + 'Recycle bin file system directory containing file + 'objects in the user's recycle bin. The location of + 'this directory is not in the registry; it is marked + 'with the hidden and system attributes to prevent the + 'user from moving or deleting it. + Public Const CSIDL_BITBUCKET = &HA + + 'File system directory containing Start menu items + Public Const CSIDL_STARTMENU = &HB + + 'File system directory used to physically store + 'file objects on the desktop (not to be confused + 'with the desktop folder itself). + Public Const CSIDL_DESKTOPDIRECTORY = &H10 + + 'My Computer - virtual folder containing everything + 'on the local computer: storage devices, printers, + 'and Control Panel. The folder may also contain + 'mapped network drives. + Public Const CSIDL_DRIVES = &H11 + + 'Network Neighborhood - virtual folder representing + 'the top level of the network hierarchy + Public Const CSIDL_NETWORK = &H12 + + 'File system directory containing objects that + 'appear in the network neighborhood + Public Const CSIDL_NETHOOD = &H13 + + 'Virtual folder containing fonts + Public Const CSIDL_FONTS = &H14 + + 'File system directory that serves as a + 'common repository for document templates + '(ShellNew folder.) + Public Const CSIDL_TEMPLATES = &H15 + 'application folder + Public Const CSIDL_APPLIC = &H1A + + + + + +' +' Public Constants + +Public Const VFT_UNKNOWN = &H0& +Public Const VFT_APP = &H1& +Public Const VFT_DLL = &H2& +Public Const VFT_DRV = &H3& +Public Const VFT_FONT = &H4& +Public Const VFT_VXD = &H5& +Public Const VFT_STATIC_LIB = &H7& + +Public Type VS_FIXEDFILEINFO + dwSignature As Long + dwStrucVersion As Long ' e.g. 0x00000042 = "0.42" + dwFileVersionMS As Long ' e.g. 0x00030075 = "3.75" + dwFileVersionLS As Long ' e.g. 0x00000031 = "0.31" + dwProductVersionMS As Long ' e.g. 0x00030010 = "3.10" + dwProductVersionLS As Long ' e.g. 0x00000031 = "0.31" + dwFileFlagsMask As Long ' = 0x3F for version "0.42" + dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE + dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16 + dwFileType As Long ' e.g. VFT_DRIVER + dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD + dwFileDateMS As Long ' e.g. 0 + dwFileDateLS As Long ' e.g. 0 +End Type + +Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long +End Type +Type SECURITY_ATTRIBUTES + nLength As Long + lpSecurityDescriptor As Long + bInheritHandle As Long +End Type +Public Type SHFILEOPSTRUCT + hwnd As Long + wFunc As Long + pFrom As String + pTo As String + fFlags As Integer + fAborted As Boolean + hNameMaps As Long + sProgress As String + End Type + + + +'Public Const HKEY_CLASSES_ROOT = &H80000000 +'Public Const HKEY_CURRENT_USER = &H80000001 +'Public Const HKEY_LOCAL_MACHINE = &H80000002 +'Public Const HKEY_USERS = &H80000003 +'Public Const HKEY_PERFORMANCE_DATA = &H80000004 + +'Public Const SYNCHRONIZE = &H100000 +'Public Const STANDARD_RIGHTS_READ = &H20000 +'Public Const STANDARD_RIGHTS_WRITE = &H20000 +'Public Const STANDARD_RIGHTS_EXECUTE = &H20000 +'Public Const STANDARD_RIGHTS_REQUIRED = &HF0000 +'Public Const STANDARD_RIGHTS_ALL = &H1F0000 +'Public Const KEY_QUERY_VALUE = &H1 +'Public Const KEY_SET_VALUE = &H2 +'Public Const KEY_CREATE_SUB_KEY = &H4 +'Public Const KEY_ENUMERATE_SUB_KEYS = &H8 +'Public Const KEY_NOTIFY = &H10 +'Public Const KEY_CREATE_LINK = &H20 +'Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) +'Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE)) +'Public Const KEY_EXECUTE = (KEY_READ) +'Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE)) +'Public Const ERROR_SUCCESS = 0& + +'------------------------------------------------- +' +' Public Variables +' +' We changed this to Byte to prevent the string +' mangling of the buffer + +Public Const FO_MOVE = &H1 +Public Const FO_RENAME = &H4 + +Public Const FOF_SILENT = &H4 +Public Const FOF_NOCONFIRMATION = &H10 +Public Const FOF_FILESONLY = &H80 +Public Const FOF_SIMPLEPROGRESS = &H100 +Public Const FOF_NOCONFIRMMKDIR = &H200 + +Public Const SHARD_PATH = &H2& + +Public Const VER_PLATFORM_WIN32_NT = 2 +Public Const EWX_LOGOFF = 0 +Public Const EWX_SHUTDOWN = 1 +Public Const EWX_REBOOT = 2 +Public Const EWX_FORCE = 4 +Public Const CCDEVICENAME = 32 +Public Const CCFORMNAME = 32 +Public Const DM_BITSPERPEL = &H40000 +Public Const DM_PELSWIDTH = &H80000 +Public Const DM_PELSHEIGHT = &H100000 +Public Const CDS_UPDATEREGISTRY = &H1 +Public Const CDS_TEST = &H4 +Public Const DISP_CHANGE_SUCCESSFUL = 0 +Public Const DISP_CHANGE_RESTART = 1 +Public Const ERROR_NOT_ALL_ASSIGNED = 1300 +Public Const SE_PRIVILEGE_ENABLED = 2 +Public Const TOKEN_QUERY = &H8 +Public Const TOKEN_ADJUST_PRIVILEGES = &H20 + +Type DEVMODE + dmDeviceName As String * CCDEVICENAME + dmSpecVersion As Integer + dmDriverVersion As Integer + dmSize As Integer + dmDriverExtra As Integer + dmFields As Long + dmOrientation As Integer + dmPaperSize As Integer + dmPaperLength As Integer + dmPaperWidth As Integer + dmScale As Integer + dmCopies As Integer + dmDefaultSource As Integer + dmPrintQuality As Integer + dmColor As Integer + dmDuplex As Integer + dmYResolution As Integer + dmTTOption As Integer + dmCollate As Integer + dmFormName As String * CCFORMNAME + dmUnusedPadding As Integer + dmBitsPerPel As Integer + dmPelsWidth As Long + dmPelsHeight As Long + dmDisplayFlags As Long + dmDisplayFrequency As Long +End Type + +Type OSVERSIONINFO + dwOSVersionInfoSize As Long + dwMajorVersion As Long + dwMinorVersion As Long + dwBuildNumber As Long + dwPlatformId As Long + szCSDVersion As String * 128 +End Type + +Type LUID + lowpart As Long + highpart As Long +End Type + +Type LUID_AND_ATTRIBUTES + pLuid As LUID + Attributes As Long +End Type + +Type TOKEN_PRIVILEGES + PrivilegeCount As Long + Privileges As LUID_AND_ATTRIBUTES +End Type + +Declare Function GetFocus& Lib "user32" () +Declare Function GetForegroundWindow& Lib "user32" () +Declare Function SetForegroundWindow& Lib "user32" (ByVal hwnd As Long) +Declare Function GetParent& Lib "user32" (ByVal hwnd As Long) +Declare Function GetTopWindow& Lib "user32" (ByVal hwnd As Long) +Declare Function SetActiveWindow& Lib "user32" (ByVal hwnd As Long) +Declare Function SetFocusAPI& Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) +Declare Function GetWindowText& Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal jnk As String, ByVal cch As Long) +Declare Function FINDWINDOW& Lib "user32" Alias "FindWindowA" (ByVal lpclass As String, ByVal lpwin As String) +Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal lpWinPar As Long, ByVal lpCA As Long, ByVal stclass As String, ByVal stWinNam As String) +Declare Function IsWindow& Lib "user32" (ByVal hwnd As Long) +Declare Function IsWindowEnabled& Lib "user32" (ByVal hwnd As Long) +Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long) +Declare Function GetWindow& Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) + + +Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long +Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean +Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long +Declare Function ExitWindowsEx Lib "user32" (ByVal uflags As Long, ByVal dwreserved As Long) As Long +Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long +Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpUid As LUID) As Long +Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long +Declare Function GetCurrentProcess Lib "kernel32" () As Long + +Public verbuf() As Byte ' Version buffer +Public Filename$ ' Current file to examine + +Public Declare Function SHAddToRecentDocs Lib "shell32.dll" (ByVal dwFlags As Long, ByVal dwData As String) As Long +Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long +Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long +Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long +Function QuoteAway$(X$) + y$ = Mid$(X$, 2): y$ = left$(y$, Len(y$) - 1) + QuoteAway$ = y$ +End Function + + +Public Function winFindSubWindow&(MainApp&, ChildApp$, RC%) + RC% = False: Fw& = 0 + ' Call diag("Main " + Str$(MainApp&)) + If MainApp& <> 0 Then + ca& = 0 + Do + Nxt& = FindWindowEx(MainApp&, ca&, vbNullString, vbNullString) + Buffer$ = WindowName$(Nxt&) + ' Call diag("Buffer " + Str$(Nxt&) + " - " + Buffer$) + ' Call diag("ChildApp " + ChildApp$) + If Buffer$ = ChildApp$ Then + Fw& = Nxt& + RC% = True + Exit Do + End If + If Nxt& = 0 Then + Exit Do + End If + ca& = Nxt& + Loop + End If + winFindSubWindow& = Fw& +End Function + +Public Function WindowName$(wnd&) + If wnd& <> 0 Then + Buffer$ = Space(300) + winlen& = GetWindowText(wnd&, Buffer$, 250) + Buffer$ = left$(Buffer$, winlen&) + WindowName$ = Buffer$ + End If +End Function + +Public Function FindTheNextWindow&(Nxt&, WindName$) + hdx& = 0 + hdl& = Nxt& + Do + hdl& = FindWindowEx&(0&, hdl&, vbNullString, vbNullString) + wn$ = WindowName$(hdl&) + If hdl& = 0 Then Exit Do + If WindName$ = left$(wn$, Len(WindName$)) Then + hdx& = hdl& + Exit Do + End If + Loop + FindTheNextWindow& = hdx& +End Function +Public Sub findalllevel(lvl&, WindowString$, List1 As ListBox) +' +xxt& = lvl& +hdl& = 0 +Do + hdl& = FindWindowEx&(xxt&, hdl&, vbNullString, vbNullString) + If WindowString$ = "" Then + List1.AddItem Str(hdl&) + Else + wn$ = left(WindowName$(hdl&), Len(WindowString$)) + If wn$ = WindowString$ Then + List1.AddItem Str(hdl&) + End If + End If + If hdl& = 0 Then Exit Do + Loop + +End Sub + +Public Function searchChildren&(WindowString$, List1 As ListBox) +' +' This routine parses a windowstring formated as follows: +' RootWindowName|ChildName|ChildofChildName... +' requires a listbox (it may be invisible) +' +' returning the window number of the first child meeting the requirements +' returns 0 if none are apply + List1.Clear + a$ = "0|" + WindowString$ + "~" + List1.AddItem a$ + ListCountr = 0 + Do + b$ = List1.List(0) + List1.RemoveItem (0) + + Call PARSE(b$, a$, "~", RC%) + Parent$ = b$ + + Call PARSE(a$, WindowNumber$, "|", RC%) + Call PARSE(a$, searchWindow$, "|", RC%) + Rest$ = a$ + Parent$ + Rt& = Val(WindowNumber$) + + If searchWindow$ = "" Then + ' + ' search is done + ' + List1.Clear + List1.AddItem Parent$ + searchChildren = Rt& + Exit Function + + End If + If searchWindow$ = " " Then searchWindow$ = "" + + ct& = 0 + Do + ct& = winFindSubWindow2&(Rt&, ct&, searchWindow$) + If ct& <> 0 Then + wn$ = WindowName$(ct&) + List1.AddItem Trim$(Str$(ct&)) + Rest$ + wn$ + "|" + End If + Loop Until ct& = 0 + Loop Until List1.ListCount = 0 +End Function +Public Function winFindSubWindow2&(Root&, Nxt&, WindName$) + hdx& = 0 + hdl& = Nxt& + Do + hdl& = FindWindowEx&(Root&, hdl&, vbNullString, vbNullString) + wn$ = WindowName$(hdl&) + If hdl& = 0 Then Exit Do + If WindName$ = left$(wn$, Len(WindName$)) Then + hdx& = hdl& + Exit Do + End If + Loop + winFindSubWindow2& = hdx& +End Function + +Private Function GetSpecialFolder(CSIDL As Long) As String + + 'a few local variables needed + Dim r As Long + Dim sPath As String + Dim pidl As Long + + Const NOERROR = 0 + Const MAX_LENGTH = 260 + + 'fill pidl with the specified folder item + r = SHGetSpecialFolderLocation(Form1.hwnd, CSIDL, pidl) + + If r = NOERROR Then + + 'Of the structure is filled, initialize and + 'retrieve the path from the id list, and return + 'the folder with a trailing slash appended. + sPath = Space$(MAX_LENGTH) + r = SHGetPathFromIDList(ByVal pidl, ByVal sPath) + + If r Then + GetSpecialFolder = left$(sPath, _ + InStr(sPath, Chr$(0)) - 1) & "\" + End If + + End If + +End Function + + +Private Sub ShellRenameFile(sOldName As String, sNewName As String) + + 'set some working variables + Dim SHFileOp As SHFILEOPSTRUCT + Dim r As Long + + 'add a pair of terminating nulls to each string + sOldName = sOldName & Chr$(0) & Chr$(0) + sNewName = sNewName & Chr$(0) & Chr$(0) + + 'set up the options + With SHFileOp + .wFunc = FO_RENAME + .pFrom = sOldName + .pTo = sNewName + .fFlags = FOF_SILENT Or FOF_NOCONFIRMATION + End With + + 'and rename the file + r = SHFileOperation(SHFileOp) + +End Sub +'--end block--' + + + diff --git a/tstPROC.VBP b/tstPROC.VBP new file mode 100644 index 0000000..2567fa2 --- /dev/null +++ b/tstPROC.VBP @@ -0,0 +1,62 @@ +Type=Exe +Reference=*\G{56BF9020-7A2F-11D0-9482-00A0C91110ED}#1.0#0#C:\WINDOWS\system32\MSBIND.DLL#Microsoft Data Binding Collection +Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#C:\Program Files\Common Files\system\ado\msado25.tlb#Microsoft ActiveX Data Objects 2.5 Library +Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINDOWS\system32\scrrun.dll#Microsoft Scripting Runtime +Object={BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0; TABCTL32.OCX +Object={67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0; MSADODC.OCX +Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; MSDatGrd.ocx +Form=Cmdproc-3.frm +Module=Main; CMNDPROC.BAS +Module=MyFunctions; ..\..\vbsubs\Myfunc.bas +Form=Cmdproc-4.frm +Form=Cmdproc-1.frm +Form=Cmdproc-2.frm +Class=dwPortInfo; DWPORT.CLS +Class=dwPrinterInfo; DWPRINFO.CLS +Class=dwPrintMonitor; DWPRMON.CLS +Class=dwSpool; DWSPOOL.CLS +Form=SPOOLER1.FRM +Module=APIGuide32; APIGID32.BAS +Module=PrinterConstants; SPPRINT.BAS +Module=dwTypes; SPTYPES.BAS +Form=filewatch.frm +Form=Cmdproc-5.frm +Form=Cmdproc-6.frm +Class=ClearBOM; ClearBom.cls +Form=Pdf.frm +Object={19B7F2A2-1610-11D3-BF30-1AF820524153}#1.1#0; ccrpftv6.ocx +Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX +IconForm="frmMain" +Startup="frmStart" +HelpFile="" +Title="Cmndproc" +ExeName32="Cmndproc17OCT2012.exe" +Path32="\\Fm1\eng\USERS\286\CMNDPROC" +Command32="" +Name="CommandProcessor" +HelpContextID="0" +CompatibleMode="0" +MajorVer=4 +MinorVer=0 +RevisionVer=122 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="Enterprise Computing Services, Inc." +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/tstPROC.vbw b/tstPROC.vbw new file mode 100644 index 0000000..159d4e8 --- /dev/null +++ b/tstPROC.vbw @@ -0,0 +1,19 @@ +frmStart = 0, 0, 0, 0, C, 0, 0, 0, 0, C +Main = 0, 0, 0, 0, C +MyFunctions = 0, 0, 0, 0, C +frmCheckAssembly = 0, 0, 0, 0, C, 22, 29, 524, 519, C +frmMain = 0, 0, 0, 0, C, 0, 0, 0, 0, C +frmQueHandler = 0, 0, 0, 0, C, 0, 0, 0, 0, C +dwPortInfo = 0, 0, 0, 0, C +dwPrinterInfo = 0, 0, 0, 0, C +dwPrintMonitor = 0, 0, 0, 0, C +dwSpool = 0, 0, 0, 0, C +frmPSSpooler = 0, 0, 0, 0, C, 0, 0, 0, 0, C +APIGuide32 = 0, 0, 0, 0, C +PrinterConstants = 0, 0, 0, 0, C +dwTypes = 0, 0, 0, 0, C +frmFileWatch = 0, 0, 0, 0, C, 0, 0, 0, 0, C +frmBOM = 0, 0, 0, 0, C, 0, 0, 0, 0, C +frmFolderCopy = 0, 0, 0, 0, C, 0, 0, 0, 0, C +ClearBOM = 0, 0, 0, 0, C +frmPDF = 0, 0, 0, 0, C, 0, 0, 0, 0, C