Create Desktop Shortcuts (Windows)

[RASHAD]

Very simple ,very effective
Tested with Win Xp,Win 7

Code: Select all

  listptr=0
  result$=Space(270)
  SHGetSpecialFolderLocation_(0,#CSIDL_DESKTOPDIRECTORY,@listptr)
  SHGetPathFromIDList_(listptr,@result$)  
  Path$ = Trim(result$)
  
  Linkn$ = "KCC.LNK"                              ;Link Name
  Prog$ = "C:\WINDOWS\regedit.exe"                ;Programme Name (With Full Path)
  WorkDir$ = "C:\WINDOWS\"                        ;Working Directory
  
  If OpenFile(0,Path$+"\temp.vbs")
    CloseFile(0)
    DeleteFile(Path$+"\temp.vbs")
  EndIf
  
  DeleteFile(Path$+"\KCC.LNK")


If CreateFile(0, Path$+"\temp.vbs")
  WriteStringN(0, "Set oWS = WScript.CreateObject("+Chr(34)+"WScript.Shell"+Chr(34)+")")
  WriteStringN(0, "sLinkFile = "+Chr(34)+Path$+"\"+Linkn$+Chr(34))
  WriteStringN(0, "Set oLink = oWS.CreateShortcut(sLinkFile)")
  WriteStringN(0, "oLink.TargetPath = "+Chr(34)+Prog$+Chr(34))
  WriteStringN(0, "oLink.IconLocation = "+Chr(34)+Prog$+", 0"+Chr(34))
  WriteStringN(0, "oLink.WindowStyle = "+Chr(34)+"3"+Chr(34))                   ;#SW_SHOWNORMAL = 1 ,#SW_SHOWMINIMIZED = 2 ,#SW_SHOWMAXIMIZED = 3
  WriteStringN(0, "oLink.WorkingDirectory = "+Chr(34)+WorkDir$+Chr(34))
  WriteStringN(0, "oLink.Save")
  CloseFile(0)
Else
  MessageRequester("Error", "Error: can't write the file", 0)
EndIf

RunProgram("WScript.exe"," "+Path$+"\temp.vbs","",#PB_Program_Wait|#PB_Program_Hide)
DeleteFile(Path$+"\temp.vbs")

[utopiomania]

You can do this from inside PB with a bit of API instead.

Code: Select all

;PB4.00
;20061127, now works with unicode executables

enableExplicit

Declare createShellLink(obj.s, lnk.s, arg.s, tip.s, dir.s, icon.s, index.l)
declare.s getSpecialFolder(id)

procedure.s getSpecialFolder(id)
  protected path.s, *ItemId.ITEMIDLIST
  
  *itemId = #Null 
  if SHGetSpecialFolderLocation_(0, id, @*ItemId) = #NOERROR 
    path = space(#MAX_PATH) 
    if SHGetPathFromIDList_(*itemId, @path)
      if right(path, 1) <> "\"
        path + "\"
      endIf
      procedureReturn path 
    endIf 
  endIf 
  procedureReturn "" 
endProcedure 

procedure createShellLink(obj.s, lnk.s, arg.s, desc.s, dir.s, icon.s, index)
  ;obj - path to the exe that is linked to, lnk - link name, dir - working
  ;directory, icon - path to the icon file, index - icon index in iconfile
  protected hRes.l, mem.s, ppf.IPersistFile
  compilerIf #PB_Compiler_Unicode 
    protected psl.IShellLinkW 
  compilerElse 
    protected psl.IShellLinkA 
  compilerEndIf 

  ;make shure COM is active
  CoInitialize_(0) 
  hRes = CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl)

  if hRes = 0
    psl\SetPath(@Obj)
    psl\SetArguments(@arg)
    psl\SetDescription(@desc)
    psl\SetWorkingDirectory(@dir)
    psl\SetIconLocation(@icon, index) 
    ;query IShellLink for the IPersistFile interface for saving the 
    ;link in persistent storage
    hRes = psl\QueryInterface(?IID_IPersistFile, @ppf)

    if hRes = 0
      compilerIf #PB_Compiler_Unicode 
        ;save the link 
        hRes = ppf\Save(@lnk, #True) 
      compilerElse 
        ;ensure that the string is ansi unicode
        mem = space(#MAX_PATH)
        MultiByteToWideChar_(#CP_ACP, 0, lnk, -1, mem, #MAX_PATH) 
        ;save the link 
        hRes = ppf\Save(@mem, #True) 
      compilerEndIf 
      ppf\Release() 
    endIf
    psl\Release()
  endIf 

  ;shut down COM
  CoUninitialize_() 

  dataSection 
    CLSID_ShellLink: 
    data.l $00021401 
    data.w $0000,$0000 
    data.b $C0,$00,$00,$00,$00,$00,$00,$46 
    IID_IShellLink: 
    compilerIf #PB_Compiler_Unicode 
      data.l $000214F9 
    compilerElse 
      data.l $000214EE 
    compilerEndIf 
    data.w $0000,$0000 
    data.b $C0,$00,$00,$00,$00,$00,$00,$46 
    IID_IPersistFile: 
    data.l $0000010b 
    data.w $0000,$0000 
    data.b $C0,$00,$00,$00,$00,$00,$00,$46 
  endDataSection 
  procedureReturn hRes 
endProcedure

#CSIDL_WINDOWS = $24
#CSIDL_DESKTOPDIRECTORY = $10 

global obj.s, lnk.s

obj = getSpecialFolder(#CSIDL_WINDOWS) + "Notepad.exe"
lnk = getSpecialFolder(#CSIDL_DESKTOPDIRECTORY) + "Demo link.lnk"

if createShellLink(obj, lnk, "arg", "Open Notepad", "C:\", obj, 0) = 0
  messageRequester("Link created on the desktop", "", #PB_MessageRequester_Ok)
endIf
end

[RASHAD]

@utopiomania
Your code is based on Danilo code which had been handled before by ts-soft and srod

Edit :revised for PB 4.51
Enable Unicode

Code: Select all

;PB4.00
;20061127, now works with unicode executables

EnableExplicit

Declare createShellLink(obj.s, lnk.s, arg.s, desc.s, dir.s, icon.s, index)
Declare.s getSpecialFolder(id)

Procedure.s getSpecialFolder(id)
  Protected path.s, *ItemId.ITEMIDLIST
 
  *itemId = #Null
  If SHGetSpecialFolderLocation_(0, id, @*ItemId) = #NOERROR
    path = Space(#MAX_PATH)
    If SHGetPathFromIDList_(*itemId, @path)
      If Right(path, 1) <> "\"
        path + "\"
      EndIf
      ProcedureReturn path
    EndIf
  EndIf
  ProcedureReturn ""
EndProcedure

Procedure createShellLink(obj.s, lnk.s, arg.s, desc.s, dir.s, icon.s, index)
  ;obj - path to the exe that is linked to, lnk - link name, dir - working
  ;directory, icon - path to the icon file, index - icon index in iconfile
  Protected hRes.l, mem.s, ppf.IPersistFile
  CompilerIf #PB_Compiler_Unicode
    Protected psl.IShellLinkW
  CompilerElse
    Protected psl.IShellLinkA
  CompilerEndIf

  ;make shure COM is active
  CoInitialize_(0)
  hRes = CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl)

  If hRes = 0
    psl\SetPath(Obj)
    psl\SetArguments(arg)
    psl\SetDescription(desc)
    psl\SetWorkingDirectory(dir)
    psl\SetIconLocation(icon, index)
    ;query IShellLink for the IPersistFile interface for saving the
    ;link in persistent storage
    hRes = psl\QueryInterface(?IID_IPersistFile, @ppf)

    If hRes = 0
      ;CompilerIf #PB_Compiler_Unicode
        ;save the link
        hRes = ppf\Save(lnk, #True)
;       CompilerElse
;         ;ensure that the string is ansi unicode
;         mem = Space(#MAX_PATH)
;         MultiByteToWideChar_(#CP_ACP, 0, lnk, -1, mem, #MAX_PATH)
;         ;save the link
;         hRes = ppf\Save(mem, #True)
;       CompilerEndIf
      ppf\Release()
    EndIf
    psl\Release()
  EndIf

  ;shut down COM
  CoUninitialize_()

  DataSection
    CLSID_ShellLink:
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IShellLink:
    CompilerIf #PB_Compiler_Unicode
      Data.l $000214F9
    CompilerElse
      Data.l $000214EE
    CompilerEndIf
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IPersistFile:
    Data.l $0000010b
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
  ProcedureReturn hRes
EndProcedure

#CSIDL_WINDOWS = $24
#CSIDL_DESKTOPDIRECTORY = $10

Global obj.s, lnk.s

obj = getSpecialFolder(#CSIDL_WINDOWS) + "Notepad.exe"
lnk = getSpecialFolder(#CSIDL_DESKTOPDIRECTORY) + "Demo link.lnk"

If createShellLink(obj, lnk, "", "Open Notepad", "C:\", obj, 0) = 0
  MessageRequester("OK", "Link created on the desktop", #PB_MessageRequester_Ok)
EndIf
End

Edit : Ascii and Unicode compatible

[utopiomania]

It works as advertised, RASHAD.

[RASHAD]

It does not with me
You have a problem with Declare and a few with the strings
Beside it does not work in Ascii mode ,works only in unicode mode
PB 4.51 x86,x64 Windows 7 x64
Check please.

[Andi]

Is there an easy way to do the opposite, i. e. to delete desktop icons and shortcuts respectively?

[Kwai chang caine]

You can enumerate the shortcuts of your desktop, and when you have the good name, you can have the target of the shortcut with this
After you can delete the two files ...
Is it what you want to do ??

Code of INFRATEC

Code: Select all

Structure ShellLinkHeaderStr
  HeaderSize.l
  LinkCLSID.a[16]
  LinkFlags.l
  FileAttributes.l
  CreationTime.q
  AccessTime.q
  WriteTime.q
  FileSize.l
  IconIndex.l
  ShowCommand.l
  HotKey.w
  Reserved1.w
  Reserved2.l
  Reserved3.l
EndStructure

Structure LinkInfoStr
  LinkInfoSize.l
  LinkInfoHeaderSize.l
  LinkInfoFlags.l
  VolumeIDOffset.l
  LocalBasePathOffset.l
  CommonNetworkRelativeLinkOffset.l
  CommonPathSuffixOffset.l
  LocalBasePathOffsetUnicode.l
  CommonPathSuffixOffsetUnicode.l
EndStructure


Enumeration ; neccessary LinkFlags
  #HasLinkTargetIDList
  #HasLinkInfo
EndEnumeration


Procedure.s GetLinkTarget(FileName$)

  If ReadFile(0, Filename$)
    
    Define ByteLengthW.w, ByteLengthL.l, CharLength.w
    
    ReadData(0, @ByteLengthL, 4)
    FileSeek(0, 0)
    *Header = AllocateMemory(ByteLengthL)
    If ReadData(0, *Header, ByteLengthL) = ByteLengthL
      
      *ShellLinkHeader.ShellLinkHeaderStr = *Header
      
      If *ShellLinkHeader\LinkFlags & (1 << #HasLinkTargetIDList)
        ReadData(0, @ByteLengthW, 2)
        ; skip the LinkTargetIDList for now
        FileSeek(0, Loc(0) + ByteLengthW)
      EndIf
      
      Pos = Loc(0)
      
      If *ShellLinkHeader\LinkFlags & (1 << #HasLinkInfo)
        ReadData(0, @BytelengthL, 4)
        If ByteLengthL > 0
          FileSeek(0, Pos)
          *Buffer = AllocateMemory(ByteLengthL)
          If ReadData(0, *Buffer, ByteLengthL) = ByteLengthL
            *LinkInfo.LinkInfoStr = *Buffer
            Target$ = PeekS(*Buffer + *LinkInfo\LocalBasePathOffset)
            Target$ + PeekS(*Buffer + *LinkInfo\CommonPathSuffixOffset)
          Else
            Target$ = "Error: A fault occured"
          EndIf
          FreeMemory(*Buffer)
        EndIf
      Else
        Target$ = "Error: " + Filename$ + " has no LinkInfo"
      EndIf
      
    EndIf
      
    FreeMemory(*Header)
    CloseFile(0)
  Else
    Target$ = "Error: Was not able to open " + Filename$
  EndIf
  
  ProcedureReturn Target$
  
EndProcedure

Debug GetLinkTarget("Visual Basic 6.0.lnk")

[Andi]

No, not exactly. For a certain executable file (e.g. example.exe), I created a desktop icon and corresponding shortcut. My idea is, that it would be nice to delete the desktop icon and(!) its shortcut by specifying only the name of the exe-file (here: example.exe).

[RASHAD]

Hi

Code: Select all

#SHCNF_PATH              = 1
#SHCNE_DELETE            = 4

Procedure DeleteLink(ExeName$)

Path$ = GetHomeDirectory() + "Desktop\"
LinkName$ = ReplaceString(GetFilePart(ExeName$),"exe","lnk")
SHChangeNotify_(#SHCNE_DELETE, #SHCNF_PATH, LinkName$, #Null)

EndProcedure


DeleteLink("UltraISO.exe")   ;For example

[Andi]

Hi Rashad, thanks for your answer!! Your code worked (I only had to add this line: linkname$ = path$ + linkname$). The icon disappeared from my desktop. But the shortcut, which was connected with it, still works. Is there a way to get rid off it, too?

[RASHAD]

I only tested it with PB 4.61 x86 Win 7 x64
What is your configuration ?

[Andi]

My configuration is: PB 4.61 x86 Windows XP

By the way, it's crazy: The desktop icon has dissappeared after running your code, but the link in the "desktop"-folder still exists. After restarting my computer, the icon can be found on the desktop again.

[RASHAD]

Andi can you tell me where is your link file reside
For XP Documents and settings\all User
or ..................................\Your User Name
And check MSconfig.exe maybe the exe file in RUN cat of the registry

[Andi]

Sorry, Rashad, for my delayed answer, a friend of mine dropped by.

The folder is: "Document and Settings\my user name\desktop". And the file, which icon and shortcut I want to delete, is a self-written exe-file. So it cannot be detected by the msconfig.exe. It's really crazy, the icon disappeared, but the link is still in the desktop-folder, and that's why the shortcut works.

[RASHAD]

OK Andi
Try DeleteFile(Path$+"your exe file.LNK")

BTW : Are you running any protection software like Deep Freeze or Shadow Defender ?