' Just some tests with the new WIA-2 of Windows XP SP1...
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wiaaut/wia/wiax/overviews/sharedsamples.asp

option explicit

' WIA Constants:
'	WiaDeviceType
Const UnspecifiedDeviceType = 0
Const ScannerDeviceType = 1
Const CameraDeviceType = 2
Const VideoDeviceType = 3

Const wiaCommandSynchronize = "{9B26B7B2-ACAD-11D2-A093-00C04F72DC3C}"
'CommandID for Synchronize. Causes the device driver to synchronize cached items with the hardware device.

Const wiaCommandTakePicture = "{AF933CAC-ACAD-11D2-A093-00C04F72DC3C}"
'CommandID for Take Picture. Causes a Microsoft Windows Image Acquisition (WIA) device to acquire an image.

Const wiaCommandDeleteAllItems = "{E208C170-ACAD-11D2-A093-00C04F72DC3C}"
'CommandID for Delete All Items. Notifies the device to delete all items that can be deleted from the device.

Const wiaCommandChangeDocument = "{04E725B0-ACAE-11D2-A093-00C04F72DC3C}"
'CommandID for Change Document. Causes the document scanner to load the next page in its document handler. Does not apply to other device types.

Const wiaCommandUnloadDocument = "{1F3B3D8E-ACAE-11D2-A093-00C04F72DC3C}"
'CommandID for Unload Document. Notifies the document scanner to unload all remaining pages in its document handler. Does not apply to other device types.

Const UnsupportedPropertyType = 0
Const BooleanPropertyType = 1
Const BytePropertyType = 2
Const IntegerPropertyType = 3
Const UnsignedIntegerPropertyType = 4
Const LongPropertyType = 5
Const UnsignedLongPropertyType = 6
Const ErrorCodePropertyType = 7
Const LargeIntegerPropertyType = 8
Const UnsignedLargeIntegerPropertyType = 9
Const SinglePropertyType = 10
Const DoublePropertyType = 11
Const CurrencyPropertyType = 12
Const DatePropertyType = 13
Const FileTimePropertyType = 14
Const ClassIDPropertyType = 15
Const StringPropertyType = 16
Const ObjectPropertyType = 17
Const HandlePropertyType = 18
Const VariantPropertyType = 19
Const VectorOfBooleansPropertyType = 101
Const VectorOfBytesPropertyType = 102
Const VectorOfIntegersPropertyType = 103
Const VectorOfUnsignedIntegersPropertyType = 104
Const VectorOfLongsPropertyType = 105
Const VectorOfUnsignedLongsPropertyType = 106
Const VectorOfErrorCodesPropertyType = 107
Const VectorOfLargeIntegersPropertyType = 108
Const VectorOfUnsignedLargeIntegersPropertyType = 109
Const VectorOfSinglesPropertyType = 110
Const VectorOfDoublesPropertyType = 111
Const VectorOfCurrenciesPropertyType = 112
Const VectorOfDatesPropertyType = 113
Const VectorOfFileTimesPropertyType = 114
Const VectorOfClassIDsPropertyType = 115
Const VectorOfStringsPropertyType = 116
Const VectorOfVariantsPropertyType = 119

Const UndefinedImagePropertyType = 1000
Const ByteImagePropertyType = 1001
Const StringImagePropertyType = 1002
Const UnsignedIntegerImagePropertyType = 1003
Const LongImagePropertyType = 1004
Const UnsignedLongImagePropertyType = 1005
Const RationalImagePropertyType = 1006
Const UnsignedRationalImagePropertyType = 1007
Const VectorOfUndefinedImagePropertyType = 1100
Const VectorOfBytesImagePropertyType = 1101
Const VectorOfUnsignedIntegersImagePropertyType = 1102
Const VectorOfLongsImagePropertyType = 1103
Const VectorOfUnsignedLongsImagePropertyType = 1104
Const VectorOfRationalsImagePropertyType = 1105
Const VectorOfUnsignedRationalsImagePropertyType = 1106

App.ClearTrace


Dim devMngr, CommonDialog1, p
Dim s 'As String
Dim dev 'As Device

set devMngr = CreateObject("WIA.DeviceManager")
set CommonDialog1 = CreateObject("WIA.CommonDialog")


' List all Available Devices by Name and DeviceID
' The following example shows how to list all available devices by name and DeviceID. 
Dim i, n 'As Integer
n = devMngr.DeviceInfos.Count
App.Trace "Number of device found = " & n, -1, TRACE_INFORMATION
For i = 1 to devMngr.DeviceInfos.Count
  app.Trace " Device " & i & ":" & vbTab & devMngr.DeviceInfos(i).Properties("Name").Value & vbTab & "(" & devMngr.DeviceInfos(i).DeviceID & ")", &hff0000
Next

'Display all the Properties for the Selected Device - 1
'The following example shows how to display all the properties for the selected device.
App.Trace "Properties for the Selected Device", -1, TRACE_INFORMATION
Set dev = CommonDialog1.ShowSelectDevice( UnspecifiedDeviceType, True )

App.Trace "Available commands for the Device", -1, TRACE_INFORMATION
Dim dc 'As DeviceCommand
Dim bCanTakePicture
bCanTakePicture = False
For Each dc In dev.Commands
    If dc.CommandID = wiaCommandTakePicture Then
        bCanTakePicture  = True
        App.Trace "Selected device supports the TakePicture command", &hff0000, TRACE_OK
    End If
Next

if bCanTakePicture  then
  App.Trace "Taking a picture...", -1, TRACE_INFORMATION
  'Set dev = CommonDialog1.ShowSelectDevice
  If dev.Type = CameraDeviceType Then
    Dim itm 'As Item
    'Set itm = dev.ExecuteCommand(wiaCommandTakePicture)
  End If
end if

App.Trace "Items:", -1, TRACE_INFORMATION
Dim img 'As ImageFile
For Each itm In dev.Items
  If itm.Properties.Exists("Item Name") Then
    s = itm.Properties("Item Name").Value
    If itm.Properties.Exists("Item Time Stamp") Then
        Dim v 'As Vector

        Set v = itm.Properties("Item Time Stamp").Value
        If v.Count = 8 Then
            s = s & " (" & v.Date & ")"
        End If
    End If
    App.Trace s
    for each p in itm.Properties
      s = ""
      If p.IsVector Then
        s = s & "[vector data not emitted]"
      ElseIf p.Type = RationalImagePropertyType Then
        s = s & p.Value.Numerator & "/" & p.Value.Denominator
      ElseIf p.Type = StringImagePropertyType Then
        s = s & """" & p.Value & """"
      Else
        s = s & p.Value
      End If
      app.Trace vbtab & p.Name & "(" & p.PropertyID & ") " & s
    next

    If itm.Properties.Exists("Filename extension") Then
      if lcase(itm.Properties("Filename extension").value) = "jpg" Then
        'Set Img = Itm.Transfer
	'Img.SaveFile "m:\" & Itm.Properties("Item Name").Value & "." & Img.FileExtension
      end if
    end if



  else
    App.Trace "Unnamed item..."
  end if
Next


'Set itm = dev.GetItem(ItemID)
'Set img = CommonDialog1.ShowTransfer(itm)
'Set v = img.FileData
'Set Picture1.Picture = v.Picture

app.Trace "Done !!!", -1, TRACE_OK