I believe there is. It's called WIA Automation Layer (i.e. Windows Image
Acquisition Automation Layer 2.0). It's bascically a DLL that needs
registering, and then you get all sorts of objects and methods available
from WSH. It's free from Microsoft, but I believe it needs a minimum of
Windows XP SP1 and also dotNET v1.1.
N.B. Don't get WIA (Windows Imaging Architecture) confused with WIA (Windows
Image Acquisition) nor is it to be confused with WIA Scripting Model. These
three things are related (I think) but all very different topics.
N.B. WIA Automation Layer supersedes the older WIA Scripting Model.
Anyway, here's an overview of WIA Automation Layer
http://windowssdk.msdn.microsoft.com/en-us/library/ms630827.aspx
Download here:
http://www.microsoft.com/downloa ... yID=a332a77a-01b...
i.e. "Windows® Image Acquisition Automation Library v2.0 Tool: Image
acquisition and manipulation component for VB and scripting"
Unzip the file, read the docs, and then start to play.
I can't supply an example of accessing a WebCam, although I'm sure it is
possible - anyway, attached below is my example of using WIA Automation
Layer v2.0. Search the code for:
CreateObject( "WIA.
...and you'll also need to search the Web for other examples.
In my example code I use WIA Automation Layer to convert JPG to BMP and to
re-size the image. Watch out for word/line wrap if you cut and paste.
Good luck.
Regards,
Dave.
Option Explicit
Const cs_fac = "%rotate-wallpaper, "
Const cs_script_version = "v0.02"
Const ci_temporary_folder = 2
Const cb_debug = True
Const cl_image_wait = 3
Dim go_fso, go_wsh, go_app, go_wmi
Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title,
gs_script_engine, gs_script_fac, gd_script_start, gd_script_end
Dim gs_temp_path, gs_temp_file, gs_temp_spec
Dim gb_echo, gb_popup
Dim gs_pics, gl_screen_height, gl_screen_width
Dim gl_tot_folders, gl_tot_files, gl_tot_images, gl_tot_used
Set go_fso = CreateObject( "Scripting.FileSystemObject" )
Set go_wsh = CreateObject( "WScript.Shell" )
Set go_app = CreateObject( "Shell.Application" )
Set go_wmi = GetObject( "WinMgmts://./root/cimv2" )
Call s_setup()
gs_pics = go_app.NameSpace( 39 ).Self.Path
If cb_debug Then Call s_log( cs_fac & "My Pictures: " & gs_pics )
Call s_scan_tree( gs_pics )
If cb_debug Then
Call s_log( "" )
Call s_log( cs_fac & "Folders: " & gl_tot_folders )
Call s_log( cs_fac & "Files: " & gl_tot_files )
Call s_log( cs_fac & "Images: " & gl_tot_images )
Call s_log( cs_fac & "Used: " & gl_tot_used )
End If
WScript.Quit
Sub s_setup()
Const cs_fac = "%s_setup, "
Dim lo_displays, lo_display
Set lo_displays = go_wmi.ExecQuery( "Select * from
Win32_DisplayConfiguration", , 48 )
For Each lo_display In lo_displays
gl_screen_width = lo_display.PelsWidth
gl_screen_height = lo_display.PelsHeight
Next
If cb_debug Then
Call s_log( "" )
Call s_log( cs_fac & "Screen height: " & gl_screen_height )
Call s_log( cs_fac & "Screen width: " & gl_screen_width )
End If
Call s_set_wallpaper_style( "centered" )
gs_script_spec = Wscript.ScriptFullName
gs_script_path = go_fso.GetParentFolderName( gs_script_spec )
gs_script_name = go_fso.GetBaseName( gs_script_spec )
gs_script_title = gs_script_name & " (" & cs_script_version & ")"
gs_script_fac = "%" & gs_script_name & ", "
gs_script_engine = LCase( go_fso.GetBaseName( Wscript.FullName ) )
Select Case gs_script_engine
Case "cscript"
gb_echo = True
gb_popup = False
Case "wscript"
gb_echo = False
gb_popup = True
End Select
gs_temp_path = go_fso.GetSpecialFolder( ci_temporary_folder )
gs_temp_file = go_fso.GetTempName
gs_temp_spec = gs_temp_path & "\" & gs_script_name & ".bmp"
End Sub
Sub s_scan_tree( ps_folder )
Const cs_fac = "%s_scan_tree, "
Dim lo_folder, lb_exists
Call s_log( "" )
Call s_log( cs_fac & "Scanning folder tree `" & ps_folder & "`..." )
On Error Resume Next
Set lo_folder = go_fso.GetFolder( ps_folder )
Select Case Err.Number
Case 0
lb_exists = True
Case 76
lb_exists = False
Case Else
Call s_error( cs_fac & "Failed to attach to folder object `" & ps_folder
& "`..." )
End Select
On Error Goto 0
If lb_exists Then
Call s_scan_folder( lo_folder )
Else
Call s_log( cs_fac & "Folder `" & ps_folder & "` does not exist..." )
End If
Set lo_folder = Nothing
End Sub
Sub s_scan_folder( po_folder )
Const cs_fac = "%s_scan_folder, "
Dim lo_subfolders, lo_subfolder
Dim lo_files, lo_file
Set lo_subfolders = po_folder.SubFolders
Set lo_files = po_folder.Files
gl_tot_folders = gl_tot_folders + 1
For Each lo_file In lo_files
Call s_scan_file( lo_file )
Next
For Each lo_subfolder In lo_subfolders
Call s_scan_folder( lo_subfolder )
Next
Set lo_subfolder = Nothing
Set lo_subfolders = Nothing
Set lo_file = Nothing
Set lo_files = Nothing
End Sub
Sub s_scan_file( po_file )
Const cs_fac = "%s_scan_file, "
Dim ls_file_base, ls_file_extn, lb_valid, lo_cim
Dim ls_dimensions, ls_sizes, ll_height, ll_width, lb_wanted
gl_tot_files = gl_tot_files + 1
ls_file_base = LCase( go_fso.GetBaseName( po_file.Path ) )
ls_file_extn = LCase( go_fso.GetExtensionName( po_file.Path ) )
Select Case ls_file_extn
Case "jpg", "bmp"
Case Else
Exit Sub
End Select
gl_tot_images = gl_tot_images + 1
ls_dimensions = fs_property( po_file.Path, "dimensions" )
ls_sizes = Split( ls_dimensions, " ", 3 )
ll_height = CLng( ls_sizes( 0 ) )
ll_width = CLng( ls_sizes( 2 ) )
lb_wanted = True
If lb_wanted Then If ll_height < ( gl_screen_height * 0.50 ) Then
lb_wanted = False
If lb_wanted Then If ll_width < ( gl_screen_height * 0.50 ) Then
lb_wanted = False
If lb_wanted Then If Instr( 1, LCase( po_file.Path ), "wedding" ) > 0 Then
lb_wanted = False
If Not lb_wanted Then
If cb_debug Then Call s_log( cs_fac & "Ignoring file `" & po_file.Path &
"`..." )
Exit Sub
End If
If cb_debug Then
Call s_log( cs_fac & "File: " & po_file.Path )
Call s_log( cs_fac & " Size: " & po_file.Size )
Call s_log( cs_fac & " Dimensions: " & fs_property( po_file.Path,
"dimensions" ) )
End If
gl_tot_used = gl_tot_used + 1
Dim lo_image_file, lo_image_process
Set lo_image_file = CreateObject( "WIA.ImageFile" )
Set lo_image_process = CreateObject( "WIA.ImageProcess" )
Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
lo_image_file.LoadFile po_file.Path
lo_image_process.Filters.Add lo_image_process.FilterInfos(
"Scale" ).FilterID
lo_image_process.Filters(1).Properties( "MaximumHeight" ) =
gl_screen_height
lo_image_process.Filters(1).Properties( "MaximumWidth" ) =
gl_screen_width
lo_image_process.Filters(1).Properties( "PreserveAspectRatio" ) = True
lo_image_process.Filters.Add lo_image_process.FilterInfos(
"Convert" ).FilterID
lo_image_process.Filters(2).Properties( "FormatID" ).Value = wiaFormatBMP
Set lo_image_file = lo_image_process.Apply( lo_image_file )
If go_fso.FileExists( gs_temp_spec ) Then go_fso.DeleteFile gs_temp_spec
lo_image_file.SaveFile gs_temp_spec
Call s_set_wallpaper_image( gs_temp_spec )
WScript.Sleep cl_image_wait * 1000
End Sub
Sub s_show_info( ps_file )
Const cs_fac = "%s_show_info, "
Const cl_max = 47
Dim lo_fso, lo_app
Dim lo_fso_file, ls_fso_parent, ls_fso_name
Dim lo_app_parent, lo_app_name
Dim ll_property, ls_property_name, ls_property_value
Set lo_fso = CreateObject( "Scripting.FileSystemObject" )
Set lo_app = CreateObject( "Shell.Application" )
Set lo_fso_file = lo_fso.GetFile( ps_file )
ls_fso_parent = lo_fso_file.ParentFolder
ls_fso_name = lo_fso_file.Name
Set lo_app_parent = lo_app.NameSpace( ls_fso_parent )
Set lo_app_name = lo_app_parent.ParseName( ls_fso_name )
For ll_property = 0 To cl_max
ls_property_name = lo_app_parent.GetDetailsOf( lo_app_parent,
ll_property )
ls_property_value = lo_app_parent.GetDetailsOf( lo_app_name,
ll_property )
Call s_log( ll_property & vbTab & Left( ls_property_name & Space(20),
20 ) & " " & ls_property_value )
Next
End Sub
Function fs_property( ps_file, ps_property_name )
Const cs_fac = "%fs_property, "
Const cl_max = 47
Dim lo_fso, lo_app
Dim lo_fso_file, ls_fso_parent, ls_fso_name
Dim lo_app_parent, lo_app_name
Dim ll_property, ls_property_name, ls_property_value
Set lo_fso = CreateObject( "Scripting.FileSystemObject" )
Set lo_app = CreateObject( "Shell.Application" )
Set lo_fso_file = lo_fso.GetFile( ps_file )
ls_fso_parent = lo_fso_file.ParentFolder
ls_fso_name = lo_fso_file.Name
Set lo_app_parent = lo_app.NameSpace( ls_fso_parent )
Set lo_app_name = lo_app_parent.ParseName( ls_fso_name )
For ll_property = 0 To cl_max
ls_property_name = lo_app_parent.GetDetailsOf( lo_app_parent,
ll_property )
ls_property_value = lo_app_parent.GetDetailsOf( lo_app_name,
ll_property )
If ( LCase( ps_property_name ) = LCase( ls_property_name ) ) Or (
ps_property_name = CStr( ll_property ) ) Then
fs_property = ls_property_value
Exit Function
End If
Next
fs_property = ""
End Function
Sub s_set_wallpaper_style( ps_style )
Const cs_fac = "%s_set_wallpaper_style, "
Select Case LCase( ps_style )
Case "stretched"
go_wsh.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", "2"
go_wsh.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper", "0"
Case "centered" |
|
