Monday, March 26, 2012

Creating a SendTo Shortcut through MSI

If you want to create a SendTo shortcut through MSI, then if you just add the shortcut in MSI in SendTo folder, it will not work. Even if you get the shortcut there in every user profile, still it will not work. To make a SendTo shortcut, you need to create it on the fly, which means that shortcut should be created from original exe. To solve this issue for one of my application, WinSCP, I wrote the below VBScript and placed it in %ALLUSERPROFILE%\WinSCP folder. Then I created an Active setup to call this VBScript.

Set Shell = CreateObject("WScript.Shell")
ShortcutPath = Shell.SpecialFolders("SendTo")
Set link = Shell.CreateShortcut(ShortcutPath & "\WinSCP (for upload).lnk")
link.Arguments = "/upload"
link.Description = "WinScp"
link.HotKey = ""
link.IconLocation = "C:\Program Files (x86)\WinSCP\WinSCP.exe,0"
link.TargetPath = "C:\Program Files (x86)\WinSCP\WinSCP.exe"
link.WindowStyle = 3
link.WorkingDirectory = "C:\Program Files (x86)\WinSCP"

To delete this SendTo shortcut, I wrote another script and added an active setup registry key through CA during Remove sequence to run this script.

dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sup = oShell.ExpandEnvironmentStrings ("%APPDATA%")
WinSCPlnk= sup & "\Microsoft\Windows\SendTo\WinSCP (for upload).lnk"
If filesys.FileExists(WinSCPlnk) Then
filesys.DeleteFile WinSCPlnk
End If

Also remember to make the above component as permanent, because you do not want to delete this vbs file at uninstall of application.

Sunday, March 18, 2012

VBScript to Kill a Process

This worked great for me. Just use as function and kill as many processes as you like.

KillProc "abc.exe"
Sub KillProc( myProcess )
    Dim blnRunning, colProcesses, objProcess
    blnRunning = False
    Set colProcesses = GetObject( _
                       "winmgmts:{impersonationLevel=impersonate}" _
                       ).ExecQuery( "Select * From Win32_Process", , 48 )
    For Each objProcess in colProcesses
        If LCase( myProcess ) = LCase( objProcess.Name ) Then
            ' Confirm that the process was actually running
            blnRunning = True
            ' Get exact case for the actual process name
            myProcess  = objProcess.Name
            ' Kill all instances of the process
        End If
    If blnRunning Then
        Do Until Not blnRunning
            Set colProcesses = GetObject( _
                               "winmgmts:{impersonationLevel=impersonate}" _
                               ).ExecQuery( "Select * From Win32_Process Where Name = '" _
                             & myProcess & "'" )
            WScript.Sleep 100 'Wait for 100 MilliSeconds
            If colProcesses.Count = 0 Then 'If no more processes are running, exit loop
                blnRunning = False
            End If
      End If
End Sub

Monday, March 12, 2012

VBScript to enable "Use this connection's DNS Suffix in DNS registration" in IPV4

I have written this below VBScript to enable "Use this connection's DNS Suffix in DNS registration" in IPV4 Advanced Settings.

For Desktop adaptor, this (to enable "Use this connection's DNS Suffix in DNS registration" in IPV4) can be fixed by changing the registry value of HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\Tcpip\Parameters\Interfaces\NetworkInterfaceID\RegisterAdapterName to 1

Here NetowrkInterfaceID is a unique ID for every user and this can be obtained from "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\8\ServiceName" key.

The issue is there can be multiple Network adaptors connected to the machine like Network adaptor for Desktop, Wireless Adaptor, VMware adaptor etc and they all are stored under different hive, like 8, 12, 14 etc. Hence I have written a script which will check for all this and will change the value for all adaptors. If you want for only one particular adaptor, you can modify the script accordingly.

Following VB Functions can be independently picked too:
1) Read Registry
2) Registry Key exists
3) iteration in VBScript (For Loop)
4) Write Registry key.

On Error Resume Next

Dim NetworkInterfaceID, RegKeyValue, Temp

Function KeyExists(key)
    Dim objShell
    On Error Resume Next
    Set objShell = CreateObject("WScript.Shell")
        objShell.RegRead (key)
    Set objShell = Nothing
    If Err = 0 Then KeyExists = True
End Function

For i = 0 to 20
RegistryKeyName = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\" & i & "\"
If KeyExists(RegistryKeyName) Then
Reg= RegistryKeyName + "ServiceName"
NetworkInterfaceID = ReadReg(Reg)
RegKeyValue = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\Tcpip\Parameters\Interfaces\" + NetworkInterfaceID + "\RegisterAdapterName"
WriteReg RegKeyValue, 1 ,"REG_DWORD"
End If
 'WScript.Echo Temp
 Function WriteReg(RegPath, Value, RegType)
       'Regtype should be "REG_SZ" for string, "REG_DWORD" for a integer,…
       '"REG_BINARY" for a binary or boolean, and "REG_EXPAND_SZ" for an expandable string
       Dim objRegistry, Key
       Set objRegistry = CreateObject("")

      Key = objRegistry.RegWrite(RegPath, Value, RegType)
       WriteReg = Key
 End Function
 Function ReadReg(RegPath)
       Dim objRegistry, Key
       Set objRegistry = CreateObject("")

      Key = objRegistry.RegRead(RegPath)
       ReadReg = Key
 End Function