
Originally Posted by
Mark II
Hello,
I'm a newbie here, but have been kicking around in VB for more years than I like to remember.
My question: we distribute a VB6 app that creates a desktop shortcut. At least it did so reliably on all OSs prior to Vista. No luck in Vista. The installer is a customized version of the "Setup1" program provided with the VB6 P&D Wizard.
If this is old news, my apologies. I've searched around but could not find a thread covering it.
Thanks in advance for any suggestions,
M2
To answer your question, I presume that your customized installer implements what is in this article: "Make P&D Wizard create Desktop shortcuts".
The following updates are intended to fix two issues with this excellent code example:
A) Internationalization. The article assumes that the name of the Windows desktop folder is "Desktop". The shortcut creation will fail in most non-US Windows because this is not the case.
B) Windows Vista. The article assumes that the location of the user's Windows desktop is "{CSIDL_PROGRAMS}\..\..\Desktop". This assumption is true under (US) XP where {CSIDL_PROGRAMS} = "%SYSTEMDRIVE%\Documents and Settings\<user>\Start Menu\Programs" and {CSIDL_DESKTOP} = "%SYSTEMDRIVE%\Documents and Settings\<user>\Desktop", but is NOT true for Vista where {CSIDL_PROGRAMS} = "%SYSTEMDRIVE%\Users\<user>\AppData\Roaming\Microsoft\Windows\Start Menu" and CSIDL_DESKTOP = "%SYSTEMDRIVE\Users\<user>\Desktop". This update fixes this issue as well.
Here are the updates to "http://www.freevbcode.com/ShowCode.asp?ID=3650" that fix these issues. In basSetup1's 'CreateIcons' Sub, add the Declarations below to the existing declarations within this sub. Next, replace the entire If-Then-End If section given in the mentioned article ("If UCase(strGroup) = "DESKTOP" Then...") with the Code snippet below.
Declarations:
Dim intCommonDepth As Integer
Dim DesktopPathArr As Variant
Dim ProgramsMenuPathArr As Variant
Code:
If UCase(strGroup) = "DESKTOP" Then
DesktopPathArr = Split(GetSpecialFolder(frmSetup1.hwnd, CSIDL_DESKTOP), "\")
'Get programs path, used in the function below
ProgramsMenuPathArr = Split(GetSpecialFolder(frmSetup1.hwnd, CSIDL_PROGRAMS), "\")
intCommonDepth = -1
Do While ((intCommonDepth + 1) < UBound(DesktopPathArr)) And ((intCommonDepth + 1) < UBound(ProgramsMenuPathArr))
If DesktopPathArr(intCommonDepth + 1) <> ProgramsMenuPathArr(intCommonDepth + 1) Then Exit Do
intCommonDepth = intCommonDepth + 1
Loop
strGroup = ""
For intIdx2 = intCommonDepth + 1 To UBound(ProgramsMenuPathArr)
strGroup = strGroup & "..\"
Next intIdx2
For intIdx2 = intCommonDepth + 1 To UBound(DesktopPathArr)
strGroup = strGroup & DesktopPathArr(intIdx2)
If intIdx2 < UBound(DesktopPathArr) Then strGroup = strGroup & "\"
Next intIdx2
End If