Drag and Drop in Internet Explorer
MarceepooNu
drop" capable, so that a user could drag files (from Windows Explorer, e.g.,
WinXP, Win Vista and Win7) onto the HTA page, in order to get the file's
FullName (path + name) pushed into a variable?
I found an example of "drag and drop" HTA, that enables me to harvest some
useful info about Web pages (i.e., URLname and LOCATIONname) that I drag onto
my HTA file (below). In the example below, that info is announced in a
message box.
But I can't figure out how to modify the HTA, so that I could drag a file
from Windows Explorer onto the HTA, and get the file's FullName (path + name)
into the message box. Any suggestions (sample code (?) and hopefully
direction to where I could learn more about this) would be much appreciated.
Issue No. 2. Lastly, (returning to the URL and LOcationName) harvesting), I
have the impression that it would be possible to alter the script so that the
"drag and drop" would harvest more info about the web pages (e.g., "title"
and I don't know what the other "attributes" (?), "properties (?) are, or
where to find a list of them).
Any suggestions (sample code (?) and hopefully direction to where I could
learn more about getting info about web pages through vbscript) would be much
appreciated.
I posted another copy at the HTA at this URL (in case that makes it easier
for someone to see what I posted below):
.. .
http://theadhdsolution.net//publicmisc/DragAndDrogUsingVbScript_MarcAttempt02.hta
Thanks for your time and effort. It is always much appreciated.
Marc
p.s. Here's the HTA....
<html>
<head>
<title>Drag and Drop, dataTransfer.getData("URL")</title>
<style>
#divTarget {
position: absolute;
left: 50px;
width: 200px;
height: 200px;
background-color: yellow}
</style>
<HTA:APPLICATION
APPLICATIONNAME="Drag and Drop, dataTransfer.getData("URL")"
ID="DragandDropDataTransferGetdata"
VERSION="1.0"/>
</head>
<script language="VBScript">
FullName = replace(DragandDropDataTransferGetdata.commandLine,chr(34),"")
arrFN=split(FullName,"\")
FileName = Trim(arrFN(ubound(arrFN)))
SourceDir=replace(FullName,FileName,"")
Sub Window_OnLoad
'This method will be called when the application loads
'Add your code here
End Sub
Sub subRarCpyThisPrgFile2Pdrv
Dim sHtaPrgFullName
Dim sThisHtaFullNam
Dim sThisHtaFileName
Dim sCmdLine
Dim sRarCopyScriptFullName
Dim sArgFullNameOfFil2bBakdUp
Dim oFSO
Const LOCAL_BACKUPDIR = "L"
Const SVR6_BACKUPDIR = "SVR6"
Const SCRIPT_TYPE = "VBS"
Set oFSO = CreateObject("Scripting.FileSystemObject")
'http://gallery.technet.microsoft.com/ScriptCenter/de-de/7a7f9937-0c6f-4f1e-a953-d29e47b2f5d5 ''''''''
sThisHtaFullName = Trim(FullName)' "\\svr6\Data1\data\_Shtcuts\Toolbar
links\A\A_HtaReplacment\ToolbarA_replacement.aaa.hta"
sThisHtaFileName = Trim(oFSO.GetFileName(sThisPrgFullName))
sThisPrgFullName = sThisHtaFullName
If Len(sThisHtaFullName) > 5 Then
sThisPrgFullName = sThisHtaFullName
Else
sThisPrgFullName = WScript.ScriptFullName
End If
sRarCopyScriptFullName =
"K:\data\Programs\HtaPrgs\Vbs.RarCpyBakupSelected.file.namedArgs.aaa.vbs"
sArgFullNameOfFil2bBakdUp = "/FulNameOfFil2bBakdUp:" & Chr(34) &
sThisPrgFullName & Chr(34)
' sArgFullNameOfArcFile = "/RarArcFilPath:" & Chr(34) &
"P:\Data\VB\HTML_MarcsPrgs\ItWorks\" '& sThisHtaFileName & Chr(34)
sArgPathOfArcFile = "/RarArcFilPath:" & chr(34) &
"\\svr6\D\Data\VB\HTML_MarcsPrgs\ItWorks_Hta\" & chr(34)'& _
' sThisHtaFileName & ".rar" & Chr(34)
' sCmdLine = "wscript " & Chr(34) & sRarCopyScriptFullName & Chr(34) & " " &
sArgFullNameOfFil2bBakdUp & Chr(34) & _
' sThisHtaFullName & Chr(34) & " " & sArgFullNameOfArcFile
sCmdLine = "wscript " & Chr(34) & sRarCopyScriptFullName & Chr(34) & " " &
sArgFullNameOfFil2bBakdUp & _
" " & sArgPathOfArcFile
' MsgBox sCmdline
Set objShell = CreateObject("Wscript.Shell")
objShell.Run sCmdline '"notepad.exe c:\scripts\test.txt"
End Sub
Function fnDrop
Dim strRetVal
strRetVal = window.event.dataTransfer.getData("URL")
MsgBox strRetVal
subRarCpyThisPrgFile2Pdrv
End Function '* fnDrop
Function cancelEvent
window.event.returnValue = False
End Function '*
</script>
<body bgcolor="white">
<h1>Drag and Drop, dataTransfer.getData("URL").</h1>
<p>This page was copied from webreference.com. Try dragging
<a
href="http://webreference.com/programming/javascript/dragdropie/Example2.htm">this link</a>,
and dropping it on the yellow box below.</p>
<div id="divTarget"
ondragenter="cancelEvent()"
ondragover="cancelEvent()"
ondrop="fnDrop()">Drop on me</div>
<!--Add your controls here-->
<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>
--
MarceepooNu
Tom Lavedas
> Issue No. 1. Does anyone know how to make an area on an HTA page "drag and
> drop" capable, so that a user could drag files (from Windows Explorer, e.g.,
> WinXP, Win Vista and Win7) onto the HTA page, in order to get the file's
> FullName (path + name) pushed into a variable?
>
> I found an example of "drag and drop" HTA, that enables me to harvest some
> useful info about Web pages (i.e., URLname and LOCATIONname) that I drag onto
> my HTA file (below). In the example below, that info is announced in a
> message box.
>
> But I can't figure out how to modify the HTA, so that I could drag a file
> from Windows Explorer onto the HTA, and get the file's FullName (path + name)
> into the message box. Any suggestions (sample code (?) and hopefully
> direction to where I could learn more about this) would be much appreciated.
>
> Issue No. 2. Lastly, (returning to the URL and LOcationName) harvesting), I
> have the impression that it would be possible to alter the script so that the
> "drag and drop" would harvest more info about the web pages (e.g., "title"
> and I don't know what the other "attributes" (?), "properties (?) are, or
> where to find a list of them).
>
> Any suggestions (sample code (?) and hopefully direction to where I could
> learn more about getting info about web pages through vbscript) would be much
> appreciated.
>
> I posted another copy at the HTA at this URL (in case that makes it easier
> for someone to see what I posted below):
I figured out how to do this using an IFrame, but it is broken by IE8.
<html>
<head>
<HTA: APPLICATION ID="oDDT"
APPLICATIONNAME="DandDTest"
>
<title>DandD Test</title>
</head>
<body>
<script language=vbScript>
sub GetDropPath
if MyIFrame.document.readystate = "complete" then
display MyIFrame.location.href
end if
end sub
sub Display(sText)
document.all.debug.insertAdjacentHTML "afterbegin", sText & "<br>"
end sub
</script>
<iframe name=MyIFrame onreadystatechange=GetDropPath
application="yes" style="height:400px;width:400px"
src='about:<body title="Drop file here">File goes here</body>'>
</iframe>
<div id=debug></div>
</body>
</html>
EditFlags need to be changed in the registry to use this with
executable files, like MS Office files or HTAs etc.
_____________________
Tom Lavedas
Paul Randall
"Tom Lavedas" <tglb...@verizon.net> wrote in message
news:e42e37b3-4990-489e...@o30g2000yqb.googlegroups.com...
<snip>
</head>
<body>
<script language=vbScript>
</script>
----------------------------------------------------------
Hi, Tom
Thanks for sharing this script.
Can you elaborate on how to change the EditFlags for specific file types.
I'm currently interested in what to do for .exe executables and "Unknown
File Type" which is what your HTA calls it when I make up a phony file
extension, like a.aaa, and drag the file to the HTA.
-Paul Randall
Tom Lavedas
> "Tom Lavedas" <tglba...@verizon.net> wrote in message
The particular files I was working with were Office files, like .doc
and .ppt. The EditFlag for these are located at :
HKEY_CLASSES_ROOT\PowerPoint.Show.8\EditFlags
HKEY_CLASSES_ROOT\Word.Document.8\EditFlags
When set to &h00010000& they will open without a dialog. I use a
toggle to store the existing value, set it to open and then reset it
back to the initial condition when the program closes.
Const HKEY_CLASSES_ROOT\PowerPoint.Show.8\EditFlags
Dim g_nFlags
' Open
with createobject("wscript.shell")
g_nFlags = .regread(g_sPPTkey)
.regwrite g_sPPTkey, &h00010000&, "REG_DWORD"
end with
'Close
with createobject("wscript.shell")
.regwrite g_sPPTkey, g_nFlags, "REG_DWORD"
end with
I would suggest a search for a value of 'EditFlags' to find the
locations in the registry of other files. For files of arbitrary
extensions, I think you need to build an association - possibly to
NotePad - for that extension and set its EditFlag value to be able to
use it this way. I've never tried it.
I suspect an EXE would be a big challenge. In fact, I doubt this
approach can be made to work with an EXE.
_____________________
Tom Lavedas
MarceepooNu
But I'm troubled.
1. We're using Internet Explorer 8 in our office.
2. Would the "drag and drop" be more readily do-able if one of the
following conditions occurred?
----(a) Assume that the Hta is opened in a Mozilla Firefox window.
----(b) Assume that the Hta is opened in a Mozilla Firefox window, and
javascript or jscript (Are they the same thing?) is used instead of vbscript.
[Note that I'm assuming that replacing vbscript with javascript would
contribute nothing in the IE8 setting. Am I wrong?]
----(c) Assume that, instead of an Hta file, we were setting up the drag
and drop using ASP (which I've only read about, and never set up) and
Internet explorer?
----(d) Assume that, instead of an Hta file, we were setting up the drag
and drop using PHP (which I've only read about, and never set up) and
Internet explorer?
--- (e) Assume that, instead of an Hta file, we were setting up the drag
and drop using PHP (which I've only read about, and never set up) andFirefox?
--- (f) What do you think are the chances that it's fairly easy to create a
contrivance/gismo of some sort in VB.Net, using Visual Studio 2008, that I
could use with an Hta file, so as to make the Hta's drag and drop area work
well with any type of file, which is dragged from Windows Explorer? (I'm
very new to Visual Studio, and very clumsy with it.)
Eventually, I'll also want to drag and drop onto the Hta:
--(1) Mail Items from Outlook
--(2) Calendar Items from Outlook
--(3) Text ranges from Word
--(4) Something like "ranges" (which is analogous to the "ranges" in Word
vba, that I just noticed seeing somewhere) in the W3c specs for HTML 4 or 5
I presume that you guys, Tom and Paul, intend to resign your jobs and leave
your families in order to have enough time to fully respond to each of my
questions above, and I wish to commend you for your doing so. (Do you have
any idea where I could get these questions answered w/o taking unfair
advantage of nice people like you guys - which is how I feel now, about
asking so many questions here?)
Thanks,
MarceepooNu
--
MarceepooNu
"Tom Lavedas" wrote:
> .
>
Paul Randall
----------------------------------------------------------------------
Tom,
Thanks for that sample code too. I have a drag and drop project on the back
burner that I hope to get to within the next year or so.
-Paul Randall
Tom Lavedas
1. I posted some inquiries about doing this in IE8 and never got a
response, so as far as I know it cannot be used there. Sorry.
2. Since HTAs must access the IE DOM, I don't see how Firefox could be
used for this purpose. The IFRAME trick only worked for an HTA
previously. The D&D was and is still blocked in HTML, regardless of
the browser.
I ended up building my own file listing window, in a SPAN box within
the HTA, that allowed me to drag and drop the file names from the list
onto another SPAN that allowed me to select and set the order of the
files. I put that over a tabbed form using the Office forms object,
which provides a way to preselect any number of folders for ready
access.
I chose to use the registry to persist which folders are represented
by each tab so that the application returns to a specific location
when reopened. All in all, this ninth generation of my original PPT
presentation builder is now fairly useful. I use it to build a
presentation every week for a church service. I still wish I could
d&d from explorer. It just seems so much more intuitive, but I'd have
to move to a compiled language to do that, I think.
_____________________
Tom Lavedas
MarceepooNu
With your help, I poked around the web more intelligently and found the
following stuff, that I think you'll like.
<html>
<!------------------------------------------------------------------------------------
http://www.jensign.com/JavaScience/www/wsh/imager/imager.hta
Title: imager.hta html application with VBScript
M. Gallant 12/07/2001
imager.hta is a drag & drop utility for recursively displaying images files
within folders. The file path is displayed, along with file size, and if the
file is of type gif, jpg, ico, bmp, png, emf, xbm the image is displayed.
The DropHandler shell extension must be configured for .hta file types
to use this utility. The application checks to see if the necessary registry
changes have already been made, and if not, offers the option to perform
the change using this code:
---------- Configure DropHandler for .hta ----------------
set shell = createobject("wscript.shell")
sKey = "HKEY_CLASSES_ROOT\HTAFile\ShellEx\DropHandler\"
sValue = "{60254CA5-953B-11CF-8C96-00AA00B8708C}"
shell.regwrite sKey, sValue, "REG_SZ"
---------- End Configure DropHandler for .hta -----------
Buttons:
Enable Recursive: Recursively displays all subfolders (default disabled)
Show All Files : Shows file path and size for all files in folders (default
disabled)
Select Folder: Displays folder-selection dialog (single folder only)
Refresh: For < IE5.5, items dragged into "Drop Here" requires manual
Refresh
Parameters:
MaxFiles: Maximum number of listed folders and files.
Credits:
Thanks to the following for valuable revisions and suggestions:
Mike Musterd, Alex Angelopoulos, Michael Harris
-------------------------------------------------------------------------------------->
<head>
<hta:application id=imagerHTA
APPLICATIONNAME="imagerApp"
SINGLEINSTANCE="no"
NAVIGABLE="no"
>
<script language="VBScript">
Option Explicit
Const RevDate = "12/07/2001"
Dim strCommandLine, dropHandlerConfigured, arin, result, ShowAllFiles,
Recursive, sKey, sValue, selectPath, filecount, MaxFiles
Dim fso, WshShell, oFolder, oFiles, oFile, Folders, Folder, file, Exten,
oShell, oShFolder, oFolderItem
Dim shellVersionOK, shell32dllpath, shellversion, strOSversion, versionnums,
clickedFiletxt, clickedFile, fitem
Dim args(20), nextquote, nextspace, arglength, argscount, charcount,
MaxFileExceeded, appimgprops, oImage, IF1dropText, decimalsymbol
Set fso = CreateObject("Scripting.FileSystemObject") 'instantiates fso for
all later use
Set WshShell = CreateObject("WScript.Shell")
ShowAllFiles = False 'set this to true to show also non-pictures
Recursive = False 'recursively search all subfolders
shellVersionOK = True 'status of shell32.dll version (v4.71 required for
shell file dialog and props sheet)
shellVersionOK = shellVersionCheck()
dropHandlerConfigured = startupCheck() ' ensure dropHandler configured via
registry.
MaxFiles = 250
Sub showIFcontents
If IF1.location = "about:blank" Then
IF1.document.writeln "<body bgcolor=blue>"
IF1.document.writeln "<font color=yellow>Drop Here</font></body>"
Exit Sub
End If
If LEFT(LCase(IF1.location), 8) = "file:///" Then
selectPath = unescape(MID(IF1.location, 9)) 'remove encoded spaces
etc.
window_onLoad()
End If
IF1.location = "about:blank"
End Sub
Sub dorefresh
IF1dropText = ""
On Error Resume Next
IF1dropText = IF1.document.body.innerText 'generates an error if folder
was dropped
If Err Or LEFT(IF1dropText,9) <>"Drop Here" And LEFT(LCase(IF1.location),
8) = "file:///" Then
selectPath = unescape(MID(IF1.location, 9)) 'remove encoded spaces
etc.
IF1.location = "about:<body bgcolor=blue><font color=yellow>Drop
Here</font>"
End If
On Error GoTo 0
window_onLoad()
End Sub
Sub setmaxfiles
If oMaxfiles.selectedIndex = 4 Then
MaxFiles = 1E9
Else
MaxFiles = CLng(oMaxfiles.options(oMaxfiles.selectedIndex).text)
End If
End Sub
Sub document_onclick
If window.event.srcElement.tagName = "IMG" Then
Set oImage = window.event.srcElement
oImage.border = 2 'highlight image with border
MsgBox "Image: " & oImage.nameProp & vbCrLf & vbCrLf & _
"Image Size: " & oImage.width & " x " & oImage.height & " pixels" &
vbCrLf & _
"File Size: " & oImage.fileSize & " bytes" & vbCrLf & vbCrLf & _
"Created: " & oImage.fileCreatedDate & vbCrLf & _
"Modified: " & oImage.fileModifiedDate & vbCrLf , _
vbInformation + vbOKOnly
oImage.border = 0
Exit Sub
End If
If IsNumeric(window.event.srcElement.id) Then 'only capture numeric
IDs
clickedFiletxt = window.event.srcElement.innerText
Else
Exit Sub
End If
If InStr(clickedFiletxt, " (") Then
clickedFiletxt = Trim(Left(clickedFiletxt, InStr(clickedFiletxt, " (")))
Else
Exit Sub
End If
If fso.FileExists(clickedFiletxt) And Not window.event.ctrlKey _
And Not window.event.shiftKey And Not window.event.altKey Then
'unmodified mouse left-button
On Error Resume Next
WshShell.Run """" & clickedFiletxt & """" 'open image with
file-associated application
On Error GoTo 0
ElseIf shellVersionOK And window.event.ctrlKey _
And Not window.event.shiftKey And Not window.event.altkey Then
Set clickedFile = fso.getFile(clickedFiletxt)
Set oShell = CreateObject("Shell.Application")
If RIGHT(fso.getParentFolderName(clickedFiletxt), 1) = "\" Then
'watch for root drive
Set fitem =
oShell.namespace(fso.getParentFolderName(clickedFiletxt)).parsename(clickedFile.Name)
Else
Set fitem = oShell.namespace(fso.getParentFolderName(clickedFiletxt)&
"\").parsename(clickedFile.Name)
End If
fitem.invokeverb("P&roperties")
Set clickedFile = Nothing
Set oShell = Nothing
End If
End Sub
Sub toggleRecurse
Recursive = Not Recursive
If Recursive Then
recurse.value = "Disable Recursive"
Else
recurse.value = "Enable Recursive"
End If
window_onload()
End Sub
Sub toggleShowAll
ShowAllFiles = Not ShowAllFiles
If ShowAllFiles Then
showall.value = "Show Images Only"
Else
showall.value = "Show All Files"
End If
window_onload()
End Sub
Sub selectFolder
If Not shellVersionOK Then 'do nothing if Shell32.dll < 4.71
Exit Sub
End If
filecount = 0
MaxFileExceeded = False
selectPath = ""
If Not dropHandlerConfigured Then
Exit Sub
Else
div1.innerHTML = "" 'clear DIV block
End If
Set oShell = CreateObject("Shell.Application")
Set oShFolder = oShell.BrowseForFolder(0, "Choose a Folder", 0)
On Error Resume Next
Set oFolderItem = oShFolder.Items.Item
If Err.Number <> 0 Then ' check if user cancelled folder-select
Exit Sub
Else
selectPath = oFolderItem.Path
DisplayContents selectPath
End If
On Error GoTo 0
Set oShell = Nothing
Set oShFolder = Nothing
CheckFileCount()
End Sub
Sub window_onload()
filecount=0
MaxFileExceeded = False
If Not dropHandlerConfigured Then
Exit Sub
Else
div1.innerHTML = "" 'clear DIV block
End If
If selectPath <> "" Then
DisplayContents selectPath 'if File Dialog used
Else
strCommandLine = Trim(imagerHTA.commandLine) 'removing trailing space(s)
charcount = 1
argscount = 0
'--------- parse command line; paths with spaces are explicitly quoted;
others are not ---------
Do While charcount< Len(strCommandLine)
If Mid(strCommandLine,charcount,1) = """" Then 'if quoted argument
nextquote = Instr(charcount+1, strCommandLine, """")
arglength = nextquote - charcount - 1
args(argscount) = Mid(strCommandLine, charcount+1,arglength)
argscount = argscount + 1
charcount = nextquote + 2 ' skip final quote and space
Else 'must be unquoted argument with no
internal spaces
nextspace = Instr(charcount, strCommandLine, " ")
If nextspace=0 Then ' final space is Trimmed
nextspace = Len(strCommandLine) + 1
End If
arglength = nextspace - charcount
args(argscount) = Mid(strCommandLine, charcount, arglength)
argscount = argscount + 1
charcount = nextspace + 1 ' skip space
End If
Loop
If argscount > 1 Then
arin = 1 'first argument is application itself ;skip this
While arin < argscount
DisplayContents args(arin)
arin = arin + 1
Wend
End If
End If 'end If selectPath ....
CheckFileCount()
End Sub
Sub DisplayContents(FileOrFolder)
If MaxFileExceeded Then Exit Sub ' recursively break out of procedure
filecount = filecount+1
If fso.FileExists(FileOrFolder) Then
displayfiletag(fso.getFile(FileOrFolder)) ' need to pass file object to
use file.Size
ElseIf fso.FolderExists(FileOrFolder) Then
' if a folder was given
div1.insertAdjacentHTML "BeforeEnd", _
"<b>---- Folder <A HREF=""file:///" & FileOrFolder & """>" & _
FileOrFolder & "</A></b><br>"
Set oFolder = fso.GetFolder(FileOrFolder)
Set oFiles = oFolder.Files ' Get Files collection.
For Each oFile In oFiles ' All files
displayfiletag(oFile)
Next
If Recursive Then 'If recursive into subfolders
Set Folders = oFolder.SubFolders 'recurse
For Each Folder In Folders
DisplayContents(Folder)
Next
End If
div1.insertAdjacentHTML "BeforeEnd", _
"<b>---- End Folder ----</b><br><br>"
Set oFolder = Nothing
Set oFiles = Nothing
Else
displayfiletag(FileOrFolder)
End If
End Sub
Sub displayfiletag(file) ' textual comparisons
If filecount > MaxFiles Then
MaxFileExceeded = True
Exit Sub
End If
Exten = LCase(Right(file, 4)) '
If Exten = ".gif" Or Exten = ".jpg" Or Exten = ".bmp" Or _
Exten = ".ico" Or Exten = ".xbm" Or Exten = ".png" Or _
Exten = ".wmf" Or Exten =".emf" Then
If Eval(LCase(Right(file, 3)) & ".checked") Then
div1.insertAdjacentHTML "BeforeEnd", _
"<img src=""file://" & file & """><br>"
div1.insertAdjacentHTML "BeforeEnd", _
"<font size=-1><div ID=" & filecount & ">" & file & " (" & file.Size &
" bytes ) </div></font><br>"
filecount=filecount+1
End If ' end Eval(LCase ...
ElseIf ShowAllFiles Then
div1.insertAdjacentHTML "BeforeEnd", _
"<font size=-1><div ID=" & filecount & ">" & file & " (" & file.Size
& " bytes ) </div></font><br>"
filecount=filecount+1
End If ' end If Exten
End Sub
Sub CheckFileCount
If filecount > MaxFiles Then
MsgBox "Too many files (" & filecount & ")" & vbCrLf & _
"Increase the MaxFiles value", vbExclamation
End If
End Sub
Function shellVersionCheck() 'check is Win95 or NT4 and if so, if
Shell32.dll ver is <4.71
shellVersionCheck = True 'assume success
On Error Resume Next
strOSversion = WshShell.RegRead(_
"HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
If Err Then ' must be Win9x or WinME; only Win95 is really an issue
shell32dllpath =
WshShell.ExpandEnvironmentStrings("%WINDIR%\System\Shell32.dll")
ElseIf strOSversion = "4.0" Then 'only NT4 is a potential issue
shell32dllpath =
WshShell.ExpandEnvironmentStrings("%WINDIR%\System32\Shell32.dll")
Else
shellVersionCheck = True 'must be Win2000 or XP so OK
Exit Function
End If
On Error GoTo 0
decimalsymbol = "."
If fso.FileExists(shell32dllpath) Then
shellversion = fso.GetFileVersion(shell32dllpath)
On Error Resume Next
decimalsymbol = WshShell.RegRead(_
"HKEY_CURRENT_USER\Control Panel\International\sDecimal")
versionnums =Split(shellversion, ".")
shellversion = CSng(versionnums(0) & decimalsymbol & versionnums(1))
On Error GoTo 0
If shellversion < 4.71 Then
shellVersionCheck = False
End If
Else
shellVersionCheck = False
End If
End Function
Function startupCheck()
' check to ensure DropHandler shell extension is configured
On Error Resume Next
WshShell.RegRead("HKEY_CLASSES_ROOT\HTAFile\ShellEx\DropHandler\")
If Err.Number <> 0 Then
startupCheck = False ' not configured yet
result = MsgBox ("DropHandler extension not configured for .hta file" &
vbCrLf & vbCrLf & _
"Configure Registry Now?? ", vbYesNo+vbExclamation, "DropHandler
Configuration")
If result = vbYes Then
ConfigDropHandler()
Else
MsgBox "DropHandler must be configured to use this hta
application", vbOK + vbCritical
End If
Else
startupCheck = True ' already properly configured
End If
End Function
Sub ConfigDropHandler()
sKey = "HKEY_CLASSES_ROOT\HTAFile\ShellEx\DropHandler\"
sValue = "{60254CA5-953B-11CF-8C96-00AA00B8708C}"
WshShell.regwrite sKey, sValue, "REG_SZ"
MsgBox "DropHandler configured" & vbCrLf & _
"You may need to restart Windows", vbInformation
End Sub
Sub About
MsgBox "Imager.hta M. Gallant " & RevDate & vbCrLf & vbCrLf & _
" Drag files and/or folders onto imager.hta icon or ... " & vbCrLf & _
" drag folder into ""Drop Here"" box or ..." & vbCrLf & _
" click ""Select Folder"" button." & vbCrLf & vbCrLf & _
" Click listed file-path to open file with file-type associated
application." & vbCrLf & _
" <Ctrl+Click> to display Properties Panel for file." & vbCrLf & _
" Click displayed image to display basic image properties." & vbCrLf &
vbCrLf & _
" Limit number of displayed files with ""MaxFiles"" selection." & vbCrLf & _
" Filter image file-types with checkboxes." & vbCrLf & _
" Toggle show all files with ""Show All Files"" button." & vbCrLf & _
" Toggle full folder recursion with ""Enable Recursive"" button." & vbCrLf,
vbInformation
window.event.returnValue = False
End Sub
Sub Credits
MsgBox "Imager.hta M. Gallant " & RevDate & vbCrLf & vbCrLf & _
"Thanks to the following for valuable contributions: " & vbCrLf & _
" - Michael Harris" & vbCrLf & _
" - Mike Musterd" & vbCrLf & _
" - Alex Angelopoulos" & vbCrLf, vbInformation
window.event.returnValue = False
End Sub
</script>
</head>
<body>
<table border=0 width=450 cellpadding = 7 bgcolor="#D0D0D0" STYLE =
"border: 1px solid black"><tr>
<td valign=top><font size=+2 color=red><b>Imager.hta: </b></font> <br>
MaxFiles: <SELECT ID="oMaxfiles" SIZE="1" LANGUAGE='VBScript'
onchange="setmaxfiles()">
<OPTION VALUE=1>100
<OPTION VALUE=2 SELECTED>250
<OPTION VALUE=3 >500
<OPTION VALUE=4 >1000
<OPTION VALUE=5>All
</SELECT>
</td>
<td align=right width=100>
<IFrame ID="IF1" scrolling=no width=80 height=70 onload="showIFcontents()"
TRUSTED=yes bgcolor="RED"></IFRAME>
</td>
<td align=right>
<a LANGUAGE="VBScript" href="#" onclick="About()">About</a><br><br>
<a LANGUAGE="VBScript" href="#" onclick="Credits()">Credits</a><br>
</td></tr></table>
<br>
<INPUT TYPE='BUTTON' LANGUAGE='VBScript' ID='recurse'
onclick='toggleRecurse' VALUE='Enable Recursive' STYLE =
'width: 120; font-size: 75%; color:blue'>
<INPUT TYPE='BUTTON' LANGUAGE='VBScript' ID='ShowAll'
onclick='toggleShowAll' VALUE='Show All Files' STYLE = 'width:
120; font-size: 75%; color:blue' >
<INPUT TYPE='BUTTON' LANGUAGE='VBScript' ID='ChooseFolder'
onclick='selectFolder' VALUE='Select Folder' STYLE = 'width:
120; font-size: 75%; color:blue'>
<INPUT TYPE='BUTTON' LANGUAGE='VBScript' ID='Refresh'
onclick='dorefresh()' VALUE='Refresh' STYLE = 'width: 120;
font-size: 75%; color:yellow; background-Color:blue'><br>
<INPUT TYPE=checkbox CHECKED ID=GIF>gif
<INPUT TYPE=checkbox CHECKED ID=JPG>jpg
<INPUT TYPE=checkbox CHECKED ID=BMP>bmp
<INPUT TYPE=checkbox CHECKED ID=ICO>ico
<INPUT TYPE=checkbox CHECKED ID=XBM>xbm
<INPUT TYPE=checkbox CHECKED ID=PNG>png
<INPUT TYPE=checkbox CHECKED ID=WMF>wmf
<INPUT TYPE=checkbox CHECKED ID=EMF>emf
<br><hr align=left size=1 width=500><br>
<div ID="div1"></div>
</body>
</html>
--
MarceepooNu
"Paul Randall" wrote:
> .
>
Tom Lavedas
> Guys, you helped me quite a bit, and I want to thank you again.
>
> With your help, I poked around the web more intelligently and found the
> following stuff, that I think you'll like.
>
> <html>
> Title: imager.hta html application with VBScript
> M. Gallant 12/07/2001
I have tried this in the past script and again with your posting. As
I suspected, it is broken by IE8s increased "cross-domain" security
features, even though it is running in an HTA. In particular, the
drop is recorded, but the dropped file is NOT permitted to load.
Therefore the URL to the file is not returned - it always says that
the location is "about:blank". At least, that's my experience.
________________
Tom Lavedas
MarceepooNu
I just saw your post a few minutes ago. Wow! So, what do you think is
the solution for someone who wants to use Htas or Html for menus and such
things? Do you know if the drag and drop is possible under asp? I've been
thinking about making the plunge, once I find the time. This would be a
major incentive.
Thanks,
marc
--
MarceepooNu
"Tom Lavedas" wrote:
> .
>