admin
activec
admt
burnslib
cmdline
consoles
controls
cys
darwin
dcpromo
display
dsadminlib
dsclientnt4
dscmd
dsutils
dsweb
eelvewer
extens
hmonitor
netid
netui
pchealth
authtools
prodtools
authdatabase
common
docs
hssextensions
extensions
frmext.frm
hssext.cls
hssextensions.vbp
hssexts.cls
hssx.frm
installer
livehelpimage
lvitracker
searchtester
ui
buildall.bat
readme.txt
binary_release
build
client
core
helpctr
pchmars
redist
setup
sr
sysinfo
upload
dirs
published
select
services
sms
snapin
wizards
wmi
wmiprov
wmiscmgr
dirs
makefile.inc
project.mk
base
com
developer
drivers
ds
enduser
inetcore
inetsrv
loc
mergedcomponents
multimedia
net
printscan
public
published
sdktools
shell
termsrv
tools
windows
dirs
makefil0
600 lines
19 KiB
Plaintext
600 lines
19 KiB
Plaintext
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
|
|
|