复制代码 代码如下:
<html>
<head>
<title>Tweakomatic 1.0</title>
<HTA:APPLICATION
ID="objTweakomatic"
APPLICATIONNAME="Tweakomatic"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
>
</head>
<style>
BODY
{
background-color: buttonface;
font-family: Helvetica;
font-size: 8pt;
margin-top: 10px;
margin-left: 10px;
margin-right: 10px;
margin-bottom: 10px;
}
.button
{
font-family: Helvetica;
font-size: 8pt;
}
textarea
{
font-family: arial;
font-size: 8pt;
margin-left: 3px;
}
select
{
font-family: arial;
font-size: 8pt;
width: 450px;
margin-left: 0px;
}
td
{
font-family: arial;
font-size: 10pt;
}
</style>
<
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
DefaultComputer = "."
MasterFile = ""
RetrievalFile = ""
StartHelp = "To begin, select a manageable component, and then select a category of tasks. When you do so, a set of tasks will be displayed in the Task Area. Click a task and two
Help2 = "Select a category from the list of categories. When you do so, a set of tasks will be displayed in the Task Area. Click a task and two
Help3 = "Click a task and two
Sub Window_on load
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider= Microsoft.Jet.OLEDB.4.0; Data Source=tweakomatic.mdb"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT DISTINCT Tweaks.Component FROM Tweaks ORDER BY Tweaks.Component" , objConnection, adOpenStatic, adLockOptimistic
objRecordSet.MoveFirst
strHTML = "<select style='width: 460' on Change=""GetCategoryInfo()"" name=ComponentList>"
strHTML = strHTML & "<option value= " & chr(34) & chr(34) & ">"
Do Until objRecordSet.EOF
strHTML = strHTML & "<option value= " & chr(34) & _
objRecordSet.Fields.Item("Component") & chr(34) & _
">" & objRecordSet.Fields.Item("Component")
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</select>"
ComponentArea.InnerHTML = strHTML
run_button.disabled = True
run_button2.disabled = True
save_button.disabled = True
save_button2.disabled = True
change_button.disabled = True
Master_button.disabled = True
Master_button2.disabled = True
show_button.disabled = True
show_button2.disabled = True
HelpArea.InnerHTML = StartHelp
End Sub
Sub Window_on Unload
On Error Resume Next
Set objFSO = CreateObject("
objFSO.DeleteFile "temp_
Set objFSO = Nothing
self.Close()
End Sub
Sub GetCategoryInfo()
On Error Resume Next
FilterValue = ComponentList.Value
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider= Microsoft.Jet.OLEDB.4.0; Data Source=tweakomatic.mdb"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT DISTINCT Tweaks.Category FROM Tweaks Where Component = '" & FilterValue & "'ORDER BY Tweaks.Category" , objConnection, adOpenStatic, adLockOptimistic
objRecordSet.MoveFirst
CategoryArea.InnerHTML = ""
strHTML = "<select style='width: 460' on Change=""GetTaskInfo"" name=CategoryList>"
strHTML = strHTML & "<option value= " & chr(34) & chr(34) & ">"
Do Until objRecordSet.EOF
strHTML = strHTML & "<option value= " & chr(34) &_
objRecordSet.Fields.Item("Category") & chr(34) &_
">" & objRecordSet.Fields.Item("Category")
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</select>"
CategoryArea.InnerHTML = strHTML
TaskArea.InnerHTML = "<select size='15' name='D2'>"
HelpArea.InnerHTML= Help2
RetrievalArea.Value = ""
run_button.disabled = True
run_button2.disabled = True
save_button.disabled = True
save_button2.disabled = True
change_button.disabled = True
Master_button.disabled = True
Master_button2.disabled = True
objRecordSet.Close
objConnection.Close
End Sub
Sub GetTaskInfo()
On Error Resume Next
FilterValue = ComponentList.Value
FilterValue2 = CategoryList.Value
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider= Microsoft.Jet.OLEDB.4.0; Data Source=tweakomatic.mdb"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT DISTINCT Tweaks.Task FROM Tweaks Where Component = '" & FilterValue & "' AND Category = '" & FilterValue2 & "'ORDER BY Tweaks.Task" , objConnection, adOpenStatic, adLockOptimistic
objRecordSet.MoveFirst
TaskArea.InnerHTML = ""
strHTML = "<select size = '15' style='width: 460' on Change=""GetHelpText()"" name=TaskList>"
Do Until objRecordSet.EOF
strHTML = strHTML & "<option value= " & chr(34) &_
objRecordSet.Fields.Item("Task") & chr(34) &_
">" & objRecordSet.Fields.Item("Task")
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</select>"
TaskArea.InnerHTML = strHTML
HelpArea.InnerHTML= Help3
RetrievalArea.Value = ""
run_button.disabled = True
run_button2.disabled = True
save_button.disabled = True
save_button2.disabled = True
change_button.disabled = True
Master_button.disabled = True
Master_button2.disabled = True
objRecordSet.Close
objConnection.Close
End Sub
Sub GetHelpText()
FilterValue = TaskList.Value
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider= Microsoft.Jet.OLEDB.4.0; Data Source=tweakomatic.mdb"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT * FROM Tweaks WHERE Task = '" & FilterValue & "' ORDER BY Tweaks.Task" , objConnection, adOpenStatic, adLockOptimistic
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strHTML = objRecordSet.Fields.Item("Help")
strText2 = "On Error Resume Next" & vbCrLf
strLocation = objRecordSet.Fields.Item("RegistryLocation")
If StrLocation = "HKEY_CURRENT_USER" Then
strText = "HKEY_CURRENT_USER = &H80000001" & VbCrLf
strText2 = strText2 & "HKEY_CURRENT_USER = &H80000001" & VbCrLf
strText = strText & "strComputer = " & chr(34) & DefaultComputer & chr(34) & VbCrLf
strText2 = strText2 & "strComputer = " & chr(34) & DefaultComputer & chr(34) & VbCrLf
strText = strText & "Set objReg = GetObject(" & chr(34) & "winmgmts:\\" & chr(34)
strText2 = strText2 & "Set objReg = GetObject(" & chr(34) & "winmgmts:\\" & chr(34)
strText = strText & " & strComputer & " & chr(34) & "\root\default:StdRegProv" & chr(34) & ")" & VbCrLf
strText2 = strText2 & " & strComputer & " & chr(34) & "\root\default:StdRegProv" & chr(34) & ")" & VbCrLf
strText = strText & "strKeyPath = " & chr(34) & objRecordSet.Fields.Item("RegKey") & chr(34) & VbCrLf
strText2 = strtext2 & "strKeyPath = " & chr(34) & objRecordSet.Fields.Item("RegKey") & chr(34) & VbCrLf
strText = strText & "objReg.CreateKey " & strLocation & ", strKeyPath" & VbCrLf
strText = strText & "ValueName = " & chr(34) & objRecordSet.Fields.Item("RegValue") & chr(34) & VbCrLf
strText2 = strText2 & "ValueName = " & chr(34) & objRecordSet.Fields.Item("RegValue") & chr(34) & VbCrLf
Else
strText = strText & "HKEY_LOCAL_MACHINE = &H80000002" & vbCrLf
strText2 = strText2 & "HKEY_LOCAL_MACHINE = &H80000002" & vbCrLf
strText = strText & "strComputer = " & chr(34) & DefaultComputer & chr(34) & VbCrLf
strText2 = strText2 & "strComputer = " & chr(34) & DefaultComputer & chr(34) & VbCrLf
strText = strText & "Set objReg = GetObject(" & chr(34) & "winmgmts:\\" & chr(34)
strText2 = strText2 & "Set objReg = GetObject(" & chr(34) & "winmgmts:\\" & chr(34)
strText = strText & " & strComputer & " & chr(34) & "\root\default:StdRegProv" & chr(34) & ")" & VbCrLf
strText2 = strText2 & " & strComputer & " & chr(34) & "\root\default:StdRegProv" & chr(34) & ")" & VbCrLf
strText = strText & "strKeyPath = " & chr(34) & objRecordSet.Fields.Item("RegKey") & chr(34) & VbCrLf
strText2 = strText2 & "strKeyPath = " & chr(34) & objRecordSet.Fields.Item("RegKey") & chr(34) & VbCrLf
strText = strText & "objReg.CreateKey " & strLocation & ", strKeyPath" & VbCrLf
strText = strText & "ValueName = " & chr(34) & objRecordSet.Fields.Item("RegValue") & chr(34) & VbCrLf
strText2 = strText2 & "ValueName = " & chr(34) & objRecordSet.Fields.Item("RegValue") & chr(34) & VbCrLf
End If
strValueType = objRecordSet.Fields.Item("DataType")
If strValueType = "REG_DWORD" Then
strText = strText & "dwValue = " & objRecordSet.Fields.Item("DefaultValue") & VbCrLf
strText = strText & "objReg.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, ValueName, dwValue" & VbCrLf
strText2 = strText2 & "objReg.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, ValueName, dwValue" & VbCrLf
strEcho = " W
Else
strText = strText & "strValue = " & chr(34) & objRecordSet.Fields.Item("DefaultValue") & chr(34) & VbCrLf
strText = strText & "objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue" & VbCrLf
strText2 = strText2 & " objReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue" & VbCrLf
strEcho = " W
End If
strText2 = strText2 & "If IsNull(strValue) Then" & VbCrLf
strText2 = strtext2 & " W
strText2 = strText2 & "Else" & vbCrLf
strText2 = strText2 & strEcho
strText2 = strtext2 & "End If"
objRecordSet.MoveNext
Loop
HelpArea.InnerHTML = strHTML
RetrievalArea.Value = strText2
run_button.disabled = False
run_button2.disabled = False
save_button.disabled = False
save_button2.disabled = False
change_button.disabled = False
Master_button.disabled = False
Master_button2.disabled = False
End Sub
Sub RunConfiguration
Set objFS = CreateObject("
strTmpName = "temp_
Set ob
ob
ob
Set objShell = CreateObject("W
strCmdLine = "w
objShell.Run strCmdLine
strAction = "Configured value for " & TaskList.Value
ActionArea.InnerHTML = strAction
End Sub
Sub RunRetrieval
Set objFS = CreateObject("
strTmpName = "temp_
Set ob
ob
ob
Set objShell = CreateObject("W
strCmdLine = "w
objShell.Run strCmdLine
strAction = "Retrieved value for " & TaskList.Value
ActionArea.InnerHTML = strAction
End Sub
Sub SaveConfiguration
Set objFSO = CreateObject("
strSaveFileName = InputBox("Please enter the complete path where you want to save your
If strSaveFileName = "" Then
Exit Sub
End If
Set objFile = objFSO.CreateTextFile(strSaveFileName)
objFile.WriteLine
objFile.Close
strAction = "Saved " & TaskList.Value & " to " & strSaveFileName
ActionArea.InnerHTML = strAction
End Sub
Sub SaveRetrieval
Set objFSO = CreateObject("
strSaveFileName = InputBox("Please enter the complete path where you want to save your
If strSaveFileName = "" Then
Exit Sub
End If
Set objFile = objFSO.CreateTextFile(strSaveFileName)
objFile.WriteLine RetrievalArea.Value
objFile.Close
strAction = "Saved " & TaskList.Value & " to " & strSaveFileName
ActionArea.InnerHTML = strAction
End Sub
Sub ChangeValue()
strCurrent =
NewValue = InputBox("Please enter the new value: ")
If NewValue = "" Then
Exit Sub
End If
If Left(
If Not IsNumeric(NewValue) Then
Msgbox "You must enter a number when configuring DWORD registry values."
Exit Sub
End If
Else
End If
strReplace = Join(
strAction = "Changed value for " & TaskList.Value & " to " & NewValue
ActionArea.InnerHTML = strAction
End Sub
Sub ChangeMasterFile()
If MasterFile = "" Then
strCurrentFile = "Currently you do not have an master
Else
strCurrentFile = "Your current master
End If
strMessage = strCurrentFile & "Please enter the path to the new master
NewValue = InputBox(strMessage)
If NewValue = "" Then
Exit Sub
End If
Set objFSO = CreateObject("
If objFSO.FileExists(NewValue) Then
MasterFile = NewValue
show_button.disabled = False
Else
CreateFile = Msgbox("This file does not exist. Would you like to create it",4)
If CreateFile = vbYes Then
objFSO.CreateTextFile(NewValue)
MasterFile = NewValue
show_button.disabled = False
End If
End If
strAction = "Changed name of master
ActionArea.InnerHTML = strAction
End Sub
Sub ChangeRetrievalFile()
If RetrievalFile = "" Then
strCurrentFile = "Currently you do not have a retrieval master
Else
strCurrentFile = "You current retrieval master
End If
strMessage = strCurrentFile & "Please enter the path to the new retrieval master
NewValue = InputBox(strMessage)
If NewValue = "" Then
Exit Sub
End If
Set objFSO = CreateObject("
If objFSO.FileExists(NewValue) Then
RetrievalFile = NewValue
show_button2.disabled = False
Else
CreateFile = Msgbox("This file does not exist. Would you like to create it",4)
If CreateFile = vbYes Then
objFSO.CreateTextFile(NewValue)
RetrievalFile = NewValue
show_button2.disabled = False
End If
End If
strAction = "Changed name of retrieval master
ActionArea.InnerHTML = strAction
End Sub
Sub SetComputerName()
strMessage = "Curently your
NewValue = InputBox(strMessage)
If NewValue = "" Then
Exit Sub
End If
DefaultComputer = NewValue
strAction = "Changed default computer name to " & NewValue
ActionArea.InnerHTML = strAction
End Sub
Sub MasterConfiguration
Set objFSO = CreateObject("
If MasterFile = "" Then
strCurrentFile = "Currently you do not have a master
strMessage = strCurrentFile & "Please enter the path to the new master
NewValue = InputBox(strMessage)
If NewValue = "" Then
Exit Sub
End If
If objFSO.FileExists(NewValue) Then
MasterFile = NewValue
show_button.disabled = False
Else
CreateFile = Msgbox("This file does not exist. Would you like to create it",4)
If CreateFile = vbYes Then
objFSO.CreateTextFile(NewValue)
MasterFile = NewValue
show_button.disabled = False
Else
Exit Sub
End If
End If
End If
Set objFile = objFSO.OpenTextFile(MasterFile, 8)
objFile.WriteLine Chr(39) & " " & TaskList.Value
objFile.WriteLine
objFile.WriteLine vbCrLf & vbCrLf
objFile.Close
strAction = "Appended " & TaskList.Value & " to " & MasterFile
ActionArea.InnerHTML = strAction
End Sub
Sub MasterRetrieval
Set objFSO = CreateObject("
If RetrievalFile = "" Then
strCurrentFile = "Currently you do not have a retrieval master
strMessage = strCurrentFile & "Please enter the path to the new master
NewValue = InputBox(strMessage)
If NewValue = "" Then
Exit Sub
End If
If objFSO.FileExists(NewValue) Then
RetrievalFile = NewValue
show_button2.disabled = False
Else
CreateFile = Msgbox("This file does not exist. Would you like to create it",4)
If CreateFile = vbYes Then
objFSO.CreateTextFile(NewValue)
RetrievalFile = NewValue
show_button2.disabled = False
Else
Exit Sub
End If
End If
End If
Set objFile = objFSO.OpenTextFile(RetrievalFile, 8)
objFile.WriteLine Chr(39) & " " & TaskList.Value
objFile.WriteLine RetrievalArea.Value
objFile.WriteLine vbCrLf & vbCrLf
objFile.Close
strAction = "Appended " & TaskList.Value & " to " & RetrievalFile
ActionArea.InnerHTML = strAction
End Sub
Sub ShowConfiguration
Set objShell = CreateObject("W
strCmdLine = "notepad.exe " & MasterFile
objShell.Run strCmdLine
strAction = "Opened file " & MasterFile & " in Notepad"
ActionArea.InnerHTML = strAction
End Sub
Sub ShowRetrieval
Set objShell = CreateObject("W
strCmdLine = "notepad.exe " & RetrievalFile
objShell.Run strCmdLine
strAction = "Opened file " & RetrievalFile & " in Notepad"
ActionArea.InnerHTML = strAction
End Sub
</
<body>
<BR>
<table border="0" cellspacing="1" width="100%" id="AutoNumber1">
<tr>
<td width = "50%"><b> Select a manageable component from this list</b>
</td>
<td width = "50%"><b> Select a task category from this list</b>
</td>
</tr>
<tr>
<td width="50%">
<span id="ComponentArea"></span>
</td>
<td width="50%"><span id="CategoryArea"><select size="1" name="D1"></select></span></td>
</tr>
</table>
<BR>
<table border="0" cellspacing="1" width="100%" id="AutoNumber2">
<tr>
<td width = "50%"><b> Select an individual task from this list</b>
</td>
<td width = "50%"><b>Task de
</td>
</tr>
<tr>
<td width="50%"><span id="TaskArea"><select size="15" name="D2"></span></td>
<td width="50%" valign="top"><font color="navy"><span id="HelpArea"></span></font></td>
</tr>
</table>
<BR>
<table border="0" cellspacing="1" width="100%" id="AutoNumber3">
<tr>
<td width = "50%"><b>
</td>
<td width = "50%"><b>
</td>
</tr>
<tr>
<td width="50%">
<textarea rows="12" name="
<td width="50%">
<textarea rows="12" name="RetrievalArea" cols="90"></textarea></td>
</tr>
</table>
<BR>
<table border="0" cellspacing="1" width="100%" id="AutoNumber2">
<tr>
<td width="50%"><input id=runbutton class="button" type="button" value="Run
<td width="50%"><input id=runbutton class="button" type="button" value="Run
</tr>
</table>
<BR>
<table border="0" cellspacing="1" width="100%" id="AutoNumber2">
<tr>
<td width="100%"> <br><b>Tweakomatic Options</b> <input id=runbutton class="button" type="button" value="Set Computer Name" name="computer_name" onClick="SetComputerName()"><input id=runbutton class="button" type="button" value="Set Configuration Master
</tr>
<tr>
<td width="100%"> <br><b>Last Action: </b><span id="ActionArea"></span></td>
</tr>
</table>
</body>
</html>
下载此文件
查看更多关于【hta】的文章