home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / free_security / msshared / Shared_Computer_Toolkit_ENU.msi / FileInclude013 < prev    next >
Encoding:
Text (UTF-16)  |  2005-09-02  |  32.3 KB  |  474 lines
  1. ' *** 
  2. ' *** ------------------------------------------------------------------------------
  3. ' *** Filename:        libHTA.vbs
  4. ' *** ------------------------------------------------------------------------------
  5. ' *** Description:    The Shared Computer Toolkit for Windows XP Common HTA Framework 
  6. ' *** ------------------------------------------------------------------------------
  7. ' *** Version:        1.0
  8. ' *** Notes:        
  9. ' *** ------------------------------------------------------------------------------
  10. ' *** Copyright (C) Microsoft Corporation 2005, All Rights Reserved
  11. ' *** ------------------------------------------------------------------------------
  12. ' *** 
  13.  
  14. ' ~~~ 
  15. ' ~~~ Force variables to be declared 
  16. ' ~~~ 
  17. Option Explicit
  18.  
  19. ' ~~~ 
  20. ' ~~~ Declare global variables and constants
  21. ' ~~~ 
  22. Dim sTitle, bDomainMember, bProcessing 
  23. bProcessing = True
  24.  
  25. ' *** 
  26. ' *** ------------------------------------------------------------------------------
  27. ' *** Name:            Main()
  28. ' *** ------------------------------------------------------------------------------
  29. ' *** Purpose:        Initialize the framework
  30. ' *** ------------------------------------------------------------------------------
  31. ' *** 
  32. Sub Main()
  33.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  34.     Dim bOK
  35.     bOK = True
  36.  
  37.     ' ~~~ Call the InitialiseAllObjects method
  38.     InitialiseAllObjects()
  39.  
  40.     ' ~~~ Sets DEBUG using registry value from this point on
  41.     DEBUG = RegRead(TOOLKITKEY & "SCTDebug")
  42.  
  43.     If DEBUG = "1" Then
  44.         DEBUG = True
  45.     Else
  46.         DEBUG = False
  47.     End If
  48.  
  49.     IsAppRunningTwice()
  50.  
  51.     ' ~~~ Resize the tool first, if the tool should be
  52.     Call ResizeMe()
  53.  
  54.     ' ~~~ Disable the body on load
  55.     Call BodyDisable(True)
  56.             
  57.     ' ~~~ Set up the screen, load controls and pages
  58.     Call Setup()
  59.  
  60.     ' ~~~ Prereq checks
  61.     If document.all("resAdminOnly").innerHTML = "YES" Then
  62.         bOK = IsAdministrator(True)
  63.     End If
  64.  
  65.     If bOK and document.all("resWGAOnly").innerHTML = "YES" Then
  66.         If CheckWGA(True) = False Then bOK = False
  67.     End If
  68.  
  69.     If InSafeMode(True) Then bOK = False
  70.  
  71.     ' ~~~ If ok continue
  72.     If bOK Then
  73.  
  74.         ' ~~~ Call the tool initalization function
  75.         Call Init()
  76.  
  77.         ' ~~~ Call the domain warning method 
  78.         Call ShowDomainWarning()
  79.         
  80.         ' ~~~ Call the tool load function
  81.         Call Load()
  82.         bProcessing = False
  83.     Else
  84.         bProcessing = False
  85.         Call BodyDisable(False)
  86.         Self.Close()
  87.     End If
  88. End Sub
  89.  
  90.  
  91. ' ~~~ ------------------------------------------------------------------------------
  92. ' ~~~ Check for .HTA running
  93. ' ~~~ ------------------------------------------------------------------------------
  94.  
  95. ' *** 
  96. ' *** ------------------------------------------------------------------------------
  97. ' *** Name:            IsAppRunningTwice()
  98. ' *** ------------------------------------------------------------------------------
  99. ' *** Purpose:        Check to see if .HTA is running more than once.
  100. ' *** ------------------------------------------------------------------------------
  101. ' *** 
  102. Sub IsAppRunningTwice()
  103.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  104.     Dim iCount, colProcesses, oProcess, sAppName
  105.  
  106.  
  107.     sAppName = lCase(GetAppName & ".hta")
  108.  
  109.     Set colProcesses = oWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name='MSHTA.EXE'")
  110.  
  111.     iCount = 0
  112.  
  113.     For Each oProcess in colProcesses
  114.         If Left(Right(LCase(oProcess.CommandLine), len(sAppName) + 2), len(sAppName)) = sAppName Then
  115.             iCount = iCount + 1
  116.             If iCount > 1 Then
  117.                 bProcessing = False
  118.                 Window.Close
  119.                 exit sub
  120.             End If
  121.         End If
  122.     Next
  123.  
  124. End Sub
  125.  
  126. ' ~~~ ------------------------------------------------------------------------------
  127. ' ~~~ Screen setup and handling
  128. ' ~~~ ------------------------------------------------------------------------------
  129.  
  130. ' *** 
  131. ' *** ------------------------------------------------------------------------------
  132. ' *** Name:            ResizeMe()
  133. ' *** ------------------------------------------------------------------------------
  134. ' *** Purpose:        Resize the HTA
  135. ' *** ------------------------------------------------------------------------------
  136. ' *** 
  137. Sub ResizeMe()
  138.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  139.  
  140.     If oImagine.Border <> "thick" Then
  141.         Window.resizeTo oDiv.offsetLeft + oDiv.offsetWidth + 15, oFooter.offsetTop + oFooter.offsetHeight + 35
  142.     End If
  143. End Sub
  144.  
  145. ' *** 
  146. ' *** ------------------------------------------------------------------------------
  147. ' *** Name:            Setup()
  148. ' *** ------------------------------------------------------------------------------
  149. ' *** Purpose:        Sets up the hta
  150. ' *** ------------------------------------------------------------------------------
  151. ' *** 
  152. Sub Setup()
  153.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  154.  
  155.     ' set the titles
  156.     document.title = appTitle.innerHTML
  157.     sTitle = appTitle.innerHTML
  158.     title.Title = L_sToolkitTitle_TEXT
  159. End Sub
  160.  
  161. ' *** 
  162. ' *** ------------------------------------------------------------------------------
  163. ' *** Name:            ShowDomainWarning()
  164. ' *** ------------------------------------------------------------------------------
  165. ' *** Purpose:        Checks if the computer is a member of a domain
  166. ' ***                 If it is, the domain warning message is shown and the function
  167. ' ***                 returns false; otherwise the function returns true
  168. ' *** ------------------------------------------------------------------------------
  169. ' *** 
  170. Function ShowDomainWarning()
  171.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  172.  
  173.     Dim bchkDomainWarning
  174.     bDomainMember = DomainMember()     
  175.     bchkDomainWarning = False
  176.     If resDomainWarning.innerHTML = "YES" Then
  177.         If bDomainMember and RegRead(TOOLKITKEY & "ShowDomainWarning") = "1" Then
  178.             ShowDomainWarning = True
  179.             ' ~~~ Call the Domainwarning HTA
  180.             bchkDomainWarning = Window.ShowModalDialog("Domainwarning.hta", "Domainwarning", "dialogWidth:30;dialogHeight:15;Center:Yes;help:No;Resizable:No;Scroll:NO;")
  181.             
  182.             ' ~~~ If tick box checked, set reg to not show again
  183.             If bchkDomainWarning Then
  184.                 Call RegWrite(TOOLKITKEY & "ShowDomainWarning","0", "REG_SZ")
  185.             End If
  186.         End If
  187.     Else
  188.         ShowDomainWarning = False        
  189.     End If
  190. End Function
  191.  
  192. ' *** 
  193. ' *** ------------------------------------------------------------------------------
  194. ' *** Name:            CloseDomainWarning()
  195. ' *** ------------------------------------------------------------------------------
  196. ' *** Purpose:        Called upon click of the domain warning ok button.
  197. ' ***                 Checks if "do not show again" was checked
  198. ' *** ------------------------------------------------------------------------------
  199. ' *** 
  200. Sub CloseDomainWarning()
  201.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  202.  
  203.     ' ~~~ If tick box checked, set reg to not show again
  204.     If document.all("chkDomainWarning").checked Then
  205.         ' ~~~ If checkbox is tick, set the returnvalue to True
  206.         window.returnvalue = True
  207.     End If
  208.     Self.Close()
  209.     
  210. End Sub
  211.  
  212. ' *** 
  213. ' *** ------------------------------------------------------------------------------
  214. ' *** Name:            GetRootFolder
  215. ' *** ------------------------------------------------------------------------------
  216. ' *** Purpose:        Returns the application root folder (location of .HTA files)
  217. ' *** ------------------------------------------------------------------------------
  218. ' *** 
  219. Function GetRootFolder
  220.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  221.     Dim sCmd, iStart, iEnd
  222.  
  223.     ' ~~~ Define command line, start and end
  224.     sCmd   = oImagine.CommandLine
  225.     iStart = 1
  226.     iEnd   = InStrRev(sCmd, "\")
  227.     
  228.     ' ~~~ If first character is a quote, skip it
  229.     If Left(sCmd, 1) = Chr(34) Then iStart = 2
  230.  
  231.     ' ~~~ Return path
  232.     GetRootFolder = Mid(sCmd, iStart, iEnd - iStart)
  233. End Function
  234.  
  235. ' *** 
  236. ' *** ------------------------------------------------------------------------------
  237. ' *** Name:            GetAppname
  238. ' *** ------------------------------------------------------------------------------
  239. ' *** Purpose:        Returns the application filename with the .hta removed
  240. ' *** ------------------------------------------------------------------------------
  241. ' *** 
  242. Function GetAppname
  243.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  244.     Dim sCmd, iSlash, iDot
  245.     sCmd   = oImagine.CommandLine
  246.     iSlash = InStrRev(sCmd, "\")+1
  247.     iDot   = InStrRev(sCmd, ".")
  248.  
  249.     GetAppname = Mid(sCmd, iSlash, iDot-iSlash)
  250. End Function
  251.  
  252. ' *** 
  253. ' *** ------------------------------------------------------------------------------
  254. ' *** Name:        GetRadio()
  255. ' *** ------------------------------------------------------------------------------
  256. ' *** Purpose:    Returns the value of a checked radio button
  257. ' *** ------------------------------------------------------------------------------
  258. ' *** 
  259. Function GetRadio(sRadioGroup)
  260.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  261.     Dim oRadio
  262.     
  263.     For Each oRadio in document.getElementsByName(sRadioGroup)
  264.         If oRadio.Checked Then GetRadio=oRadio.Value
  265.     Next
  266. End Function
  267.  
  268. ' *** 
  269. ' *** ------------------------------------------------------------------------------
  270. ' *** Name:            ShowHelp()
  271. ' *** ------------------------------------------------------------------------------
  272. ' *** Purpose:        Display the online help file
  273. ' *** ------------------------------------------------------------------------------
  274. ' *** 
  275. Sub ShowHelp()
  276.     Dim sHelpFile, sHelpTopic
  277.  
  278.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  279.     
  280.     ' set default help file
  281.     sHelpFile = "sectools.chm"
  282.     
  283.     ' determine which help file to run
  284.     Select Case GetAppname()
  285.         Case "Accessibility"
  286.             sHelpFile = "accessibility.chm"
  287.             sHelpTopic = "3-1-1-AccessibilityOptions.htm"
  288.         Case "DiskProtect"
  289.             sHelpTopic = "3-4-0-WDP.htm"
  290.         Case "GetStarted"
  291.             sHelpTopic = "3-2-0-GettingStarted.htm"
  292.         Case "ProfileMgr"
  293.             sHelpTopic = "3-3-0-ProfileManager.htm"
  294.         Case "Restrict"
  295.             sHelpTopic = "3-5-0-UserRestrictions.htm"
  296.         Case Else
  297.             sHelpTopic = ""
  298.     End Select        
  299.     
  300.     ' open the help file
  301.     Call oShell.Run("hh.exe """ & GetRootFolder & "\" & sHelpFile & "::/" & sHelpTopic & """", 1, True)
  302. End Sub
  303.  
  304. ' *** 
  305. ' *** ------------------------------------------------------------------------------
  306. ' *** Name:            Rollover(sId, sImg)
  307. ' *** ------------------------------------------------------------------------------
  308. ' *** Purpose:        Hover buttons
  309. ' *** ------------------------------------------------------------------------------
  310. ' *** 
  311. Sub Rollover(sId,sImg)
  312.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  313.     document.all(sId).src = "graphics/" & sImg
  314. End Sub
  315.  
  316. ' *** 
  317. ' *** ------------------------------------------------------------------------------
  318. ' *** Name:            Submit()
  319. ' *** ------------------------------------------------------------------------------
  320. ' *** Purpose:        Process submit button
  321. ' *** ------------------------------------------------------------------------------
  322. ' *** 
  323. Sub Submit()
  324.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  325.  
  326.     If Validate() Then
  327.         Call Action()
  328.         Self.Close
  329.     End If
  330. End Sub
  331.  
  332. ' *** 
  333. ' *** ------------------------------------------------------------------------------
  334. ' *** Name:            onkeydown()
  335. ' *** ------------------------------------------------------------------------------
  336. ' *** Purpose:        This subroutine is executed on the click Help F1
  337. ' *** ------------------------------------------------------------------------------
  338. ' *** 
  339. Sub onkeydown()
  340.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  341.     ' ~~~ Handle all the common keys
  342.     select case (window.event.keycode)
  343.         case 112 ' ~~~ F1 is clicked
  344.             Call ShowHelp()
  345.         case 116 ' ~~~ F5 is clicked
  346.             window.event.returnvalue = False
  347.     End select
  348.  
  349.     ' ~~~ Handle Tool specific keys
  350.     HTAKeyDown()
  351. End sub
  352.  
  353. ' *** 
  354. ' *** ------------------------------------------------------------------------------
  355. ' *** Name:            Highlight(objBtn,bOn)
  356. ' *** ------------------------------------------------------------------------------
  357. ' *** Purpose:        This sub is executed to highlight the common buttons 
  358. ' ***                in all HTA
  359. ' *** ------------------------------------------------------------------------------
  360. ' *** 
  361. Sub Highlight(objBtn, bOn)
  362.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  363.  
  364.     If bOn Then
  365.         objBtn.filters.Light.Enabled = true
  366.         objBtn.filters.Light.Clear
  367.         objBtn.filters.Light.AddAmbient 255,255,255,90
  368.         objBtn.filters.Light.AddAmbient 255,255,255,25
  369.  
  370.     Else
  371.         objBtn.filters.Light.Clear
  372.         objBtn.filters.Light.Enabled = false
  373.     End If
  374. End Sub
  375.  
  376. ' *** 
  377. ' *** ------------------------------------------------------------------------------
  378. ' *** Name:            BodyDisable(bDisable)
  379. ' *** ------------------------------------------------------------------------------
  380. ' *** Purpose:        This sub is executed to disable the body during load and
  381. ' ***                change the cursor to wait icon in all HTA.
  382. ' *** ------------------------------------------------------------------------------
  383. ' *** 
  384. Sub BodyDisable(bDisable)
  385.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  386.     Dim oControls, oControl
  387.  
  388.     ' ~~~ Derickc - We must not set bProcessing here. There are cases we want the UI 
  389.     ' ~~~ to be enabled yet processing is underway. (Getting Started, for example.)
  390.     ' ~~~ bProcessing should be set with each action.
  391.  
  392.     ' ~~~ Derickc - I removed this line: bProcessing = bDisable 
  393.     
  394.     If bDisable = True Then
  395.         oBody.Style.cursor = "wait"
  396.     Else 
  397.         oBody.Style.cursor = "auto"
  398.     End If
  399.     set oControls = oBody.all
  400.     For each oControl in oControls
  401.         oControl.disabled = bDisable
  402.     Next
  403.  
  404.     ' ~~~ This allows UI to immediately update by yielding to IE... oShell created by design - DO NOT REMOVE
  405.         dim oShell
  406.         set oShell = createobject("wscript.shell")
  407.         call oShell.run(chr(34) & oShell.ExpandEnvironmentStrings("%SCTPath%") &"bin\AccessibilityTool.exe" & chr(34),0, True)
  408. End Sub
  409.  
  410. ' *** 
  411. ' *** ------------------------------------------------------------------------------
  412. ' *** Name:            Unload()
  413. ' *** ------------------------------------------------------------------------------
  414. ' *** Purpose:        This sub is executed while closing the hta 
  415. ' *** ------------------------------------------------------------------------------
  416. ' *** 
  417. Sub Unload()
  418.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  419.     UnLoadObjects()
  420.     HTAUnLoad()
  421. End Sub
  422.  
  423. ' *** 
  424. ' *** ------------------------------------------------------------------------------
  425. ' *** Name:            OnBeforeUnload()
  426. ' *** ------------------------------------------------------------------------------
  427. ' *** Purpose:        This sub is executed before closing the hta 
  428. ' ***                 Checks whether any processing is going on while closing
  429. ' ***                 the HTA
  430. ' *** ------------------------------------------------------------------------------
  431. ' *** 
  432. Function OnBeforeUnload()
  433.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  434.     
  435.     ' ~~~ Exit this function if HTA is not processing while closing
  436.     If Not bProcessing Then Exit Function
  437.  
  438.     ' ~~~ Prompt the user whether to leave the HTA open or close the HTA
  439.     If Window.confirm(L_sBeforeUnloadWarning_TEXT) = False Then
  440.         ' ~~~ If processing should continue, then indicate Unload is cancelled and send the next dialog two ESC keys
  441.         window.event.returnvalue = False
  442.         oShell.SendKeys("{esc}{esc}")
  443.     Else
  444.         ' ~~~ If processing should not continue, close, wait for five seconds and then Terminate this HTA
  445.         Window.SetTimeout "TerminateHTA", 5000, "VBScript"
  446.         Exit Function
  447.     End If
  448. End Function
  449.  
  450. ' *** 
  451. ' *** ------------------------------------------------------------------------------
  452. ' *** Name:            TerminateHTA()
  453. ' *** ------------------------------------------------------------------------------
  454. ' *** Purpose:        This sub is to terminate the mshta process that is 
  455. ' ***                still running after closing the HTA
  456. ' *** ------------------------------------------------------------------------------
  457. ' *** 
  458. Sub TerminateHTA()
  459.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  460.     
  461.     Dim colProcesses, oProcess, sCommandline
  462.     ' ~~~ Look for the running HTA process with the same command-line as this one and terminate it
  463.     Set colProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process WHERE Name = 'mshta.exe'")
  464.  
  465.     If colProcesses.Count > 0 Then
  466.         For Each oProcess in colProcesses
  467.         sCommandline = Right(oProcess.commandLine, Len(oImagine.commandLine))
  468.         If sCommandline = oImagine.commandline Then
  469.             oProcess.Terminate
  470.             Exit For
  471.         End If
  472.         Next
  473.     End If
  474. End Sub