windows-server-2003/admin/pchealth/authtools/prodtools/unused/extensionsframework/hssx.frm

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form HssX 
   Caption         =   "HSC Extensions Manager"
   ClientHeight    =   8235
   ClientLeft      =   3135
   ClientTop       =   2280
   ClientWidth     =   6240
   LinkTopic       =   "Form1"
   ScaleHeight     =   8235
   ScaleWidth      =   6240
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   285
      Left            =   0
      TabIndex        =   21
      Top             =   7950
      Width           =   6240
      _ExtentX        =   11007
      _ExtentY        =   503
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.TextBox txtAuxFolder 
      Height          =   300
      Left            =   30
      TabIndex        =   18
      Top             =   1245
      Width           =   5355
   End
   Begin VB.TextBox txtCabFile 
      Height          =   300
      Left            =   30
      TabIndex        =   17
      Top             =   720
      Width           =   5355
   End
   Begin VB.CommandButton cmdExecuteExts 
      Caption         =   "E&xecute Extensions"
      Height          =   375
      Left            =   3750
      TabIndex        =   16
      Top             =   7560
      Width           =   1800
   End
   Begin MSComctlLib.ListView lstvwExtensions 
      Height          =   2070
      Left            =   30
      TabIndex        =   15
      Top             =   3195
      Width           =   6150
      _ExtentX        =   10848
      _ExtentY        =   3651
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      OLEDropMode     =   1
      Checkboxes      =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      OLEDropMode     =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Frame fraSKU 
      Caption         =   "SKU"
      Height          =   1575
      Left            =   30
      TabIndex        =   5
      Top             =   1560
      Width           =   6135
      Begin VB.CheckBox chkStandard 
         Caption         =   "32-bit Standard"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   480
         Width           =   1695
      End
      Begin VB.CheckBox chkProfessional 
         Caption         =   "32-bit Professional"
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   720
         Width           =   1695
      End
      Begin VB.CheckBox chkServer 
         Caption         =   "32-bit Server"
         Height          =   255
         Left            =   3120
         TabIndex        =   12
         Top             =   240
         Width           =   2055
      End
      Begin VB.CheckBox chkAdvancedServer 
         Caption         =   "32-bit Advanced Server"
         Height          =   255
         Left            =   3120
         TabIndex        =   11
         Top             =   480
         Width           =   2055
      End
      Begin VB.CheckBox chkDataCenterServer 
         Caption         =   "32-bit Datacenter Server"
         Height          =   255
         Left            =   3120
         TabIndex        =   10
         Top             =   960
         Width           =   2055
      End
      Begin VB.CheckBox chkProfessional64 
         Caption         =   "64-bit Professional"
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   960
         Width           =   1695
      End
      Begin VB.CheckBox chkAdvancedServer64 
         Caption         =   "64-bit Advanced Server"
         Height          =   255
         Left            =   3120
         TabIndex        =   8
         Top             =   720
         Width           =   2055
      End
      Begin VB.CheckBox chkDataCenterServer64 
         Caption         =   "64-bit Datacenter Server"
         Height          =   255
         Left            =   3120
         TabIndex        =   7
         Top             =   1200
         Width           =   2055
      End
      Begin VB.CheckBox chkWindowsMillennium 
         Caption         =   "Windows Me"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   240
         Width           =   1695
      End
   End
   Begin SHDocVwCtl.WebBrowser wb 
      Height          =   2235
      Left            =   45
      TabIndex        =   4
      Top             =   5280
      Width           =   6165
      ExtentX         =   10874
      ExtentY         =   3942
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "res://C:\WINNT\system32\shdoclc.dll/dnserror.htm#http:///"
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "&Close"
      Height          =   375
      Left            =   5565
      TabIndex        =   3
      Top             =   7560
      Width           =   675
   End
   Begin VB.CommandButton cmdGo 
      Caption         =   "&Go"
      Height          =   315
      Left            =   5415
      TabIndex        =   2
      Top             =   240
      Width           =   675
   End
   Begin VB.TextBox txtExtensionsFolder 
      Height          =   300
      Left            =   30
      TabIndex        =   0
      Top             =   240
      Width           =   5355
   End
   Begin VB.Label Label3 
      Caption         =   "Auxiliary Folder for Storing Extensions Output:"
      Height          =   240
      Left            =   75
      TabIndex        =   20
      Top             =   1035
      Width           =   3555
   End
   Begin VB.Label Label2 
      Caption         =   "Cab File Location:"
      Height          =   240
      Left            =   45
      TabIndex        =   19
      Top             =   525
      Width           =   3000
   End
   Begin VB.Label Label1 
      Caption         =   "Extension Tools Directory Location:"
      Height          =   240
      Left            =   30
      TabIndex        =   1
      Top             =   15
      Width           =   3000
   End
   Begin VB.Menu mnuExt 
      Caption         =   "Extension Right Click Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuEdit 
         Caption         =   "Edit"
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "Delete"
      End
   End
End
Attribute VB_Name = "HssX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ==========================================================================================
Option Explicit
Private m_strTempXMLFile As String      ' Temporary File for XML Rendering
Private m_oDomList As IXMLDOMNodeList   ' List of Extensions
Private WithEvents m_oHssExt As HssExts
Attribute m_oHssExt.VB_VarHelpID = -1
Private m_oFs As Scripting.FileSystemObject
Private m_bIndrag As Boolean            ' This variable is used to control
                                        ' dragging inside the Listview
Private m_oCachedExt As IXMLDOMNode     ' This is the Cached DOMNODE
                                        ' which is saved on MouseUp
                                        ' event from the ListView.
                                        ' We need to cache it because
                                        ' Menus are event driven.
Private m_dblTimeLeftButtonDown As Double    ' Tracks how long the Mouse Down button was pressed.

Private Sub Form_Initialize()
    Set m_oHssExt = New HssExts
    Set m_oFs = New Scripting.FileSystemObject
End Sub

Private Sub Form_Load()
    With Me
        .txtExtensionsFolder = App.Path + "\Extensions"
        .txtAuxFolder = App.Path + "\AuxFolder"
        .txtCabFile = App.Path + "\hcdata.cab"
    End With
    
    ' Let's Get a Temporary File Name
    m_strTempXMLFile = Environ$("TEMP") + "\" + m_oFs.GetTempName + ".xml"
    Dim oFh As Scripting.TextStream
    Set oFh = m_oFs.CreateTextFile(m_strTempXMLFile)
    oFh.WriteLine "<Note>When you click on an extension in the List Above, the HSS Tool Extension XML Entry will show up here</Note>"
    oFh.Close
    wb.Navigate m_strTempXMLFile
    
    ' let's kick the first Extensions Search.
    ' txtExtensionsFolder_Change

End Sub


Private Sub chkAdvancedServer_Click()
    cmdGo_Click
End Sub

Private Sub chkAdvancedServer64_Click()
    cmdGo_Click
End Sub

Private Sub chkDataCenterServer_Click()
    cmdGo_Click
End Sub

Private Sub chkDataCenterServer64_Click()
    cmdGo_Click
End Sub

Private Sub chkProfessional_Click()
    cmdGo_Click
End Sub

Private Sub chkProfessional64_Click()
    cmdGo_Click
End Sub

Private Sub chkServer_Click()
    cmdGo_Click
End Sub

Private Sub chkStandard_Click()
    cmdGo_Click
End Sub

Private Sub chkWindowsMillennium_Click()
    cmdGo_Click
End Sub

Private Sub cmdExecuteExts_Click()
    m_oHssExt.ExecuteExtensions m_oDomList, Me.txtCabFile, Me.txtAuxFolder
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdGo_Click()

    Dim oDomList As IXMLDOMNodeList
    
    Set m_oDomList = m_oHssExt.GetExtensionsList(Me.txtExtensionsFolder, SkuCollection)
    
    With Me.lstvwExtensions
        .LabelEdit = lvwManual
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders(1).Text = "Select Extensions to Run"
        .ColumnHeaders(1).Width = lstvwExtensions.Width - 85
        If (m_oDomList Is Nothing) Then GoTo Common_Exit
        Dim oDomNode As IXMLDOMNode
        Dim l As ListItem
        For Each oDomNode In m_oDomList
            Set l = .ListItems.Add(Text:=oDomNode.selectSingleNode("display-name").Text)
            Set l.Tag = oDomNode
        Next
    End With

Common_Exit:

End Sub

Private Function SkuCollection() As Scripting.Dictionary

    Set SkuCollection = New Scripting.Dictionary
    If (Me.chkAdvancedServer) Then
        SkuCollection.Add "ADV", "ADV"
    End If
    If (Me.chkAdvancedServer64) Then
        SkuCollection.Add "ADV64", "ADV64"
    End If
    If (Me.chkDataCenterServer) Then
        SkuCollection.Add "DAT", "DAT"
    End If
    If (Me.chkDataCenterServer64) Then
        SkuCollection.Add "DAT64", "DAT64"
    End If
    If (Me.chkProfessional) Then
        SkuCollection.Add "PRO", "PRO"
    End If
    If (Me.chkProfessional64) Then
        SkuCollection.Add "PRO64", "PRO64"
    End If
    If (Me.chkServer) Then
        SkuCollection.Add "SRV", "SRV"
    End If
    If (Me.chkStandard) Then
        SkuCollection.Add "STD", "STD"
    End If
    If (Me.chkWindowsMillennium) Then
        SkuCollection.Add "WINME", "WINME"
    End If

End Function

Private Sub lstvwExtensions_Click()
    DisplayTaxonomyEntry2 lstvwExtensions, m_oDomList, wb
End Sub

Private Sub lstvwExtensions_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Dim oElem As IXMLDOMElement
'    Set oElem = m_oDomList.Item(lstvwExtensions.HitTest(Item.Left, Item.Top).Index - 1).selectSingleNode("run-this-extension")
    Set oElem = Item.Tag
    Set oElem = oElem.selectSingleNode("run-this-extension")
    oElem.Text = IIf(Item.Checked, "yes", "no")
End Sub

Private Sub lstvwExtensions_DragDrop(source As Control, x As Single, y As Single)
    DoDragDrop lstvwExtensions, source, x, y
End Sub

Private Sub lstvwExtensions_DragOver(source As Control, x As Single, y As Single, State As Integer)
    DoDragOver lstvwExtensions, source, x, y, State
End Sub


Private Sub lstvwExtensions_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (Button = vbLeftButton) Then
        m_dblTimeLeftButtonDown = HighResTimer
    End If
End Sub

Private Sub lstvwExtensions_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' Debug.Print "Button = " & Button & " - Shift = " & Shift
    Select Case Button
    Case vbRightButton
        If (Not lstvwExtensions.HitTest(x, y) Is Nothing) Then
            Set m_oCachedExt = lstvwExtensions.HitTest(x, y).Tag
            PopupMenu mnuExt
            Set m_oCachedExt = Nothing
        End If
    Case vbLeftButton
        m_dblTimeLeftButtonDown = 0
    End Select
End Sub


Private Sub lstvwExtensions_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    DoMouseMove lstvwExtensions, Button, Shift, x, y

End Sub

Sub DoMouseMove(lvw As ListView, Button As Integer, Shift As Integer, x As Single, y As Single)
    If (Button = vbLeftButton) Then
        If (LeftButtonWasPressedLongEnough) Then ' Signal a Drag operation.
            ' Set the drag icon with the CreateDragImage method.
            If (Not lvw.SelectedItem Is Nothing) Then
                m_bIndrag = True ' Set the flag to true.
                lvw.DragIcon = lvw.SelectedItem.CreateDragImage
                lvw.Drag vbBeginDrag ' Drag operation.
            End If
        End If
    Else
        m_bIndrag = False
    End If

    ' Debug.Print "DoMouseMove Called from " & lvw.Name; "_MouseMove. m_bIndrag = " & m_bIndrag
End Sub

Private Function LeftButtonWasPressedLongEnough() As Boolean
    LeftButtonWasPressedLongEnough = False
    
    If (m_dblTimeLeftButtonDown <> 0) Then
        LeftButtonWasPressedLongEnough = ((HighResTimer - m_dblTimeLeftButtonDown) > 0.4)
    End If
    
End Function
Sub DoDragOver(lvw As ListView, source As Control, x As Single, y As Single, State As Integer)

   If m_bIndrag = True Then
      ' Set DropHighlight to the mouse's coordinates.
      Set lvw.DropHighlight = lvw.HitTest(x, y)
   End If
End Sub

Sub DoDragDrop(lvw As ListView, _
        source As Control, x As Single, y As Single _
    )

    If lvw.DropHighlight Is Nothing Then GoTo Common_Exit
    If (lvw Is source) Then
        ' We are on the Same Tree, so we need
        If lvw.SelectedItem.Index = lvw.DropHighlight.Index Then GoTo Common_Exit
        
        ' Temporary Variables to keep The List view Item contents.
        Dim strLi1 As String, strSli1 As String, strSli2 As String
        Dim oTag As Object, bChecked As Boolean
        
        ' The direction in which the List Items will be moved
        ' on the list to make room for the move
        Dim lDirection As Long
        
        If (lvw.DropHighlight.Index < lvw.SelectedItem.Index) Then
            lDirection = -1
        Else
            lDirection = 1
        End If
        
        With lvw.SelectedItem
            bChecked = .Checked
            Set oTag = .Tag
            strLi1 = .Text
'            strSli1 = .ListSubItems(1).Text
'            strSli2 = .ListSubItems(2).Text
        End With
        
        Dim i As Long
        For i = lvw.SelectedItem.Index To lvw.DropHighlight.Index - lDirection Step lDirection
            With lvw.ListItems
                .Item(i).Checked = .Item(i + lDirection).Checked
                Set .Item(i).Tag = .Item(i + lDirection).Tag
                .Item(i) = .Item(i + lDirection)
'                .Item(i).ListSubItems(1) = .Item(i + lDirection).ListSubItems(1)
'                .Item(i).ListSubItems(2) = .Item(i + lDirection).ListSubItems(2)
            End With
        Next i
    
        With lvw.DropHighlight
            .Checked = bChecked
            Set .Tag = oTag
            .Text = strLi1
 '           .ListSubItems(1).Text = strSli1
 '           .ListSubItems(2).Text = strSli2
        End With
        
        Debug.Print lvw.SelectedItem.Text & " dropped on " & lvw.DropHighlight.Text
        
    End If
    
Common_Exit:
    ' This is the exit Condition for Shutting Down the Drag operation
    Set lvw.DropHighlight = Nothing: m_bIndrag = False
    Exit Sub
    
End Sub


Private Sub lstvwExtensions_OLEDragDrop( _
        Data As MSComctlLib.DataObject, _
        Effect As Long, Button As Integer, _
        Shift As Integer, _
        x As Single, _
        y As Single _
    )
    If Data.GetFormat(vbCFFiles) Then
        Dim vFN
        
        For Each vFN In Data.Files
'            Screen.MousePointer = vbHourglass
            ' Screen.MousePointer = 99
            ' Screen.MouseIcon = LoadPicture(Environ$("WINDIR") + "\cursors\wait_m.cur")

            Select Case UCase$(m_oFs.GetExtensionName(vFN))
            Case "EXE", "VBS", "JS", "BAT", "PL"
                If (Not m_oHssExt.ExtensionExists(m_oFs.GetFileName(vFN))) Then
                    Dim oFext As frmExt: Set oFext = New frmExt
                    oFext.DropFile Nothing, vFN, "MSFT"
                    cmdGo_Click
                Else
                    
                    MsgBox "This Extension was already added to the Extensions System " + vbCrLf + _
                        "in case you want to update it, please remove first the old " + vbCrLf + _
                        "extension and then retry the operation", vbInformation, _
                        Me.Caption
                End If
            End Select
            ' Screen.MousePointer = vbDefault
        Next vFN
    End If

End Sub

Private Sub m_oHssExt_RunStatus(ByVal strExt As String, bCancel As Boolean)
    Me.StatusBar1.SimpleText = strExt
End Sub

Private Sub mnuDelete_Click()
    m_oHssExt.DeleteExtension m_oCachedExt
    cmdGo_Click
End Sub

Private Sub mnuEdit_Click()
    MsgBox "Edit Menu"
End Sub

Private Sub txtExtensionsFolder_Change()

    Dim bEnabled As Boolean
    bEnabled = m_oFs.FolderExists(Me.txtExtensionsFolder)
    With Me
        .txtAuxFolder.Enabled = bEnabled
        .txtCabFile.Enabled = bEnabled
        .lstvwExtensions.Enabled = bEnabled
        .fraSKU.Enabled = bEnabled
        .cmdExecuteExts.Enabled = bEnabled
        .cmdGo.Enabled = bEnabled
    End With
    
    cmdGo_Click
    
End Sub

Sub DisplayTaxonomyEntry2(oList As ListView, oResultsList As IXMLDOMNodeList, wBrowser As WebBrowser)

    If (oList.SelectedItem Is Nothing) Then GoTo Common_Exit

    Dim oDom As DOMDocument: Set oDom = New DOMDocument
    oDom.loadXML oList.SelectedItem.Tag.xml
    oDom.save m_strTempXMLFile
    wBrowser.Navigate m_strTempXMLFile
    
Common_Exit:

End Sub