登 录
Option Explicit<br /> '定义属性常量<br /> const Normal = 0<br /> const OnlyRead = 1<br /> const Hidden = 2<br /> const System = 4<br /> Dim LngAttrib<br /> LngAttrib = InputBox("请输入想要更改为的属性的序号(如2)" & vbLf & vbLf & "1.无属性" _<br /> & vbLf & vbLf & "2.只读属性" & vbLf & vbLf & "3.隐藏属性" & vbLf & vbLf & "4.系统属性" _<br /> & vbLf & vbLf & "5.只读属性 加 隐藏属性" & vbLf & vbLf & "6.只读属性 加 系统属性" & vbLf _<br /> & vbLf & "7.系统属性 加 隐藏属性" & vbLf & vbLf & "8.只读属性 加 系统属性 加 隐藏属性",_<br /> "提示",1)<br /> If IsNumeric(LngAttrib) = True And LngAttrib <= 7 And LngAttrib >= 1 Then<br /> Dim ObjFSO,Objpath,LngN<br /> Set ObjFSO = CreateObject("Scripting.FileSystemObject")<br /> Set Objpath = ObjFSO.GetFolder(ObjFSo.GetAbsolutePathName("")) '获取路径<br /> Set ObjFSO = Nothing<br /> LngN = Objpath.Files.Count '获取文件数量<br /> LngN = LngN + Objpath.SubFolders.Count '文件以及文件夹的总数量</p> <p> Dim i,one<br /> ReDim arrAll(LngN) '存放文件及文件夹的信息</p> <p> For Each one In Objpath.Files<br /> i = i + 1<br /> arrAll(i) = one.Name '每个数组元素存放一个文件的名字<br /> Next</p> <p> For Each one In Objpath.SubFolders<br /> i = i + 1<br /> arrAll(i) = one.Name '每个数组元素存放一个文件夹的名字<br /> Next</p> <p> Dim m,a<br /> For m=1 To Objpath.Files.Count<br /> a = a & m & ". File:" & arrAll(m) & vbLf & vbLf '将文件信息转入一个变量中<br /> Next</p> <p> Set Objpath = Nothing</p> <p> For m = m To LngN<br /> a = a & m & ". Folder:" & arrAll(m) & vbLf & vbLf '将文件夹信息转入一个变量中<br /> Next</p> <p> Dim strtarget,strTmp,str<br /> strtarget = InputBox ("请输入你想要更改属性的文件的序号,可以输入多个,以"".""结束(如1.2.)" _<br /> & vbLf & vbLf & a,"提示")<br /> If strtarget <> "" And Len(strtarget) <> 1 Then<br /> For i = 1 To Len(strtarget)<br /> strTmp = Mid(strtarget,i,1) '逐个读取字符窜<br /> If strTmp = "." Then '如果是点则读取之前字符所组成的数字<br /> str = CLng(str) '将字符串强制转换成数字<br /> If str >= 1 And str <= LngN Then<br /> call FindF<br /> Else '不再范围内则提示错误<br /> EntErr<br /> End If<br /> Else '不是点则将读取的数据合并成一个新的字符串，遇到点后转换<br /> If strTmp <> "." And IsNumeric(strTmp) Then<br /> str = str & strTmp<br /> Else '字符串不是数字则提示错误<br /> EntErr<br /> End If<br /> End If<br /> Next<br /> Else '字符串为空则提示错误<br /> EntErr<br /> End If<br /> Flush<br /> Else<br /> EntErr '不再范围内则提示错误<br /> End If<br /> Sub FindF<br /> Dim ObjF,ObjFSO<br /> Set ObjFSO = CreateObject("Scripting.FileSystemObject")<br /> If ObjFSO.FileExists(arrAll(str)) = True Then '查找文件<br /> Set ObjF = ObjFSO.GetFile(arrAll(str))<br /> call ChangeAtt(ObjF)<br /> str = Empty<br /> Set ObjF = Nothing<br /> Else<br /> If ObjFSO.FolderExists(arrAll(str)) = True Then '查找文件夹<br /> Set ObjF = ObjFSO.GetFolder(arrAll(str))<br /> call ChangeAtt(ObjF)<br /> str = Empty<br /> Set ObjF = Nothing<br /> Else '如果都不存在则提示并退出<br /> MsgBox "不存在该文件或文件夹",64,"提示"<br /> WScript.Quit<br /> End If<br /> End If<br /> Set ObjFSO = Nothing<br /> End Sub<br /> Sub ChangeAtt(ObjF) '更改属性<br /> With ObjF<br /> Select Case (LngAttrib)<br /> Case 1:.Attributes = Normal<br /> Case 2:.Attributes = OnlyRead<br /> Case 3:.Attributes = Hidden<br /> Case 4:.Attributes = System<br /> Case 5:.Attributes = OnlyRead + Hidden<br /> Case 6:.Attributes = OnlyRead + System<br /> Case 7:.Attributes = Hidden + System<br /> Case 8:.Attributes = OnlyRead + Hidden + System<br /> End Select<br /> End With<br /> End Sub<br /> Sub Flush<br /> Wscript.Sleep 100 '暂停<br /> Dim ws<br /> set ws=wscript.createobject("wscript.shell")<br /> ws.SendKeys("{F5}") '刷新<br /> Set ws = Nothing<br /> End Sub<br /> Sub EntErr '错误提示<br /> MsgBox "请输入有效字符",64,"提示"<br /> WScript.Quit<br /> End Sub<br />
这是我这两个星期学期VBS的研究成果之一，呵呵，其实只是把书上讲的属性、方法简单的用了一下，希望对那些学习VBS的人也会有帮助把，纯属娱乐
抱歉!评论已关闭.