首页 > 编程 > HTA > 正文

tweakomatic hta 下载

2020-01-31 15:43:23
字体:
来源:转载
供稿:网友
复制代码 代码如下:

<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>



<SCRIPT LANGUAGE="VBScript">

    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 scripts will automatically be created: one for configuring information, the other for retrieving information."
    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 scripts will automatically be created: one for configuring information, the other for retrieving information."
    Help3 = "Click a task and two scripts will automatically be created: one for configuring information, the other for retrieving information."


Sub Window_Onload
    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' onChange=""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_OnUnload
   On Error Resume Next
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   objFSO.DeleteFile "temp_script.sm"
   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' onChange=""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
    ScriptArea.Value = ""
    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' onChange=""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
    ScriptArea.Value = ""
    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 = "    Wscript.Echo " & chr(34) & FilterValue & ": " & chr(34) & ", dwValue" & vbCrLf

        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 = "    Wscript.Echo " & chr(34) & FilterValue & ": " & chr(34) & ", strValue" & vbCrLf

        End If



        strText2 = strText2 & "If IsNull(strValue) Then" & VbCrLf
        strText2 = strtext2 & "    Wscript.Echo " & chr(34) &  FilterValue & ":  The value is either Null or could not be found in the registry." & chr(34) & VbCrLf
        strText2 = strText2 & "Else"  & vbCrLf    
        strText2 = strText2 & strEcho

        strText2 = strtext2 & "End If" 

        objRecordSet.MoveNext
    Loop
    HelpArea.InnerHTML = strHTML
    ScriptArea.Value = strText
    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 RunConfigurationScript()
   Set objFS = CreateObject("Scripting.FileSystemObject")
   strTmpName = "temp_script.sm"
   Set objScript = objFS.CreateTextFile(strTmpName)
   objScript.Write ScriptArea.Value
   objScript.Close
   Set objShell = CreateObject("WScript.Shell")
   strCmdLine = "wscript.exe //E:VBScript " & strTmpName
   objShell.Run strCmdLine
   strAction = "Configured value for " & TaskList.Value 
   ActionArea.InnerHTML = strAction
End Sub


Sub RunRetrievalScript()
   Set objFS = CreateObject("Scripting.FileSystemObject")
   strTmpName = "temp_script.sm"
   Set objScript = objFS.CreateTextFile(strTmpName)
   objScript.Write RetrievalArea.Value
   objScript.Close
   Set objShell = CreateObject("WScript.Shell")
   strCmdLine = "wscript.exe //E:VBScript " & strTmpName
   objShell.Run strCmdLine
   strAction = "Retrieved value for " & TaskList.Value 
   ActionArea.InnerHTML = strAction
End Sub


Sub SaveConfigurationScript()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   strSaveFileName = InputBox("Please enter the complete path where you want to save your script (for example, C:/Scripts/MyScript.vbs).")
   If strSaveFileName = "" Then
      Exit Sub
   End If

   Set objFile = objFSO.CreateTextFile(strSaveFileName)
   objFile.WriteLine ScriptArea.Value
   objFile.Close
   strAction = "Saved " & TaskList.Value & " to " & strSaveFileName
   ActionArea.InnerHTML = strAction
End Sub


Sub SaveRetrievalScript()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   strSaveFileName = InputBox("Please enter the complete path where you want to save your script (for example, C:/Scripts/MyScript.vbs).")
   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 = ScriptArea.Value
    NewValue = InputBox("Please enter the new value: ")
    If NewValue = "" Then
        Exit Sub
    End If
    ScriptType = Split(strCurrent, vbCrLf, -1)
    If Left(ScriptType(6),2) = "dw" Then
        If Not IsNumeric(NewValue) Then
            Msgbox "You must enter a number when configuring DWORD registry values."
            Exit Sub
        End If
        ScriptType(6) = "dwValue = " & NewValue
    Else
        ScriptType(6) = "strValue = " & chr(34) & NewValue & chr(34)
    End If
    strReplace = Join(ScriptType, vbcrlf)
    ScriptArea.Value = strReplace
    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 script. "
    Else
        strCurrentFile = "Your current master script is " & MasterFile & ". "
    End If
    strMessage = strCurrentFile & "Please enter the path to the new master script: "
    NewValue = InputBox(strMessage)
    If NewValue = "" Then
        Exit Sub
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    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 script to " & NewValue
    ActionArea.InnerHTML = strAction
End Sub


Sub ChangeRetrievalFile()
    If RetrievalFile = "" Then
        strCurrentFile = "Currently you do not have a retrieval master script. "
    Else
        strCurrentFile = "You current retrieval master script is " & RetrievalFile & ". "
    End If
    strMessage = strCurrentFile & "Please enter the path to the new retrieval master script: "
    NewValue = InputBox(strMessage)
    If NewValue = "" Then
        Exit Sub
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    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 script to " & NewValue
    ActionArea.InnerHTML = strAction
End Sub



Sub SetComputerName()
    strMessage = "Curently your scripts are using " & DefaultComputer & " as the default computer name. Please enter the new computer name. To run the script against the local computer, simply type a period (.) for the computer name: "
    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 MasterConfigurationScript()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If MasterFile = "" Then
        strCurrentFile = "Currently you do not have a master script. "
        strMessage = strCurrentFile & "Please enter the path to the new master script: "
        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 ScriptArea.Value
    objFile.WriteLine vbCrLf & vbCrLf
    objFile.Close
    strAction = "Appended " & TaskList.Value & " to " & MasterFile
    ActionArea.InnerHTML = strAction
End Sub


Sub MasterRetrievalScript()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If RetrievalFile = "" Then
        strCurrentFile = "Currently you do not have a retrieval master script. "
        strMessage = strCurrentFile & "Please enter the path to the new master script: "
        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 ShowConfigurationScript()
   Set objShell = CreateObject("WScript.Shell")
   strCmdLine = "notepad.exe " & MasterFile
   objShell.Run strCmdLine
   strAction = "Opened file " & MasterFile & " in Notepad"
   ActionArea.InnerHTML = strAction
End Sub



Sub ShowRetrievalScript()
   Set objShell = CreateObject("WScript.Shell")
   strCmdLine = "notepad.exe " & RetrievalFile
   objShell.Run strCmdLine
   strAction = "Opened file " & RetrievalFile & " in Notepad"
   ActionArea.InnerHTML = strAction
End Sub


</SCRIPT>



<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 description</b>
    </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>  Script for carrying out this task</b>
    </td>
    <td width = "50%"><b>  Script for retrieving the current task setting</b>
    </td>
  </tr>
  <tr>
    <td width="50%">
  <textarea rows="12" name="ScriptArea" cols="90"></textarea></td>

    <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 Script" name="run_button"  onClick="RunConfigurationScript()"><input id=runbutton  class="button" type="button" value="Save Script"  name="save_button"  onClick="SaveConfigurationScript()"><input id=runbutton  class="button" type="button" value="Change Value"  name="change_button"  onClick="ChangeValue()"><input id=runbutton  class="button" type="button" value="Master Script" name="Master_button"  onClick="MasterConfigurationScript()"><input id=runbutton  class="button" type="button" value="ShowScript" name="show_button"  onClick="ShowConfigurationScript()"></td>

    <td width="50%"><input id=runbutton  class="button" type="button" value="Run Script"  name="run_button2"  onClick="RunRetrievalScript()"><input id=runbutton  class="button" type="button" value="Save Script"  name="save_button2"  onClick="SaveRetrievalScript()"><input id=runbutton  class="button" type="button" value="Master Script" name="Master_button2" onClick="MasterRetrievalScript()"><input id=runbutton  class="button" type="button" value="ShowScript" name="show_button2"  onClick="ShowRetrievalScript()"></td>
  </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 Script" name="set_Master_file"  onClick="ChangeMasterFile()"><input id=runbutton  class="button" type="button" value="Set Retrieval Master Script" name="set_retrieval_button"  onClick="ChangeRetrievalFile()"></td>
  </tr>
  <tr>
    <td width="100%"> <br><b>Last Action: </b><span id="ActionArea"></span></td>
  </tr>

</table>

</body>

</html>

下载文件 下载此文件
发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表