VBA设置文件属性及加密源代码示例
代码如下：－－－－－－－－－－－开始－－－－－－－－－－－－
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.Number0 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
－－－－－－－－－－－结束－－－－－－－－－－－－
代码网上弄滴，不知原作者为何人，在此引用，谢谢！
PPT学习论坛，找到组织了！
页:
[1]