VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Begin VB.Form frmAddRefs 
   Appearance      =   0  'Flat
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Fast Build - Add References"
   ClientHeight    =   7905
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11595
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7905
   ScaleWidth      =   11595
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame5 
      Caption         =   "Component Properties"
      Height          =   3705
      Left            =   60
      TabIndex        =   16
      Top             =   4125
      Visible         =   0   'False
      Width           =   11460
   End
   Begin VB.Frame Frame3 
      Height          =   1890
      Left            =   60
      TabIndex        =   13
      Top             =   4125
      Width           =   11445
      Begin VB.TextBox txtDetails 
         Height          =   1200
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   15
         Top             =   585
         Width           =   11190
      End
      Begin VB.TextBox txtObj 
         Height          =   345
         Left            =   120
         TabIndex        =   14
         Top             =   210
         Width           =   11190
      End
   End
   Begin Project1.axButton cmdSelect 
      Height          =   450
      Index           =   0
      Left            =   5850
      TabIndex        =   7
      Top             =   2055
      Width           =   2070
      _ExtentX        =   3651
      _ExtentY        =   794
      ButtonType      =   7
      Caption         =   "Select from left"
      Enabled         =   -1  'True
      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
      COLTYPE         =   1
      FOCUSR          =   -1  'True
      BCOL            =   15790320
      BCOLO           =   15790320
      FCOL            =   0
      FCOLO           =   0
      MCOL            =   12632256
      MPTR            =   1
      MICON           =   "frmAddRefs.frx":0000
      Picture         =   "frmAddRefs.frx":001C
      UMCOL           =   -1  'True
      SOFT            =   0   'False
      PICPOS          =   0
      NGREY           =   0   'False
      FX              =   0
      HAND            =   0   'False
      CHECK           =   0   'False
      VALUE           =   0   'False
   End
   Begin VB.Frame Frame4 
      Caption         =   "Selected Components"
      Height          =   1515
      Left            =   5805
      TabIndex        =   4
      Top             =   2580
      Width           =   5700
      Begin VB.ListBox Selected 
         Height          =   645
         Left            =   105
         TabIndex        =   11
         Top             =   300
         Width           =   5475
      End
      Begin Project1.axButton cmdReplaceObj 
         Height          =   435
         Left            =   135
         TabIndex        =   12
         Top             =   990
         Width           =   2295
         _ExtentX        =   4048
         _ExtentY        =   767
         ButtonType      =   7
         Caption         =   "Replace Component"
         Enabled         =   -1  'True
         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
         COLTYPE         =   1
         FOCUSR          =   -1  'True
         BCOL            =   15790320
         BCOLO           =   15790320
         FCOL            =   0
         FCOLO           =   0
         MCOL            =   12632256
         MPTR            =   1
         MICON           =   "frmAddRefs.frx":05B6
         Picture         =   "frmAddRefs.frx":05D2
         UMCOL           =   -1  'True
         SOFT            =   0   'False
         PICPOS          =   0
         NGREY           =   0   'False
         FX              =   0
         HAND            =   0   'False
         CHECK           =   0   'False
         VALUE           =   0   'False
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Search"
      Height          =   1935
      Left            =   5790
      TabIndex        =   2
      Top             =   45
      Width           =   5700
      Begin VB.TextBox txtSearch 
         Height          =   285
         Left            =   135
         TabIndex        =   5
         Top             =   285
         Width           =   2715
      End
      Begin MSComctlLib.ListView lv2 
         Height          =   1185
         Left            =   120
         TabIndex        =   3
         Top             =   615
         Width           =   5430
         _ExtentX        =   9578
         _ExtentY        =   2090
         View            =   3
         LabelEdit       =   1
         Sorted          =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         HideColumnHeaders=   -1  'True
         FullRowSelect   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   1
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Object.Width           =   2540
         EndProperty
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "?"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   240
         Left            =   3000
         TabIndex        =   6
         Top             =   300
         Width           =   195
      End
   End
   Begin VB.Frame Frame2 
      Height          =   4095
      Left            =   60
      TabIndex        =   0
      Top             =   15
      Width           =   5655
      Begin Project1.axButton cmdBuildComp 
         Height          =   435
         Left            =   2370
         TabIndex        =   8
         Top             =   195
         Width           =   1860
         _ExtentX        =   3281
         _ExtentY        =   767
         ButtonType      =   7
         Caption         =   "&Build Component List"
         Enabled         =   -1  'True
         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
         COLTYPE         =   1
         FOCUSR          =   -1  'True
         BCOL            =   15790320
         BCOLO           =   15790320
         FCOL            =   0
         FCOLO           =   0
         MCOL            =   12632256
         MPTR            =   1
         MICON           =   "frmAddRefs.frx":0B6C
         UMCOL           =   -1  'True
         SOFT            =   0   'False
         PICPOS          =   0
         NGREY           =   0   'False
         FX              =   0
         HAND            =   0   'False
         CHECK           =   0   'False
         VALUE           =   0   'False
      End
      Begin MSComctlLib.ListView lv1 
         Height          =   3270
         Left            =   90
         TabIndex        =   1
         Top             =   705
         Width           =   5430
         _ExtentX        =   9578
         _ExtentY        =   5768
         View            =   3
         LabelEdit       =   1
         Sorted          =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         HideColumnHeaders=   -1  'True
         FullRowSelect   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   1
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Object.Width           =   2540
         EndProperty
      End
      Begin Project1.axButton cmdBuildRefs 
         Height          =   435
         Left            =   150
         TabIndex        =   9
         Top             =   195
         Width           =   1860
         _ExtentX        =   3281
         _ExtentY        =   767
         ButtonType      =   7
         Caption         =   "Build Reference List"
         Enabled         =   -1  'True
         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
         COLTYPE         =   1
         FOCUSR          =   -1  'True
         BCOL            =   15790320
         BCOLO           =   15790320
         FCOL            =   0
         FCOLO           =   0
         MCOL            =   12632256
         MPTR            =   1
         MICON           =   "frmAddRefs.frx":0B88
         UMCOL           =   -1  'True
         SOFT            =   0   'False
         PICPOS          =   0
         NGREY           =   0   'False
         FX              =   0
         HAND            =   0   'False
         CHECK           =   0   'False
         VALUE           =   0   'False
      End
   End
   Begin Project1.axButton cmdSelect 
      Height          =   450
      Index           =   1
      Left            =   8895
      TabIndex        =   10
      Top             =   2070
      Width           =   2010
      _ExtentX        =   3545
      _ExtentY        =   794
      ButtonType      =   7
      Caption         =   "Select from above"
      Enabled         =   -1  'True
      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
      COLTYPE         =   1
      FOCUSR          =   -1  'True
      BCOL            =   15790320
      BCOLO           =   15790320
      FCOL            =   0
      FCOLO           =   0
      MCOL            =   12632256
      MPTR            =   1
      MICON           =   "frmAddRefs.frx":0BA4
      Picture         =   "frmAddRefs.frx":0BC0
      UMCOL           =   -1  'True
      SOFT            =   0   'False
      PICPOS          =   1
      NGREY           =   0   'False
      FX              =   0
      HAND            =   0   'False
      CHECK           =   0   'False
      VALUE           =   0   'False
   End
End
Attribute VB_Name = "frmAddRefs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Author: David Zimmer
' Site:   http://sandsprite.com
'
Option Explicit

Dim reg As New CReg
Dim tlbs As Collection
Dim selEntry As CEntry

Dim ItemSel1 As Long
Dim ItemSel2 As Long

Dim Row As Long
Dim Sel As Boolean


Private Sub cmdBuildComp_Click()
BuildComponentList
End Sub

Private Sub cmdBuildRefs_Click()
BuildReferenceList
End Sub

Private Sub cmdReplaceObj_Click()
Dim Part1() As String, Part2() As String

Frame3.Visible = False
Frame5.Visible = True
Me.Height = 8350

Selected.ListIndex = 0
Part1 = Split(Selected.Text, "|")
strNameObj1 = Part1(0)
strPathObj1 = Part1(1)

Selected.ListIndex = 1
Part2 = Split(Selected.Text, "|")
strNameObj2 = Part2(0)
strPathObj2 = Part2(1)

frmCompareInterfaces.Show
End Sub

Private Sub cmdSelect_Click(Index As Integer)
With Selected

  If .ListCount = 2 Then
    If Sel Then
      .RemoveItem (Row)
    Else:
      .RemoveItem (1)
      Row = 1
    End If
  Else
    If Sel Then .RemoveItem (Row)
  End If
  
  Select Case Index
    Case Is = 0
      .AddItem selEntry.GetProgID & "|" & selEntry.GetPath, Row
    
    Case Is = 1
      .AddItem selEntry.GetProgID & "|" & selEntry.GetPath, Row
  
  End Select
  
  Sel = False
End With
End Sub

Private Sub Form_Load()
   
  lv1.ColumnHeaders(1).Width = lv1.Width
  lv2.ColumnHeaders(1).Width = lv1.Width
  
  Set tlbs = New Collection
  reg.hive = HKEY_CLASSES_ROOT

  Row = 0
  Sel = False
  
  Me.Height = 6550
End Sub


Function BuildReferenceList()
    Dim clsids() As String
    Dim clsid
    Dim li As ListItem
    Dim e As CEntry
    Dim tmp As CEntry
    Dim vers() As String
    Dim revs() As String
    Dim c As New Collection
    Dim lia As ListItem
    
    lv1.ListItems.Clear
    lv2.ListItems.Clear

    If reg.hive = HKEY_CLASSES_ROOT Then
        clsids = reg.EnumKeys("\TypeLib")
    End If
    
    For Each clsid In clsids

        Set e = New CEntry
        e.clsid = clsid
        
         vers() = reg.EnumKeys("\TypeLib\" & clsid)
         If AryIsEmpty(vers) Then GoTo nextone
                
         revs() = reg.EnumKeys("\TypeLib\" & clsid & "\" & vers(UBound(vers)))
         If AryIsEmpty(revs) Then GoTo nextone
         
         With e
            .Name = reg.ReadValue("\TypeLib\" & clsid & "\" & vers(UBound(vers)), "")
            .path = reg.ReadValue("\TypeLib\" & clsid & "\" & vers(UBound(vers)) & "\" & revs(0) & "\win32", "")
            .version = vers(UBound(vers)) & "." & revs(0)
            
            .path = ValidatePath(e.path)
            
            If FileExists(.path) And Len(.Name) > 0 Then
                If Not KeyExistsInCollection(.Name, c) Then
                    Set li = lv1.ListItems.Add(, , .Name)
                    Set li.Tag = e
                    c.Add e, .Name
                End If
            End If
            
        End With
        
nextone:

   Next
End Function

Function ValidatePath(fpath As String) As String
    
    Dim a As Long
    Dim b As Long
    'example input: C:\WINDOWS\system32\catsrvut.dll\2
    
    a = InStrRev(fpath, ".")
    b = InStrRev(fpath, "\")
    If b > a Then
        ValidatePath = Mid(fpath, 1, b - 1)
    Else
        ValidatePath = fpath
    End If
    
End Function

Function GetExtension(path) As String
    Dim tmp, ub
    If Len(path) = 0 Then Exit Function
    tmp = Split(path, "\")
    ub = tmp(UBound(tmp))
    If InStr(1, ub, ".") > 0 Then
       GetExtension = LCase(Mid(ub, InStrRev(ub, "."), Len(ub)))
    Else
       GetExtension = ""
    End If
End Function

'no addin api to add ocx controls :-\
Function BuildComponentList()
    Dim clsids() As String
    Dim clsid
    Dim li As ListItem
    Dim e As CEntry
    Dim tmp As CEntry

    lv1.ListItems.Clear
    lv2.ListItems.Clear
    
    Const catid_control = "\Implemented Categories\{40FC6ED4-2438-11cf-A3DB-080036F12502}"
    Const catid_programmable = "\Implemented Categories\{40FC6ED5-2438-11CF-A3DB-080036F12502}"
    Const server = "\InprocServer32"

    If reg.hive = HKEY_CLASSES_ROOT Then
        clsids = reg.EnumKeys("\CLSID")
    Else
        clsids = reg.EnumKeys("\SOFTWARE\Classes\CLSID")
    End If

    For Each clsid In clsids

        Set e = New CEntry
        e.clsid = clsid

        If reg.hive = HKEY_CLASSES_ROOT Then
            clsid = "\CLSID\" & clsid
        Else
            clsid = "\SOFTWARE\Classes\CLSID\" & clsid
        End If

        With e

            .isControl = reg.keyExists(clsid & "\Control")
            If .isControl = False Then
                If reg.keyExists(clsid & catid_control) Then .isControl = True
            End If

            .typeLib = reg.ReadValue(clsid & "\typeLib", "")

            If Len(.typeLib) > 0 Then

                If .isControl And Not KeyExistsInCollection(.typeLib, tlbs) Then
                    .Name = GetName(.typeLib)
                    If Len(.Name) > 0 Then
                        .path = reg.ReadValue(clsid & "\InprocServer32", "")
                        .ProgID = reg.ReadValue(clsid & "\ProgID", "")
                        .version = reg.ReadValue(clsid & "\version", "")
                        tlbs.Add e, .typeLib

                        If e.isControl Then
                            Set li = lv1.ListItems.Add(, , .Name)
                            Set li.Tag = e
                        End If
                    End If

                End If
            End If

        End With

   Next
End Function

Function ExistsInLV(s, lv As ListView) As Boolean
    Dim li As ListItem
    For Each li In lv.ListItems
        If li.Text = s Then ExistsInLV = True
    Next
End Function

Private Sub push(ary, Value) 'this modifies parent ary object
    On Error GoTo init
    Dim x
    x = UBound(ary) '<-throws Error If Not initalized
    ReDim Preserve ary(UBound(ary) + 1)
    ary(UBound(ary)) = Value
    Exit Sub
init:     ReDim ary(0): ary(0) = Value
End Sub

Function KeyExistsInCollection(key As String, c As Collection) As Boolean
    On Error GoTo hell
    Dim x
    Set x = c(key)
    KeyExistsInCollection = True
    Exit Function
hell:
End Function

Function GetName(typeLibID As String)
    Dim keys() As String
    Dim k, v As String, Base As String

    If reg.hive = HKEY_CLASSES_ROOT Then
        Base = "\TypeLib\" & typeLibID
    Else
        Base = "\SOFTWARE\Classes\TypeLib\" & typeLibID
    End If
    
    keys() = reg.EnumKeys(Base)
    If AryIsEmpty(keys) Then Exit Function
    For Each k In keys
       v = reg.ReadValue(Base & "\" & k, "")
       If Len(v) > 0 Then
           GetName = v
           Exit Function
       End If
    Next
End Function

Function FileExists(path) As Boolean
  If Len(path) = 0 Then Exit Function
  If Dir(path, vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then FileExists = True _
  Else FileExists = False
End Function

Function AryIsEmpty(ary) As Boolean
  On Error GoTo oops
    Dim i
    i = UBound(ary)  '<- throws error if not initalized
    AryIsEmpty = False
  Exit Function
oops: AryIsEmpty = True
End Function
 

Private Sub Label2_Click()
    MsgBox "Case insensitive search. Type 'checked' to see active references", vbInformation
End Sub

Private Sub lv1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Set selEntry = Item.Tag
    txtDetails.Text = selEntry.ToString()
    ItemSel1 = Item.Index
    txtObj.Text = selEntry.Output()
    'Sel = False
End Sub

Private Sub lv2_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Set selEntry = Item.Tag
    txtDetails.Text = selEntry.ToString()
    ItemSel2 = Item.Index
    txtObj.Text = selEntry.Output()
    'Sel = False
End Sub

Private Sub Selected_Click()
Row = Selected.ListIndex
Sel = True
End Sub

Private Sub txtSearch_Change()

    If Len(txtSearch) = 0 Then Exit Sub
    
    Dim li As ListItem
    Dim li2 As ListItem
    Dim llv As ListView
    
    Set llv = lv1
    
    lv2.ListItems.Clear
    
    For Each li In llv.ListItems
        If txtSearch = "checked" And li.Checked Then
            Set li2 = lv2.ListItems.Add(, , li.Text)
            Set li2.Tag = li.Tag
            li2.Checked = li.Checked
        ElseIf InStr(1, li.Text, txtSearch, vbTextCompare) > 0 Then
            Set li2 = lv2.ListItems.Add(, , li.Text)
            Set li2.Tag = li.Tag
            li2.Checked = li.Checked
        End If
    Next
        
End Sub