Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for capslock.vbs

(view source code of capslock.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim arrCaps, strMsg, strProc
  4. Dim blnExitWord, blnExitWP
  5. Dim colItems, objItem, objWMIService
  6.  
  7. strMsg = ""
  8.  
  9. ' Check for command line arguments (none required)
  10. If WScript.Arguments.Count > 0 Then
  11. 	Syntax
  12. End If
  13.  
  14. ' Check if MSWord and/or WordPerfect are already active by
  15. ' searching for processes named WINWORD.EXE or WPWIN**.EXE
  16. blnExitWP   = True
  17. blnExitWord = True
  18. Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
  19. Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Process", , 48 )
  20. For Each objItem In colItems
  21. 	strProc = UCase( objItem.Name )
  22. 	If Len( strProc ) > 11 Then Exit For
  23. 	If Left( strProc, 5 ) = "WPWIN" And Right( strProc, 4 ) = ".EXE" Then
  24. 		blnExitWP = False
  25. 	End If
  26. 	If strProc = "WINWORD.EXE" Then
  27. 		blnExitWord = False
  28. 	End If
  29. Next
  30. Set objWMIService = Nothing
  31.  
  32. ' Start with WordPerfect only if it is
  33. ' active already, otherwise try MSWord first
  34. If blnExitWord = False And blnExitWP = True Then
  35. 	arrCaps = CapsLockWP( )
  36. 	If arrCaps(1) Then
  37. 		arrCaps = CapsLockWord( )
  38. 		If arrCaps(1) Then
  39. 			WScript.Echo strMsg & "Unable to read CapsLock status"
  40. 			WScript.Quit
  41. 		End If
  42. 	End If
  43. Else
  44. 	arrCaps = CapsLockWord( )
  45. 	If arrCaps(1) Then
  46. 		arrCaps = CapsLockWP( )
  47. 		If arrCaps(1) Then
  48. 			WScript.Echo strMsg & "Unable to read CapsLock status"
  49. 			WScript.Quit
  50. 		End If
  51. 	End If
  52. End If
  53.  
  54. If arrCaps(0) Then
  55. 	WScript.Echo strMsg & "CapsLock is ON"
  56. Else
  57. 	WScript.Echo strMsg & "CapsLock is OFF"
  58. End If
  59.  
  60.  
  61. Function CapsLockWord( )
  62. 	Dim objWord, blnCapsLock, blnError
  63. 	On Error Resume Next
  64. 	Set objWord = CreateObject( "Word.Application" )
  65. 	If Err Then
  66. 		blnCapsLock = False
  67. 		blnError    = True
  68. 	Else
  69. 		blnCapsLock = CBool( objWord.CapsLock )
  70. 		blnError    = False
  71. 		If blnExitWord Then
  72. 			objWord.Quit
  73. 		End If
  74. 	End If
  75. 	On Error Goto 0
  76. 	CapsLockWord = Array( blnCapsLock, blnError )
  77. End Function
  78.  
  79.  
  80. Function CapsLockWP( )
  81. 	Dim objWP, blnCapsLock, blnError
  82. 	On Error Resume Next
  83. 	Set objWP = CreateObject( "WordPerfect.PerfectScript" )
  84. 	If Err Then
  85. 		blnCapsLock = False
  86. 		blnError    = True
  87. 	Else
  88. 		blnCapsLock = CBool( objWP.envKeyCapsLock )
  89. 		blnError    = False
  90. 		If blnExitWP Then
  91. 			objWP.ExitWordPerfect
  92. 		End If
  93. 	End If
  94. 	On Error Goto 0
  95. 	CapsLockWP = Array( blnCapsLock, blnError )
  96. End Function
  97.  
  98.  
  99. Sub Syntax( )
  100. 	strMsg = "CapsLock.vbs,  Version 1.01" _
  101. 	       & vbCrLf _
  102. 	       & "Display CapsLock status using MS Word or WordPerfect" _
  103. 	       & vbCrLf & vbCrLf _
  104. 	       & "Usage:  CAPSLOCK.VBS" _
  105. 	       & vbCrLf & vbCrLf _
  106. 	       & "Note:   This script will first check if WordPerfect is active." _
  107. 	       & vbCrLf _
  108. 	       & "        If so, it will use WordPerfect to read the CapsLock status." _
  109. 	       & vbCrLf _
  110. 	       & "        Otherwise it will try using MS Word, and if it fails try" _
  111. 	       & vbCrLf _
  112. 	       & "        again using WordPerfect." _
  113. 	       & vbCrLf _
  114. 	       & "        It won't close MS Word nor WordPerfect if they were active" _
  115. 	       & vbCrLf _
  116. 	       & "        at the time the script was started." _
  117. 	       & vbCrLf & vbCrLf _
  118. 	       & "Written by Rob van der Woude" & vbCrLf _
  119. 	       & "http://www.robvanderwoude.com" _
  120. 	       & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
  121. End Sub
  122.  

page last modified: 2024-04-16; loaded in 0.0065 seconds