(view source code of getdde.vbs as plain text)
Option Explicit
Dim arrAssoc, arrKeys, arrSubKeys
Dim blnFullCmdOnly
Dim i, intValidArgs, j
Dim objDic, objReg
Dim strCommand, strDDEApp, strDDEExec, strDDETopic
Dim strFileType, strKey, strSubKey, strSubSubKey
Const HKCR = &H80000000
blnFullCmdOnly = False
intValidArgs = 0
' No command line arguments required
With WScript.Arguments
If .Unnamed.Count > 0 Then Syntax
If .Named.Count > 0 Then
If .Named.Exists( "H" ) Then
intValidArgs = intValidArgs + 1
WScript.Echo "Extension" & vbTab _
& "File Type" & vbTab _
& "Shell Command" & vbTab _
& "DDE Server Command" & vbTab _
& "DDE Application" & vbTab _
& "DDE Topic" & vbTab _
& "DDE Client Command"
End If
If .Named.Exists( "F" ) Then
intValidArgs = intValidArgs + 1
blnFullCmdOnly = True
End If
If intValidArgs <> .Named.Count Then Syntax
End If
End With
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
Set objDic = CreateObject( "Scripting.Dictionary" )
' List all keys in the HKEY_CLASSES_ROOT hive
objReg.EnumKey HKCR, "", arrKeys
For i = 0 To UBound( arrKeys )
' Store registered extensions and their associated file types in a dictionary
If Left( arrKeys(i), 1 ) = "." Then
objReg.GetStringValue HKCR, arrKeys(i), "", strFileType
objDic.Item( strFileType) = arrKeys(i)
End If
' Check if any commands are available for a file type
strSubKey = arrKeys(i) & "\shell"
objReg.EnumKey HKCR, strSubKey, arrSubKeys
If IsArray( arrSubKeys ) Then
For j = 0 To UBound( arrSubKeys )
strSubSubKey = arrKeys(i) & "\shell\" & arrSubKeys(j) & "\ddeexec"
objReg.GetStringValue HKCR, strSubSubKey, "", strDDEExec
' DDE commands only
If IsNull( strDDEExec ) Then Exit For
strSubSubKey = arrKeys(i) & "\shell\" & arrSubKeys(j) & "\command"
objReg.GetStringValue HKCR, strSubSubKey, "", strCommand
strSubSubKey = arrKeys(i) & "\shell\" & arrSubKeys(j) & "\ddeexec\Application"
objReg.GetStringValue HKCR, strSubSubKey, "", strDDEApp
strSubSubKey = arrKeys(i) & "\shell\" & arrSubKeys(j) & "\ddeexec\Topic"
objReg.GetStringValue HKCR, strSubSubKey, "", strDDETopic
If blnFullCmdOnly Then
If IsNull( strDDEApp ) Then Exit For
If IsNull( strDDETopic ) Then Exit For
End If
' Display the DDE commands
strFileType = Split( strSubSubKey, "\" )(0)
WScript.Echo objDic.Item( strFileType ) & vbTab _
& strFileType & vbTab _
& arrSubKeys(j) & vbTab _
& strCommand & vbTab _
& strDDEApp & vbTab _
& strDDETopic & vbTab _
& strDDEExec
Next
End If
arrSubKeys = ""
Next
Set objDic = Nothing
Set objReg = Nothing
Sub Syntax
WScript.Echo vbCrLf _
& "GetDDE.vbs, Version 1.00" _
& vbCrLf _
& "List DDE commands for all registered file types" _
& vbCrLf & vbCrLf _
& "Usage: CSCRIPT.EXE //NoLogo GETDDE.VBS [ /F ] [ /H ]" _
& vbCrLf & vbCrLf _
& "Where: /F list fully defined DDE commands only, i.e. if either the DDE" _
& vbCrLf _
& " Application or Topic is not defined, it will not be displayed." _
& vbCrLf _
& " /H display a header line." _
& vbCrLf & vbCrLf _
& "Note: Only one file extension will be listed for each registered file type." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Quit 1
End Sub
page last modified: 2024-04-16; loaded in 0.0067 seconds