Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Серый форум → Общение → Windows Script Host, HTA (VBScript, JScript) → VBS диалог открытия файла не работает на Windows 7
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Помогите понять, как вызвать диалог открытия файла если http://forum.script-coding.com/viewtopic.php?pid=6509 эти примеры не сработали?
СОМ библиотеки пишут, что в Висте не работают, а остальные, что невозможно создать такой объект.
Разобрался сам
http://devonenote.com/2010/02/register- … -x64-win7/
Тут инструкция по регистрации COMDLG32.OCX в 64 битных операционках и Висте.
Хотелось бы найти универсальное решение на Windows 7, без стороннего вмешательства (регистрации компонентов, установки сторонних программ и тд.)
Хотелось бы найти универсальное решение на Windows 7...
Такого решения нет (по крайней мере, пока).
Mat Skywalker здесь подробно обсуждали:http://forum.script-coding.com/viewtopic.php?id=3969
set [Шел] = CreateObject("Shell.Application")
set [ШелСкрипт] = CreateObject("WScript.Shell")
randomize
[Сигнатура] = cstr(rnd)
[Стр] = "mshta ""about:<hta:application border='none' caption='no' showintaskbar='no' /><script>self.resizeTo(0,0)</script>><body onload=""Окно.object.PutProperty('Сигнатура','" + [Сигнатура] + "')""><object id='Окно' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></body>"""
set [Процесс] = [ШелСкрипт].exec([Стр])
do while [Процесс].status <> 2
WScript.Sleep(30)
for each [Окно] in [Шел].Windows()
if [Окно].GetProperty("Сигнатура") = [Сигнатура] then
exit do
end if
next
loop
set [Документ] = [Окно].document
set [Диалог] = [Документ].createElement("object")
[Диалог].classid="clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b"
[Документ].body.appendChild([Диалог])
msgbox [Диалог].object.openfiledlg("C:\*.jpg;*.gif;*.png;*.bmp ",,"Картинки (*.jpg;*.gif;*.png;*.bmp)|*.jpg;*.gif;*.png;*.bmp|Все файлы (*.*)|*.*","Выберите картинку...")
[Документ].parentWindow.close()smaharbA, та же песня, что и здесь:
если открыть список «Тип файлов» — после первых пунктов у меня идёт «каша».
Только теперь ещё вдобавок вместо «"Картинки (*.jpg;…» — «Љартинки (*.jpg;…».
если открыть список «Тип файлов» — после первых пунктов у меня идёт «каша».
http://forum.script-coding.com/viewtopi … 417#p40417:
…
По логике, она должна вызывать API функию GetOpenFileName, у которой параметр Filter задается как набор пар строк, заканчивающихся нулями и в конце еще просто ноль. Если исходить из синтаксиса, то фунция подменяет символы "|" на нули и передает функции API. Так что можно попробовать добавить в конце символ "|":
"Только текстовые(*.txt)|*.txt|Все(*.*)|*.*|"
— мусор пропадает.
wisgest, спасибо. Там сие не сработало. На этом коде — да, помогло.
Интересно, а можно ли переделать код, чтобы не выскакивал msgbox с полным путём файла ?
Rialto, можно.
Шутку понял 
Я неточно выразился, но всё же.
Хотелось бы пример такого кода.
Это не была шутка: §4.3.
Какой именно пример? В приведённом коде меняете MsgBox на присвоение значения переменной:
sPath2File = [Диалог].object.openfiledlg("C:\*.jpg;*.gif;*.png;*.bmp ",,"Картинки (*.jpg;*.gif;*.png;*.bmp)|*.jpg;*.gif;*.png;*.bmp|Все файлы (*.*)|*.*","Выберите картинку...")после закрытия окна:
[Документ].parentWindow.close()вписываете проверку, что не была нажата кнопка «Отмена», и пользуетесь полученным путём к файлу:
If Len(sPath2File) <> 0 Then
' Здесь Ваш код, например
WScript.Echo sPath2File
End IfКоллеги, данный диалог можно ли вызвать так, чтобы была возможность выбора не единственного файла, а множественный выбор?
Этот нюанс мне довольно критичено, подскажите плз.
чтобы была возможность выбора не единственного файла, а множественный выбор
Если речь о диалоге UserAccounts.CommonDialog, то у него есть свойство Flags, если устанавливаем = &H0200 - получаем возможность выбрать несколько файлов.
Еще одни грабли с CommonDialog это лицензирование. При вызове диалога появляется сообщение навроде: "Лицензирование верно не выполнено".
Вот здесь была ссылка текст для реестра с лицензиями на большинство контролов VB:
REGEDIT
…Вот такой вопросец. Вызов диалога меняет текущую рабочую папку скрипта. Как следствие перестают читаться файли настроек и т.д. "нацеленые" на как бы "текущую" папку. Как этот победить? Есть команда смены папки?
Mat Skywalker, согласно §2.9 — такое здесь не публикуем. Я удалил из Вашего поста лишнее.
Есть команда смены папки?
Спасибо
Приветствую всех. Захотелось поучаствовать в обсуждении. ) Использовал идею smaharbA. За что ему большое спасибо. ) Не так давно понадобилась такая же функция. В итоге собрал класс и WSC оболочку на него. Может кому то так удобнее будет.
Вышеописанных проблем с кодировкой вроде бы не заметил.
Ниже исходники + примеры
Класс
Class clsOPTSHOLDLib
Private WshExec, oDlg, ShellWindows, form_id, id, st, ShellWindow
Private Sub Class_Initialize()
On Error Resume Next
Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
"<hta:application showintaskbar=no />" &_
"<object id=" & id & " classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object>" &_
"<object id=oDlg classid='clsid:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B'></object>""")
st = Now
Do
For Each ShellWindow in ShellWindows
form_id = Clng(ShellWindow.id)
if form_id = id Then
Set oDlg = ShellWindow.document.all.oDlg.Object
Exit Sub
End if
Next
Loop Until DateDiff("s",st,now) => 10
On Error Goto 0
if isEmpty(oDlg) Then Err.Raise vbObjectError, "HtmlDlgHelper", "Dialog creation failed."
End Sub
Public Property Get HtmlDlgHelper()
Set HtmlDlgHelper = oDlg
End Property
Private Sub Class_Terminate()
On Error Resume Next
WshExec.Terminate()
End Sub
End ClassПример с использованием класса
Option Explicit
Dim OPTSHOLDLib, HtmlDlgHelper, ret
Set OPTSHOLDLib = New clsOPTSHOLDLib
Set HtmlDlgHelper = OPTSHOLDLib.HtmlDlgHelper
ret = HtmlDlgHelper.openfiledlg()
MsgBox retWSC (Windows Script Component)
<?xml version="1.0"?>
<component>
<?component error="true" debug="true"?>
<registration
description="HtmlDlgHelper"
progid="HtmlDlgHelper.wsc"
version="1.00"
classid="{86376100-1f27-4d81-8328-8c6565096c0e}"
>
</registration>
<public>
<property name="fonts">
<get/>
</property>
<method name="openfiledlg">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="title"/>
</method>
<method name="savefiledlg">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="title"/>
</method>
<method name="choosecolordlg">
<PARAMETER name="initColor"/>
</method>
<method name="getCharset">
<PARAMETER name="fontName"/>
</method>
<method name="openfiledlgex">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="initFilterIndex"/>
<PARAMETER name="title"/>
</method>
</public>
<script language="VBScript">
<![CDATA[
Option Explicit
Dim OPTSHOLDLib, HtmlDlgHelper
Set OPTSHOLDLib = New clsOPTSHOLDLib
Set HtmlDlgHelper = OPTSHOLDLib.HtmlDlgHelper
Class clsOPTSHOLDLib
Private WshExec, oDlg, ShellWindows, form_id, id, st, ShellWindow
Private Sub Class_Initialize()
On Error Resume Next
Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
"<hta:application showintaskbar=no />" &_
"<object id=" & id & " classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object>" &_
"<object id=oDlg classid='clsid:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B'></object>""")
st = Now
Do
For Each ShellWindow in ShellWindows
form_id = Clng(ShellWindow.id)
if form_id = id Then
Set oDlg = ShellWindow.document.all.oDlg.Object
Exit Sub
End if
Next
Loop Until DateDiff("s",st,now) => 10
On Error Goto 0
if isEmpty(oDlg) Then Err.Raise vbObjectError, "HtmlDlgHelper", "Dialog creation failed."
End Sub
Public Property Get HtmlDlgHelper()
Set HtmlDlgHelper = oDlg
End Property
Private Sub Class_Terminate()
On Error Resume Next
WshExec.Terminate()
End Sub
End Class
]]>
</script>
<script language="JScript">
<![CDATA[
function get_fonts()
{
return HtmlDlgHelper.fonts
}
function openfiledlg(initFile,initDir,filter,title)
{
return HtmlDlgHelper.openfiledlg(initFile,initDir,filter,title)
}
function savefiledlg(initFile,initDir,filter,title)
{
return HtmlDlgHelper.savefiledlg(initFile,initDir,filter,title)
}
function choosecolordlg(initColor)
{
return HtmlDlgHelper.choosecolordlg(initColor)
}
function getCharset(fontName)
{
return HtmlDlgHelper.getCharset(fontName)
}
function openfiledlgex(initFile,initDir,filter,initFilterIndex,title)
{
return HtmlDlgHelper.openfiledlgex(initFile,initDir,filter,initFilterIndex,title)
}
]]>
</script>
</component>Пример использования WSC
Option Explicit
Dim HtmlDlgHelper, ret
Set HtmlDlgHelper = GetObject("script:" & Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")) & "HtmlDlgHelper.wsc")
ret = HtmlDlgHelper.openfiledlg("",,"Картинки (*.jpg;*.gif;*.png;*.bmp)|*.jpg;*.gif;*.png;*.bmp|Все файлы (*.*)|*.*","Выберите картинку...")
MsgBox retSet WshShell = WScript.CreateObject("WScript.Shell")
WScript.Echo WshShell.CurrentDirectory
А если через HTA нужно сделать?
Set WshShell = CreateObject("WScript.Shell")
…WshShell.CurrentDirectory…Это понятно.
Вызов диалога меняет текущую рабочую папку скрипта. Как следствие перестают читаться файли настроек и т.д. "нацеленые" на как бы "текущую" папку. Как этот победить? Есть команда смены папки?
Получить текущую папку труда не составляет. Как вернуться обратно потом?
Точно так же:
Set WshShell = CreateObject("WScript.Shell")
…
strCurrentDirectory = WshShell.CurrentDirectory
…
<код по Dialog Open File>
…
WshShell.CurrentDirectory = strCurrentDirectory
…Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
