532 lines
16 KiB
Plaintext
532 lines
16 KiB
Plaintext
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
|
|
|
|
|