X-Setup Pro

Select your language: 

Windmeier Internet Services UG

 

Home

Product

Downloads

Purchase

License Center

Support

Developers

Forum

 

X-Setup Pro | Free Vista Files Certify

X-Setup Pro Plugins

Note for everybody who is visiting this page via a search engine like Google:
This page shows the HTML version (with full source code) of one of our many plugins included with our tweaker utility X-Setup Pro. With this tool you can change over 1,700 settings for Windows and other applications - settings that are normally hidden deep inside the registry. Read more about X-Setup Pro on our Product info about X-Setup ProProduct page.

If you are interested in using this plugin, because it contains a tweak you would like to have, it's easy as 1-2-3-4:

  • Download X-Setup Pro from our Download X-Setup ProDownload page.
  • Install it on your computer and execute it.
  • On the welcome screen, select "Classic mode".
  • Simply use the information about the path and the name of the plugin shown below to easily locate it.

Plugin details

This is the HTML representation of the plugin Editor (Version 1.02) which can be found in the following path(s) in X-Setup Pro classic:
Internet\Internet Explorer\Context Menu Entries

The plugin can be executed on the following Windows versions (Operation Systems):
Windows NT 4.0, Windows 98, Windows 2000, Windows ME, Windows XP, Windows 2003

Description :
This plug-in edits entries in Internet Explorer context menu. You may need to restart Internet Explorer to make it work. NOTE #1: Entries, that begin with '[]' are unvisible. NOTE #2: Entries, that begin with '!!' are visible, but IE shows them not, because they are useless (without default URL). NOTE #3: To only rename the entry, click 'Edit', change the name, click 'OK' and then 'Cancel'.

The plugin was created by Svyatoslav Holub
This plug-in is Freeware. Use at your own risk!

The plugin offers the following user-interface controls:
&Edit
&Add new
&Delete

Below is the code of this plugin written in "VBScript". Please note that this code can only be executed inside X-Setup Pro. 

visibleMenuExt="HKCU\Software\Microsoft\Internet Explorer\MenuExt"
unvisibleMenuExt="HKCU\Software\Microsoft\Internet Explorer\MenuExt-"

const vMark ="[] "  'indicates unvisibility
const uMark ="!! "              'indicates useless

dim visibleCount, unvisibleCount
dim visibleMenuExists, unvisibleMenuExists
dim vMarkLength, uMarkLength
dim trueNames()


Sub Plugin_Initialize
 vMarkLength = Len(vMark)
 uMarkLength = Len(uMark)
 
'Clear listbox
 elemNumber = visibleCount + unvisibleCount
 For l = 1 to elemNumber
   SetUIElement l, ""
 Next

'Clear names array
 Redim trueNames(0)

 visibleCount = 0
 unvisibleCount = 0


 visibleMenuExists = RegPathExists(visibleMenuExt)
 unvisibleMenuExists = RegPathExists(unvisibleMenuExt)

 dim  falseNames
 If  visibleMenuExists = true Then
  visibleCount=RegEnumPaths(visibleMenuExt)
  If CBool (visibleCount) Then listAddNew visibleCount, 0, true, falseNames
 End If

 If  unvisibleMenuExists = true Then
  unvisibleCount=RegEnumPaths(unvisibleMenuExt)
  If CBool (unvisibleCount) Then listAddNew unvisibleCount, visibleCount, false, falseNames
 End If

 If falseNames <> "" Then MsgWarning "Following context menu names begin with " & _
          vMark & "or " & uMark & ":" & vbCrLf & vbCrLf & _
          falseNames & vbCrLf & "The plug-in uses this characters " & _
          "to indicate entry properties." & vbCrLf & _
          "Please rename this entries with 'Edit'-button."
 'If visibleCount + unvisibleCount = 0 Then Disable
End Sub

Sub listAddNew (elemCounter, listCounter, visibilityFlag, ByRef falseNames)
 For i=1 to elemCounter
   extText=RegEnumElement(i)
   j = i + listCounter
   Redim Preserve trueNames(j)
   trueNames(j) = extText
   If Len(extText) > 1 Then _
     If Left(extText,2)=Left(uMark,2) OR Left(extText,2)=Left(vMark,2) Then _
       falseNames = falseNames & vbTab & extText & vbCrLf
   If visibilityFlag = false Then
       SetUIElement j, vMark & extText
   Else
       If RegReadValue(visibleMenuExt & "\" & extText & "\" & "@")="" Then
        SetUIElement j, uMark & extText
       Else
        SetUIElement j, extText
       End If
   End If
 Next
End Sub


Sub Plugin_Apply(ElementIndex,ElementSubIndex)
'Nothing to do, if IE settings in Registry were meantime for example manual changed.
 If RegistryChanged = true Then Exit Sub

 Select Case ElementIndex
 Case 1 'edit
  If ElementSubIndex <> 0 Then editEntry ElementSubIndex
 Case 2 'add new
  addEntry
 Case 3 'delete
  If ElementSubIndex <> 0 Then deleteEntry ElementSubIndex
 Case Else
  'not possible
 End Select
    
End Sub


Sub editEntry (entryIndex)

changed = false

If entryIndex <> 0 Then
  If entryIndex > visibleCount Then
    fullName = unvisibleMenuExt & "\" & trueNames(entryIndex)
    visibility = false
  Else
    fullName = visibleMenuExt & "\" & trueNames(entryIndex)
    visibility = true
  End If
Else
  visibility = true
End If
  
  dim editValues(3)
  editValues(3) = visibility
  
  'show input windows
  For i=1 to 4
    answer = DataInput (i, fullName, entryIndex, editValues)
    If IsEmpty(answer) = true Then Exit For
  Next

  If IsEmpty(editValues(0)) = true Then Exit Sub

  If editValues(0) <> trueNames(entryIndex) OR editValues(3) <> visibility Then
    If editValues(3) = true Then _
        fullDestination = visibleMenuExt & "\" & editValues(0) Else _
        fullDestination = unvisibleMenuExt & "\" & editValues(0)
    If RegistryChanged = true Then Exit Sub
    If entryIndex <> 0 Then moveSubKey  fullName, fullDestination _
    Else RegWriteValue fullDestination & "\@", "", 1
    changed = true
    fullName = fullDestination
  End If

  If IsEmpty(editValues(1)) = true Then
    If changed = true Then
      IndicateSettingChange
      Plugin_Initialize 
    End If
    Exit Sub
  End If
  RegWriteValue fullName & "\@", editValues(1), 1 
  
  If IsEmpty(editValues(2)) = true Then
    If changed = true Then
      IndicateSettingChange
      Plugin_Initialize
    End If
    Exit Sub
  End If 
  If editValues(2) = "" Then
    If RegValueExists(fullName & "\contexts") = true Then _
    RegDeleteValue fullName & "\contexts"
  Else
    RegWriteValue fullName & "\contexts", editValues(2), 3 
  End If

  If changed = true Then
    IndicateSettingChange
    Plugin_Initialize 
  End If  
End Sub


Sub addEntry
  editEntry 0 
End Sub


Sub deleteEntry (entryIndex)
  If entryIndex > visibleCount Then
    deleteSubKey unvisibleMenuExt & "\" & trueNames(entryIndex)
  Else
    deleteSubKey visibleMenuExt & "\" & trueNames(entryIndex)
    IndicateSettingChange
  End If
 Plugin_Initialize
End Sub


'show input windows
'check, convert and save input values
Function DataInput(inputIndex, fullKeyName, namesIndex, ByRef values)
         'show input windows with values
  Select Case inputIndex
    Case 1          'entry name
     text = "Enter context menu name, which can include an ampersand character to cause " & _
            "the character that follows to be underlined and used as a shortcut key:"
  value = trueNames(namesIndex)
    Case 2          'default URL
     text = "Enter URL of the page that contains the script, which you want to execute:" & vbCrLf & _
            "(if URL is empty, IE shows this entry not!)"
     If namesIndex <> 0 Then value = RegReadValue(fullKeyName & "\@") _
     Else value = ""
    Case 3          'contexts
     text = "Which contexts this entry should appear? " & _
            "Use the logical OR of the following values:" & vbCrLf & _
            "00000001-default" & vbTab & "00001000-tables" & vbCrLf & _
            "00000010-images" & vbTab & "00010000-selection   " & vbCrLf & _ 
            "00000100-controls" & vbTab & "00100000-anchor"
      If namesIndex <> 0 Then 
     If RegValueExists(fullKeyName & "\contexts")=true Then _
        valueType=RegValueType(fullKeyName & "\contexts")  
        value = RegReadValue(fullKeyName & "\contexts")
     If value <> Empty Then
       'convert only last byte
       If valueType=3 Then value=CLng("&H" & Right(value,2))
       If valueType=2 OR valueType=3 Then value=dez2bin(value)
     Else
       value = ""
     End If
      Else
        value = "00000001"
      End If
    Case 4          'visibility
     text = "Are you want to make this entry visible (Yes/No)?"
     If namesIndex > visibleCount Then value = "No" Else value = "Yes"
    Case Else
     Err.Raise vbObjectError + 1, "Function DataInput", "inputIndex (" & inputIndex & ") is out of bound (4)!" 
  End Select

  Do         'check input data
    reinput = false
    answer = InputWindow(text,value,1)
    If IsEmpty(answer) = true Then Exit Function
  
         'syntax check and data convert
    Select Case inputIndex
      Case 1          'entry name
        If Trim(answer) = "" Then 
          reinput = true
        ElseIf Len(Trim(answer)) > 1 Then
          If Left(Trim(answer),2)=Left(uMark,2) OR Left(Trim(answer),2)=Left(vMark,2) Then
            MsgWarning "Names, which begin with " & _
                    uMark & "or " & vMark & _
                    "are not allowed!"
            reinput = true
          End If
        End If

        If reinput = false Then        
          If LCase(answer) <> LCase(trueNames(namesIndex)) Then
            For c=1 To UBound(trueNames)
              If LCase(answer) = LCase(trueNames(c)) Then
                MsgWarning "This name already exists!"
                reinput = true
                Exit For
              End If
            Next
          End If
        End If
      Case 2          'default URL
        If Trim(answer) = "" AND answer <> "" Then reinput = true
      Case 3          'contexts
        If answer = "" Then
          'nothing to do
        ElseIf Len(answer)=8 Then
          For i=1 To Len(answer)
           char = Mid(answer,i,1)
           Select Case char
            Case "0", "1"
              filtredAnswer = filtredAnswer & char
            Case Else
              'nothing to do
           End Select
          Next
          If answer = filtredAnswer Then
            answer = bin2hex(answer)
          Else
            reinput = true
          End If
        Else
          reinput = true
        End If
      Case 4          'visibility
        If LCase(answer)="yes" Then
          answer = true
        ElseIf LCase(answer)="no" Then
          answer = false
        Else
          reinput = true
        End If
      Case Else
        'unpossible
    End Select
    value = answer
  Loop While reinput = true 
    
  values(inputIndex-1) = answer
  
  DataInput = answer
End Function


Function bin2hex(binValue)
 For i=0 To 7
  dezValue = dezValue + Mid(binValue,8-i,1)*2^(i)
 Next
 bin2hex = Hex(dezValue)
 If Len(bin2hex) = 1 Then bin2hex = "0" & bin2hex 
End Function


'convert only last byte
Function dez2bin(ByVal dezValue)
  For i=1 to 8
   bit = (dezValue Mod 2) & bit
   dezValue = dezValue \ 2
  Next
  dez2bin = bit
End Function


Sub moveSubKey (fullSourceKey, fullDestinationKey)
  dim i, j
  dim pathsCount, valuesCount
  dim defaultString, value, data, dataType
    
    pathsCount = RegEnumPaths(fullSourceKey)
    If pathsCount <> 0 Then
      For j=1 to pathsCount
       moveSubKey fullSourceKey & "\" & RegEnumElement(j), fullDestinationKey & "\" & RegEnumElement(j)
      Next
    End If
    
    defaultString = RegReadValue(fullSourceKey & "\@")
    RegWriteValue fullDestinationKey & "\@", defaultString, 1

    valuesCount = RegEnumValues(fullSourceKey)
    For i=1 to valuesCount
       value = RegEnumElement(i)
       data = RegReadValue(fullSourceKey & "\" & value)
       dataType = RegValueType(fullSourceKey & "\" & value)
       RegWriteValue fullDestinationKey & "\" & value, data, dataType 
       RegDeleteValue fullSourceKey & "\" & value
    Next
    RegDeletePath fullSourceKey
End Sub


Sub deleteSubKey (fullName)
 dim x, y
 dim values, pathsCount
   pathsCount = RegEnumPaths(fullName)
   If pathsCount <> 0 Then
    For x=1 to pathsCount
     deleteSubKey fullName & "\" & RegEnumElement(x)
    Next
   End If

   values = RegEnumValues(fullName)
   For y=1 to values
    valueName = RegEnumElement(y)
    RegDeleteValue fullName & "\" & valueName
   Next
   RegDeletePath fullName
End Sub

'Check, if IE settings in Registry were meantime for example manual changed.
'If yes, plug-in restarts.
Function RegistryChanged
  If visibleMenuExists <> RegPathExists(visibleMenuExt) Then
      IndicateSettingChange
      RestartMessage
      RegistryChanged = true
      Exit Function
  ElseIf visibleMenuExists = true Then
      If visibleCount <> RegEnumPaths(visibleMenuExt) Then
 IndicateSettingChange
       RestartMessage
       RegistryChanged = true
       Exit Function
      End If
  End If
  
  If unvisibleMenuExists <> RegPathExists(unvisibleMenuExt) Then
      RestartMessage
      RegistryChanged = true
      Exit Function
  ElseIf unvisibleMenuExists = true Then
      If unvisibleCount <> RegEnumPaths(unvisibleMenuExt) Then
       RestartMessage
       RegistryChanged = true
       Exit Function
      End If
  End If

  For i=1 to visibleCount
    If RegPathExists(visibleMenuExt & "\" & trueNames(i)) = false Then
      IndicateSettingChange
      RestartMessage
      RegistryChanged = true
      Exit Function
    End If
  Next

  elCount = visibleCount + unvisibleCount
  For i=visibleCount + 1 to elCount
    If RegPathExists(unvisibleMenuExt & "\" & trueNames(i)) = false Then
      RestartMessage
      RegistryChanged = true
      Exit Function
    End If
  Next
  
  RegistryChanged = false
End Function


Sub RestartMessage
  Plugin_Initialize
  MsgWarning "Plug-in is restarted, because" & vbCrLf & _
        "Registry was changed!" & vbCrLf & "Your changes were not applied."
End Sub


Sub Plugin_Terminate
End Sub

Comment by the author: Tested on Windows 98SE with Internet Explorer 6.0

You can get more detailed information about this plugin inside the application X-Setup Pro. Get the most popular tweaker software for free: Download X-Setup ProDownload X-Setup Pro