领星动网编程开发之爆炸小宇宙

cnitblog.com/lxasp - - 有一种信念叫做编程
posts - 61, comments - 34, trackbacks - 0, articles - 0

打开文件对话框的VBScript全兼容解决方案(无临时文件)XP-W7-W10(IE6-11) GetOpenFileName

Posted on 2023-08-29 15:22 lxasp 阅读(188) 评论(0)  编辑 收藏 引用 所属分类: VBScript
VBScript实现运行“打开文件对话框”进行文件选择。（不创建临时文件）

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"

 
只有注册用户登录后才能发表评论。