大众计算机学习网欢迎诸位!收藏本站注 册登 陆
常用教程:基础知识网络知识操作系统WPS网页制作数据库算法网页成功之路网络安全最新技术古典mid流行midmid背景下载中心
您现在的位置:首页 > 教程 > 文章页

VBA设置文件属性及加密源代码示例

Admin | 2008-4-22 22:42:34 | ReadNums | 6266 | 标签 PowerPoint教程 | 打印本页
     

代码如下:

-----------开始------------

Option Explicit
Dim sPath As String '文件夹变量
Private Sub Command2_Click()
Dim fs
Shell "attrib -s " & sPath, vbHide
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(sPath & "\" & "desktop.ini") Then
    fs.DeleteFile sPath & "\" & "desktop.ini", True
End If
End Sub
Private Sub Dir1_Click()
Dim i As Integer
Command1.Enabled = True
Command2.Enabled = True
i = Dir1.ListIndex
sPath = Dir1.List(i)
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
'Command1.Caption = "定义文件夹图标"
Command1.Enabled = False
Command2.Enabled = False
End Sub
Private Sub Command1_Click()
ChangeFolderInfo sPath '更改目录为系统文件
Dim s As String '图标文件路径、名称变量
If Chk1.Value = 1 Then
    With CommonDialog1
    .Filter = "(*.ico)|*.ico"
    .DialogTitle = "查找图标"
    .ShowOpen
    s = .FileName
    End With
End If
On Error Resume Next
Open sPath & "\" & "desktop.ini" For Output As #1
If Err.Number <> 0 Then
    MsgBox "该文件已经加密!"
    Err.Number = 0
    Exit Sub
End If
If Chk1.Value = 1 Then
    Print #1, "[.ShellClassInfo]"; vbCrLf; "ConfirmFileOp=0"; vbCrLf; "IconIndex=0"; vbCrLf; "iconfile="; s
Else
    Print #1, "[.ShellClassInfo]"; vbCrLf; "CLSID={871C5380-42A0-1069-A2EA-08002B30309D}"; vbCrLf; "ConfirmFileOp=0"; vbCrLf;
End If
Close #1
ChangeFileInfo (sPath & "\" & "desktop.ini")
End Sub
'赋予文件夹系统属性子程序
Private Sub ChangeFolderInfo(folderspec)
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
f.Attributes = 4 '用Attributes函数设置文件夹属性
End Sub
'赋予Desktop.ini文件隐藏属性
Private Sub ChangeFileInfo(filespec)
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
f.Attributes = 2 '用Attributes属性设置文件属性
End Sub

-----------结束------------

  代码网上弄滴,不知原作者为何人,在此引用,谢谢!


问题未解决:在线咨询

网友评论

(访客)
内容实用原创,讲得很好。
20xx年x月x日
(站长)
有问题请在线咨询。
20xx年x月x日