1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
| <html>
<head>
<title>Application pour changer le fond d'écran dans Windows 7 © Hackoo © 2013</title>
<HTA:APPLICATION
APPLICATIONNAME="Application pour changer le fond d'écran dans Windows 7"
ID="Application pour changer le fond d'écran dans Windows 7"
ICON="Explorer.exe"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="No"
SCROLL="no"
VERSION="1.0"/>
<style>
Label
{
color : #123456;
font-family : "Courrier New";
}
BODY {background-color:lightcyan;}
input.button { background-color : #EFEFEF;
color : #000000; cursor:hand;
font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
}
.alt2, .alt2Active
{
background: #E1E4F2;
color: #000000;
}
</style>
</head>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<script language="VBScript">
Option Explicit
Dim Titre,fso,MyFolder,TabFolder,DossierCourant,DossierCourantIMAGE
Titre = "Application pour changer le fond d'écran dans Windows 7 © Hackoo © 2013"
set fso = CreateObject("Scripting.FileSystemObject")
MyFolder = fso.GetAbsolutePathName(".")
TabFolder = Split(MyFolder,"\")
DossierCourant = TabFolder(UBound(TabFolder))
DossierCourantIMAGE = DossierCourant&"_IMAGE_FOND"
If Not fso.FolderExists(DossierCourantIMAGE) Then
CreateFolder(DossierCourantIMAGE)
End if
'*****************************************************************
Sub Window_OnLoad
CenterWindow 640,200
End Sub
'*****************************************************************
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x, y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft, itop
End Sub
'*****************************************************************
Sub OnClickButtonCancel()
Window.Close
End Sub
'*****************************************************************
Function DblQuote(strIn)
DblQuote = Chr(34) & strIn & Chr(34)
End Function
'*****************************************************************
Sub CreateFolder(strPath)
set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
If Not fso.FolderExists(fso.GetParentFolderName(strPath)) then Call CreateFolder(fso.GetParentFolderName(strPath))
fso.CreateFolder(strPath)
End If
End Sub
'*****************************************************************
SUB ChangeFondEcran()
Dim MyNewWallPaper,NomMyNewWallPaper,NewWallPaperName,WshShell,MonFondEcranBDR,CheminAncienWallpaper,i,MonTab,Destination
Set WshShell = CreateObject("WScript.Shell")
MonFondEcranBDR = "HKEY_CURRENT_USER\Control Panel\desktop\Wallpaper"
CheminAncienWallpaper = WshShell.RegRead(MonFondEcranBDR)
MsgBox CheminAncienWallpaper,64,Titre
'Copie de Sauvegarde de l'ancien Wallpaper
Call CopyFile(CheminAncienWallpaper,DossierCourantIMAGE)
MyNewWallPaper = fichecran.Value
NomMyNewWallPaper = Split(MyNewWallPaper,"\")
NewWallPaperName = NomMyNewWallPaper(UBound(NomMyNewWallPaper))
'MsgBox MyNewWallPaper,64,Titre
If MyNewWallPaper <> "" Then
MonTab = Split(CheminAncienWallpaper,"\")
Destination = ""
For i = LBound(MonTab) To UBound(MonTab) - 1
Destination = Destination + MonTab(i) + "\"
Next
'MsgBox Destination,64,Titre
'Supprimer l'ancien Wallpaper
Call DeleteMyOldFile(CheminAncienWallpaper)
Call CopyFile(MyNewWallPaper,Destination)
Call Renommer(Destination & NewWallPaperName,MonTab(UBound(MonTab)))
RefreshExplorer()
End if
Set WshShell = Nothing
END Sub
'*****************************************************************
Function CopyFile(Source,Destination)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(Destination) Then
If Right(Destination,1) <> "\" Then
Destination = Destination & "\"
End if
FSO.GetFile(Source).Copy Destination & FSO.GetFileName(Source),True
MsgBox "Copie du fond d'écran : " & DblQuote(FSO.GetFileName(Source)) & " dans le dossier " & DblQuote(Destination),64,Titre
Else
MsgBox DblQuote(Destination) & " n'existe pas !",48,Titre
End If
End Function
'*****************************************************************
'Fonction pour écrire le résultat dans un fichier texte
Sub WriteLog(strText,LogFile)
Dim fs,ts
Const ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
ts.WriteLine strText
ts.Close
End Sub
'*****************************************************************
Function DeleteMyOldFile(Source)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(Source) Then
FSO.GetFile(Source).Delete False
End If
End Function
'******************************************************************
Function Renommer(Fichier1,Fichier2)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "Cmd /C Ren "&Fichier1&","&Fichier2&""
Execution = Ws.Run(Command,0,True)
End Function
'******************************************************************
Sub Kill(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
'*****************************************************************
Sub Start(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "cmd /c Start "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
'*****************************************************************
Sub RefreshExplorer()
Kill("Explorer.exe")
Start("Explorer.exe")
End Sub
</script>
<center>
<B>Veuillez choisir l'image pour changer le fond d'écran </B><br><br>
<input type="file" size="50" name="fichecran" style="font-weight: bold; id="file1" />
<br><br><br>
<input type="Submit" style="width: 180px" style="font-weight: bold; name="OK" id="OK" value="Changer le fond d'écran" onclick="ChangeFondEcran()">
<input type="button" style="width: 100px" style="font-weight: bold; name="Cancel" id="Cancel" value="Sortir" onclick="OnClickButtonCancel"><br><br>
</body>
</html> |
