You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
386 lines
11 KiB
386 lines
11 KiB
<?XML version="1.0" ?>
|
|
<package>
|
|
<job error="false" debug="false" logo="false">
|
|
<reference guid="{565783C6-CB41-11D1-8B02-00600806D9B6}" version="1.1"/>
|
|
<resource id="file mask"><![CDATA[slide*.bmp]]></resource>
|
|
<resource id="application available">SELECT * from win32_product WHERE NAME LIKE "Microsoft Office XP%" AND InstallState = 5</resource>
|
|
<runtime>
|
|
<description>
|
|
Creates the desktop wallpaper for the build name and language
|
|
</description>
|
|
|
|
<named name="label" required="true" type="simple"
|
|
helpstring="part of the wallpaper to generate
|
|
(default <BLDNUM> FRE/CHK)">
|
|
</named>
|
|
|
|
<named name="computer" required="true" type="simple"
|
|
helpstring="part of the wallpaper to generate
|
|
(default %COMPUTERNAME%)"/>
|
|
|
|
<named name="dest" required="false" type="simple"
|
|
helpstring="desired box to set the wallpaper
|
|
(default %COMPUTERNAME%)">
|
|
</named>
|
|
|
|
</runtime>
|
|
<comment>
|
|
Win32_UserDesktop
|
|
</comment>
|
|
|
|
vba.set.wallpaper.wsf /computer:i32bt0011 /label:TEST /scheme:flesh
|
|
vba.set.wallpaper.wsf /computer:i32bt0011 /label:SAFE /scheme:fen
|
|
|
|
<comment>
|
|
<comment>
|
|
Flesh colorscheme:
|
|
164,179,255 # background
|
|
224,125,225 # big letters
|
|
74,25,65 # computer name
|
|
Fen colorscheme:
|
|
0,64,48 # background
|
|
128,128,0 # big letters
|
|
255,128,0 # computer name
|
|
</comment>
|
|
|
|
The following break occurs at user level.
|
|
|
|
To reproduce:
|
|
|
|
1. create an .bmp image name it
|
|
2. set this image a wallpapaer by browsing for image from desk.cpl
|
|
3. overwrite the image with siomething different.
|
|
4. set this image a wallpapaer by browsing for image from desk.cpl
|
|
The desktop wallpaper will not change,
|
|
|
|
To verify that the image is changed, change the desktop wallpaper into some different image, then back to the browser dile.
|
|
Now you see the image is changed to what you supplied as the second file.
|
|
</comment>
|
|
<comment>
|
|
ppLayoutBlank
|
|
ppLayoutChart
|
|
ppLayoutChartAndText
|
|
ppLayoutClipartAndText
|
|
ppLayoutClipArtAndVerticalText
|
|
ppLayoutFourObjects
|
|
ppLayoutLargeObject
|
|
LayoutMediaClipAndText
|
|
LayoutObject
|
|
LayoutObjectAndText
|
|
LayoutObjectOverText
|
|
LayoutOrgchart
|
|
LayoutTable
|
|
LayoutText
|
|
LayoutTextAndChart
|
|
LayoutTextAndClipart
|
|
LayoutTextAndMediaClip
|
|
LayoutTextAndObject
|
|
LayoutTextAndTwoObjects
|
|
LayoutTextOverObject
|
|
defined in ?
|
|
\Program Files\Microsoft Office\Office10\MSPPT.OLB
|
|
</comment>
|
|
|
|
<reference guid="{565783C6-CB41-11D1-8B02-00600806D9B6}" version="1.1"/>
|
|
<resource id="fontsize">60</resource>
|
|
<resource id="width">174</resource>
|
|
<resource id="height">60</resource>
|
|
<resource id="index">Name</resource>
|
|
<resource id="search">NTDEV\sergueik</resource>
|
|
<resource id="field">WallPaper</resource>
|
|
<resource id="targetclass">Win32_Desktop</resource>
|
|
<resource id="regpath">HKEY_CURRENT_USER\Control Panel\Desktop\WallPaper</resource>
|
|
<script language="VBScript">
|
|
<![CDATA[
|
|
|
|
|
|
Option Explicit
|
|
Dim Debug
|
|
Const QQUOT = """"
|
|
|
|
'' on error resume next
|
|
err.CLEAR
|
|
if err.number then
|
|
WScript.echo err.Source, err.Number, err.Description
|
|
WScript.quit
|
|
end if
|
|
|
|
Dim opPowerPoint, opPresentation, opSlide, opshape, opLabel
|
|
Dim npHeight, npwidth
|
|
Dim spOutput, spFolderName, opshell
|
|
Dim spComputerName, opNetwork
|
|
Dim sLabel
|
|
Set opshell = CreateObject("WScript.Shell")
|
|
If NOT WScript.Arguments.Named.Exists("computer") Then
|
|
Set opNetwork = CreateObject("WScript.Network")
|
|
With opNetwork
|
|
spComputerName = .ComputerName
|
|
End With
|
|
Set opNetwork = Nothing
|
|
WScript.Arguments.ShowUsage
|
|
Else
|
|
spComputerName = WScript.Arguments.Named("computer")
|
|
End If
|
|
_
|
|
If NOT WScript.Arguments.Named.Exists("label") Then
|
|
sLabel = spComputerName
|
|
WScript.Arguments.ShowUsage
|
|
Else
|
|
sLabel = WScript.Arguments.Named("label")
|
|
End If
|
|
|
|
spFolderName = "WALLPAPER"
|
|
|
|
If 1 > nxDataSetCnt("application available") Then
|
|
Call opShell.PopUp("Microsoft Office XP" & _
|
|
VBNEWLINE & _
|
|
"not found on this machine." & _
|
|
VBNEWLINE & _
|
|
"Please install.", _
|
|
60, _
|
|
WScript.Application.FullName, _
|
|
0 + 16)
|
|
WSCript.quit
|
|
End If
|
|
|
|
With opShell
|
|
spOutput = .ExpandEnvironmentStrings("%TEMP%") & "\" & spFolderName
|
|
'' %TEMP%\wallpaper\Slide1.BMP
|
|
End With
|
|
set opshell = nothing
|
|
Dim opFilesys
|
|
Set opFilesys = CreateObject("Scripting.FilesystemObject")
|
|
Dim opBrow
|
|
Set opBrow = WScript.CreateObject("Shell.Application")
|
|
Set opPowerPoint = CreateObject("PowerPoint.Application")
|
|
|
|
With opPowerPoint
|
|
|
|
Set opPresentation = .Presentations.Add(False)
|
|
|
|
With opPresentation
|
|
|
|
With .PageSetup
|
|
|
|
.SlideHeight = cInt(GetResource("height"))
|
|
.SlideWidth = cInt(GetResource("width"))
|
|
|
|
npHeight = .SlideHeight
|
|
npWidth = .SlideWidth
|
|
|
|
End With
|
|
|
|
Set opSlide = .Slides.Add(.Slides.Count + 1, 12)
|
|
|
|
With opSlide
|
|
|
|
.ColorScheme = opPresentation.ColorSchemes(1)
|
|
|
|
Set opShape = opSlide.Shapes.AddShape(1, 0, 0, npWidth, npHeight)
|
|
opShape.Line.ForeColor.RGB = RGB(0,64,48)
|
|
opShape.Fill.ForeColor.RGB = RGB(0,64,48)
|
|
opShape.Line.ForeColor.RGB = RGB(94,157,102)
|
|
opShape.Fill.ForeColor.RGB = RGB(94,157,102)
|
|
|
|
Set opLabel = opSlide.Shapes.AddLabel(1, _
|
|
0, 0, 0, 0) '' most argument are ignored anyway
|
|
|
|
opLabel.TextFrame.TextRange = Ucase(sLabel)
|
|
|
|
with opLabel.TextFrame.TextRange
|
|
|
|
With .Font
|
|
.color.RGB = RGB(128, 64, 0)
|
|
.color.RGB = RGB(149, 113, 45)
|
|
.Bold = True
|
|
.Name = "Arial Black"
|
|
.Size = cInt(GetResource("fontsize"))
|
|
End With
|
|
|
|
End with
|
|
|
|
Dim opLabel2
|
|
Set opLabel2 = opSlide.Shapes.AddLabel(1, _
|
|
15, 15, 0, 0) '' most argument are ignored anyway
|
|
|
|
opLabel2.TextFrame.TextRange = Ucase(spComputerName)
|
|
|
|
|
|
with opLabel2.TextFrame.TextRange
|
|
|
|
With .Font
|
|
.color.RGB = RGB(255,255,255 )
|
|
.Bold = True
|
|
.iTALIC = True
|
|
.Name = "Arial"
|
|
.Size = cInt(GetResource("fontsize")) /2
|
|
End With
|
|
|
|
End with
|
|
|
|
|
|
End With
|
|
|
|
Set opSlide = Nothing
|
|
End With
|
|
|
|
call opPresentation.SaveAs(spOutput, 19, 0) '' ppSaveAsXXX constants need type library...
|
|
Set opPresentation = Nothing
|
|
End With
|
|
Set opPowerPoint = Nothing
|
|
Debug = True
|
|
''WSCript.echo spFindF(spOutPut, "slide*.bmp")
|
|
WSCript.echo spFindF(spOutPut, GetResource("file mask"))
|
|
|
|
WScript.quit
|
|
_
|
|
Dim opWbemLoc, opService
|
|
Set opWbemLoc = CreateObject("WbemScripting.SWbemLocator")
|
|
_
|
|
opWbemLoc.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeSystemEnvironmentPrivilege")
|
|
_
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeAssignPrimaryTokenPrivilege")
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeIncreaseQuotaPrivilege")
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeCreatePermanentPrivilege")
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeTakeOwnershipPrivilege")
|
|
_
|
|
set opService = opWbemLoc.connectserver
|
|
_
|
|
Dim aopMemberSet
|
|
Set aopMemberSet = opService.InstancesOf(GetResource("targetclass"))
|
|
_
|
|
Dim opProc, opProp
|
|
Dim bpUpdateThisMember
|
|
_
|
|
For Each opProc in aopMemberSet
|
|
bpUpdateThisMember = False
|
|
For Each opProp In opProc.Properties_
|
|
If Ucase(opProp.Name) = UCase(GetResource("index")) _
|
|
and _
|
|
Ucase(opProp.Value) = UCase(GetResource("search")) _
|
|
Then
|
|
bpUpdateThisMember = True
|
|
End If
|
|
Next
|
|
If bpUpdateThisMember Then
|
|
_
|
|
WScript.echo opProc.Properties_(GetResource("field")).value
|
|
opProc.Properties_(GetResource("field")).value = "d:\ntt.temp.x86fe\WALLPAPER\Slide1.BMP"
|
|
opProc.Wallpaper = "d:\ntt.temp.x86fe\WALLPAPER\Slide1.BMP"
|
|
'' on error resume next
|
|
'' opProc.Put_()
|
|
'' on error goto 0
|
|
'' ... fail here
|
|
_
|
|
End If
|
|
Next
|
|
_
|
|
Dim WSshell
|
|
Dim spRegPath
|
|
spRegPath = CSTR(GetResource("regpath"))
|
|
Set WSshell = CreateObject("WScript.Shell")
|
|
_
|
|
With WSshell
|
|
WSCript.echo spRegPath, _
|
|
.RegRead(spRegPath)
|
|
End With
|
|
Set WSshell = Nothing
|
|
WScript.quit
|
|
_
|
|
Function spFindF(siFolderName, siFnameMask)
|
|
Dim opBrw, spResult, opNZs, opEx, opEy, opEz
|
|
Set opBrw = WScript.CreateObject("Shell.Application")
|
|
spResult = ""
|
|
Set opEx = opBrw.NameSpace(spOutput)
|
|
Set opNZs = CreateObject("VBscript.RegExp")
|
|
With opNZs
|
|
.Global = True
|
|
.Pattern = spQthisE(siFnameMask)
|
|
.IgnoreCase = True
|
|
End With
|
|
If Debug Then
|
|
WSCript.echo TypeName(opEx) , opEx.Title
|
|
end if
|
|
Set opEy = opEx.items
|
|
If Debug Then
|
|
WSCript.echo TypeName(opEy) , opEy.count
|
|
end if
|
|
'' sorting!
|
|
'' opEy.sort("[ModifyDate]")
|
|
For Each opEz in opEy
|
|
If InStr(1,opEz.Type,"File Folder") = 0 Then
|
|
If opNZs.Test(opEz.name) Then
|
|
If Debug Then
|
|
WSCript.echo TypeName(opEz) , opEz.name
|
|
If True = opNZs.Test(opEz.Name) then
|
|
WSCript.echo TypeName(opEz) , opEz.name, opEz.ModifyDate, opEz.type
|
|
End If
|
|
End If
|
|
' full name?
|
|
spResult = spResult & VBNEWLINE & ucase(spOutput & "\" & opEz.name)
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Set opBrw = Nothing
|
|
Set opEx = Nothing
|
|
Set opEy = Nothing
|
|
Set opNZs = Nothing
|
|
spFindF = Mid(spResult,3)
|
|
End Function
|
|
|
|
Function spQthisE(siBarE)
|
|
|
|
Dim opRxS, opRxX, opRxA, opRxB, opRxC
|
|
Set opRxS = CreateObject("Scripting.Dictionary")
|
|
Set opRxX = CreateObject("VBscript.RegExp")
|
|
opRxS.add ".", "\."
|
|
opRxS.add " ", "\s"
|
|
opRxS.add "*", "[^.].*"
|
|
With opRxX
|
|
.Global = True
|
|
.IgnoreCase = True
|
|
.Pattern = ""
|
|
End With
|
|
opRxB = siBarE
|
|
For Each opRxA in opRxS.Keys
|
|
opRxB = Replace(opRxB, opRxA, opRxS(opRxA))
|
|
Next
|
|
If Debug Then
|
|
If opRxX.Test(opRxB) then
|
|
WSCript.echo "Replaced:", _
|
|
QQUOT & siBarE & QQUOT, _
|
|
QQUOT & opRxB & QQUOT
|
|
End If
|
|
End If
|
|
Set opRxS = Nothing
|
|
Set opRxX = Nothing
|
|
spQthisE = opRxB
|
|
End Function
|
|
Function nxDataSetCnt(siQuery)
|
|
'' e.g.
|
|
'' nxDataSetCnt("application available")
|
|
Dim opWbemLoc, opService, aopDataSet
|
|
Set opWbemLoc = CreateObject("WbemScripting.SWbemLocator")
|
|
opWbemLoc.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
|
|
opWbemLoc.Security_.Privileges.AddAsString("SeSystemEnvironmentPrivilege")
|
|
|
|
Set opService = opWbemLoc.connectserver
|
|
Set aopDataSet = opService.ExecQuery(GetResource(siQuery))
|
|
nxDataSetCnt = aopDataSet.Count
|
|
|
|
End Function
|
|
|
|
]]>
|
|
</script>
|
|
</job>
|
|
<comment>
|
|
This approach does not work.
|
|
Objects\Shell\MinimizeAll.htm
|
|
...change wallpaper...
|
|
Objects\Shell\UndoMinimizeALL.htm</comment>
|
|
<comment>
|
|
</comment>
|
|
</package>
|
|
|