first commit
commit
293c16e220
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
@ -0,0 +1 @@
|
|||
Line 368: Class TabDlg.SSTab of control SSTab1 was not a loaded control class.
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
Binary file not shown.
|
@ -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
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Line 51: Class ComctlLib.TreeView of control TreeView1 was not a loaded control class.
|
|
@ -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
|
||||
'
|
||||
' ItemNo<TAB>PartNo<TAB>Qty<TAB>Descr
|
||||
'
|
||||
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
|
||||
|
Binary file not shown.
|
@ -0,0 +1 @@
|
|||
Line 86: Class MSDataGridLib.DataGrid of control DataGrid1 was not a loaded control class.
|
|
@ -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
|
||||
|
Binary file not shown.
|
@ -0,0 +1 @@
|
|||
Line 14: Class MSDataGridLib.DataGrid of control DataGrid1 was not a loaded control class.
|
|
@ -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
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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=<This is an empty string for the mssccprj.scc file>
|
||||
[SPOOLER.VBP]
|
||||
SCC_Project_Name=this project is not under source code control
|
||||
SCC_Aux_Path=<This is an empty string for the mssccprj.scc file>
|
||||
[TestFolder.VBP]
|
||||
SCC_Project_Name=this project is not under source code control
|
||||
SCC_Aux_Path=<This is an empty string for the mssccprj.scc file>
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
||||
|
Binary file not shown.
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -0,0 +1,2 @@
|
|||
MyFunctions = 274, 111, 1024, 546, C
|
||||
frmPDF = 145, 44, 979, 596, , 110, 145, 944, 697, C
|
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
|
@ -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--'
|
||||
|
||||
|
||||
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue