'OpensWith.vbs
'Alan dot Kaplan at VA dot GOV
'Gets the associated program for an extension.
'You can drag a file onto this or run and put in extension for a lookup
'12/15/2010.  updated 10-30-12 to improve errorhandling on Win7

Option Explicit
const strEntry = ""
Const HKCR=&H80000000
Const strComputer = "."
Dim strExt
Dim WshShell, oExec, strCommand
Dim strAllOUt, strType, strPath 
Dim objReg, strValue, strFile
Set WshShell = CreateObject("WScript.Shell")
Dim quote, strArgs, i
quote=chr(34)

'Accept long names for drop and drag of file name by concatenating them into strArgs
For i  = WScript.Arguments.Count -1 to  0 Step -1
	strArgs = WScript.Arguments(i) & Space(1) &  strArgs
	strArgs = Trim(strArgs)
Next
	
If (Not IsCScript()) Then 		'If not CScript, re-run with cscript to avoid EXEC box, See below	
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 0, true
    WScript.Quit            	'...and stop running as WScript
End If

If len(strArgs) >0 Then 
	dim fso
	set fso = CreateObject("Scripting.FileSystemObject")
	strFile = strArgs
	If fso.FileExists( strFile ) Then strExt = fso.GetExtensionName( strFile )
Else
	Dim message
	message = "This script looks up the program associated with a file extension. " & _
	"If there are multiple associated programs, it returns the first one only. " & VbCrLf & VbCrLf & _
	"Get primary program associated with what extension?"
	strExt = InputBox(message,"Extension",".vbs")
	If strExt = "" Then WScript.Quit
End If

strExt = Replace(strExt,"*","")

If Left(strExt,1) <> "." Then strExt = "." & strExt 
'Shell out and user ASSOC command to get associated filetype.  Quick and dirty
WScript.Echo WScript.ScriptName & " written by Alan Kaplan" & VbCrLf & "Visit my scripting blog at www.akaplan.com/blog"
strCommand = "%comspec% /c assoc " & strExt
'a shortcoming of .EXEC method is the window it pops up if WScript is the host.
Set oExec = WshShell.Exec(strCommand)
wscript.sleep 500

'capture output of ASSOC
strAllOut = oExec.StdOut.ReadAll

If oExec.ExitCode <> 0 Then
     msgbox strExt  & " has no associated program on this computer",vbExclamation + vbOKOnly,"No Association Found"
     WScript.Quit
End If

'parse output to get filetype

strType = Replace(strAllOUt,strExt& "=","")
strType= replace(strType,vbcrlf,"")

'Look at this path in registry
strPath = strType & "\shell\open\command"

Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'Get value
objReg.GetExpandedStringValue HKCR, strPath, strEntry, strValue

If InStr(strValue,"rundll") Then 
	Dim tArray
	tArray = split(strValue,",")
	strFile = replace(tArray(0),"rundll32.exe","")
Else 
	'Clean up and parse
	strValue = LCase(strValue)
	On Error Resume Next
	strFile = Left(strValue,instrrev(strValue,".exe")+3)
	strFile = GetLongPath(strFile)
	If Err <> 0 Then
		MsgBox "Error looking up associated program for " & strExt, vbCritical + vbOKOnly,"Error"
		WScript.Quit
	End If 
End If 

MsgBox Ucase(strExt) & " opens with " & strFile,vbInformation + vbOKOnly,"Associated Program for " & UCase(strExt)

Function GetLongPath(strShortPath)
	strShortPath = Replace(strShortPath,quote,"")
	'This is the new one that works with Vista and later
	'http://www.myitforum.com/forums/m_168099/mpage_1/key_/tm.htm#168187
	On Error Resume Next
	dim oSC, sLongName
	' Link will not be created!
	Set oSC = wshShell.CreateShortcut("foo.lnk")
	oSC.TargetPath = strShortPath
	sLongName = oSC.TargetPath
	GetLongPath = sLongName
	
	If Err.Number > 0 Then
		Err.Clear
	    GetLongPath = strShortPath	'could not resolve
	End If 

End Function


Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function