1

Тема: HTA: Drag & Drop файлов

Пытался победить самостоятельно задачу перетаскивания файлов на форму HTA, но не смог.
В том методе, который я собрал из всевозможных примеров, обрабатываются только текст и ссылки, так как по запросу Window.Event.DataTransfer возвращается объект типа IHTMLDataTransfer.
При перетаскивании файлов сами события генерируются, но информации о них никакой не возвращается (или я не смог её получить).

<html>
	<head>
		<meta http-equiv=Content-Type Content="text-html; charset=1251">
		<hta:application
		id=Drop
		applicationName='Drop'
		maximizeButton=yes
		innerBorder=yes
		border=thick
		scroll=auto
		selection=yes
		contextMenu=yes
		singleinstance=yes
		sysMenu=yes
		version=0.0.1
		>
		<title>Drop</title>
		<style type="text/css">
			.block1
			{
				width: 200px;
				height: 200px;
				background: gray;
				padding: 5px;
				padding-right: 20px;
				border: solid 1px black;
				float: left;
				text-align: center;
				font-size: 50;
			}
			.block2
			{
				width: 200px;
				height: 200px;
				background: gray;
				padding: 5px;
				border: solid 1px black;
				float: left;
				position: relative;
				top: 40px;
				left: -70px;
				text-align: center;
				font-size: 50;
			}
			.info
			{
				width: 450px;
				height: 30px;
				padding: 5px;
				border: solid 1px black;
				float: left;
				position: relative;
				top: 80px;
				left: 5px;
				text-align: center;
			}
		</style>
	</head>
	<body>
		<textarea cols="50" rows="1">Текст для перетаскивания</textarea>
		<br><a href="http://forum.script-coding.com/">Ссылка для перетаскивания</a>
		<div id="div1" class="block1">div1</div>
		<div id="div2" class="block2">div2</div>
		<br>
		<table id="info" class="info" border="1">
			<tr><td width="33%"><b>div1:</b></td><td width="33%" id="Event1">&nbsp;</td><td width="33%" id="Time1">&nbsp;</td></tr>
			<tr><td><b>div2:</b></td><td id="Event2" title="Последнее событие">&nbsp;</td><td id="Time2">&nbsp;</td></tr>
			<tr>
				<td id="TypeDataTransfer" title="TypeName(Window.Event.DataTransfer)">&nbsp;</td>
				<td id="TypeURL" title="TypeName(DataURL), DataURL">&nbsp;</td>
				<td id="TypeText" title="TypeName(DataTXT), DataTXT">&nbsp;</td>
			</tr>
		</table>
	</body>
</html>
<script language="VBS">
	Option Explicit
	Window.ResizeTo 500,500
	Sub GetInfo()
		Dim DataTXT,DataURL
		TypeDataTransfer.InnerHtml=TypeName(Window.Event.DataTransfer)
		DataTXT=Window.Event.DataTransfer.GetData("Text")
		DataURL=Window.Event.DataTransfer.GetData("URL")
		TypeURL.InnerHtml=TypeName(DataURL) & ", " & DataURL
		TypeText.InnerHtml=TypeName(DataTXT) & ", " & DataTXT
	End Sub
	Sub div1_OnDragEnter()
		Event1.InnerHtml="OnDragEnter"
		Time1.InnerHtml=Now
		div1.Style.Background="Cyan"
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div1_OnDragLeave()
		Event1.InnerHtml="OnDragLeave"
		Time1.InnerHtml=Now
		div1.Style.Background="Gray"
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div1_OnDragOver()
		Event1.InnerHtml="OnDragOver"
		Time1.InnerHtml=Now
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div1_OnDrop()
		Event1.InnerHtml="OnDrop"
		Time1.InnerHtml=Now
		Window.Event.ReturnValue=False
		GetInfo
		div1.Style.Background="Red"
		SetTimeout "SetGray(1)", 2000, "VBScript"
	End Sub
	Sub div2_OnDragEnter()
		Event2.InnerHtml="OnDragEnter"
		Time2.InnerHtml=Now
		div2.Style.Background="Cyan"
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div2_OnDragLeave()
		Event2.InnerHtml="OnDragLeave"
		Time2.InnerHtml=Now
		div2.Style.Background="Gray"
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div2_OnDragOver()
		Event2.InnerHtml="OnDragOver"
		Time2.InnerHtml=Now
		Window.Event.ReturnValue=False
		GetInfo
	End Sub
	Sub div2_OnDrop()
		Event2.InnerHtml="OnDrop"
		Time2.InnerHtml=Now
		Window.Event.ReturnValue=False
		GetInfo
		div2.Style.Background="Red"
		SetTimeout "SetGray(2)", 2000, "VBScript"
	End Sub
	Sub SetGray(Num)
		Document.GetElementById("div" & Num).Style.Background="Gray"
	End Sub
</script>

Если знаете рабочий способ, помогите пожалуйста.

2

Re: HTA: Drag & Drop файлов

Попытался выкрутиться через HTML5.
Добавил директиву <!DOCTYPE html>, нашёл пример, с помощью другого примера перевёл его в VBS:

	Sub Init(id_div)
		Dim customFn,cEvent,div
		Set div=Document.GetElementById(id_div)
		
		Set customFn=GetRef("dropHandler")
		div.addEventListener "OnDrop",customFn
		Set cEvent=Document.CreateEvent("Drop")
		cEvent.InitCustomEvent "OnDrop",false,false,null
		div.DispatchEvent(cEvent)
		div.RemoveEventListener "OnDrop",customFn
		
		Set customFn=GetRef("doNothing")
		div.addEventListener "OnDragOver",customFn
		Set cEvent=Document.CreateEvent("DragOver")
		cEvent.InitCustomEvent "OnDragOver",false,false,null
		div.DispatchEvent(cEvent)
		div.RemoveEventListener "OnDragOver",customFn
	End Sub

Но на строке div.addEventListener "OnDrop",customFn получаю ошибку "Объект не поддерживает это свойство или метод: 'div.addEventListener'".
То есть всё? Невозможно от слова совсем?

3

Re: HTA: Drag & Drop файлов

fy73, думаю Вам нужно добавить тэг meta c указанием необходимого движка IE.


<meta http-equiv="X-UA-Compatible" content="IE=..."/>

Это сказывается и на отрисовку HTML содержимого и на методы, свойства, события объектов в коде JS и VBS.

Проверил на Windows 10. По умолчанию, используется движок IE 7. На других системах не проверял.

Вот такой пример у меня работает с файлами и прочим содержимым:


<!DOCTYPE html>
<html>
	<head>
		<meta http-equiv="X-UA-Compatible" content="IE=9; IE=8; IE=7; IE=EDGE"/>
		<script type="text/javascript">
			
			function window::onload(){
				alert("document mode: " + document.documentMode)
			}
			
			function OnDropBody (event) {
				alert ("Please drop the files into the textarea.");
				return false;
			}

			function OnDropTextarea (event) {
				if (event.dataTransfer) {
					if (event.dataTransfer.files) {
						var target = document.getElementById ("target");
						target.value = "";
						for (var i = 0; i < event.dataTransfer.files.length; i++) {
							var file = event.dataTransfer.files[i];
							if ('name' in file) {
								var fileName = file.name;
							}
							else {
								var fileName = file.fileName;
							}
							if ('size' in file) {
								var fileSize = file.size;
							}
							else {
								var fileSize = file.fileSize;
							}

							target.value += (i+1) + ". file -- name: " + fileName + ", size: " + fileSize + " bytes\n";
						}
					}
					else {
						alert ("Your browser does not support the files property.");
					}
				}
				else {
					alert ("Your browser does not support the dataTransfer property.");
				}
				if (event.stopPropagation) {
					event.stopPropagation ();
				}
				else {
					event.cancelBubble = true;
				}
				return false;
			}
		</script>
	</head>
	<body ondragenter="return false;" ondragover="return false;" ondrop="return OnDropBody (event);">
		Please drag some files into this browser window and drop them in the following field:<br />
		<textarea id="target" rows="5" cols="50" spellcheck="false" 
			ondragenter="return false;" ondragover="return false;" 
			ondrop="return OnDropTextarea (event);">
		</textarea>
		<br /><br />
		In Safari, please drag some text within this browser window first and drag files next.
	</body>
</html>
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

4

Re: HTA: Drag & Drop файлов

Большое спасибо!
Буду экспериментировать.
А то я уже начал пытаться запихнуть туда объект WebBrowser и ловить файлы им.

5

Re: HTA: Drag & Drop файлов

Пример работает.
А VBS его перевести возможно?
Что-то перевод в HTML5 так всё изменил, что у меня даже в малости ничего не выходит.

6

Re: HTA: Drag & Drop файлов

Наверное, как-то так.


 <!DOCTYPE HTML>
<html>
	<head>
		<meta http-equiv="X-UA-Compatible" content="IE=10"/>
		<style>
			body, html {
				width: 100%;
				height: 100%;
				margin: 0;
			}
			#table {
				font-family:Tahoma;
				width:100%;
				height:100%;
				border-collapse:collapse;
			}
			
			#table td {
				border:solid 1px black;
			}
			
		</style>
		<script language="VBScript">
			Option Explicit
			
			window.resizeTo 640,480
			
			Function dropContainer_ondrop(objEvent)
				Dim types, files, iFile, iType, file, text
				With objEvent.dataTransfer
					Set files = .files
					Set types = .types
					dropContainer.innerText = ""
					For iType=0 to types.length - 1
						Select Case types.item(iType)
						Case "Text"
							PrintText "You dropped text """ & .GetData("Text") & """"
						Case "Url"
							PrintText "You dropped url """ & .GetData("Url") & """"
						Case "Files"
							PrintText "You dropped " & files.length & " file(s):"
							For iFile=0 to files.length - 1
								Set file = files.item(iFile)
								PrintText(iFile & ". " & file.name & " (" & file.size & " bytes)")
							Next
						Case Else
							MsgBox "Unknown format """ & types.item(iType) & """", vbCritical
						End Select
					Next
				End With
			End Function
			
			Sub PrintText(text)
				dropContainer.insertAdjacentText "beforeend", text & vbCrlf
			End Sub
		</script>
		<hta:application 
		scroll="no"
		/>
		<title>drop test</title>
	</head>
	<body 
		ondragenter="return false;" 
		ondragover="return false;" 
		ondrop="return false"> 
		
		<table id="table">
			<tr>
				<td>Sample text for drop</td>
			</tr>
			<tr>
				<td><a href="#">Sample url for drop</a></td>
			</tr>
			<tr style="height:100%;">
				<td id="dropContainer" style="background: #eee;">
					drop something here
				</td>
			</tr>
		<table>
	</body>
</html> 
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

7

Re: HTA: Drag & Drop файлов

Спасибо.
Теперь есть полный комплект для анализа.
Оказывается, ещё и засада в совместимости: IE9 ещё не поддерживает файлы, а IE11 уже как-то по-другому реагирует на VBS. То-то в предыдущем примере на JS у меня на VBS вообще ничего не работало.
Очень ценная информация, ещё раз большое спасибо.