Question

我正在试图弄清楚如何编写我可以在多台计算机上使用的批处理文件来设置背景。我在其他一些搜索中尝试了一些建议，但除此之外我还不确定如何做到这一点。有人有什么建议吗？谢谢！

Answer 1

要使用的行是：

@%SystemRoot%\System32\reg.exe add "HKCU\Control Panel\Desktop" /v Wallpaper /t REG_SZ /d "C:\Windows\winnt.bmp" /f

在命令提示符窗口reg add /?中运行，以获取有关此命令的详细信息。

我真的很惊讶您自己找不到，因为已经Changing Wallpaper with a batch file, on program close. Possible?并且使用[batch-file] wallpaper搜索Stack Overflow会返回41个结果。

Answer 2

此HTA在 Windows 7 32位且UAC已禁用下进行测试。只是尝试一下你的XP，让我知道它是否适合你。祝你好运！

<强> ChangeWallpaper.hta

<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:DarkOrange;}
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>

在XP中设置壁纸的脚本？

2 个答案: