4 votes

Hackoo avatar

Comment puis-je afficher la boîte de dialogue de changement d'icône, avec un vbscript ou une ligne de commande ?

Demandé el 28 de Décembre, 2017
Quand la question a-t-elle été
1002 affichage
Nombre de visites la question a
1 Réponses
Nombre de réponses aux questions
Résolu
Situation réelle de la question

Comment puis-je afficher la boîte de dialogue de changement d'icône, avec un vbscript ou une ligne de commande et utiliser les informations qu'elle contient dans mon vbscript afin de laisser l'utilisateur choisir l'icône qu'il souhaite définir à partir de la boîte de dialogue de changement d'icône ?

enter image description here

Voici mon vbscript que j'ai créé et testé sur mon Windows 10 et il a fonctionné pour créer un dossier sur le bureau et changer son icône en icône de cadenas.

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
'********************************************************************
Demandé el 28 de Décembre, 2017 par Hackoo

Réponse

Trop de publicités?

4voto

Hackoo avatar
Hackoo Points 967

Finalement, j'ai trouvé une solution avec HTA pour afficher et choisir une icône à changer pour le dossier par défaut.

enter image description here

<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>

EDIT : Nouvelle version 2020 : Obtenir et extraire toutes les icônes de Shell32.dll du site. 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>

Obtenir et extraire toutes les icônes de imageres.dll du site.

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>

Enfin, voici le dernier HTA (2 en 1) Shell32.dll_Imageres.dll.hta

Répondu el 19 de Janvier, 2018 par Hackoo (967 Points )

Questions en vedette

Top Tags

Dans notre réseau

SistemesEz.com

SystemesEZ est une communauté de sysadmins où vous pouvez résoudre vos problèmes et vos doutes. Vous pouvez consulter les questions des autres sysadmins, poser vos propres questions ou résoudre celles des autres.

Powered by:

Yandex
X