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