I created a Tool that can take all files in Source and resize it to a given maximum width and/or height and save them to a output directory...
It will show a status bar when it progresses the files...
if you doubleclick on the folderinputs you can select a folder with your mouse... ;-)
To run it, you need the wiaaut.dll in the same directory, or registered in winsysdir
Get it here:
http://www.ilixis.com/developer/wia.html Its not much commented, because its not heavyweight code ;-) and i didn't have time to. And the Messages are in German, but it's not a problem to change them...
Try it, and if you like it, maybe i make a better documented Version of it...
<html>
<head>
<title id="title">ImageResizer</title>
<HTA:APPLICATION
ID="Liste"
APPLICATIONNAME="ImageResizer"
SCROLL="yes"
SINGLEINSTANCE="yes"
caption="yes"
BORDER="thin"
BORDERSTYLE="normal"
MAXIMIZEBUTTON="yes"
MINIMIZEBUTTON="yes"
SYSMENU="no"
WINDOWSTATE="normal"
CONTEXTMENU="NO"
SELECTION="NO"
navigable="yes"
/>
<SCRIPT Language="VBScript">
' -------------------------------------------------------------------------------
' ::: ImageResizer :::
' -------------------------------------------------------------------------------
' CHANGE-LOG:
' 27.09.05 JOS 1.0 Erste Version
' 27.09.05 JOS 2.0 Fix Installation Procedure
' 05.10.05 JOS 3.0 Final Version
' 13.03.06 JOS 4.0 Ordner per Click auslesen
strVer = "4.0"
' -------------------------------------------------------------------------------
' (c) Reto Jossi ([email=info@stageweb.net]info@stageweb.net[/email])
' -------------------------------------------------------------------------------
' Variable für Fehlerhandling
Dim strCount, objExplorer
strExit = 0
Sub Window_Onload
document.title = document.title & " | Version: "&strVer
window.resizeTo 500,600
End Sub
Sub Doit
' Test ob wiaaut.dll installiert
On Error Resume Next
Set Img = CreateObject("WIA.ImageFile")
If Err.Number <> 0 Then
Installieren
If strExit <> 0 Then
Exit Sub
End If
End If
On Error GoTo 0
Set Img = Nothing
strSRC = document.getElementById("SRC").Value
If right(strSRC, 1) <> "\" Then
strSRC = strSRC & "\"
End If
strDST = document.getElementById("DST").Value
If right(strDST, 1) <> "\" Then
strDST = strDST & "\"
End If
Call StatusBar("Start")
strBREITE = document.getElementById("BREITE").Value
strHOEHE = document.getElementById("HOEHE").Value
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set folderSRC = objFSO.GetFolder(strSRC)
Set folderDST = objFSO.GetFolder(strDST)
For each file in folderDST.Files
objFSO.DeleteFile(file)
Next
For each file in folderSRC.Files
If lcase(right(file.Name, 3)) = "jpg" Then
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile file
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = strBREITE
IP.Filters(1).Properties("MaximumHeight") = strHOEHE
Set Img = IP.Apply(Img)
Img.SaveFile strDST & file.Name
Set Img = Nothing
Set IP = Nothing
End If
Call StatusBar("Inc")
Next
Call StatusBar("Stop")
End Sub
Sub OrdnerAuslesenSRC()
On Error Resume Next
Set objSA = CreateObject("Shell.Application")
Set oFolder = objSA.BrowseForFolder(0, "Quell-Ordner auswählen:", 0, document.all.item("SRC").Value)
If oFolder.Items.Item <> "" Then
Set oFolderItem = oFolder.Items.Item
document.all.item("SRC").innerText = oFolderItem.Path
End If
On Error GoTo 0
End Sub
Sub OrdnerAuslesenDST()
On Error Resume Next
Set objSA = CreateObject("Shell.Application")
Set oFolder = objSA.BrowseForFolder(0, "Ziel-Ordner auswählen:", 0, document.all.item("DST").Value)
If oFolder.Items.Item <> "" Then
Set oFolderItem = oFolder.Items.Item
document.all.item("DST").innerText = oFolderItem.Path
End If
On Error GoTo 0
End Sub
Function StatusBar(actstat)
If actstat = "Start" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set folderSRC = objFSO.GetFolder(document.getElementById("SRC").Value)
strCount = 0
For each file in folderSRC.Files
strCount = strCount + 1
Next
document.getElementById("StatusArea").innerHTML = "..."
'Explorer Open! yeahh!
strHTML = "<html><body><p><object classid='clsid:35053A22-8589-11D1-B16A-00C0F0283628' id='ProgressBar1' height='20' width='800'><param name='Min' value='0'><param name='Max' value='"&strCount&"'><param name='Orientation' value='0'><param name='Scrolling' value='1'></object></p></body></html>"
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.Document.title = "Bitte warten . . ."
objExplorer.Document.body.bgcolor = "buttonface"
objExplorer.Document.body.Innerhtml = strHTML
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 850
objExplorer.Height = 90
objExplorer.Left = 50
objExplorer.Top = 50
objExplorer.Visible = 1
Do While (objExplorer.Busy)
Wscript.Sleep 200
Loop
Elseif actstat = "Inc" Then
objExplorer.Document.Body.All.ProgressBar1.Value = objExplorer.Document.Body.All.ProgressBar1.Value + 1
Elseif actstat = "Stop" Then
objExplorer.Quit
StatusArea.innerhtml = "<b>Fertig</b>"
End If
End Function
Sub Installieren
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject ("Scripting.FileSystemObject")
If (fso.FileExists("wiaaut.dll")) Then
strCMD = "copy wiaaut.dll C:\windows\system32\wiaaut.dll"
Return = WshShell.Run("cmd /c" & strCMD,,True)
strCMD = "regsvr32 C:\windows\system32\wiaaut.dll -s"
Return = WshShell.Run("cmd /c" & strCMD,,True)
Else
MsgBox "wiaaut.dll nicht gefunden"
strExit = 1
End If
End Sub
</SCRIPT>
<style>
body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}
body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#FFFFFF', EndColorStr='#9999FF')}
fieldset, legend {padding: 10px;}
</style>
</head>
<body topmargin="0">
<center>
<table width="400">
<tr>
<td><fieldset><legend>Quellverzeichnis</legend><center><input name='SRC' size=40 value='' onDblClick=OrdnerAuslesenSRC()></center></fieldset></td>
</tr>
<tr>
<td><fieldset><legend>Zielverzeichnis</legend><center><input name='DST' size=40 value='' onDblClick=OrdnerAuslesenDST()></center></fieldset></td>
</tr>
<tr>
<td><fieldset><legend>Optionen</legend><center>
<table>
<tr>
<td>maximale Breite:</td>
<td><input name='BREITE' size=4 value='800'> pixel</td>
</tr>
<tr>
<td>maximale Höhe:</td>
<td><input name='HOEHE' size=4 value='600'> pixel</td>
</tr>
</table>
</center></fieldset></td>
</tr>
<tr>
<td><fieldset><legend>Status</legend><span id="StatusArea"><b>ACHTUNG: Dateien im Zielverzeichnis werden vorher gelöscht.</b></span></fieldset></td>
</tr>
<tr>
<td><fieldset><legend>Steuerung</legend><center>
<table>
<tr>
<td><input type='button' name='OKButton' value=' Starten . . . ' onclick="Doit()"></td>
<td><input type='button' name='CloseButton' value=' Schliessen ' onclick="Close()"></td>
</tr>
</table>
</fieldset></td>
</tr>
</center>
</body>
</html>