home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / free_security / msshared / Shared_Computer_Toolkit_ENU.msi / FileInclude003 < prev    next >
Encoding:
Text (UTF-16)  |  2005-09-02  |  30.6 KB  |  428 lines
  1. ' ***
  2. ' *** ------------------------------------------------------------------------------
  3. ' *** Filename:        clsAccessibility.vbs
  4. ' *** ------------------------------------------------------------------------------
  5. ' *** Description:    Accessibility Class
  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 and turn off script error messages unless in DEBUG mode
  16. ' ~~~ 
  17. Option Explicit
  18. If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  19.  
  20. Class accessibility
  21.  
  22. ' ~~~
  23. ' ~~~ declare global variables and constants
  24. ' ~~~ 
  25. Dim bLogging, strAccessibility, HKEY
  26.  
  27. ' ***
  28. ' *** ------------------------------------------------------------------------------
  29. ' *** Property:    Logging
  30. ' *** ------------------------------------------------------------------------------
  31. ' *** Purpose:    Turns on logging, property must be set to a logging object
  32. ' *** ------------------------------------------------------------------------------
  33. ' ***
  34.     Public Property Get Logging
  35.         Logging = bLogging
  36.     End Property    
  37.  
  38.     Public Property Let Logging(oObject)
  39.         If VarType(oObject) = vbObject Then
  40.             bLogging = True
  41.             Set oLog = oObject
  42.         End If
  43.     End Property
  44.     
  45.     
  46. ' ~~~
  47. ' ~~~ public methods
  48. ' ~~~ 
  49.  
  50. ' ***
  51. ' *** ------------------------------------------------------------------------------
  52. ' *** Name:        CloseApplication()
  53. ' *** ------------------------------------------------------------------------------
  54. ' *** Purpose:    Close the Application corresponding to the unselect of the option
  55. ' *** ------------------------------------------------------------------------------
  56. ' ***
  57. Public Function CloseApplication()
  58.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  59.     
  60.     Dim MagnifyProcID, colProcesses, oProcess
  61.     MagnifyProcID = ""
  62.     Set colProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process WHERE Name = 'magnify.exe'")
  63.     
  64.     If colProcesses.Count > 0 Then
  65.         For Each oProcess in colProcesses
  66.         MagnifyProcID = oProcess.ProcessId  
  67.         Next
  68.     End If
  69.     
  70.     If MagnifyProcID <> "" Then
  71.         oShell.AppActivate MagnifyProcID
  72.         oShell.SendKeys ("%{F4}")
  73.     End If
  74.  
  75. End Function
  76.  
  77. ' ***
  78. ' *** ------------------------------------------------------------------------------
  79. ' *** Name:        End_Process(Process_Name)
  80. ' *** ------------------------------------------------------------------------------
  81. ' *** Purpose:    Terminate the Process corresponding to the unselect of the option
  82. ' *** ------------------------------------------------------------------------------
  83. ' ***
  84. Public Function End_Process(Process_Name)
  85.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  86.     
  87.     Dim colProcesses, oProcess  
  88.     Set colProcesses = oWMIService.ExecQuery _
  89.             ("Select * from Win32_Process Where Name = '" & Process_Name & "'")
  90.     For Each oProcess in colProcesses
  91.         oProcess.Terminate
  92.     Next
  93. End Function
  94.  
  95. ' ***
  96. ' *** ------------------------------------------------------------------------------
  97. ' *** Name:        Start_Process(objID)
  98. ' *** ------------------------------------------------------------------------------
  99. ' *** Purpose:    Starts the process corresponding to the option selected
  100. ' *** ------------------------------------------------------------------------------
  101. ' ***
  102. Public Function Start_Process(objID)
  103.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  104.     
  105.     Dim processName 
  106.     processName = Get_ProcessName(objID)
  107.     Select Case objID 
  108.         Case "magnifier"
  109.             Call RegWrite(HKEY & "Magnify\ShowWarning",0,"REG_DWORD")
  110.             Call RegWrite(HKEY & "Magnify\StationaryStartMinimized",1,"REG_DWORD")
  111.         Case "narrator"
  112.             Call RegWrite(HKEY & "Narrator\ShowWarning",0,"REG_DWORD")
  113.             Call RegWrite(HKEY & "Narrator\StartType",1,"REG_DWORD")
  114.         Case "oskeyboard"
  115.             HideOSKeyWarning()
  116.     End Select
  117.     oShell.Run processName, 0, False
  118.  
  119. End Function
  120.  
  121. ' ***
  122. ' *** ------------------------------------------------------------------------------
  123. ' *** Name:        Get_ProcessName(proID)
  124. ' *** ------------------------------------------------------------------------------
  125. ' *** Purpose:    Gets the name of the process for the option that is selected
  126. ' *** ------------------------------------------------------------------------------
  127. ' ***
  128. Public Function Get_ProcessName(proID)
  129.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  130.     
  131.     If proID = "magnifier" Then
  132.         Get_ProcessName = "Magnify.exe"
  133.     ElseIf proID = "narrator" Then
  134.         Get_ProcessName = "Narrator.exe"
  135.     ElseIf proID = "oskeyboard" Then
  136.         Get_ProcessName = "OSK.exe"
  137.     Else
  138.         Get_ProcessName = ""
  139.     End If
  140.     
  141. End Function
  142.  
  143. ' ***
  144. ' *** ------------------------------------------------------------------------------
  145. ' *** Name:        Get_ProcessStatus(proId)
  146. ' *** ------------------------------------------------------------------------------
  147. ' *** Purpose:    Gets the status of the exe's that are 
  148. ' ***        currently running for the option that is selected
  149. ' *** ------------------------------------------------------------------------------
  150. ' ***
  151. Public Function Get_ProcessStatus(proId)
  152.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  153.     
  154.     Dim sProcessName, colProcesses, oProcess  
  155.     Get_ProcessStatus = False
  156.     sProcessName = Get_ProcessName(proId)
  157.     Set colProcesses = oWMIService.ExecQuery _
  158.             ("Select * from Win32_Process Where Name = '" & sProcessName & "'")
  159.     For Each oProcess in colProcesses
  160.         Get_ProcessStatus = True
  161.     Next
  162. End Function
  163.  
  164. ' ***
  165. ' *** ------------------------------------------------------------------------------
  166. ' *** Name:        GetOption(sOption)
  167. ' *** ------------------------------------------------------------------------------
  168. ' *** Purpose:    Returns 1 if the option is enabled or 0 if it is disabled. 
  169. ' *** ------------------------------------------------------------------------------
  170. ' ***
  171. Public Function GetOption(sOption)
  172.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  173.     
  174. Dim scmd
  175.  
  176. Select Case (sOption)
  177.     Case "contrast"
  178.         scmd = strAccessibility & " " & "GetContrast" 
  179.         GetOption = ShellRun (scmd)
  180.         
  181.     Case "largepointer"
  182.         scmd = strAccessibility & " " & "GetLargeCursor" 
  183.         GetOption = ShellRun (scmd)
  184.         
  185.     Case "soundsentry"
  186.         scmd = strAccessibility & " " & "GetSoundSentry"
  187.         GetOption = ShellRun (scmd)
  188.         
  189.     Case "showsound"
  190.         scmd = strAccessibility & " " & "GetShowSound" 
  191.         GetOption = ShellRun (scmd)
  192.         
  193.     Case "stickykeys"
  194.         scmd = strAccessibility & " " & "GetStickyKeys" 
  195.         GetOption = ShellRun (scmd)
  196.         
  197.     Case "filterkeys"
  198.         scmd = strAccessibility & " " & "GetFilterKeys"
  199.         GetOption = ShellRun (scmd)
  200.         
  201.     Case "mousekeys"
  202.         scmd = strAccessibility & " " & "GetMouseKeys" 
  203.         GetOption = ShellRun (scmd)
  204.         
  205. End Select
  206.  
  207. End Function
  208.  
  209. ' ***
  210. ' *** ------------------------------------------------------------------------------
  211. ' *** Name:        SetOption(sOption, bEnable)
  212. ' *** ------------------------------------------------------------------------------
  213. ' *** Purpose:    Gets the feature name as input and return whether it is 
  214. ' ***        enabled(1) or disabled(0)
  215. ' *** ------------------------------------------------------------------------------
  216. ' ***
  217. Public Function SetOption(sOption, bEnable)
  218.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  219.  
  220. Dim strCmd
  221. Select Case (sOption)
  222.     Case "contrast"
  223.         strCmd = strAccessibility & " " & "SetContrast" & " " &  bEnable
  224.         ShellRun strCmd  
  225.         Exit Function
  226.     Case "largepointer"
  227.         strCmd = strAccessibility & " " & "SetLargeCursor" & " " &  bEnable
  228.         ShellRun strCmd  
  229.         Exit Function
  230.     Case "soundsentry"
  231.         strCmd = strAccessibility & " " & "SetSoundSentry" & " " & bEnable 
  232.         ShellRun strCmd
  233.         Exit Function
  234.     Case "showsound"
  235.         strCmd = strAccessibility & " " & "SetShowSound" & " " &  bEnable
  236.         ShellRun strCmd
  237.         Exit Function
  238.     Case "stickykeys"
  239.         strCmd = strAccessibility & " " & "SetStickyKeys" & " " &  bEnable
  240.         ShellRun strCmd  
  241.         Exit Function
  242.     Case "filterkeys"
  243.         strCmd = strAccessibility & " " & "SetFilterKeys" & " " &  bEnable
  244.         ShellRun strCmd  
  245.         Exit Function
  246.     Case "mousekeys"
  247.         strCmd = strAccessibility & " " & "SetMouseKeys" & " " &  bEnable
  248.         ShellRun strCmd  
  249.         Exit Function
  250. End Select
  251.  
  252. End Function
  253.  
  254. ' ***
  255. ' *** ------------------------------------------------------------------------------
  256. ' *** Name:        Advanced()
  257. ' *** ------------------------------------------------------------------------------
  258. ' *** Purpose:    Called to display the Advanced accessibility options 
  259. ' *** ------------------------------------------------------------------------------
  260. ' ***
  261. Public Function Advanced()
  262.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  263.     
  264.     Dim sysDirectory
  265.     
  266.     ' ~~~ Get the system root directory
  267.     sysDirectory = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%")
  268.     sysDirectory = sysDirectory & "\system32"
  269.     
  270.     ' ~~~ Run the Control Panel Applet using the control.exe
  271.     oShell.run "control.exe " & sysDirectory & "\access.cpl",1,False
  272. End Function 
  273.  
  274. ' ***
  275. ' *** ------------------------------------------------------------------------------
  276. ' *** Name:        GetContrastThemes(bCalledFrom, sContrast)
  277. ' *** ------------------------------------------------------------------------------
  278. ' *** Purpose:    Used by both HTA and Wsf to get the high contrast themes 
  279. ' ***         from registry
  280. ' *** ------------------------------------------------------------------------------
  281. ' ***
  282. Public Function GetContrastThemes(bCalledFrom, sContrast)
  283.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  284.     
  285.     Dim strComputer, oReg, strKeyPath
  286.     Dim arrValueNames, arrValueTypes, iTheme
  287.     
  288.     GetContrastThemes = ""
  289.     
  290.     const HKEY_CURRENT_USER = &H80000001
  291.     strComputer = "."
  292.         
  293.     Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
  294.         strComputer & "\root\default:StdRegProv")
  295.         
  296.     strKeyPath = "Control Panel\Appearance\Schemes"
  297.         
  298.     ' ~~~ Enumerate the high contrast themes stored in the registry hive
  299.     oReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValueNames, arrValueTypes
  300.     
  301.     Select Case bCalledFrom
  302.         Case "HTA"
  303.             ' ~~~ Populate the enumerated themes in the dd list
  304.             For iTheme = 0 To UBound(arrValueNames)
  305.                 Call PopulateContrast( arrValueNames(iTheme) )
  306.             Next
  307.         Case "WSF"
  308.             ' ~~~ Return the actual theme name stored in the registry
  309.             For iTheme = 0 To UBound(arrValueNames)
  310.                 If UCase( arrValueNames(iTheme) ) = UCase( sContrast ) Then
  311.                     GetContrastThemes = arrValueNames(iTheme) 
  312.                     Exit For
  313.                 End If
  314.             Next
  315.     End Select
  316. End Function
  317.  
  318. ' ~~~ 
  319. ' ~~~ private methods
  320. ' ~~~
  321.  
  322. ' ***    
  323. ' *** ------------------------------------------------------------------------------
  324. ' *** Name:        Class_Initialize
  325. ' *** ------------------------------------------------------------------------------
  326. ' *** Purpose:    Used internally by the class when it is created.
  327. ' ***            Declared as private because it must not be called directly.
  328. ' *** ------------------------------------------------------------------------------
  329. ' ***
  330. Private Sub Class_Initialize
  331.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  332.     
  333.     strAccessibility = chr(34) & GetRootFolder & "\bin\AccessibilityTool.exe" & chr(34)
  334.     HKEY = "HKEY_CURRENT_USER\Software\Microsoft\"    
  335. End Sub
  336.  
  337. ' ***
  338. ' *** ------------------------------------------------------------------------------
  339. ' *** Name:        Class_Terminate
  340. ' *** ------------------------------------------------------------------------------
  341. ' *** Purpose:    Used internally by the class when it is destroyed.
  342. ' ***            Declared as private because it must not be called directly.
  343. ' *** ------------------------------------------------------------------------------
  344. ' ***
  345. Private Sub Class_Terminate
  346.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0    
  347. End Sub
  348.  
  349. ' ***
  350. ' *** ------------------------------------------------------------------------------
  351. ' *** Name:        ShellRun(sCmd)
  352. ' *** ------------------------------------------------------------------------------
  353. ' *** Purpose:    Executes the AccessibilityTool.exe in the command line
  354. ' ***        And returns 1 (success) and 0 (failure) 
  355. ' *** ------------------------------------------------------------------------------
  356. ' ***
  357. Private Function ShellRun(sCmd)
  358.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  359.     
  360.     ShellRun = oShell.Run (sCmd,0,True)
  361. End Function
  362.  
  363. ' ***
  364. ' *** ------------------------------------------------------------------------------
  365. ' *** Name:        HideOSKeyWarning()
  366. ' *** ------------------------------------------------------------------------------
  367. ' *** Purpose:    Called to hide the warning window for os key 
  368. ' *** ------------------------------------------------------------------------------
  369. ' ***
  370. Private Function HideOSKeyWarning()
  371.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  372.  
  373.     Dim strKeyPath, strValueName, bRegResult
  374.     Dim strValue(503)
  375.     Dim iKey,iUpper
  376.     const HKEY_CURRENT_USER = &H80000001
  377.  
  378.     strKeyPath = "Software\Microsoft\Osk"
  379.     strValueName = "Setting"
  380.  
  381.     bRegResult = oWmiReg.GetBinaryValue (HKEY_CURRENT_USER,strKeyPath,_
  382.             strValueName,strValue)
  383.     
  384.     If bRegResult = 0 Then
  385.         ' ~~~ If registry exists, change the last four values to hidewarning
  386.         ReDim preserve strValue(uBound(strValue))
  387.         iUpper = uBound(strValue)
  388.         For iKey = iUpper-4 to iUpper
  389.             strValue(iKey) = 0
  390.         Next
  391.  
  392.         RegWrite "HKEY_CURRENT_USER" & "\" & strKeyPath & "\" & strValueName,strValue, "REG_BINARY"
  393.         
  394.     Else
  395.         
  396.         ' ~~~ Registry for OSK does not exists
  397.         ' ~~~ Set the Binary value for the "Setting" reg value
  398.         strValue = Array(4,0,0,0,0,0,0,0,0,0,0,0,192,192,192,0,255,128,192,0,0,255,64,0,128,128,255,0,2,0,0,0,_
  399.                  1,0,0,0,101,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,232,3,0,0,245,255,255,255,0,0,0,0,_
  400.                  0,0,0,0,0,0,0,0,188,2,0,0,0,0,0,0,3,2,1,34,77,83,32,83,104,101,108,108,32,68,108,103,_
  401.                  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,_
  402.                  152,58,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,2,0,0,0,1,0,0,0,7,0,0,0,7,0,0,0,_
  403.                  16,0,0,0,7,0,0,0,0,0,0,0,0,0,0,0,188,2,0,0,0,0,0,0,1,2,2,34,83,121,115,116,101,109,0,16,104,138,247,12,_
  404.                  172,0,1,0,148,51,2,0,0,0,87,1,0,0,9,0,139,1,164,1,0,0,0,0,128,255,128,0,1,0,0,0,_
  405.                  32,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,184,0,0,0,206,0,0,0,31,2,0,0,_
  406.                  50,3,0,0,226,2,0,0,109,1,0,0,238,2,0,0,57,2,0,0,0,0,0,0,0,0,0,0,114,0,0,0,177,0,0,0,0,0,188,66,_
  407.                  0,0,200,65,113,0,0,0,114,0,0,0,115,0,0,0,116,0,0,0,117,0,0,0,118,0,0,0,119,0,0,0,_
  408.                  120,0,0,0,121,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  409.                  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  410.                  0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,_
  411.                  0,0,0,0,244,1,0,0,1,0,0,0,0,0,0,0)
  412.                          
  413.         ' ~~~ Create two registry keys for OSK 
  414.         ' ~~~ Create the setting BINARY value
  415.         RegWrite "HKCU\Software\Microsoft\Osk\Setting", 0, "REG_BINARY"
  416.             
  417.         ' ~~~ Write the setting key value
  418.         RegWrite "HKCU" & "\" & strKeyPath & "\" & strValueName, strValue,  "REG_BINARY"
  419.         
  420.         ' ~~~ Create the Stepping DWORD value
  421.         RegWrite "HKCU\Software\Microsoft\Osk\Stepping", "3", "REG_DWORD"
  422.         
  423.     
  424.     End If
  425.     
  426. End Function 
  427.  
  428. End Class