Dead Link Cleaner
So I went looking for a utility to do this for me, and couldn't find one that either itself or its installer didn't look shady/spammy. Since shell interfaces are my favorite thing anyway, I went ahead and wrote program to make it.
I'm posting here instead of utilities because this example marks the first VB6 a technique for enumerating/searching files recursively using the standard IShellItem interface, where most previous examples either aren't recursive, aren't for general file system locations, or use a different method- sticking with IShellItem increases your coding efficiency since you don't need to convert between different ways of interacting with the file system.
Unicode is fully supported. The textbox and listbox are the standard VB controls so won't display Unicode, but the names are stored internally so everything will work; just if you need to use a path with Unicode extended characters in the name, select it with the Browse... button.
Requirements
-Windows Vista or newer (the link check/delete works on XP but the file enumeration uses IEnumShellItems, which is only available as of Vista)
-oleexp.tlb v4.0 or newer
-oleexp addon mIID.bas (included in oleexp download)
Code
The code here is to show core concepts, see the full project in the attachment for additional declares and support functions that the below requires to run.
We use IShellLinkW and IPersistFile to load links and grab their target:
Code:
Public Function GetLinkTarget(sLNK As String) As String
Dim pSL As ShellLinkW
Dim ipf As IPersistFile
Dim sTar As String
Dim wfd As WIN32_FIND_DATAW
Set pSL = New ShellLinkW
Set ipf = pSL
ipf.Load sLNK, STGM_READ
sTar = String$(MAX_PATH, 0)
pSL.GetPath sTar, MAX_PATH, wfd, SLGP_UNCPRIORITY
pSL.Release
If InStr(sTar, vbNullChar) > 2 Then
sTar = Left$(sTar, InStr(sTar, vbNullChar) - 1)
End If
If Left$(sTar, 1) = vbNullChar Then
GetLinkTarget = ""
Else
GetLinkTarget = sTar
End If
End FunctionCode:
Private Sub Command2_Click()
Dim psi As IShellItem
Dim piesi As IEnumShellItems
Dim isia As IShellItemArray
Dim pidl As Long
Dim pFile As IShellItem
Dim lpName As Long
Dim sName As String
Dim sDisp As String
Dim pcl As Long
Dim sTarget As String
Dim sStart As String
Dim lAtr As SFGAO_Flags
List1.Clear
ReDim arToDel(0)
nToDel = 0
nLinks = 0
pidl = ILCreateFromPathW(StrPtr(sRoot))
SHCreateItemFromIDList pidl, IID_IShellItem, psi
psi.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, piesi
Do While piesi.Next(1&, pFile, pcl) = S_OK
pFile.GetAttributes SFGAO_FOLDER, lAtr
If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
If Check1.Value = vbChecked Then
ScanDeep pFile
End If
Else
pFile.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpName
sName = LPWSTRtoStr(lpName)
sDisp = Right(sName, Len(sName) - InStrRev(sName, "\"))
If Right$(sName, 4) = ".lnk" Then
Debug.Print "Found link: " & sName
nLinks = nLinks + 1
sTarget = GetLinkTarget(sName)
If PathFileExistsW(StrPtr(sTarget)) Then
Debug.Print "Link is valid, skipping."
Else
Debug.Print "Link is invalid, deleting..."
ReDim Preserve arToDel(nToDel)
arToDel(nToDel) = sName
nToDel = nToDel + 1
List1.AddItem sDisp
End If
End If
End If
Loop
Label2.Caption = "Found " & nLinks & " total, " & nToDel & " pending deletion."
Call CoTaskMemFree(pidl)
End Sub
Private Sub ScanDeep(psiLoc As IShellItem)
'for recursive scan
Dim psi As IShellItem
Dim piesi As IEnumShellItems
Dim pFile As IShellItem
Dim lpName As Long
Dim sName As String
Dim sDisp As String
Dim pcl As Long
Dim sTarget As String
Dim lAtr As SFGAO_Flags
psiLoc.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, piesi
Do While piesi.Next(1&, pFile, pcl) = S_OK
pFile.GetAttributes SFGAO_FOLDER, lAtr
If (lAtr And SFGAO_FOLDER) = SFGAO_FOLDER Then
ScanDeep pFile
Else
pFile.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpName
sName = LPWSTRtoStr(lpName)
sDisp = Right(sName, Len(sName) - InStrRev(sName, "\"))
If Right$(sName, 4) = ".lnk" Then
Debug.Print "Found link: " & sName
nLinks = nLinks + 1
sTarget = GetLinkTarget(sName)
If PathFileExistsW(StrPtr(sTarget)) Then
Debug.Print "Link is valid, skipping."
Else
Debug.Print "Link is invalid, deleting..."
ReDim Preserve arToDel(nToDel)
arToDel(nToDel) = sName
nToDel = nToDel + 1
List1.AddItem sDisp
End If
End If
End If
Loop
End Sub