Simple Starter...
Posted: Wed Dec 08, 2010 5:27 pm
I wrote a small program today which is able to create shortcuts to start multiple programs one after the other. I put this now on my wifes notebook, so she will be able to start certain programs easier, e.g. "Internet" only instead of the applications Firefox, Autohotkey and MobileDeviceHandler.
You can download the compiled exe here
The main procedures are these, one for executing files (if program parameters are present) and one for defining them (and building a shortcut file:
These routines (done by some fine forum members and me) are needed:
Some remarks:
• shortcuts seem to allow only 259 chars for the file name and its parameters - therefore I try to "compress" the path of all added programs. If the string would be to long, the list gadget will get a yellow background
• the checkboxes allows to define, if a new instance of a program will be started when it is already running
• anyone improving the code is welcome - just one feature I did not realize: hiding application windows during its start phase
Michael
You can download the compiled exe here
The main procedures are these, one for executing files (if program parameters are present) and one for defining them (and building a shortcut file:
Code: Select all
Procedure ExecuteProgramList()
Protected i,n,x,index
Protected GlobalPath.s,LocalPath.s
Protected WindowX
index=CountProgramParameters()-1
WindowX=#IconBox+(#IconBox+#IconSpace)*index+#IconBorder<<1
#WindowY=#IconBox+#IconBorder<<1
For i=0 To index
LocalPath=ProgramParameter(i)
StartMode(i)=FindString(LocalPath,"*",1)
If StartMode(i)=1
LocalPath=Mid(LocalPath,2)
Else
StartMode(i)=0
EndIf
If PeekC(@LocalPath)='>'
n=PeekC(@LocalPath+#CharLen)-'A'
LocalPath=Mid(LocalPath,3)
If n>=0 And n<i
LocalPath=Zip(n)+LocalPath
EndIf
EndIf
n=FindLastSlash(LocalPath)
Zip(i)=Left(LocalPath,n)
Programs(i)=LocalPath
LoadIcon(LocalPath)
Next i
OpenWindow(#WinExe,0,0,WindowX,#WindowY,#Program,#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
x=#IconBorder
For i=0 To index
TextGadget(i,x,#IconBorder,#IconBox,#IconBox,"",#PB_Text_Border)
TextGadget(i+#MaxList<<1,x+#IconColorFrame,#IconBorder+#IconColorFrame,#IconBox-#IconColorFrame<<1,#IconBox-#IconColorFrame<<1,"")
SetGadgetColor(i,#PB_Gadget_BackColor,#Red)
SetGadgetColor(i+#MaxList<<1,#PB_Gadget_BackColor,#White)
ImageGadget(i+#MaxList,x+#IconFrame+#IconHalf-Icons(i)\X>>1,#IconBorder+#IconFrame+#IconHalf-Icons(i)\Y>>1,#IconSize,#IconSize,Icons(i)\Image)
x+#IconBox+#IconSpace
Next i
StickyWindow(#WinExe,#True)
Wait(500)
For i=0 To index
LocalPath=Programs(i)
If StartMode(i)=0
StartMode(i)=IsNull(ProcessNamePresent(LocalPath))
EndIf
If StartMode(i)
SetCurrentDirectory(GlobalPath)
SetCurrentDirectory(GetPathPart(LocalPath))
RunProgram(GetFilePart(LocalPath))
EndIf
wait(250)
;DisableGadget(i,1)
SetGadgetColor(i,#PB_Gadget_BackColor,#Green)
SetGadgetColor(i+#MaxList+#MaxList,#PB_Gadget_BackColor,#White)
SetGadgetState(i+#MaxList,Icons(i)\Image)
wait(750)
Next i
wait(2000)
EndProcedure
Procedure DefineProgramList()
Protected i,event
Protected information.s
Protected parameter.s
Protected text.s
#Border=10
#Gap=10
#DefHeight=180
#InfoTop=#DefHeight+#Border+#Gap>>1
#InfoHeight=20
#ButHeight=25
#ButTop=#Border+#DefHeight+#Gap<<1+#InfoHeight
WinDef=OpenWindow(#WinDef,0,0,480,#DefHeight+#Border<<1+#InfoHeight+#Gap<<1+#ButHeight,#Program+" - Configuration",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
TextGadget(#DefName,10,#InfoTop,70,#InfoHeight,"Information:",#SS_CENTERIMAGE)
StringGadget(#DefInfo,80,#InfoTop,390,#InfoHeight,#Program)
ListIconGadget(#DefList,10,#Border,460,#DefHeight,"Program",136,#PB_ListIcon_CheckBoxes|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection )
AddGadgetColumn(#DefList,1,"Path",320)
ButtonGadget(#DefAdd,10,#ButTop,100,#ButHeight,"Add",#PB_Button_Default)
ButtonGadget(#DefDel,130,#ButTop,100,#ButHeight,"Del")
ButtonGadget(#DefCreate,250,#ButTop,100,#ButHeight,"Create Batch")
ButtonGadget(#DefCancel,370,#ButTop,100,#ButHeight,"Cancel")
DisableGadget(#DefDel,#True)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Alt|#PB_Shortcut_A,#DefAdd)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Alt|#PB_Shortcut_B,#DefCreate)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Alt|#PB_Shortcut_C,#DefCancel)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Escape,#DefCancel)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Alt|#PB_Shortcut_D,#DefDel)
AddKeyboardShortcut(#WinDef,#PB_Shortcut_Shift|#PB_Shortcut_Delete,#DefDel)
Repeat
i=CountGadgetItems(#DefList)
DisableGadget(#DefCreate,IsNull(i))
DisableGadget(#DefDel,IsNull(GetGadgetState(#DefList)+1))
DisableGadget(#DefAdd,IsNull(i-#MaxList))
event=WaitWindowEvent()
Select event
Case #PB_Event_Menu
event=EventMenu()
If GetGadgetEnabledState(event)
PostMessage_(WinDef,#PB_Event_Gadget,#PB_Shortcut_SrodFlag|event,0)
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #DefAdd
Program=OpenFileRequester("Add Program File","","Program Files (*com, *.exe)|*.com;*.exe|Shortcut Files (*.lnk)|*.lnk|Batch Files (*.bat, *.cmd)|*.bat;*.cmd|Executable Files|*.com;*.exe;*.lnk;*.bat;*.cmd|All Files (*.*)|*.*",0)
If Len(Program)
Path=GetPathPart(Program)
Program=GetFilePart(Program)
AddGadgetItem(#DefList,#LastPosition,Program+#LF$+Path)
SetActiveGadget(#DefList)
SetListColor()
EndIf
Case #DefDel
RemoveGadgetItem(#DefList,GetGadgetState(#DefList))
SetListColor()
Case #DefCreate
Program=OpenFileRequester("Create Shortcut File","","Shortcut Files (*.lnk)|*.lnk|All Files (*.*)|*.*",0)
If Len(Program)
If LCase(Right(Program,4))<>".lnk"
Program+".lnk"
EndIf
CreateShellLink(Quoter(ProgramFilename()),Program,CreateParameter(),GetGadgetText(#DefInfo),GetPathPart(ProgramFilename()),#WM_SHOWWINDOW,0,ProgramFilename(),0)
EndIf
Case #DefCancel
Break
EndSelect
Case #WM_CLOSE
Break
EndSelect
ForEver
EndProcedure
If CountProgramParameters()
ExecuteProgramList()
Else
DefineProgramList()
EndIf
Code: Select all
; Define
EnableExplicit
#Program="Bashful Bat"
#LastPosition=-#True
#PB_Shortcut_SrodFlag=1<<16
#MaxList=3
#IconSize=64
#IconHalf=32
#IconColorFrame=4
#IconWhiteFrame=1
#IconFrame=#IconColorFrame+#IconWhiteFrame
#IconBox=#IconSize+#IconFrame<<1
#IconBorder=20
#IconSpace=16
Enumeration
#WinExe
#WinDef
#DefName
#DefInfo
#DefList
#DefAdd
#DefDel
#DefCreate
#DefCancel
EndEnumeration
Global Program.s
Global Path.s
Global WinDef
Structure IconType
Image.l
X.l
Y.l
EndStructure
Global Dim Zip.s(#MaxList)
Global Dim Programs.s(#MaxList)
Global Dim StartMode(#MaxList)
Global Dim Icons.IconType(#MaxList)
Global NewList Icon_List.i()
Global IconCount
; EndDefine
Procedure IsNull(value)
If value
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure GetGadgetEnabledState(Gadget)
ProcedureReturn IsWindowEnabled_(GadgetID(Gadget))
;ProcedureReturn GetWindowLong_(GadgetID(Gadget),#GWL_STYLE)&#WS_DISABLED
EndProcedure
Procedure CreateShellLink(Prog.s,Link.s,Args.s,Info.s,Dir.s,Show.l,HotKey.l,Icon.s,IconNr.l)
; CreateLink
; Prog for the Link "c:\PureBasic\purebasic.exe"
; Link name of the Link "c:\pb.lnk"
; Args for the target "%1"
; Info Description & Tooltip "Start PureBasic"
; Dir Working Directory "c:\PureBasic\"
; Show Show Flags #SW_SHOWNORMAL, #SW_SHOWMAXIMIZED, #SW_SHOWMINIMIZED
; HotKey Shortcut ?
; Icon/Nr Icon file & Index "c:\PureBasic\purebasic.exe",1
Protected mem.s
Protected hres
Protected result
Protected ppf.IPersistFile
CompilerIf #PB_Compiler_Unicode
#CharLen=2
Protected psl.IShellLinkW
CompilerElse
#CharLen=1
Protected psl.IShellLinkA
CompilerEndIf
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl)=0
; Set_ShellLink_preferences
psl\SetPath(Prog); 4.4x: @Prog the file to which is linked (target for the Link)
psl\SetArguments(Args); 4.4x: @Args Arguments for the Target
psl\SetWorkingDirectory(Dir); 4.4x: @Dir Working Directory
psl\SetDescription(Info); 4.4x: @Info Description (also used as Tooltip for the Link)
psl\SetShowCmd(Show); Show command (default=SW_SHOWNORMAL, SW_SHOWMAXIMIZED, SW_SHOWMINIMIZED)
psl\SetHotkey(HotKey); Hotkey (Virtual key code in low-order byte, modifier in the high-order byte)
; HOTKEYF_ALT, HOTKEYF_CONTROL, HOTKEYF_EXT, HOTKEYF_SHIFT
psl\SetIconLocation(Icon,IconNr); 4.4x: @Icon Icon file and index number of the icon
; ShellLink_Save
; Query IShellLink For the IPersistFile interface For saving the shortcut in persistent storage.
If psl\QueryInterface(?IID_IPersistFile,@ppf)=0
;CompilerIf #PB_Compiler_Unicode=0
;mem=Space(1000); AllocateMemory(1,1000)
;MultiByteToWideChar_(#CP_ACP,0,Link,-1,mem,1000); Ensure that the string is Unicode.
;hres=ppf\Save(mem,#True); 4.4x: @mem Save the link by calling IPersistFile::Save.
;CompilerElse
hres=ppf\Save(Link,#True); 4.4x: @mem Save the link by calling IPersistFile::Save.
;CompilerEndIf
ppf\Release()
result=#True
EndIf
psl\Release()
EndIf
CoUninitialize_()
ProcedureReturn result
DataSection
CLSID_ShellLink:
; 00021401-0000-0000-C000-000000000046
Data.l $00021401
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IShellLink:
; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0);
; C000-000000000046
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:
; 0000010b-0000-0000-C000-000000000046
Data.l $0000010b
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
EndProcedure
Procedure.s ProcessNameFromHwnd(hwnd)
Protected processid.l,psapilib.l
Protected GetModuleFileNameEx,hprocess.l
Protected processname.s
psapilib=OpenLibrary(#PB_Any,"psapi.dll")
If psapilib
CompilerIf #PB_Compiler_Unicode
GetModuleFileNameEx=GetFunction(psapilib,"GetModuleFileNameExW")
CompilerElse
GetModuleFileNameEx=GetFunction(psapilib,"GetModuleFileNameExA")
CompilerEndIf
If GetModuleFileNameEx
If GetWindowThreadProcessId_(hwnd,@processid)
hprocess=OpenProcess_(#PROCESS_QUERY_INFORMATION|#PROCESS_VM_READ,#Null,processid)
If hprocess
processname=Space(#MAX_PATH)
If Not CallFunctionFast(GetModuleFileNameEx,hprocess,#Null,@processname,#MAX_PATH)
processname=""
EndIf
CloseHandle_(hprocess)
EndIf
EndIf
EndIf
CloseLibrary(psapilib)
EndIf
ProcedureReturn processname
EndProcedure
Procedure ProcessNamePresent(process.s)
Protected handle=FindWindow_(0,0)
Protected PID.l
process=LCase(GetFilePart(process))
handle=GetWindow_(handle,#GW_HWNDFIRST)
While handle
GetWindowThreadProcessId_(handle,@PID)
If LCase(GetFilePart(ProcessNameFromHwnd(handle)))=process
ProcedureReturn #True
EndIf
handle=GetWindow_(handle,#GW_HWNDNEXT)
Wend
ProcedureReturn #False
EndProcedure
Procedure.i Enum_IconList(ResHandle.i,ResType.i,ResName.i,AppParam.i)
AddElement(Icon_List())
Icon_List()=ResName
ProcedureReturn #True
EndProcedure
Procedure.i Enum_IconType(ResHandle.i,ResType.i,AppParam.i)
If ResType=#RT_GROUP_ICON
EnumResourceNames_(ResHandle,ResType,@Enum_IconList(),0)
EndIf
ProcedureReturn #True
EndProcedure
Procedure LoadIcon(IconFile.s)
Global Icon_Lib.i
Global Icon_Count.i
Global *Icon_Group.GRPIconDIR
Global *Icon_Image.IconIMAGE
Protected n,saven,m,maxm
Icon_Lib=LoadLibraryEx_(@IconFile,0,#LOAD_LIBRARY_AS_DATAFILE)
If Icon_Lib
EnumResourceTypes_(Icon_Lib,@Enum_IconType(),0)
EndIf
ForEach Icon_List()
*Icon_Group=LoadResource_(Icon_Lib,FindResource_(Icon_Lib,Icon_List(),#RT_GROUP_ICON))
If *Icon_Group
maxm=0
saven=0
For n=0 To *Icon_Group\idCount-1
m=*Icon_Group\idEntries[n]\bWidth
If (m>maxm) And (m<=#IconSize)
saven=n
maxm=m
EndIf
Next n
*Icon_Image=LoadResource_(Icon_Lib,FindResource_(Icon_Lib,*Icon_Group\idEntries[saven]\nID,#RT_ICON))
With Icons(IconCount)
\Image=CreateIconFromResourceEx_(*Icon_Image,*Icon_Image\icHeader\biBitCount,#True,$00030000,maxm,*Icon_Group\idEntries[saven]\bHeight,0)
\X=maxm
\Y=*Icon_Group\idEntries[saven]\bHeight
;DestroyIcon_(\Image)
EndWith
IconCount+1
Break
EndIf
Next
EndProcedure
Procedure.l FindLastSlash(s.s)
Protected p=Len(s)
While p
p-1
If PeekA(@s+p)='\'
ProcedureReturn p+1
EndIf
Wend
ProcedureReturn 0
EndProcedure
Procedure.s Quoter(text.s)
If FindString(text," ",1)
ProcedureReturn #DQUOTE$+text+#DQUOTE$
Else
ProcedureReturn text
EndIf
EndProcedure
Procedure.i EqualPathLen(s1.s,s2.s)
; -- return length of identical part of the paths in s1$ and s2$
Protected maxEqual, temp, equal, ret
Protected *p1.Character, *p2.Character
#Slash='\'
#BadSlash='/'
s1=UCase(s1)
s2=UCase(s2)
maxEqual=Len(s1)
temp=Len(s2)
If maxEqual > temp
maxEqual=temp
EndIf
*p1=@s1
*p2=@s2
equal=0
ret=0
While equal < maxEqual And *p1\c=*p2\c
equal + 1
If *p1\c=#Slash
ret=equal
EndIf
*p1 + SizeOf(character)
*p2 + SizeOf(character)
Wend
ProcedureReturn ret
EndProcedure
Procedure.s RelativePath(baseDir.s,absPath.s)
; -- convert an absolute path to a relative one
; in : baseDir$: full name of a directory, with trailing (back)slash
; absPath$: full name of a path to a directory or file
; out: absPath$ converted, so that it is relative to baseDir$
Protected equal,s,i
Protected parent.s,ret.s=""
If UCase(Left(baseDir,1)) <> UCase(Left(absPath,1))
ProcedureReturn absPath; can't build a relative path
EndIf
ReplaceString(baseDir,Chr(#BadSlash),Chr(#Slash),#PB_String_InPlace)
ReplaceString(absPath,Chr(#BadSlash),Chr(#Slash),#PB_String_InPlace)
equal=EqualPathLen(baseDir,absPath)
s=CountString(Mid(baseDir,equal+1),Chr(#Slash))
parent=".."+Chr(#Slash)
For i=1 To s
ret+parent
Next
ProcedureReturn ret+Mid(absPath,equal+1)
EndProcedure
Procedure.s CompactPath(index,main.s,new.s)
Protected samedrive
Protected i,n,best,bestlen
If Mid(new,2,1)=":" And (Left(new,2)=Left(main,2))
samedrive=#True
EndIf
If CountString(new,"\")=1 And samedrive
Zip(index)="*"
ProcedureReturn Mid(new,3)
Else
main=RelativePath(main,new)
If samedrive
new=Mid(new,3)
EndIf
If Len(main)<Len(new)
new=main
EndIf
i=index
best=-1
bestlen=#MAXLONG
While i>0
i-1
n=Len(Zip(i))
If Left(new,n)=Zip(i)
If (best=-1) Or (n>bestlen)
best=i
bestlen=n
EndIf
EndIf
Wend
If best=-1
n=FindLastSlash(new)
If n
Debug Left(new,n)
Zip(index)=Left(new,n)
Else
Zip(index)="*"
EndIf
Else
new=">"+Chr(best+'A')+Mid(new,bestlen+1)
n=FindLastSlash(new)
If n
Zip(index)=Zip(best)+Mid(new,3,n-2)
Else
Zip(index)="*"
EndIf
EndIf
ProcedureReturn new
EndIf
EndProcedure
Procedure.s CreateParameter()
Protected i
Protected parameter.s
i=0
parameter=""
While i<CountGadgetItems(#DefList)
parameter+" "+Quoter(Mid("*"+CompactPath(i,GetPathPart(ProgramFilename()),GetGadgetItemText(#DefList,i,1)+GetGadgetItemText(#DefList,i,0)),2-(GetGadgetItemState(#DefList,i)&#PB_ListIcon_Checked)>>1))
i+1
Wend
ProcedureReturn parameter
EndProcedure
Procedure SetListColor()
If Len(Quoter(ProgramFilename())+CreateParameter())>=258
SetGadgetColor(#DefList,#PB_Gadget_BackColor,#Yellow)
Else
SetGadgetColor(#DefList,#PB_Gadget_BackColor,#White)
EndIf
EndProcedure
Procedure Wait(ms)
ms+ElapsedMilliseconds()
Repeat
WaitWindowEvent(5)
Until ElapsedMilliseconds()>ms
EndProcedure
• shortcuts seem to allow only 259 chars for the file name and its parameters - therefore I try to "compress" the path of all added programs. If the string would be to long, the list gadget will get a yellow background
• the checkboxes allows to define, if a new instance of a program will be started when it is already running
• anyone improving the code is welcome - just one feature I did not realize: hiding application windows during its start phase
Michael
If not, just add all features you need and post them 
