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

Comments (0)

› No comments yet.