IT博客-领星动网编程开发之爆炸小宇宙-随笔分类-VBScripthttp://www.cnitblog.com/lxasp/category/8981.htmlcnitblog.com/lxasp - - 有一种信念叫做编程zh-cnTue, 17 Oct 2023 17:35:24 GMTTue, 17 Oct 2023 17:35:24 GMT60打开文件对话框的VBScript全兼容解决方案(无临时文件)XP-W7-W10(IE6-11) GetOpenFileNamehttp://www.cnitblog.com/lxasp/archive/2023/08/29/96720.htmllxasplxaspTue, 29 Aug 2023 07:22:00 GMThttp://www.cnitblog.com/lxasp/archive/2023/08/29/96720.htmlhttp://www.cnitblog.com/lxasp/comments/96720.htmlhttp://www.cnitblog.com/lxasp/archive/2023/08/29/96720.html#Feedback0http://www.cnitblog.com/lxasp/comments/commentRss/96720.htmlhttp://www.cnitblog.com/lxasp/services/trackbacks/96720.htmlVBScript实现运行“打开文件对话框”进行文件选择。（不创建临时文件）

GetOpenFileName VBScript Solution Without Create Temporary File

Using HTA:APPLICATION with HtmlDlgHelper.openfiledlg(InitFilePath,'',FileTypeFilters,DialogCaption) 

Return The Result FileName From FileSystemObject(FSO) Stdout

Fully compatible: Windows XP / Windows Server 2003 (IE6--IE8)
Fully compatible: Windows 7 / Windows 8 / Windows 10 (IE8--IE11)
Fully compatible: Windows Vista (IE7) / Windows Server 2008 (IE7)

VBScript Code:
Function pickOpenFileName(caption,filters,initfn)
  caption=Trim(caption)
  Set w=CreateObject("WScript.Shell")::Set k=w.Environment("PROCESS")::k("c")=caption::k("f")=filters::k("n")=initfn
  Set e=w.Exec("%SystemRoot%\System32\mshta.exe ""about:<SCRIPT>p=new ActiveXObject('WScript.Shell').Environment('PROCESS');document.write('<TITLE>'+(p('c')||'\xA0')+'</TITLE>');try{moveTo(-9e4,0)}catch(E){}onload=function(){B=D.openfiledlg(p('n'),'',p('f'),p('c'));new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(B);close()}</SCRIPT><HTA:APPLICATION WINDOWSTATE=minimize /><OBJECT ID=D CLASSID=CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B></OBJECT>""")
  pickOpenFileName=e.StdOut.ReadLine
End Function


Function takeOpenFileName(caption,filters,initfn,msght)
  caption=Trim(caption)
  Set w=CreateObject("WScript.Shell")::Set k=w.Environment("PROCESS")::k("c")=caption::k("f")=filters::k("n")=initfn::k("m")=msght
  Set e=w.Exec("%SystemRoot%\System32\mshta.exe ""about:<HTA:APPLICATION BORDER=none SHOWINTASKBAR=no INNERBORDER=no SCROLL=no /><BODY BGCOLOR=#DDEEFF TEXT=#336699><H1 ALIGN=RIGHT><SCRIPT>p=new ActiveXObject('WScript.Shell').Environment('PROCESS');document.write(p('m'))</SCRIPT></H1><OBJECT ID=D CLASSID=CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B></OBJECT><SCRIPT>onload=function(){B=D.openfiledlg(p('n'),'',p('f'),p('c'));new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(B);close()}</SCRIPT>""")
  takeOpenFileName=e.StdOut.ReadLine
End Function


Sub maybeSplashScreen()
  Set w=CreateObject("WScript.Shell")
  v=w.RegRead("HKLM\SOFTWARE\Microsoft\Internet Explorer\Version")
  If CInt(Left(v,2))>7 Then Exit Sub
  v=w.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
  If CInt(Left(v,2))>5 Then
    Set e=w.Exec("%SystemRoot%\System32\mshta.exe ""about:<HTA:APPLICATION BORDER=none SHOWINTASKBAR=no INNERBORDER=no SCROLL=no /><STYLE>body{margin:0}table{border-collapse:collapse}table,td{border:5px solid #6F6}</STYLE><BODY BGCOLOR=#009900 TEXT=#FFFFFF><TABLE WIDTH=100% HEIGHT=100%><TR VALIGN=MIDDLE><TD ALIGN=CENTER><FONT SIZE=7>正在加载...<BR>Loading...</FONT></TD></TR></TABLE></BODY>""")
    WScript.Sleep 500
    e.Terminate
  End If
End Sub


maybeSplashScreen()

r=pickOpenFileName("","","")
If Len(r)>0 Then MsgBox r,64,"OpenFile"

r=pickOpenFileName("请选择数据文件","电子表格(*.xls)|*.xls|所有文件(*.*)|*.*|","")
If Len(r)>0 Then MsgBox r,64,"OpenFile"


r=takeOpenFileName("","","","欢迎使用<BR>实用软件")
If Len(r)>0 Then MsgBox r,64,"OpenFile"

r=takeOpenFileName("请选择数据文件","电子表格(*.xls)|*.xls|所有文件(*.*)|*.*|","","欢迎使用<BR>实用软件<BR>版本:202308")
If Len(r)>0 Then MsgBox r,64,"OpenFile"

 

lxasp 2023-08-29 15:22 发表评论
]]>