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