☰

如何使用 vbscript 或命令行显示更改图标对话框？

tag-icon • tag-icon command-line icons vbscript
如何使用 vbscript 或命令行显示更改图标对话框？

我如何使用 vbscript 或命令行显示更改图标对话框，并使用信息将其放入我的 vbscript 中，以便让用户从更改图标对话框中选择他想要设置的图标？

在此处输入图片描述

这是我创建的 vbscript，我在 Windows 10 上进行了测试，它可以在桌面上创建一个文件夹并将其图标更改为挂锁图标。

Option Explicit
Dim ws,Icon,strText,DesktopFolder,strFolder
Set ws = CreateObject("wscript.Shell")
DesktopFolder = ws.SpecialFolders("Desktop")
strFolder = DesktopFolder & "\Hackoo Folder Icon Changer"
Icon = "%systemroot%\system32\shell32.dll,-48"
strText = "[.ShellClassInfo]" & vbCrLf &_
"IconResource="& Icon & vbCrLf &_
"IconFile=%systemroot%\system32\shell32.dll"
'Create a folder on our desktop
Call SmartCreateFolder(strFolder)
'Transform our folder to a system folder
Call Execute("attrib +s " & DblQuote(strFolder))
Call Write_INI_File(strFolder,strText)
'********************************************************************
Sub SmartCreateFolder(strFolder)
    Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
    End If
    oFSO.CreateFolder(strFolder)
    Set oFSO = Nothing    
End Sub
'********************************************************************
Function Execute(StrCmd)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,0,True)
        If Resultat <> 0 Then
            MsgBox "Une erreur inconnue est survenue !",16,_
            "Une erreur inconnue est survenue !"
        End If
    Execute = Resultat
End Function
'********************************************************************
Sub Write_INI_File(PathFolder,strText)
Dim fs,ts,DesktopINI
Const ForWriting = 2
    DesktopINI = PathFolder & "\Desktop.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.FileExists(DesktopINI) Then 
        Call Execute("Attrib -R -H -S "& DblQuote(DesktopINI))
        fs.DeleteFile DesktopINI
    end If
    Set ts = fs.OpenTextFile(DesktopINI,ForWriting,True)
    ts.WriteLine strText
    ts.Close
'Transform the file Desktop.ini to a hidden and system file
    Call Execute("Attrib +R +H +S "& DblQuote(DesktopINI))
End Sub
'********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************

答案1

最后，我找到了一种解决方法，使用 HTA 来显示并选择要更改的默认文件夹图标。

在此处输入图片描述

<html>
<HTA:APPLICATION  
APPLICATIONNAME="Hackoo Icon Folder Changer 2018"  
ICON="DxDiag.exe"  
SCROLL="Yes"  
SCROLLFLAT="yes"  
SINGLEINSTANCE="yes"  
WINDOWSTATE="maximize"   
SELECTION="no"/>
<Title>Hackoo Icon Folder Changer 2018</Title>
<head>
<link rel="stylesheet" type="text/css" href="https://help4windows.com/~webcode/style-help4windows.css">
<script language="JavaScript">
</script>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Function GetIndex(idx)
Dim Question,Ws,Icon,strText,DesktopFolder,strFolder
Question = MsgBox("You have chosen the icon with the index = " & idx & vbCrLf &_
"%Systemroot%\system32\shell32.dll," & idx & vbCrLf & vbCrLf &_
"Do you want to confirm or not ?",VbYesNo+VbQuestion,"Hackoo Icon Folder Changer 2018")
If Question = vbYes Then
    Set Ws = CreateObject("wscript.Shell")
    DesktopFolder = ws.SpecialFolders("Desktop")
    strFolder = DesktopFolder & "\Hackoo Folder Icon Changer"
    Icon = "%systemroot%\system32\shell32.dll," & idx
    strText = "[.ShellClassInfo]" & vbCrLf &_
    "IconResource="& Icon & vbCrLf &_
    "IconFile=%systemroot%\system32\shell32.dll"
    'Create a folder on our desktop
    Call SmartCreateFolder(strFolder)
    'Transform our folder to a system folder
    Call Execute("attrib +s " & DblQuote(strFolder))
    Call Write_INI_File(strFolder,strText)
    Ws.Run "ie4uinit.exe -ClearIconCache"
    Ws.Run "ie4uinit.exe -show"
    Ws.Run DblQuote(strFolder)
Else
    Exit Function
End If
End Function
'********************************************************************
Sub SmartCreateFolder(strFolder)
    Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
    End If
    oFSO.CreateFolder(strFolder)
    Set oFSO = Nothing    
End Sub
'********************************************************************
Function Execute(StrCmd)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,0,True)
        If Resultat <> 0 Then
            MsgBox "Une erreur inconnue est survenue !",16,_
            "Une erreur inconnue est survenue !"
        End If
    Execute = Resultat
End Function
'********************************************************************
Sub Write_INI_File(PathFolder,strText)
Dim fs,ts,DesktopINI
Const ForWriting = 2
    DesktopINI = PathFolder & "\Desktop.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.FileExists(DesktopINI) Then 
        Call Execute("Attrib -R -H -S "& DblQuote(DesktopINI))
        fs.DeleteFile DesktopINI
    end If
    Set ts = fs.OpenTextFile(DesktopINI,ForWriting,True)
    ts.WriteLine strText
    ts.Close
'Transform the file Desktop.ini to a hidden and system file
    Call Execute("Attrib +R +H +S "& DblQuote(DesktopINI))
End Sub
'********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************
</SCRIPT>
</head>
<body>
<center><font color="White">Click on an image to choose the icon of your folder</font><br>
<table class="data">
<tr>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-000.jpg" OnClick="GetIndex(this.alt)" alt="0"><br>0</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-001.jpg" OnClick="GetIndex(this.alt)" alt="1"><br>1</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-002.jpg" OnClick="GetIndex(this.alt)" alt="2"><br>2</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-003.jpg" OnClick="GetIndex(this.alt)" alt="3" ><br>3</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-004.jpg" OnClick="GetIndex(this.alt)" alt="4" ><br>4</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-005.jpg" OnClick="GetIndex(this.alt)" alt="5" ><br>5</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-006.jpg" OnClick="GetIndex(this.alt)" alt="6" ><br>6</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-007.jpg" OnClick="GetIndex(this.alt)" alt="7" ><br>7</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-008.jpg" OnClick="GetIndex(this.alt)" alt="8" ><br>8</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-009.jpg" OnClick="GetIndex(this.alt)" alt="9" ><br>9</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-010.jpg" OnClick="GetIndex(this.alt)" alt="10" ><br>10</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-011.jpg" OnClick="GetIndex(this.alt)" alt="11" ><br>11</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-012.jpg" OnClick="GetIndex(this.alt)" alt="12" ><br>12</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-013.jpg" OnClick="GetIndex(this.alt)" alt="13" ><br>13</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-014.jpg" OnClick="GetIndex(this.alt)" alt="14" ><br>14</td>
</tr>
<tr>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-015.jpg" OnClick="GetIndex(this.alt)" alt="15" ><br>15</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-016.jpg" OnClick="GetIndex(this.alt)" alt="16" ><br>16</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-017.jpg" OnClick="GetIndex(this.alt)" alt="17" ><br>17</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-018.jpg" OnClick="GetIndex(this.alt)" alt="18" ><br>18</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-019.jpg" OnClick="GetIndex(this.alt)" alt="19" ><br>19</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-020.jpg" OnClick="GetIndex(this.alt)" alt="20" ><br>20</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-021.jpg" OnClick="GetIndex(this.alt)" alt="21" ><br>21</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-022.jpg" OnClick="GetIndex(this.alt)" alt="22" ><br>22</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-023.jpg" OnClick="GetIndex(this.alt)" alt="23" ><br>23</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-024.jpg" OnClick="GetIndex(this.alt)" alt="24" ><br>24</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-025.jpg" OnClick="GetIndex(this.alt)" alt="25" ><br>25</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-026.jpg" OnClick="GetIndex(this.alt)" alt="26" ><br>26</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-027.jpg" OnClick="GetIndex(this.alt)" alt="27" ><br>27</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-028.jpg" OnClick="GetIndex(this.alt)" alt="28" ><br>28</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-029.jpg" OnClick="GetIndex(this.alt)" alt="29" ><br>29</td>
</tr>
<tr>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-030.jpg" OnClick="GetIndex(this.alt)" alt="30" ><br>30</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-031.jpg" OnClick="GetIndex(this.alt)" alt="31" ><br>31</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-032.jpg" OnClick="GetIndex(this.alt)" alt="32" ><br>32</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-033.jpg" OnClick="GetIndex(this.alt)" alt="33" ><br>33</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-034.jpg" OnClick="GetIndex(this.alt)" alt="34" ><br>34</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-035.jpg" OnClick="GetIndex(this.alt)" alt="35" ><br>35</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-036.jpg" OnClick="GetIndex(this.alt)" alt="36" ><br>36</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-037.jpg" OnClick="GetIndex(this.alt)" alt="37" ><br>37</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-038.jpg" OnClick="GetIndex(this.alt)" alt="38" ><br>38</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-039.jpg" OnClick="GetIndex(this.alt)" alt="39" ><br>39</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-040.jpg" OnClick="GetIndex(this.alt)" alt="40" ><br>40</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-041.jpg" OnClick="GetIndex(this.alt)" alt="41" ><br>41</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-042.jpg" OnClick="GetIndex(this.alt)" alt="42" ><br>42</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-043.jpg" OnClick="GetIndex(this.alt)" alt="43" ><br>43</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-044.jpg" OnClick="GetIndex(this.alt)" alt="44" ><br>44</td>
<tr>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-045.jpg" OnClick="GetIndex(this.alt)" alt="45"><br>45</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-046.jpg" OnClick="GetIndex(this.alt)" alt="46"><br>46</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-047.jpg" OnClick="GetIndex(this.alt)" alt="47"><br>47</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-048.jpg" OnClick="GetIndex(this.alt)" alt="48"><br>48</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-049.jpg" OnClick="GetIndex(this.alt)" alt="49"><br>49</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-050.jpg" OnClick="GetIndex(this.alt)" alt="50"><br>50</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-051.jpg" OnClick="GetIndex(this.alt)" alt="51"><br>51</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-052.jpg" OnClick="GetIndex(this.alt)" alt="52"><br>52</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-053.jpg" OnClick="GetIndex(this.alt)" alt="53"><br>53</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-054.jpg" OnClick="GetIndex(this.alt)" alt="54"><br>54</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-055.jpg" OnClick="GetIndex(this.alt)" alt="55"><br>55</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-056.jpg" OnClick="GetIndex(this.alt)" alt="56"><br>56</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-057.jpg" OnClick="GetIndex(this.alt)" alt="57"><br>57</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-058.jpg" OnClick="GetIndex(this.alt)" alt="58"><br>58</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-059.jpg" OnClick="GetIndex(this.alt)" alt="59"><br>59</td>
</tr>
<tr>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-060.jpg" OnClick="GetIndex(this.alt)" alt="60"><br>60</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-061.jpg" OnClick="GetIndex(this.alt)" alt="61"><br>61</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-062.jpg" OnClick="GetIndex(this.alt)" alt="62"><br>62</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-063.jpg" OnClick="GetIndex(this.alt)" alt="63"><br>63</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-064.jpg" OnClick="GetIndex(this.alt)" alt="64"><br>64</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-065.jpg" OnClick="GetIndex(this.alt)" alt="65"><br>65</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-066.jpg" OnClick="GetIndex(this.alt)" alt="66"><br>66</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-067.jpg" OnClick="GetIndex(this.alt)" alt="67"><br>67</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-068.jpg" OnClick="GetIndex(this.alt)" alt="68"><br>68</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-069.jpg" OnClick="GetIndex(this.alt)" alt="69"><br>69</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-070.jpg" OnClick="GetIndex(this.alt)" alt="70"><br>70</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-071.jpg" OnClick="GetIndex(this.alt)" alt="71"><br>71</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-072.jpg" OnClick="GetIndex(this.alt)" alt="72"><br>72</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-073.jpg" OnClick="GetIndex(this.alt)" alt="73"><br>73</td>
  <td><img src="https://help4windows.com/~webfiles/icons_win_8/win8_ico_shell32_dll-074.jpg" OnClick="GetIndex(this.alt)" alt="74"><br>74</td>
</tr>
</table>
</body>
</html>

编辑：新版本 2020：Shell32.dll从站点获取并提取所有图标。Shell32.dll.hta

<html>
<HTA:APPLICATION  
APPLICATIONNAME="Hackoo Icon Folder Changer 2020 (Resources from Shell32.dll)"  
ICON="DxDiag.exe"  
SCROLL="Yes"  
SCROLLFLAT="yes"  
SINGLEINSTANCE="no"  
WINDOWSTATE="maximize"   
SELECTION="no"/>
<Title>Hackoo Icon Folder Changer 2020 (Resources from Shell32.dll)</Title>
<head>
<link rel="stylesheet" type="text/css" href="https://help4windows.com/~webcode/style-help4windows.css">
<style>
    img { cursor: hand; }
</style>
</head>
<body>
<center><font color="White">Click on an image to choose the icon of your folder</font><br>
<span id="icons"</span>
</center>
</body>
</html>
<SCRIPT LANGUAGE="VBScript">
'---------------------------------------------
Option Explicit
Dim Title,HTTP_Request,Data,Icons,ErrorLine
Title = "Hackoo Icon Folder Changer 2020 (Resources from Shell32.dll)"
Set HTTP_Request = CreateObject("Microsoft.XMLHTTP")
On Error Resume Next
HTTP_Request.Open "GET","https://help4windows.com/windows_8_shell32_dll.shtml", False
HTTP_Request.Send()
If err.number <> 0 then 
    ErrorLine  = ErrorLine &  vbcrlf & "Error getting HTTP_Request" 
    ErrorLine  = ErrorLine &  vbcrlf & "==================" 
    ErrorLine  = ErrorLine &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
    ErrorLine  = ErrorLine &  vbcrlf & "Source " & err.source 
    ErrorLine  = ErrorLine &  vbcrlf & "HTTP Error " & HTTP_Request.Status & " " & HTTP_Request.StatusText
    ErrorLine  = ErrorLine &  vbcrlf &  HTTP_Request.getAllResponseHeaders
    MsgBox ErrorLine,vbCritical,Title
    Err.clear
End If
Data = HTTP_Request.ResponseText
Data = Extract(Data,"(?:<table class=\x22data\x22>)([\S\s]*)(?:<table class=\x22footer\x22>)")
Data = Replace(Data,"~webfiles/","https://help4windows.com/~webfiles/")
Data = Search_Replace(Data)
Set Icons = document.getElementById("icons")
Icons.InnerHTML = "<table class=""data"">" & Data &"</table>"
'---------------------------------------------
Function GetIndex(idx)
Dim Question,Ws,Icon,strText,DesktopFolder,strFolder
Question = MsgBox("You have chosen the icon with the index = " & idx & vbCrLf &_
"%Systemroot%\system32\shell32.dll," & idx & vbCrLf & vbCrLf &_
"Do you want to confirm or not ?",VbYesNo+VbQuestion,"Hackoo Icon Folder Changer 2020")
If Question = vbYes Then
    Set Ws = CreateObject("wscript.Shell")
    DesktopFolder = ws.SpecialFolders("Desktop")
    strFolder = DesktopFolder & "\Hackoo Folder Icon Changer"
    Icon = "%systemroot%\system32\shell32.dll," & idx
    strText = "[.ShellClassInfo]" & vbCrLf &_
    "IconResource="& Icon & vbCrLf &_
    "IconFile=%systemroot%\system32\imageres.dll"
    'Create a folder on our desktop
    Call SmartCreateFolder(strFolder)
    'Transform our folder to a system folder
    Call Execute("attrib +s " & DblQuote(strFolder))
    Call Write_INI_File(strFolder,strText)
    'Ws.Run "ie4uinit.exe -ClearIconCache",1,True
    WS.Run "explorer.exe shell:::{3080F90D-D7AD-11D9-BD98-0000947B0257}",1,True
    'Ws.Run "ie4uinit.exe -show",1,True
    Ws.Run DblQuote(strFolder)
Else
    Exit Function
End If
End Function
'-------------------------------------------
Sub SmartCreateFolder(strFolder)
    Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
    End If
    oFSO.CreateFolder(strFolder)
    Set oFSO = Nothing    
End Sub
'-------------------------------------------
Function Execute(StrCmd)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,0,True)
        If Resultat <> 0 Then
            MsgBox "Une erreur inconnue est survenue !",16,_
            "Une erreur inconnue est survenue !"
        End If
    Execute = Resultat
End Function
'-------------------------------------------
Sub Write_INI_File(PathFolder,strText)
Dim fs,ts,DesktopINI
Const ForWriting = 2
    DesktopINI = PathFolder & "\Desktop.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.FileExists(DesktopINI) Then 
        Call Execute("Attrib -R -H -S "& DblQuote(DesktopINI))
        fs.DeleteFile DesktopINI
    end If
    Set ts = fs.OpenTextFile(DesktopINI,ForWriting,True)
    ts.WriteLine strText
    ts.Close
'Transform the file Desktop.ini to a hidden and system file
    Call Execute("Attrib +R +H +S "& DblQuote(DesktopINI))
End Sub
'-------------------------------------------
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'-------------------------------------------
Function Extract(Data,Pattern)
   Dim oRE,oMatches,Match
   set oRE = New RegExp
   oRE.IgnoreCase = True
   oRE.Global = True
   oRE.Pattern = Pattern
   set oMatches = oRE.Execute(Data)
   If not isEmpty(oMatches) then
       Extract = oMatches(0).SubMatches(0)
   End if
End Function
'------------------------------------------
Function Search_Replace(Data)
    Dim oRegExp,strPattern,strReplace,strResult
    strPattern= "(alt=\x22(.*)\x22)"
    strReplace = "$1 OnClick=""GetIndex(me.alt)"""
    Set oRegExp = New RegExp
    oRegExp.Global = True 
    oRegExp.IgnoreCase = True 
    oRegExp.Pattern = strPattern
    strResult = oRegExp.Replace(Data,strReplace)
    Search_Replace = strResult
End Function
'-----------------------------------------------
</SCRIPT>

imageres.dll从站点获取并提取所有图标。

imageres.dll.hta

<html>
<HTA:APPLICATION  
APPLICATIONNAME="Hackoo Icon Folder Changer 2020 Resources from imageres.dll"  
ICON="DxDiag.exe"  
SCROLL="Yes"  
SCROLLFLAT="yes"  
SINGLEINSTANCE="no"  
WINDOWSTATE="maximize"   
SELECTION="no"/>
<Title>Hackoo Icon Folder Changer 2020 Resources from imageres.dll</Title>
<head>
<link rel="stylesheet" type="text/css" href="https://help4windows.com/~webcode/style-help4windows.css">
</head>
<body>
<center><font color="White">Click on an image to choose the icon of your folder</font><br>
<span id="icons"</span>
</center>
</body>
</html>
<SCRIPT LANGUAGE="VBScript">
'---------------------------------------------
Option Explicit
Dim Title,HTTP_Request,Data,Icons,ErrorLine
Title = "Hackoo Icon Folder Changer 2020 Resources from imageres.dll"
Set HTTP_Request = CreateObject("Microsoft.XMLHTTP")
On Error Resume Next
HTTP_Request.Open "GET","https://help4windows.com/windows_8_imageres_dll.shtml", False
HTTP_Request.Send()
If err.number <> 0 then 
    ErrorLine  = ErrorLine &  vbcrlf & "Error getting HTTP_Request" 
    ErrorLine  = ErrorLine &  vbcrlf & "==================" 
    ErrorLine  = ErrorLine &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
    ErrorLine  = ErrorLine &  vbcrlf & "Source " & err.source 
    ErrorLine  = ErrorLine &  vbcrlf & "HTTP Error " & HTTP_Request.Status & " " & HTTP_Request.StatusText
    ErrorLine  = ErrorLine &  vbcrlf &  HTTP_Request.getAllResponseHeaders
    MsgBox ErrorLine,vbCritical,Title
    Err.clear
End If
Data = HTTP_Request.ResponseText
Data = Extract(Data,"(?:<table class=\x22data\x22>)([\S\s]*)(?:<table class=\x22footer\x22>)")
Data = Replace(Data,"~webfiles/","https://help4windows.com/~webfiles/")
Data = Search_Replace(Data)
Set Icons = document.getElementById("icons")
Icons.InnerHTML = "<table class=""data"">" & Data &"</table>"
'---------------------------------------------
Function GetIndex(idx)
Dim Question,Ws,Icon,strText,DesktopFolder,strFolder
Question = MsgBox("You have chosen the icon with the index = " & idx & vbCrLf &_
"%Systemroot%\system32\imageres.dll," & idx & vbCrLf & vbCrLf &_
"Do you want to confirm or not ?",VbYesNo+VbQuestion,"Hackoo Icon Folder Changer 2020")
If Question = vbYes Then
    Set Ws = CreateObject("wscript.Shell")
    DesktopFolder = ws.SpecialFolders("Desktop")
    strFolder = DesktopFolder & "\Hackoo Folder Icon Changer"
    Icon = "%systemroot%\system32\imageres.dll," & idx
    strText = "[.ShellClassInfo]" & vbCrLf &_
    "IconResource="& Icon & vbCrLf &_
    "IconFile=%systemroot%\system32\imageres.dll"
    'Create a folder on our desktop
    Call SmartCreateFolder(strFolder)
    'Transform our folder to a system folder
    Call Execute("attrib +s " & DblQuote(strFolder))
    Call Write_INI_File(strFolder,strText)
    Ws.Run "ie4uinit.exe -ClearIconCache",1,True
    WS.Run "explorer.exe shell:::{3080F90D-D7AD-11D9-BD98-0000947B0257}",1,True
    Ws.Run "ie4uinit.exe -show",1,True
    Ws.Run DblQuote(strFolder)
Else
    Exit Function
End If
End Function
'-------------------------------------------
Sub SmartCreateFolder(strFolder)
    Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
    End If
    oFSO.CreateFolder(strFolder)
    Set oFSO = Nothing    
End Sub
'-------------------------------------------
Function Execute(StrCmd)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,0,True)
        If Resultat <> 0 Then
            MsgBox "Une erreur inconnue est survenue !",16,_
            "Une erreur inconnue est survenue !"
        End If
    Execute = Resultat
End Function
'-------------------------------------------
Sub Write_INI_File(PathFolder,strText)
Dim fs,ts,DesktopINI
Const ForWriting = 2
    DesktopINI = PathFolder & "\Desktop.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.FileExists(DesktopINI) Then 
        Call Execute("Attrib -R -H -S "& DblQuote(DesktopINI))
        fs.DeleteFile DesktopINI
    end If
    Set ts = fs.OpenTextFile(DesktopINI,ForWriting,True)
    ts.WriteLine strText
    ts.Close
'Transform the file Desktop.ini to a hidden and system file
    Call Execute("Attrib +R +H +S "& DblQuote(DesktopINI))
End Sub
'-------------------------------------------
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'-------------------------------------------
Function Extract(Data,Pattern)
   Dim oRE,oMatches,Match
   set oRE = New RegExp
   oRE.IgnoreCase = True
   oRE.Global = True
   oRE.Pattern = Pattern
   set oMatches = oRE.Execute(Data)
   If not isEmpty(oMatches) then
       Extract = oMatches(0).SubMatches(0)
   End if
End Function
'------------------------------------------
Function Search_Replace(Data)
    Dim oRegExp,strPattern,strReplace,strResult
    strPattern= "(alt=\x22(.*)\x22)"
    strReplace = "$1 OnClick=""GetIndex(me.alt)"""
    Set oRegExp = New RegExp
    oRegExp.Global = True 
    oRegExp.IgnoreCase = True 
    oRegExp.Pattern = strPattern
    strResult = oRegExp.Replace(Data,strReplace)
    Search_Replace = strResult
End Function
'-----------------------------------------------
</SCRIPT>

最后这是最后一个HTA（二合一）Shell32.dll_Imageres.dll.hta

相关内容