伏龙阁资源网

vbs提示没有在该机执行windows脚本宿主的权限。请与系统管理员联系
站长资源 2024/12/23 佚名
2 0

最近在项目中使用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
广告合作：本站广告合作请联系QQ：858582 申请时备注：广告合作（否则不回）
免责声明：本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除！
www.wwsws.com 伏龙阁资源网
39,976影音资源
44,792技术资源
21,817软件资源
651,128站长资源

更新日志

友情链接

杰晶网络 DDR爱好者之家 桃源资源网 杰网资源 富贵资源网 南强小屋 铁雪资源网 幽灵资源网 万梅资源网 狼山资源网 白云岛资源网 昆仑资源网 相思资源网 明霞山资源网 内蒙古资源网 黑松山资源网 茶园资源网 饿虎岗资源网 大旗谷资源网 常春岛资源网 岱庙资源网 兴国资源网 快活林资源网 蝙蝠岛资源网 帝王谷资源网 白云城资源网 伏龙阁资源网 清风细雨楼 天枫庄资源网 圆月山庄资源网 无争山庄资源网 神水资源网 移花宫资源网 神剑山庄资源网 无为清净楼资源网 金钱帮资源网 丐帮资源网 华山资源网 极乐门资源网 小李飞刀资源网 凤求凰客栈 风云阁资源网 金狮镖局 鸳鸯亭资源网 千金楼资源网 更多链接