« Posts tagged URL LNK Desktop Shortcut Information

Retrieve Desktop Shortcut (URL and LNK) Information Remotely

Every needed to get all of the TargetPaths and Parameters from the Shortcuts and URLs from a remote machine (given you have the permissions)? This script below will gather all of that information display it to the console and save the same link information into a file called links.txt on your C:\ drive. The script will scour each and ever user folder under C:\Documents and Settings\. This script will work successfully on Windows XP machines, it will not however work on Windows Vista or Windows 7 due to the location of the users folders.

Usage:
cscript links.vbs
cscript links.vbs

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set filetxt = objFSO.OpenTextFile("c:\links.txt", ForAppending, True)
set oArgs=wscript.Arguments

Function Ping(myHostName)

   Dim colPingResults, objPingResult, strQuery

   strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & myHostName & "'"

   Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery( strQuery )

   For Each objPingResult In colPingResults
      If Not IsObject( objPingResult ) Then
        Ping = False
      ElseIf objPingResult.StatusCode = 0 Then
        Ping = True
      Else
        Ping = False
      End If
   Next

   Set colPingResults = Nothing

End Function

Sub forceUseCScript()
   If Not WScript.FullName = WScript.Path & "\cscript.exe" Then
      objShell.Run "cmd.exe /c " & WScript.Path & "\cscript.exe //NOLOGO " & _
         Chr(34) & WScript.scriptFullName & Chr(34) & " " & oArgs(0),1,False
      WScript.Quit 0
   End If
End Sub 

Sub QueryLNKURL(Path)
   Set objFolder = objFSO.GetFolder(Path)
   For each objFile in objFolder.Files
      strPath = objFile.Path
      Select Case Right(Lcase(objFile),4)
         Case ".lnk":
            Set objShortcut = objShell.CreateShortcut(strPath)
            netPath = "\\" & oArgs(0) & "\c$"
            Temp = Replace(objShortcut.FullName, netPath, "C:")
            filetxt.WriteLine(oArgs(0) & "|L|" & Temp & "|" & _
               objShortcut.TargetPath & "|" & objShortcut.Arguments)
            Wscript.Echo oArgs(0) & "|L|" & Temp & "|" & objShortcut.TargetPath & _
               "|" & objShortcut.Arguments
         Case ".url":
            Set objShortcut = objShell.CreateShortcut(strPath)
            netPath = "\\" & oArgs(0) & "\c$"
            Temp = Replace(objShortcut.FullName, netPath, "C:")
            filetxt.WriteLine(oArgs(0) & "|U|" & Temp & "|" & objShortcut.TargetPath)
            Wscript.Echo oArgs(0) & "|U|" & Temp & "|" & objShortcut.TargetPath
      End Select
   Next

   For each objFile in objFolder.SubFolders
      strPath = objFile.Path
      QueryLNKURL(strPath)
   Next

End Sub

Sub RecurseFolderDesktop(sDir)
   Set oDir = objFSO.GetFolder(sDir)
   For Each i In oDir.SubFolders
      if ((strcomp(i.Name, "Default User", 1) <> 0) and _
          (strcomp(i.Name, "LocalService", 1) <> 0) and _
          (strcomp(i.Name, "NetworkService", 1) <> 0) and _
          (strcomp(i.Name, "Administrator", 1) <> 0)) then
         if (objFSO.FolderExists(sDir & "\" & i.Name & "\Desktop")) then
            QueryLNKURL(sDir & "\" & i.Name & "\Desktop")
         end if
      end if
   Next
End Sub

Banner = "Links v100a " & chr(13) & chr(10) & "(c)2011 Your Site" & _
         chr(13) & chr(10) & chr(13) & chr(10)

if (oArgs.Count <> 1) then
   Wscript.Echo Banner & chr(13) & chr(10) & _
      "Links Usage: " & chr(13) & chr(10) & "  Links <ip or hostname>"
   Wscript.Quit
end if

forceUseCScript
Wscript.Echo Banner

pResult = Ping(oArgs(0))
if pResult = False then
   Temp = "Unable to ping machine.  Invalid IP address or PC not available."
   filetxt.WriteLine(oArgs(0) & "|X|" & Temp & "|")
   Wscript.Echo oArgs(0) & "|X|" & Temp & "|"
else
   ' We have shortcuts in this path on most machines.
   attempt = false
   SCPath = "\\" & oArgs(0) & _
      "\c$\documents and settings\all users\start menu\applications\"
   if (objFSO.FolderExists(SCPath)) then
      QueryLNKURL(SCPath)
      attempt = true
   end if

   SCPath = "\\" & oArgs(0) & "\c$\documents and settings"
   if (objFSO.FolderExists(SCPath)) then
      attempt = true
      RecurseFolderDesktop objFSO.GetFolder(SCPath).Path
   end if

   if (attempt = false) then
      Temp = "Unable to locate any appropriate folders to query."
      filetxt.WriteLine(oArgs(0) & "|X|" & Temp & "|")
      Wscript.Echo oArgs(0) & "|X|" & Temp & "|"
   end if
end if

Set objFolder = Nothing
Set objFSO    = Nothing
Set objShell  = Nothing
filetxt.Close