Page 1 of 2
Create Desktop Shortcuts (Windows)
Posted: Thu Dec 02, 2010 3:27 am
by 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")
Re: Create Desktop Shortcuts (Windows)
Posted: Thu Dec 02, 2010 9:33 pm
by 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
Re: Create Desktop Shortcuts (Windows)
Posted: Thu Dec 02, 2010 9:56 pm
by 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
Re: Create Desktop Shortcuts (Windows)
Posted: Thu Dec 02, 2010 10:25 pm
by utopiomania
It works as advertised, RASHAD.
Re: Create Desktop Shortcuts (Windows)
Posted: Thu Dec 02, 2010 10:36 pm
by 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.
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 11:50 am
by Andi
Is there an easy way to do the opposite, i. e. to delete desktop icons and shortcuts respectively?
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 1:20 pm
by 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")
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 1:56 pm
by 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).
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 2:53 pm
by 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
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 4:02 pm
by 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?
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 4:07 pm
by RASHAD
I only tested it with PB 4.61 x86 Win 7 x64
What is your configuration ?
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 4:21 pm
by 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.
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 4:56 pm
by 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
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 6:50 pm
by 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.
Re: Create Desktop Shortcuts (Windows)
Posted: Fri Sep 28, 2012 7:43 pm
by RASHAD
OK Andi
Try DeleteFile(Path$+"your exe file.LNK")
BTW : Are you running any protection software like Deep Freeze or Shadow Defender ?