DDR爱好者之家 Design By 杰米
最近在项目中使用VBS来实现图片的批量删除和批量导入功能,但不知道为什么,只要在我机器上一运行VBS文件就提示“没有在该机执行windows脚本宿主的权限。请与系统管理员联系。”的错误。下面贴出本人的解决方法,并附上图片批量导入及批量删除的VBS代码。
如果只是因为权限问题可以查看这篇文章:
以管理员身份运行程序的vbs命令
1、检查系统是否禁止使用了脚本运行,即打开“INTERNET选项”的“安全”选项卡里“自定义级别”,看看“ActiveX空件及服务”禁用的选项。
2、运行 regsvr32 scrrun.dll,即打开运行输入CMD,输入regsvr32 scrrun.dll,再回车。
3、最关键的一步,即看看注册表里的这个位置HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Script Host\Settings在右边的窗口中是不是有个名为 Enabled的DWORD键值,有的话把它删除或者把值该为 1 即可。
4、重新运行VBS文件即将正常。
VBS批量导入图片功能
'****************** Const **************** '---- CuRsorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- CuRsorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 '---- Custom Values ---- Const cuDSN = "test" Const cuUsername = "sa" Const cuPassword = "" '*************** main sub ****************** Call ImageExport() '*************** define function *********** Function ImageExport() 'on error resume next Dim sSQL,Rs,Conn,sfzRs,sFilePath,sImgFile,xml Dim Ados,fso,f,oShell,sErrFile,sSucFile,iErr,iSuc Set fso = CreateObject("Scripting.FileSystemObject") ' Create Stream Object set Ados=CreateObject("Adodb.Stream") Ados.Mode=3 Ados.Type=1 Set Conn=CreateObject ("adodb.Connection") Conn.CuRsorLocation =adUseClient Call Init_Connection(Conn) Set Rs=CreateObject ("adodb.recordset") Set sfzRs=CreateObject ("adodb.recordset") sFilePath=WScript.ScriptFullName sFilePath=left(sFilePath,len(sFilePath)-len(WScript.ScriptName)) ssql="SELECT RYBH, PHOTO FROM TP_ZPXX WHERE (RYBH IN (SELECT DISTINCT RYBH FROM TP_BMKM WHERE (KSZQBH = 18) AND (JFBZ = 1)))" sfzRs.Open sSQL,Conn,adOpenForwardOnly iSuc=sfzRs.RecordCount 'Get SFZH From DataBase and import images while not sfzRs.EOF sImgFile= sFilePath & sfzRs("RYBH") & ".jpg" Ados.Open Ados.Write (sfzRs("PHOTO").GetChunk(4500000)) Ados.SaveToFile sImgFile,1 sfzRs.MoveNext Ados.Close wend sfzRs.Close Conn.Close 'Release Object set Rs=nothing:set sfzRs=nothing:set Conn=nothing:set Ados=nothing msgbox iSuc & "张照片导出成功",64 ,"照片导出" 'Quit WScript.Quit End Function Function Init_Connection(Conn) on error resume next ConnStr = "Provider=SQLOLEDB;Data Source=192.168.64.114;" & _ "Initial Catalog=VoteInfo;User Id=sa;Password=123456;timeout=50" Conn.Open ConnStr If Err.number Then msgbox "数据库联接失败",16 ,"照片导出" exit function End If End Function
VBS批量删除图片功能
'****************** Const **************** '---- CuRsorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- CuRsorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 '---- Custom Values ---- Const cuDSN = "test" Const cuUsername = "sa" Const cuPassword = "" '*************** main sub ****************** Call ImageExport() '*************** define function *********** Function ImageExport() 'on error resume next Dim sSQL,Rs,Conn,sfzRs,xml Dim Ados,fso,f,oShell,sErrFile,sSucFile,iErr,iSuc 'iSuc 文件总数 Dim PicPath,PhysicPath,DelCount '删除文件数 Set fso = CreateObject("Scripting.FileSystemObject") ' Create Stream Object set Ados=CreateObject("Adodb.Stream") Ados.Mode=3 Ados.Type=1 Set Conn=CreateObject ("adodb.Connection") Conn.CuRsorLocation =adUseClient Call Init_Connection(Conn) Set Rs=CreateObject ("adodb.recordset") Set sfzRs=CreateObject ("adodb.recordset") sSQL="select sPath,sFile from ScanFile" sfzRs.Open sSQL,Conn,adOpenForwardOnly iSuc=sfzRs.RecordCount 'Get SFZH From DataBase and import images while not sfzRs.EOF PhysicPath="E:\VBS删除照片小程序" '物理路径 Ados.Open PicPath =PhysicPath & sfzRs("sPath") &"\" & sfzRs("sFile") If (fso.FileExists(PicPath)) Then fso.DeleteFile(PicPath) DelCount=DelCount+1 end if sfzRs.MoveNext Ados.Close if iSuc-DelCount=iSuc Then DelCount=0 end if wend sfzRs.Close Conn.Close 'Release Object set Rs=nothing:set sfzRs=nothing:set Conn=nothing:set Ados=nothing:set fso=nothing msgbox "共需要删除" & iSuc & "张照片,其中" & DelCount & "张照片删除成功," &iSuc-DelCount & "张照片未找到!",64 ,"照片删除" 'Quit WScript.Quit End Function Function Init_Connection(Conn) on error resume next ConnStr = "Provider=SQLOLEDB;Data Source=192.168.64.114;" & _ "Initial Catalog=VoteInfo;User Id=sa;Password=123456;timeout=50" Conn.Open ConnStr If Err.number Then msgbox "数据库联接失败",16 ,"照片删除" exit function End If End Function
DDR爱好者之家 Design By 杰米
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
DDR爱好者之家 Design By 杰米
暂无评论...
更新日志
2024年12月25日
2024年12月25日
- 小骆驼-《草原狼2(蓝光CD)》[原抓WAV+CUE]
- 群星《欢迎来到我身边 电影原声专辑》[320K/MP3][105.02MB]
- 群星《欢迎来到我身边 电影原声专辑》[FLAC/分轨][480.9MB]
- 雷婷《梦里蓝天HQⅡ》 2023头版限量编号低速原抓[WAV+CUE][463M]
- 群星《2024好听新歌42》AI调整音效【WAV分轨】
- 王思雨-《思念陪着鸿雁飞》WAV
- 王思雨《喜马拉雅HQ》头版限量编号[WAV+CUE]
- 李健《无时无刻》[WAV+CUE][590M]
- 陈奕迅《酝酿》[WAV分轨][502M]
- 卓依婷《化蝶》2CD[WAV+CUE][1.1G]
- 群星《吉他王(黑胶CD)》[WAV+CUE]
- 齐秦《穿乐(穿越)》[WAV+CUE]
- 发烧珍品《数位CD音响测试-动向效果(九)》【WAV+CUE】
- 邝美云《邝美云精装歌集》[DSF][1.6G]
- 吕方《爱一回伤一回》[WAV+CUE][454M]