Scripting a Popup Shortcut » Forum Post by DJConnor

SirSmiley

Join Date 06/2005

+38

Depending on what your doing, why not use the "shortcut" object type?

Under the General tab select change beside "Object Type"
Choose shortcut in drop list box
Choose Folder
Check the Menu Location

Successfully updated karma reason!

Thanks for the suggestion, however that doesn't seem to work for my application:

"I would use the object properties for this except that I don't want the object to react as a shortcut every time files are dragged to it."

-Let's say that you were creating an object titled "Drop Files Here to Create a Shortcut". The first time a file or folder was dropped ont the object its path is used to set the object's shortcut. After that you want the object to act as a shortcut to that file or folder using the popup folder.

If you use the "shortcut" object type it acts as a shortcut all the time, even if you set the shortcut path to "" it will default to "My Computer". The first time you drop a file on the object it gets sent to the defalut shortcut. This sets up an interesting Catch 22 situation; the object shortcut was set with path of the file when it was dropped but the object moved the file to the object's default path then set the object path to where the file used to be so the new shortcut is always invalid.

Would you know of any way to set the "object type" from the script?

-Dave-

Successfully updated karma reason!

sViz

Join Date 04/2006

+508

I think you'd have to create your own r-click menu listing the contents of the target folder.

The basic concept is to drag and drop a folder, get the contents of the folder, put them in an array, and use the array to build a custom r-click menu.

I was working on something similar, and I think with a little tweaking it could be achieved.

Successfully updated karma reason!

sViz

Join Date 04/2006

+508

Alrighty, this was pieced together from some of scripts I've saved. This goes into the one object. It will take one file or folder. If it's a file it'll open it on l-click. If it's a folder it will show a pop-up menu on l-click.

Code: vbscript
Dim fso, fname(), fpath()
'Called when the script is executed
Sub Object_OnScriptEnter
	Set fso = CreateObject("Scripting.FileSystemObject")
End Sub
'Called when the script is terminated
Sub Object_OnScriptExit
End Sub
'Called when files are dropped onto object
Sub Object_OnDropFiles(files)
	'Get the first file dropped
	If Instr(files, "|") > 0 Then
		fArray = Split(files, "|")
		f1 = LBound(fArray)
	Else
		f1 = files
	End If
	'If folder, call function to get contents
	If fso.GetExtensionName(f1) = "" Then
		Object.ToolTipText = fso.GetBaseName(f1)'--Set tooltip to foldername
		GetFolderContents(f1)
	'If file, set arrays, tooltip to file name
	Else
		ReDim Preserve fname(0), fpath(0)
		fname(0) = fso.GetBaseName(f1)
		Object.ToolTipText = fso.GetBaseName(f1)
		fpath(0) = f1
	End If
End Sub
Function GetFolderContents(fldr)
	ReDim fname(-1), fpath(-1)
	Set f = fso.GetFolder(fldr)
	Set fl = f.Subfolders
	Set fi = f.files
	'--Get subfolders
	For Each elem In fl
		ReDim Preserve fname(UBound(fname)+1)
		ReDim Preserve fpath(UBound(fpath)+1)
		fname(UBound(fname)) = fso.GetFileName(elem)
		fpath(UBound(fpath)) = fso.GetAbsolutePathName(elem)
	Next
	'--Get files
	For Each elem In fi
		ReDim Preserve fname(UBound(fname)+1)
		fname(UBound(fname)) = fso.GetFileName(elem)
		ReDim Preserve fpath(UBound(fpath)+1)
		fpath(UBound(fpath)) = fso.GetAbsolutePathName(elem)
	Next
End Function
Function Object_OnLButtonUpEx(obj,x,y,dragged) 
  If Not dragged Then 
  	'--If folder, show pop up menu
  	If UBound(fname) > 0 Then           
    	Call CreateSectionMenu()
    '--If file, open file      
    Else
    	On Error Resume Next   
			Set Sh = CreateObject("WScript.Shell")
			target = fpath(0) 
			Sh.Run (Chr(34)& target & Chr(34))
			Set Sh = Nothing
    End If
  End If
End Function
Sub CreateSectionMenu() 
     Set mainmenu = nothing
     Set mainmenu = DesktopX.CreatePopupMenu     
     Set submenu= DesktopX.CreatePopupMenu
     For x = 0 To UBound(fname)
    	 mainmenu.AppendMenu 0, x+1, fname(x)   
   	Next
     result = mainmenu.TrackPopupMenu(0, System.CursorX, System.CursorY) 
     Call ExecuteSectionMenu(result,snum)     
End Sub
Sub ExecuteSectionMenu(result,snum)
	If result > 0 Then
   	On Error Resume Next   
		Set Sh = CreateObject("WScript.Shell")
		target = fpath(result-1) 
		Sh.Run (Chr(34)& target & Chr(34))
		Set Sh = Nothing
	End If
End Sub

Let me know if this is what you're looking for.

Successfully updated karma reason!

ZubaZ

Join Date 11/2001

+917

Cool!

Successfully updated karma reason!

sViz

Join Date 04/2006

+508

Thanks, Zubaz.

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

Cool!

Yes, yes she is!

Um you might want to add a line under the Left Click Function
in order to suppress a subscript error if no item has been dropped.

Like This

Code: vbscript
Function Object_OnLButtonUpEx(obj,x,y,dragged)
If Not dragged Then
On Error Resume Next  'Add here
'--If folder, show pop up menu
If UBound(fname) > 0 Then
Call CreateSectionMenu()
'--If file, open file
Else
On Error Resume Next
Set Sh = CreateObject("WScript.Shell")
target = fpath(0)
Sh.Run (Chr(34)& target & Chr(34))
Set Sh = Nothing
End If
End If
End Function

If your heart is set on the same menu style as the default folder menu's then I have an idea but, it would involve three objects.

Successfully updated karma reason!

sViz

Join Date 04/2006

+508

you might want to add a line under the Left Click Function

Perfect! Thanks SirS.

Successfully updated karma reason!

Wow, thanks everybody. This is really good stuff.

sViz, thanks for the fso script, that gives me an idea....

SirSmiley, yes, I am somewhat attached to the to the default folder menu since it allows for a unique browsing experience -the folders show up as folder icons and open automatically on mouse over. What is your idea?

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

Okay, here goes.

Create three objects called objBase, objFile, objFolder respectively.
objFile should be set up as a file shortcut object.
objFolder should be set up as a Folder Shortcut Object. *Make sure you check the menu option.

Set objFile & objFolder as child objects of objBase and set both to not visible. Everything will be controlled from the main script in the base object.

Here's the script.

Code: vbscript
Const oBase = "objBase"
Const oFile = "objFile"
Const oFldr = "objFolder"
'1 for File|2 for Folder
Dim oCommand
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Called when a file is dropped onto object
Function Object_OnDropFiles(files)
	'Makes sure only one file or folder is dropped
	If Instr(files, "|") = 0 Then
		If oFSO.GetExtensionName(files) = "" Then
			DesktopX.Object(oFldr).Command=files
			oCommand=2
		Else
			DesktopX.Object(oFile).Command=files
			oCommand=1
		End If
	Else
	msgbox "You must drop only 1 file or folder"
	End If
End Function
Function Object_OnLButtonUpEx(obj,x,y,dragged)
If Not dragged Then
	If oCommand="" Then
		msgbox "Please drop a file or folder first"
	'Excutes objFile Command
	ElseIf oCommand = 1 Then
		DesktopX.Object(oFile).ExecuteCommand		
	'Executes objFolder Command
	ElseIf oCommand = 2 Then
		DesktopX.Object(oFldr).ExecuteCommand
	End If
End If
End Function

Successfully updated karma reason!

ZubaZ

Join Date 11/2001

+917

I'll bet that if I paid more attention I could learn a bunch. Until then . . I'l just copy and paste what I need.

Thanks for the effort all. It rocks how the DX (sub) community shares knowledge.

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

I'll bet that if I paid more attention I could learn a bunch.

Same here!

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

Oh, I forgot one thing. Before I went away last week I made a drop script based menu bar for my usb drive.

The above script doesn't work when compiled to a gadget; so, I'm not sure how it will work in widgets or themes. I used an ini file but, persiststorage most likely will be the easiest way.

Here's a script that uses persiststorage. Notice the additional function.

Code: vbscript
Const oBase = "objBase"
Const oFile = "objFile"
Const oFldr = "objFolder"
'1 for File|2 for Folder
Dim oCommand
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Called when a file is dropped onto object
Function Object_OnDropFiles(files)
	'Makes sure only one file or folder is dropped
	If Instr(files, "|") = 0 Then
		'Saves dropped file/folder into a persist storage variable
		Object.PersistStorage("objShortcut") = files
	Else
	msgbox "You must drop only 1 file or folder"
	End If
	Call filefldrCheck
End Function
Function filefldrCheck
	'Loads "objShortuct" Persist Storage variable
	oShorcut=Object.PersistStorage("objShortcut") 
		If oFSO.GetExtensionName(oShorcut) = "" Then
			DesktopX.Object(oFldr).Command=oShorcut
			DesktopX.Object(oBase).ToolTipText=oFSO.GetBaseName(oShorcut)
			oCommand=2
		Else
			DesktopX.Object(oFile).Command=oShorcut
			DesktopX.Object(oBase).ToolTipText=oFSO.GetBaseName(oShorcut)
			oCommand=1
		End If
End Function
Function Object_OnLButtonUpEx(obj,x,y,dragged)
If Not dragged Then
	If oCommand="" Then
		msgbox "Please drop a file or folder first"
	'Excutes objFile Command
	ElseIf oCommand = 1 Then
		DesktopX.Object(oFile).ExecuteCommand		
	'Executes objFolder Command
	ElseIf oCommand = 2 Then
		DesktopX.Object(oFldr).ExecuteCommand
	End If
End If
End Function

Successfully updated karma reason!

ZubaZ

Join Date 11/2001

+917

I'll bet that if I paid more attention I could learn a bunch.

Same here

Ummm . . dude . . I was talking about learnign from you too.

Successfully updated karma reason!

sViz

Join Date 04/2006

+508

Too cool, SirS. I was having some trouble setting the correct folder location OnDrop because the target was originally set to one of the preset folders. After I browsed for and set it to a different location it worked perfectly. This script is a keeper!

It rocks how the DX (sub) community shares knowledge.

Agreed! I learn something new everyday. Gotta love this place.

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

Yeah, I've got everyone fooled!

It looks complex but, if you've worked with statements/formulas in Excel it's just a matter of finding things in the DesktopX Documentation and the WSH SDK Help File.

Edit: SViz, yeah I had that problem with the menu bar gadget. Probably best to set the command object to a null value in the Exit Script if it appears again.

Oh! One more thing if you're using the Persist Storage Script then maybe put the Call filefldrCheck into the OnScriptEnter Sub.

Successfully updated karma reason!

HAPTORK

Join Date 09/2006

+35

Really Nice Scripts.

Successfully updated karma reason!

Again, Wow! Thanks for all the help, I'm learning a lot.

SirSmiley, This is very close to the approach I tried except that I had no File System Object script (this is much neater) and I only used a foder object child (didn't think about the file shortcut being different) and I did a poor job at checking for errors ...and it took me a month to figure out. Other than that it's identical

Now for the tricky part: Lets say that after you drop a folder the object goes from "Drop Files Here to Create a Shortcut" to "I am a shortcut to the folder you just dropped on me" and now allows drag and drop to the shortcut set in "objFldr". Since the object is a child of "objBase", files that are dropped on the parent don't make it to the child. Is there a way to either pass the dropped file through to the child or promote the child to the parent?

Thanks,

-Dave-

Successfully updated karma reason!

SirSmiley

Join Date 06/2005

+38

Was about to say you really don't need the file object but, then it sort of depends on your needs. If you want to use command parameters it makes it simple but, that can also be scripted.

To answer your question really depends on a few things but, I'm assuming you want the ability for the shortcut to be dynamic? So, I scripted that into a right click function.
You need to set the objFldr object Activation to visible area and set the transparency to 0 then still set visibility to no and make sure it's the same size as the base object.

Oh, last night I scripted in the ability to change the base object to a png or ico image. You should also note that this script doesn't clean out persist storage cache;so, if you reset it then don't drop anything it will call the settings on the next load.

Code: vbscript
Const oBase = "objBase"
Const oFile = "objFile"
Const oFldr = "objFolder"
'1 for File|2 for Folder
Dim oCommand
'Object.Command and Object.CommandParams
'Object.ExecuteCommand
'Object.PersistStorage
'Object.Command = "c:\program files\Internet Explorer\iexplore.exe"
'Object.CommandParams = "https://www.wincustomize.com"
'Called when a file is dropped onto object
Function Object_OnDropFiles(files)
	'Makes sure only one file or folder is dropped
	If Instr(files, "|") = 0 Then
		Set oFSO = CreateObject("Scripting.FileSystemObject")
		'Checks to see if dropped item is an image file for the icon
		oDropItem=oFSO.GetExtensionName(files)
		If oDropItem = "ico" Or oDropItem = "png" Then
			DesktopX.Object(oBase).Picture = files
			Object.PersistStorage("objIcon")=files
		Else
		'Saves dropped file/folder into a persist storage variable
		Object.PersistStorage("objShortcut") = files
		End If
	Else
	msgbox "You must drop only 1 file or folder"
	End If
	Call filefldrCheck
End Function
'Called on Left Click Up
Function Object_OnLButtonUpEx(obj,x,y,dragged)
If Not dragged Then
	Select Case obj.name
		Case "oBase"
			If oCommand="" Then
				msgbox "Please drop a file or folder first"
			'Excutes objFile Command
			ElseIf oCommand = 1 Then
				DesktopX.Object(oFile).ExecuteCommand		
			'Executes objFolder Command
			ElseIf oCommand = 2 Then
				DesktopX.Object(oFldr).ExecuteCommand
			End If
	End Select
End If
End Function
' Called on Right Click up
Function Object_OnRButtonUpEx(obj,x,y,dragged)
If Not dragged Then
	Select Case obj.name
		Case oFldr
			Call resetSettings
	End Select
End If
End Function
Function filefldrCheck
	DesktopX.Object(oBase).Picture=Object.PersistStorage("objIcon")
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	'Loads "objShortuct" Persist Storage variable
	oShorcut=Object.PersistStorage("objShortcut")
	oIcon=Object.PersistStorage("objIcon")
	If oIcon="" Then oIcon="red.png" 
	DesktopX.Object(oBase).Picture=oIcon
		If oFSO.GetExtensionName(oShorcut) = "" Then
			DesktopX.Object(oFldr).Command=oShorcut
			DesktopX.Object(oBase).ToolTipText=oFSO.GetBaseName(oShorcut)
			oCommand=2
		Else
			DesktopX.Object(oFile).Command=oShorcut
			DesktopX.Object(oBase).ToolTipText=oFSO.GetBaseName(oShorcut)
			oCommand=1
	End If
	If oCommand = 2 Then
	DesktopX.Object(oFldr).Visible = True
	DesktopX.Object(oFldr).OnTop
	Exit Function
	End If
	Set oFSO = nothing
End Function
'Called when the script is executed
Sub Object_OnScriptEnter
Call filefldrCheck
End Sub
'Cleans up items when executed
Sub cleanup
	With DesktopX 
		.Object(oFldr).Command=""
		.Object(oFile).Command=""
		.Object(oBase).ToolTipText=""
		.Object(oBase).Picture="red.png"	'This should be your default image
		.Object(oFldr).Visible = False 
	End With
End Sub
'Resets & Clears settings when executed
Sub resetSettings
DesktopX.Object(oFldr).Visible = False
DesktopX.Object(oBase).Picture="red.png"	'This should be your default image
oCommand=""
Object.PersistStorage("objIcon")=""
Object.PersistStorage("objShortcut") = ""
End Sub
'Called when the script is terminated
Sub Object_OnScriptExit
Call cleanup
End Sub

Successfully updated karma reason!

RomanDA

Join Date 12/2003

+147

you all are doing some great stuff here.. love it!

Successfully updated karma reason!

I believe there is a typographcial error in the Case statement for the left click function above:

Case "oBase"

The quotes refer to a variable rather than the literal expression. Removing the quotes allows the left click to function properly:

Case oBase

-Dave-

Successfully updated karma reason!