Option Explicit
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Sub Form_Load()
Dim IconPath As String
'同文件夹下默认图标名称
IconPath = App.Path & "\Icon.ico"
If Dir(IconPath, vbHidden + vbSystem + vbReadOnly) <> "" Then
'更改当前选中的文件夹为系统文件
ChangeFolderInfo App.Path
Dim ini_File As String
ini_File = App.Path & "\desktop.ini"
If Dir(ini_File, vbHidden) <> "" Then
Call ChangeFileInfo(ini_File, 0)
End If
Dim Temp As Integer
Temp = FreeFile()
'打开目前选中的文件夹的desktop.ini文件
Open ini_File For Output As #Temp
'更改desktop.ini文件
Print #Temp, "[.ShellClassInfo]" + vbCrLf + "IconIndex=0" + _
vbCrLf + "iconfile=" + IconPath
Close #Temp
'将desktop.ini文件设置为隐藏
Call ChangeFileInfo(ini_File, FILE_ATTRIBUTE_HIDDEN)
MsgBox "文件夹图标设置成功!"
End
Else
MsgBox "缺少默认图标文件 Icon.ico"
End If
End Sub
'设置文件夹系统属性
Private Sub ChangeFolderInfo(folderspec)
If Len(folderspec) < 1 Then
Exit Sub
End If
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
f.Attributes = FILE_ATTRIBUTE_SYSTEM
End Sub
'设置文件隐藏属性
Private Sub ChangeFileInfo(filespec, attr)
If Len(filespec) < 1 Then
Exit Sub
End If
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
f.Attributes = attr
End Sub
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Sub Form_Load()
Dim IconPath As String
'同文件夹下默认图标名称
IconPath = App.Path & "\Icon.ico"
If Dir(IconPath, vbHidden + vbSystem + vbReadOnly) <> "" Then
'更改当前选中的文件夹为系统文件
ChangeFolderInfo App.Path
Dim ini_File As String
ini_File = App.Path & "\desktop.ini"
If Dir(ini_File, vbHidden) <> "" Then
Call ChangeFileInfo(ini_File, 0)
End If
Dim Temp As Integer
Temp = FreeFile()
'打开目前选中的文件夹的desktop.ini文件
Open ini_File For Output As #Temp
'更改desktop.ini文件
Print #Temp, "[.ShellClassInfo]" + vbCrLf + "IconIndex=0" + _
vbCrLf + "iconfile=" + IconPath
Close #Temp
'将desktop.ini文件设置为隐藏
Call ChangeFileInfo(ini_File, FILE_ATTRIBUTE_HIDDEN)
MsgBox "文件夹图标设置成功!"
End
Else
MsgBox "缺少默认图标文件 Icon.ico"
End If
End Sub
'设置文件夹系统属性
Private Sub ChangeFolderInfo(folderspec)
If Len(folderspec) < 1 Then
Exit Sub
End If
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
f.Attributes = FILE_ATTRIBUTE_SYSTEM
End Sub
'设置文件隐藏属性
Private Sub ChangeFileInfo(filespec, attr)
If Len(filespec) < 1 Then
Exit Sub
End If
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
f.Attributes = attr
End Sub
【Icon.rar】点击下载此文件
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |