Scan

I didn't quite get it ready for the codebank yet, but you can try it.
Bear in mind that it was my second VB.NET project, so you will find some older VB
styles:
[CODE]'Special thanks to gaccettola (gabe on http://www.twain.org) from

http://opentwain.codeplex.com
'Also to Spike for his cool tools at http://www.dosadi.com
'Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices 'required for <[In](), Out()> & MarshalAs
'NOTES: A structure can be allocated on the heap, a class will never be. An outside
app (or dll) can not write to this app's heap so that is why sometimes classes
' are used instead of structures. Otherwise there is no difference except that
classes need to be instanciated, and some classes have constructors.
'Prefixes: tws = TWain Structure

' tws = TWain Class
' rct = RFQ Console class/structure for Twain interface (anything designated rc
(Rotair Custom) is code used to simplify VB's interaction with TWAIN.
' rce = RFQ Console Enumeration
' scan = Used for options that can be set by the user or twain stuff that had its
names modified and made public. (FileType is one example because the enum names are
used as the actual file type so the prefix TWFF_ was removed)
'Class is organized as follows:

' 1) Constants
' 2) Enumerations
' 3) Exported function calls
' 4) Structures and classes
' 5) Local variables
' 6) Properties
' 7) Private methods
' 8) Public methods
'A scanner or camera is a Data Source (DS). The Data Source Manager (DSM) talks to
the DS. The app talks to the DSM via the single entry in the DLL.
'Category PrefixMART
'------------------- -------------------
'Data Groups DG_
'Data Argument Types DAT_
'Messages MSG_
'Capabilities CAP_, ICAP_ or ACAP_
'Return Codes TWRC_
'Condition Codes TWCC_
'Type Definitions TW_
'Structure Definitions TW_
'File Types TWFF_
Public Class clsScan
#Region "Message Intercept Form"

'Form exits just to process windows messages for TWAIN communication
Private Class frmMessageIntercept
Inherits System.Windows.Forms.Form
Implements IMessageFilter
Private mLog As clsLogging

Private mScan As clsScan
Public WriteOnly Property Log() As clsLogging

Set(ByVal value As clsLogging)
mLog = value
End Set
End Property
Public WriteOnly Property Scan() As clsScan
Set(ByVal value As clsScan)
mScan = value
End Set
End Property
Public Function PreFilterMessage(ByRef m As Message) As Boolean Implements

IMessageFilter.PreFilterMessage
Return mScan.FilterMessage(m)
End Function
Public Sub InterceptMessageLoop(ByVal bIntercept As Boolean)
Const conProc As String = "InterceptMessageLoop"
Try
mLog.EnterProc(conProc, mconModule)
If bIntercept Then
Application.AddMessageFilter(Me)
Else
Application.RemoveMessageFilter(Me)
End If
Catch ex As Exception
mLog.AddError(ex)
Finally
mLog.ExitProc(conProc)
End Try
End Sub
End Class
#End Region
'some fields can be set to -1 if we don't care about them
'***********************************************************************
****
'* *
'* CONSTANTS *
'* *
'***********************************************************************
****
'Strings to return when requesting the source and an explicit one is not selected
Public Const mconSouceUserSelect As String = "[UserSelect]"
Public Const mconSouceDefault As String = "[Default]"
Private Const mconModule As String = "clsScan" 'Used in message / error

logging (clsLogging)
Private Const mconTWAIN_DLL As String = "TWAIN_32.DLL"

Private Const mconTWCY_USA As Integer = 1
Private Const mconTWLG_ENGLISH_USA As Integer = 13
#Region "C++ Source"
'#define TWON_PROTOCOLMINOR 10 /* Changed for Version 1.10 */
'#define TWON_PROTOCOLMAJOR 1
#End Region
Private Const mconTWON_PROTOCOLMINOR As Integer = 10
Private Const mconTWON_PROTOCOLMAJOR As Integer = 1
'Flags used in TW_MEMORY structure.
Private Const TWMF_APPOWNS As Integer = &H1
Private Const TWMF_DSMOWNS As Integer = &H2
Private Const TWMF_DSOWNS As Integer = &H4
Private Const TWMF_POINTER As Integer = &H8
Private Const TWMF_HANDLE As Integer = &H10
'???
Private Const TWON_DONTCARE8 As Integer = &HFF
Private Const TWON_DONTCARE16 As Integer = &HFFFF
Private Const TWON_DONTCARE32 As Integer = &HFFFFFFFF
'Messages
Private Const mconDSM_FailedToOpen As String = "Failed to open the DSM "
Private Const mconDSM_FailedToSelectSource As String = "DSM_Entry failed
selecting a source"
Private Const mconDSM_FailedToOpenSource As String = "Failed opening a source"
Private Const mconDSM_FailedToEnableSource As String = "Failed enabling a
source"
'***********************************************************************
****
'* *
'* PUBLIC ENUMERATIONS *
'* *
'***********************************************************************
****
Public Enum scanSourceSelect As Integer

escanSourceDefault
escanSourceUserSelect
escanSourceSpecific
End Enum
Public Enum scanSourceUI As Integer

escanSourceHide
escanSourceShow
End Enum
Public Enum scanDestination As Integer

escanDestinationDIB
escanDestinationFile
End Enum
Public Enum scanTwainState As Integer 'State 2 is when the DLL is loaded into
memory, VB loads it automatically, so we go from 1 to 3 as soon as the call is made
'Load the Source Manager and Get the DSM_Entry (1 to 2)
'Open the Source Manager (2 to 3)
'Select the Source (during 3)
'Open the Source (3 to 4)
'Negotiate Capabilities with the Source (during 4)
'Request the Acquisition of Data fromthe Source (4 to 5)
'Recognize that the Data Transfer is Ready (5 to 6)
'Start and Perform the Transfer (6 to 7)
'Conclude the Transfer (7 to 6 to 5)
'Disconnect the TWAIN Session (5 to 1 in sequence)
escanPresentation = 1 'Start here. Nothing open.
escanDSM_Loaded 'This would be calls to LoadLibrary and
GetProcAddress. Done for us by VB.
escanDSM_Open 'SM open
escanDS_Open 'Source open for negotiation
escanDS_Enabled 'Source enabled to acquire
escanTransferReady 'Image ready to transfer
escanTransfering 'Image in transit
End Enum
Public Enum scanFileType As Short

'Prefix TWFF_ removed so the name can also serve as the actual file extemnsion
TIFF = 0 'Tagged Image File Format
PICT = 1 'Macintosh PICT
BMP = 2 'Windows Bitmap
XBM = 3 'X-Windows Bitmap
JFIF = 4 'JPEG File Interchange Format
FPX = 5 'Flash Pix
TIFFMULTI = 6 'Multi-page tiff file
PNG = 7
SPIFF = 8
EXIF = 9
PDF = 10 '1.91 NB: this is not PDF/A
JP2 = 11 '1.91
JPX = 13 '1.91
DEJAVU = 14 '1.91
PDFA = 15 '2.0 Adobe PDF/A, Version 1
PDFA2 = 16 '2.1 Adobe PDF/A, Version 2
End Enum
Public Enum scanCap As UShort

'Prefix CAP_ and ICAP_ removed and proper case added so the name can also serve
as a display name
TransferCount = &H1
Compression = &H100
PixelType = &H101 'Uses twsEnumeration
Units = &H102 'Units of measure that other capabilites use (twUnits);
uses twsEnumeration; default is TWUN_INCHES
TransferMechanism = &H103 'Can transfer to files
Author = &H1000
Caption = &H1001
FeederEnabled = &H1002
FeederLoaded = &H1003
TimeDate = &H1004
SupportedCapabilities = &H1005
ExtendedCapabilities = &H1006
Autofeed = &H1007
ClearPage = &H1008
FeedPage = &H1009
RewindPage = &H100A
Indicators = &H100B
SupportedCapabilitiesExtended = &H100C
PaperDetectable = &H100D
UIControllable = &H100E
DeviceOnline = &H100F
AutoScan = &H1010
ThumbnailsEnabled = &H1011
Duplex = &H1012
DuplexEnabled = &H1013
EnableDSUIOnly = &H1014
CustomData = &H1015
Endorser = &H1016
JobControl = &H1017
Alarms = &H1018
AlarmsVolume = &H1019
AutomaticCapture = &H101A
TimeBeforeFirstCapture = &H101B
TimeBetweenCaptures = &H101C
ClearBuffers = &H101D
MaxBatchBuffers = &H101E
DeviceTimeDate = &H101F
PowerSupply = &H1020
CameraPreviewUI = &H1021
DeviceEvent = &H1022
ReaquireAllowed = &H1023
SerialNumber = &H1024
Printer = &H1026
PrinterEnabled = &H1027
PrinterIndex = &H1028
PrinterMode = &H1029
PrinterString = &H102A
PrinterSuffix = &H102B
Language = &H102C
FeederAlignment = &H102D
FeederOrder = &H102E
BatteryMinutes = &H1032
BatteryPercentage = &H1033
AutoBright = &H1100
Brightness = &H1101
Contrast = &H1103
CustomHalfTone = &H1104
ExposureTime = &H1105
Filter = &H1106
FlashUsed = &H1107
Gamma = &H1108
HalfTones = &H1109
HighLight = &H110A
ImageFileFormat = &H110C
LampState = &H110D
LightSource = &H110E
Orientation = &H1110
PhysicalWidth = &H1111 'Get the max image width
PhysicalHeight = &H1112 'Get the max image height
Shadow = &H1113
Frames = &H1114
XNativeResolution = &H1116
YNativeResolution = &H1117
XResolution = &H1118
YResolution = &H1119
MaximumFrames = &H111A
Tiles = &H111B
BitOrder = &H111C
CCITTKFactor = &H111D
LightPath = &H111E
PixelFlavor = &H111F
PlanarChunky = &H1120
Rotation = &H1121
SupportedSizes = &H1122
Threshold = &H1123
XScaling = &H1124
YScaling = &H1125
BitOrderCodes = &H1126
PixelFlavorCodes = &H1127
JPegPixelType = &H1128
TimeFill = &H112A
BitDepth = &H112B 'Uses twsEnumeration
BitDepthReduction = &H112C
UndefinedImageSize = &H112D
ImageDataSet = &H112E
ExtendedImageInfo = &H112F
MinimumHeight = &H1130
MinimumWidth = &H1131
AutoDiscardBlankPages = &H1134
FlipRotation = &H1136
BarCodeDetextionEnabled = &H1137
SupportedBarCodeTypes = &H1138
BarCodeMaxSearchPriorities = &H1139
BarCodeSearchPriorities = &H113A
BarCodeSearchMode = &H113B
BarCodeMaxRetries = &H113C
BarCodeTimeout = &H113D
ZoomFactor = &H113E
PatchCodeDectionEnabled = &H113F
SupportedPathcCodeTypes = &H1140
PatchCodeMaxSearchPriorities = &H1141
PatchCodeSearchPriorities = &H1142
PatchCodeSearchMode = &H1143
PatchCodeMaxRetries = &H1144
PatchCodeTimeout = &H1145
FlashUsed2 = &H1146
ImageFilter = &H1147
NoiseFilter = &H1148
Overscan = &H1149
AutomaticBorderDection = &H1150
AutomaticDeskew = &H1151
AutomaticRotate = &H1152
JPegQuality = &H1153
FeederType = &H1154
ICCProfile = &H1155
Autosize = &H1156
AutomaticCropUsesFrame = &H1157
AutomaticLengthDetection = &H1158
AutomaticColorEnabled = &H1159
AutomaticColorNoncolorPixelType = &H115A
ColorManagementEnabled = &H115B
ImageMerge = &H115C
ImageMergeHeightThreshold = &H115D
SupportedExtImageInfo = &H115E
End Enum
Public Enum scanItemType As UInt16 'Copied from openTwain

''' <summary>An 8-bit signed integer<br></br>
''' <list type="table">
''' <item>
''' <term>TWAIN Typename:</term>
''' <description>TW_INT8</description>
''' </item>
''' <item>
''' <term>C++ typedef:</term>
''' <description>char</description>
''' </item>
''' <item>
''' <term>.Net Universal type name:</term>
''' <description><see cref="System.SByte"/></description>
''' </item>
''' <item>
''' <term>Range:</term>
''' <description>–128 to 127</description>
''' </item>
''' </list>
''' </summary>
''' <remarks></remarks>
Int8 = &H0

''' <item>
''' </item>
''' <item>
''' <description>short</description>
''' </item>
''' <item>
''' <description><see cref="System.Int16"/></description>
''' </item>
''' <item>
''' <description>–32,768 to 32,767</description>
''' </item>
''' </list>
''' </summary>
Int16 = &H1
''' <item>
''' </item>
''' <item>
''' <description>long</description>
''' </item>
''' <item>
''' <description><see cref="System.Int32"/></description>
''' </item>
''' <item>
''' <description> –2,147,483,648 to 2,147,483,647</description>
''' </item>
''' </list>
''' </summary>
Int32 = &H2
' an 8-bit unsigned integer

' TW_UINT8
''' <summary>An 8-bit unsigned integer<br></br>

''' <item>
''' <description>TW_UINT8</description>
''' </item>
''' <item>
''' <description>unsigned char</description>
''' </item>
''' <item>
''' <description><see cref="System.Byte"/></description>
''' </item>
''' <item>
''' <description>0 to 255</description>
''' </item>
''' </list>
''' </summary>
UInt8 = &H3
' a 16-bit unsigned integer

' TW_UINT16
UInt16 = &H4
''' <summary>
''' a 32-bit unsigned integer
'''
''' TW_UINT32
''' </summary>
UInt32 = &H5
''' <summary>
''' a 16-bit unsigned integer
'''
''' TW_BOOL
''' </summary>
Bool = &H6
''' <summary>
''' TW_FIX32
''' </summary>
Fix32 = &H7
''' <summary>
''' TW_FRAME
''' </summary>
Frame = &H8
''' <summary>
''' an array of 8-bit signed integers with 34 elements
'''
''' TW_STR32
''' </summary>
Str32 = &H9
''' <summary>
'''
''' TW_STR64
''' </summary>
Str64 = &HA
''' <summary>
''' TW_STR128
''' </summary>
Str128 = &HB
''' <summary>
''' an array of 8-bit signed integers with less than 256 elements
''' TW_STR128
''' </summary>
Str255 = &HC
''' <summary>
''' TW_STR1024
''' ...added 1.9
''' </summary>
Str1024 = &HD
''' <summary>
''' an array of a 16-bit unsigned integer with 512 elements
'''
''' TW_UNI512
''' ...added 1.9
''' </summary>
Str512 = &HE
End Enum
Public Enum scanContainerType As Short

Array = &H3
Enumeration = &H4
OneValue = &H5
Range = &H6
DontCare = -1
End Enum
'***********************************************************************
****
'* *
'* PRIVATE ENUMERATIONS *
'* *
'***********************************************************************
****
<Flags()> Private Enum twDG As Short
Control = &H1
Image = &H2
Audio = &H4
End Enum
Private Enum twDAT As Short

Null = &H0
Capability = &H1
[Event] = &H2
Identity = &H3
Parent = &H4
PendingXfers = &H5
SetupMemXfer = &H6
SetupFileXfer = &H7
Status = &H8
UserInterface = &H9
XferGroup = &HA
TwunkIdentity = &HB
CustomDSData = &HC
DeviceEvent = &HD
FileSystem = &HE
PassThru = &HF
ImageInfo = &H101
ImageLayout = &H102
ImageMemXfer = &H103
ImageNativeXfer = &H104
ImageFileXfer = &H105
CieColor = &H106
GrayResponse = &H107
RGBResponse = &H108
JpegCompression = &H109
Palette8 = &H10A
ExtImageInfo = &H10B
SetupFileXfer2 = &H301
End Enum
Private Enum twMSG As Short

Null = &H0
[Get] = &H1
GetCurrent = &H2
GetDefault = &H3
GetFirst = &H4
GetNext = &H5
[Set] = &H6
Reset = &H7
QuerySupport = &H8
XFerReady = &H101
CloseDSReq = &H102
CloseDSOK = &H103
DeviceEvent = &H104
CheckStatus = &H201
OpenDSM = &H301
CloseDSM = &H302
OpenDS = &H401
CloseDS = &H402
UserSelect = &H403
DisableDS = &H501
EnableDS = &H502
EnableDSUIOnly = &H503
ProcessEvent = &H601
EndXfer = &H701
StopFeeder = &H702
ChangeDirectory = &H801
CreateDirectory = &H802
Delete = &H803
FormatMedia = &H804
GetClose = &H805
GetFirstFile = &H806
GetInfo = &H807
GetNextFile = &H808
Rename = &H809
Copy = &H80A
AutoCaptureDir = &H80B
PassThru = &H901
End Enum
Private Enum twRC As Short

Success = &H0
Failure = &H1
CheckStatus = &H2
Cancel = &H3
DSEvent = &H4
NotDSEvent = &H5
XferDone = &H6
EndOfList = &H7
InfoNotSupported = &H8
DataNotAvailable = &H9
End Enum
Private Enum twTwainCommand

[Not] = -1
Null = 0
TransferReady = 1
CloseRequest = 2
CloseOk = 3
DeviceEvent = 4
End Enum
Private Enum twUnits As Short

Inches
Centimeters
Picas
points
Twips
Pixels
Millimeters
End Enum
Private Enum twPixelTypeValues As Short

TWPT_SRGB64 = 11
TWPT_BGR
TWPT_CIELAB
TWPT_CIELUV
TWPT_YCBCR
End Enum
Private Enum twPixelType As Short

TWPT_BW
TWPT_GRAY
TWPT_RGB
TWPT_PALETTE
TWPT_CMY
TWPT_CMYK
TWPT_YUV
TWPT_YUVK
TWPT_CIEXYZ
TWPT_SRGB
TWPT_SRGB64
End Enum
<Flags()> Private Enum twXferMech As Short

TWSX_NATIVE = &H0 'DIB
TWSX_FILE = &H1 'Win file
TWSX_MEMORY = &H2 'Buffered memory
TWSX_MEMFILE = &H4
End Enum
'***********************************************************************
****
'* *
'* EXPORTED CALLS *
'* *
'***********************************************************************
****
Friend Declare Function GlobalLock Lib "kernel32.dll" Alias "GlobalLock" ( _

ByVal hMem As IntPtr) As IntPtr
Friend Declare Function GlobalUnlock Lib "kernel32.dll" Alias "GlobalUnlock" ( _

ByVal hMem As Integer) As Integer
Private Declare Function GetMessagePos Lib "user32.dll" Alias "GetMessagePos" ()

As Integer
Private Declare Function GetMessageTime Lib "user32.dll" Alias "GetMessageTime"

() As Integer
'Following 2 decalres that are commented out are used by this module but also others
so have been moved to a common module. Left here for documentation purposes.
'Private Declare Function GlobalLock Lib "kernel32.dll" Alias "GlobalLock" ( _
' ByVal hMem As IntPtr) As IntPtr
'Private Declare Function GlobalUnlock Lib "kernel32.dll" Alias "GlobalUnlock" ( _

' ByVal hMem As Integer) As Integer
<DllImport("twain_32.dll", EntryPoint:="#1")> Private Shared Function

DSM_OpenClose( _
<[In](), Out()> ByVal pOrigin As twcIdentity, _
ByVal pDest As IntPtr, _
ByVal dg As twDG, _
ByVal dat As twDAT, _
ByVal msg As twMSG, _
ByRef hWnd As IntPtr) As twRC
End Function
DSM_SelectOpenSource( _
ByVal zeroptr As IntPtr, _
ByVal dg As twDG, _
ByVal msg As twMSG, <[In](), Out()> ByVal idSource As twcIdentity) As twRC
End Function
DSM_EnableSource( _
ByVal pSource As twcIdentity, _
ByVal dg As twDG, _
ByVal msg As twMSG, <[In](), Out()> ByVal uiSource As twcUserInterface) As
twRC
End Function
DSM_Event( _
<[In](), Out()> ByVal pSource As twcIdentity, _
ByVal dg As twDG, _
ByRef srcMessage As twsEvent) As twRC
End Function
DS_ImageInfo( _
<[In]()> ByVal pSource As twcIdentity, _
ByVal dg As twDG, _
<[In](), Out()> ByVal imgInfo As twsImageInfo) As twRC
End Function
DS_ImageNativeXfer( _
ByVal dg As twDG, _
ByRef hbitmap As IntPtr) As twRC
End Function
DS_ImageFileXfer( _
ByVal dg As twDG, _
ByRef zeroptr As IntPtr) As twRC
End Function
DS_Capability( _
ByVal dg As twDG, _
<[In](), Out()> ByVal pData As twcCapability) As twRC
End Function
DS_CapabilityImageLayout( _
ByVal dg As twDG, _
<[In](), Out()> ByRef pData As twsImageLayout) As twRC
End Function
DS_PendingXfer( _
ByVal dg As twDG, _
<[In](), Out()> ByVal pData As twcPendingXfers) As twRC
End Function
DS_SetupFileXfer( _
ByVal pDest As twcIdentity, _
ByVal dg As twDG, _
ByRef pData As twsSetupFileXfer) As twRC
End Function
DSM_Status( _
ByVal dg As twDG, _
ByRef pData As twsStatus) As twRC
End Function
DSM_CloseDS( _
ByVal dg As twDG, _
ByRef pData As twcIdentity) As twRC
End Function
'***********************************************************************
****
'* Function: DSM_Entry, the only entry point into the Data Source Manager.
'*
'* Parameters:
'* pOrigin Identifies the source module of the message. This could
'* identify an Application, a Source, or the Source Manager.
'*
'* pDest Identifies the destination module for the message.
'* This could identify an application or a data source.
'* If this is NULL, the message goes to the Source Manager.
'*
'* DG The Data Group.
'* Example: DG_IMAGE.
'*
'* DAT The Data Attribute Type.
'* Example: DAT_IMAGEMEMXFER.
'*
'* MSG The message. Messages are interpreted by the destination module
'* with respect to the Data Group and the Data Attribute Type.
'* Example: MSG_GET.
'*
'* pData A pointer to the data structure or variable identified
'* by the Data Attribute Type.
'* Example: (TW_MEMREF)&ImageMemXfer
'* where ImageMemXfer is a TW_IMAGEMEMXFER structure.
'*
'* Returns:
'* ReturnCode
'* Example: TWRC_SUCCESS.
'*
'***********************************************************************
****
'***********************************************************************
****
'* *
'* STRUCTURES / CLASSES *
'* *
'***********************************************************************
****
<StructLayout(LayoutKind.Sequential, Pack:=2, CharSet:=CharSet.Ansi)> Friend
Class twcIdentity
'/* DAT_IDENTITY. Identifies the program/library/code resource. */
'typedef struct {
' TW_UINT32 Id; /* Unique number. In Windows, application hWnd
*/
' TW_VERSION Version; /* Identifies the piece of code */
' TW_UINT16 ProtocolMajor; /* Application and DS must set to
TWON_PROTOCOLMAJOR */
' TW_UINT16 ProtocolMinor; /* Application and DS must set to
TWON_PROTOCOLMINOR */
' TW_UINT32 SupportedGroups; /* Bit field OR combination of DG_ constants */
' TW_STR32 Manufacturer; /* Manufacturer name, e.g. "Hewlett-Packard" */
' TW_STR32 ProductFamily; /* Product family name, e.g. "ScanJet" */
' TW_STR32 ProductName; /* Product name, e.g. "ScanJet Plus" */
'} TW_IDENTITY, FAR * pTW_IDENTITY;
#End Region
Public Id As IntPtr '4
Public Version As twcVersion '42
Public ProtocolMajor As Short '2
Public ProtocolMinor As Short '2
Public SupportedGroups As Integer '4
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=34)> Public Manufacturer As
String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=34)> Public ProductFamily
As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=34)> Public ProductName As
String
Public Sub New()

MyBase.New()
Version = New twcVersion
End Sub
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2, CharSet:=CharSet.Ansi)> Friend

Class twcVersion
'/* No DAT needed. Describes version of software currently running. */
'typedef struct {
' TW_UINT16 MajorNum; /* Major revision number of the software. */
' TW_UINT16 MinorNum; /* Incremental revision number of the software. */
' TW_UINT16 Language; /* e.g. TWLG_SWISSFRENCH */
' TW_UINT16 Country; /* e.g. TWCY_SWITZERLAND */
' TW_STR32 Info; /* e.g. "1.0b3 Beta release" */
'} TW_VERSION, FAR * pTW_VERSION;
#End Region
Public MajorNum As Short
Public MinorNum As Short
Public Language As Short
Public Country As Short
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=34)> Public Info As String
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Private Class twcCapability

'/* DAT_CAPABILITY. Used by application to get/set capability from/in a data
source. */
'typedef struct {
' TW_UINT16 Cap; /* id of capability to set or get, e.g. CAP_BRIGHTNESS */
' TW_UINT16 ConType; /* TWON_ONEVALUE, _RANGE, _ENUMERATION
or _ARRAY */
' TW_HANDLE hContainer; /* Handle to container of type Dat */
'} TW_CAPABILITY, FAR * pTW_CAPABILITY;
#End Region
Public Cap As scanCap
Public ConType As scanContainerType
Public Handle As IntPtr 'Pointer to a container
Public Sub New(ByVal eCap As scanCap)

Cap = eCap
End Sub
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsStatus

'/* DAT_STATUS. Application gets detailed status info from a data source with this.
*/
'typedef struct {
' TW_UINT16 ConditionCode; /* Any TWCC_ constant */
' TW_UINT16 Reserved; /* Future expansion space */
'} TW_STATUS, FAR * pTW_STATUS;
#End Region
Public ConditionCode As Short
Public Reserved As Short
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Private Class twcUserInterface

'typedef struct {
' TW_BOOL ShowUI; /* TRUE if DS should bring up its UI */
' TW_BOOL ModalUI; /* For Mac only - true if the DS's UI is modal */
' TW_HANDLE hParent; /* For windows only - Application window handle
*/
'} TW_USERINTERFACE, FAR * pTW_USERINTERFACE;
#End Region
Public ShowUI As Short
Public ModalUI As Short
Public ParentHand As IntPtr
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsEvent

'/* DAT_EVENT. For passing events down from the application to the DS. */
'typedef struct {
' TW_MEMREF pEvent; /* Windows pMSG or Mac pEvent. */
' TW_UINT16 TWMessage; /* TW msg from data source, e.g.
MSG_XFERREADY */
'} TW_EVENT, FAR * pTW_EVENT;
#End Region
Public EventPtr As IntPtr
Public Message As Short
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Class twsImageInfo

'/* DAT_IMAGEINFO. Application gets detailed image info from DS with this. */
'typedef struct {
' TW_FIX32 XResolution; /* Resolution in the horizontal */
' TW_FIX32 YResolution; /* Resolution in the vertical */
' TW_INT32 ImageWidth; /* Columns in the image, -1 if unknown by DS*/
' TW_INT32 ImageLength; /* Rows in the image, -1 if unknown by DS */
' TW_INT16 SamplesPerPixel; /* Number of samples per pixel, 3 for RGB */
' TW_INT16 BitsPerSample[8]; /* Number of bits for each sample */
' TW_INT16 BitsPerPixel; /* Number of bits for each padded pixel */
' TW_BOOL Planar; /* True if Planar, False if chunky */
' TW_INT16 PixelType; /* How to interp data; photo interp (TWPT_) */
' TW_UINT16 Compression; /* How the data is compressed (TWCP_xxxx) */
'} TW_IMAGEINFO, FAR * pTW_IMAGEINFO;
#End Region
Public XResolution As Integer
Public YResolution As Integer
Public ImageWidth As Integer
Public ImageLength As Integer
Public SamplesPerPixel As Short
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> Public BitsPerSample()
As Short
Public BitsPerPixel As Short
Public Planar As Short
Public PixelType As Short
Public Compression As Short
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Class twcPendingXfers

'/* DAT_PENDINGXFERS. Used with MSG_ENDXFER to indicate additional
data. */
'typedef struct {
' TW_UINT16 Count;
' union {
' TW_UINT32 EOJ;
' TW_UINT32 Reserved;
' };
'} TW_PENDINGXFERS, FAR *pTW_PENDINGXFERS;
#End Region
Public Count As Short
Public EOJ As Integer
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsArray

'/* TWON_ARRAY. Container for array of values (a simplified twsEnumeration) */
'typedef struct {
' TW_UINT16 ItemType;
' TW_UINT32 NumItems; /* How many items in ItemList */
' TW_UINT8 ItemList[1]; /* Array of ItemType values starts here */
'} TW_ARRAY, FAR * pTW_ARRAY;
#End Region
Public ItemType As scanItemType
Public NumItems As Integer
Public ItemList() As Byte
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsEnumeration

'/* TWON_ENUMERATION. Container for a collection of values. */
'typedef struct {
' TW_UINT32 NumItems; /* How many items in ItemList */
' TW_UINT32 CurrentIndex; /* Current value is in ItemList[CurrentIndex] */
' TW_UINT32 DefaultIndex; /* Powerup value is in ItemList[DefaultIndex] */
' TW_UINT8 ItemList[1]; /* Array of ItemType values starts here */
'} twsEnumeration, FAR * ptwsEnumeration;
#End Region
Public CurrentIndex As Integer
Public DefaultIndex As Integer
Public ItemList() As Byte
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsOneValue

'/* TWON_ONEVALUE. Container for one value. */
'typedef struct {
' TW_UINT32 Item;
'} TW_ONEVALUE, FAR * pTW_ONEVALUE;
#End Region
Public Item As Object
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsRange

'/* TWON_RANGE. Container for a range of values. */
'typedef struct {
' TW_UINT32 MinValue; /* Starting value in the range. */
' TW_UINT32 MaxValue; /* Final value in the range. */
' TW_UINT32 StepSize; /* Increment from MinValue to MaxValue. */
' TW_UINT32 DefaultValue; /* Power-up value. */
' TW_UINT32 CurrentValue; /* The value that is currently in effect. */
'} twsRange, FAR * ptwsRange;
#End Region
Public MinValue As Integer
Public MaxValue As Integer
Public StepSize As Integer
Public DefaultValue As Integer
Public CurrentValue As Integer
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsSetupFileXfer

'/* DAT_SETUPFILEXFER. Sets up DS to application data transfer via a file. */
'typedef struct {
' TW_STR255 FileName;
' TW_UINT16 Format; /* Any TWFF_ constant */
' TW_INT16 VRefNum; /* Used for Mac only */
'} TW_SETUPFILEXFER, FAR * pTW_SETUPFILEXFER;
#End Region
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=255)> Public FileName As
String
Public Format As Short 'Any TWFF_ constant
Public VRefNum As Short 'Used for Mac only
End Structure
'Flaw with this structure. Impossible to represent a negative fraction with out a whole
number.
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsFix32
'Stores a fraction with 2 integers. The first carries the sign and is a whole number.
' The second is a fraction expressed as the numerator of a fraction with a
denominator of 65536.
'/* Fixed point structure type. */
'typedef struct {
' TW_INT16 Whole; /* maintains the sign */
' TW_UINT16 Frac;
'} TW_FIX32, FAR *pTW_FIX32;
#End Region
Public Whole As Short
Public Frac As UInt16
Public Sub SetMembers(ByVal sngValue As Single)
Whole = CType(Fix(sngValue), Short)

If Whole > 0 Then
Frac = CType((sngValue - Whole) * 65536, UShort)
Else
Frac = CType((sngValue + Whole) * 65536, UShort)
End If
End Sub
Public Function GetValue() As Single
If Whole > 0 Then

Return Whole + CType(Frac / 65536, Single)
Else
Return Whole - CType(Frac / 65536, Single)
End If
End Function
Public Overrides Function ToString() As String

Dim sngTemp As Single
If Frac < 0 Then

sngTemp = Frac + 65536
Else
sngTemp = Frac
End If
If System.Math.Abs(Whole) = Whole Then
sngTemp = Whole + (sngTemp / 65536)
Else
sngTemp = Whole - (sngTemp / 65536)
End If
Return sngTemp.ToString
End Function
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsFrame
'/* No DAT. Defines a frame rectangle in Units coordinates. */
'typedef struct {
' TW_FIX32 Left;
' TW_FIX32 Top;
' TW_FIX32 Right;
' TW_FIX32 Bottom;
'} TW_FRAME, FAR * pTW_FRAME;
#End Region
Public Left As twsFix32
Public Top As twsFix32
Public Right As twsFix32
Public Bottom As twsFix32

Return "Left=" & Left.ToString & "; Top=" & Top.ToString & "; Right=" &
Right.ToString & "; Bottom=" & Bottom.ToString
End Function
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsImageLayout
'/* DAT_IMAGELAYOUT. Provides image layout information in current units. */
'typedef struct {
' TW_FRAME Frame; /* Frame coords within larger document */
' TW_UINT32 DocumentNumber;
' TW_UINT32 PageNumber; /* Reset when you go to next document */
' TW_UINT32 FrameNumber; /* Reset when you go to next page */
'} TW_IMAGELAYOUT, FAR * pTW_IMAGELAYOUT;
#End Region
Public Frame As twsFrame
Public DocumentNumber As Integer
Public PageNumber As Integer
Public FrameNumber As Integer
End Structure
Public Class rctCapValue

'Generic capability object. Contains all properties of all containers (array,
enumeration, onevalue and range)
Public CapNumber As scanCap
Public ContainerType As scanContainerType
Public [Default] As Object
Public Current As Object
Public NewValue As Object 'Used to set a capability (OneValue)
Public MinValue As Integer
Public MaxValue As Integer
Public StepSize As Integer
Public ItemList As Object
Public Function CopyOf() As rctCapValue

Dim CapValueCopy As rctCapValue
CapValueCopy = New rctCapValue

With Me
CapValueCopy.CapNumber = .CapNumber
CapValueCopy.ContainerType = .ContainerType
CapValueCopy.ItemType = .ItemType
CapValueCopy.Default = .Default
CapValueCopy.Current = .Current
CapValueCopy.NewValue = .NewValue
CapValueCopy.NumItems = .NumItems
CapValueCopy.MinValue = .MinValue
CapValueCopy.MaxValue = .MaxValue
CapValueCopy.StepSize = .StepSize
CapValueCopy.ItemList = .ItemList
End With
Return CapValueCopy
End Function
Public Sub CopyTo(ByVal CapValueCopy As rctCapValue)
With Me
CapValueCopy.CapNumber = .CapNumber
CapValueCopy.ContainerType = .ContainerType
CapValueCopy.ItemType = .ItemType
CapValueCopy.Default = .Default
CapValueCopy.Current = .Current
CapValueCopy.NewValue = .NewValue
CapValueCopy.NumItems = .NumItems
CapValueCopy.MinValue = .MinValue
CapValueCopy.MaxValue = .MaxValue
CapValueCopy.StepSize = .StepSize
CapValueCopy.ItemList = .ItemList
End With
End Sub

Return CapNumber.ToString
End Function
End Class
Public Class colCapValue
Inherits CollectionBase
Public Loaded As Boolean

Private mintCount As Integer
Private mcol As Collection
Public Sub New()

mcol = New Collection
End Sub

Return "Collection of rctCapValue objects"
End Function
Public Shadows ReadOnly Property Count() As Integer

Get
Return MyBase.List.Count
End Get
End Property
Default Public Property Item(ByVal index As Integer) As rctCapValue

Get
Return CType(MyBase.List.Item(index), rctCapValue)
End Get
Set(ByVal value As rctCapValue)
MyBase.List.Item(index) = value
End Set
End Property
Public Overloads Function Add() As rctCapValue
Dim CapValue As rctCapValue
CapValue = New rctCapValue

MyBase.List.Add(CapValue)
mintCount = mintCount + 1
Return CapValue
End Function
Public Overloads Sub Add(ByVal CapValue As rctCapValue)
End Sub
Public Overloads Sub Add(ByVal CapValue As rctCapValue, ByVal Key As Object)

'Method not implemented
End Sub
Public Function Contains(ByVal CapValue As rctCapValue) As Boolean
Return List.Contains(CapValue)
End Function
Public Sub CopyTo(ByVal array() As rctCapValue, ByVal intIndex As Integer)
List.CopyTo(array, intIndex)
End Sub
Public Sub Insert(ByVal intIndex As Integer, ByVal CapValue As rctCapValue)
List.Insert(intIndex, CapValue)
End Sub
Public Function IndexOf(ByVal CapValue As rctCapValue) As Integer
Return List.IndexOf(CapValue)
End Function
Public Shadows Sub Remove(ByVal CapValue As rctCapValue)
MyBase.List.Remove(CapValue)
mintCount = mintCount - 1
End Sub
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If Not TypeOf (value) Is rctCapValue Then

Throw New ArgumentException("Invalid type")
End If
End Sub
Protected Overrides Sub OnSet(ByVal index As Integer, ByVal oldValue As Object,

ByVal newValue As Object)
If Not TypeOf (newValue) Is rctCapValue Then

End If
End Sub
Protected Overrides Sub OnValidate(ByVal value As Object)
If Not TypeOf (value) Is rctCapValue Then

End If
End Sub
End Class
<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure WINMSG_S

Public hwnd As IntPtr
Public message As Integer
Public wParam As IntPtr
Public lParam As IntPtr
Public time As Integer
Public x As Integer
Public y As Integer
End Structure
'***********************************************************************
****
'* *
'* LOCAL VARIABLES *
'* *
'***********************************************************************
****
Private meState As scanTwainState 'Used in an attempt to track what state
TWAIN is in. May not be accurate if an error occurs.
Private mbDebugMessages As Boolean 'If true will display msgboxes.
Private mbSetCaps As Boolean 'If true will set the capabilities according to
the collection.
Private mbDS_Selected As Boolean 'Source gets selected in state 3. doesn't
change the state.
Private mintPageNumber As Integer 'Page number/counter. Used in the file
name.
Private mstrSourceName As String 'Name of the source that will attempt to be
explicitly opened.
Private mstrOpenedDSName As String 'Name of the actual source that gets
opened.
Private mstrScanDir As String 'Name of the directory will scanned files are
put.
Private mstrScanFileName As String 'Actual file name.
Private mstrScanFileNamePrefix As String 'Prefix of the name of the scanned file
(Batch number or ID).
Private meSourceSelect As scanSourceSelect 'Determines how the source will be
selected.
Private meSourceUI As scanSourceUI 'Determines if we will display the source's
UI.
Private meDestination As scanDestination 'Where should TWAIN put the image.
Private meFileType As scanFileType 'What format to dsave the file as.
Private frmMessageLoop As frmMessageIntercept
Private mtwApp As twcIdentity 'Structure to identify the calling app (this
code).
Private mtwSource As twcIdentity 'Used to identify the source the calling app is
talking to.
Private mtwImageInfo As twsImageInfo 'Holds info about the transfered image
Private mcolCaps As colCapValue 'Collection to hold capabilities to set befoer
a scan.
Private mLog As clsLogging 'Class to log errors and/or just any information.
Private mfrmCaller As frmMain 'Instanciates this class and functions as a
message pump for TWAIN.
'***********************************************************************
****
'* *
'* READ-ONLY PROPERTIES *
'* *
'***********************************************************************
****
Public ReadOnly Property CapsLoaded() As Boolean
Get
If Not mcolCaps Is Nothing Then
Return mcolCaps.Loaded
Else
Return False
End If
End Get
End Property
Public ReadOnly Property ImageHeight() As Integer

Get
Return mtwImageInfo.ImageLength
End Get
End Property
Public ReadOnly Property ImageWidth() As Integer

Get
Return mtwImageInfo.ImageWidth
End Get
End Property
Public ReadOnly Property OpenedDSName() As String

Get
Return mstrOpenedDSName
End Get
End Property
Public ReadOnly Property PageNumber() As Integer

Get
Return mintPageNumber
End Get
End Property
Public ReadOnly Property ScanFileName() As String

Get
Return mstrScanFileName
End Get
End Property
'***********************************************************************
****
'* *
'* PROPERTIES *
'* *
'***********************************************************************
****
Public Property CustomCapCollection() As colCapValue

Get
Return mcolCaps
End Get
Set(ByVal newCapCollection As colCapValue)
mcolCaps = newCapCollection
mbSetCaps = True
End Set
End Property
Public Property Caller() As Form

Get
Return mfrmCaller
End Get
Set(ByVal newCaller As Form)
mfrmCaller = newCaller
End Set
End Property
Public Property DebugMessages() As Boolean

Get
Return mbDebugMessages
End Get
Set(ByVal newValue As Boolean)
mbDebugMessages = newValue
End Set
End Property
Public Property Destination() As scanDestination

Get
Return meDestination
End Get
Set(ByVal newDestination As scanDestination)
meDestination = newDestination
End Set
End Property
'Public Property FileType() As scanFileType

' Get
' Return meFileType
' End Get
' Set(ByVal newFileType As scanFileType)
' meFileType = newFileType
' End Set
'End Property
'Public Property ScanDir() As String

' Get
' Return mstrScanDir
' End Get
' Set(ByVal newScanDir As String)
' mstrScanDir = newScanDir
' End Set
'End Property
'Public Property ScanFileNamePrefix() As String

' Get
' Return mstrScanFileNamePrefix
' End Get
' Set(ByVal newScanFileNamePrefix As String)
' mstrScanFileNamePrefix = newScanFileNamePrefix
' End Set
'End Property
Public Property SetCapabilities() As Boolean

Get
Return mbSetCaps
End Get
Set(ByVal newSetCaps As Boolean)
mbSetCaps = newSetCaps
End Set
End Property
Public Property SourceName() As String

Get
Return mstrSourceName
End Get
Set(ByVal newSource As String)
mstrSourceName = newSource
End Set
End Property
Public Property SourceSelect() As scanSourceSelect

Get
Return meSourceSelect
End Get
Set(ByVal newSource As scanSourceSelect)
meSourceSelect = newSource
End Set
End Property
Public Property SourceUI() As scanSourceUI

Get
Return meSourceUI
End Get
Set(ByVal newSourceUI As scanSourceUI)
meSourceUI = newSourceUI
End Set
End Property
Public Property State() As scanTwainState

'Should never be in state 2. TWAIN arrives at that state when the DLL is loaded.
' VB does it automatically, we don't try to know when this happens.
Get
Return meState
End Get
Set(ByVal newState As scanTwainState)
If newState > meState Then
If newState >= 3 Then
'Open the DSM.
If Not OpenDSM() Then Exit Property
End If
If newState > meState AndAlso newState >= 4 Then
If SelectDS() Then
OpenDS() 'We can't do much if this fails. If it succeds, scanner will start.
Else
Exit Property
End If
End If
Else 'Bring the state down
'Will we ever need to?
'***MAR
End If
End Set
End Property
'***********************************************************************
****
'* *
'* PRIVATE METHODS *
'* *
'***********************************************************************
****
Private Function DSM_Open() As Boolean
'***********************************************************************
******************
'* PURPOSE: Opens the DSM if it isn't already opened. *
'***********************************************************************
******************
'* RETURNS: TRUE if the DSM is open, or the command to open it succedes.
*
'***********************************************************************
******************
Const conProc As String = "DSM_Open"
Try
If meState < scanTwainState.escanDSM_Open Then

Return OpenDSM()
Else
Return True
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
Private Function DS_Selected() As Boolean

'***********************************************************************
******************
'* PURPOSE: Selects a DS. *
'***********************************************************************
******************
'* RETURNS: TRUE if the DS is selected, or the command to select one succedes.
*
'***********************************************************************
******************
Const conProc As String = "DS_Selected"
Try
If Not mbDS_Selected Then

Return SelectDS()
Else
Return True
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
Private Function DS_Open() As Boolean
'***********************************************************************
******************
'* PURPOSE: Opens a DS if it isn't already opened. *
'***********************************************************************
******************
'* RETURNS: TRUE if the DS is open, or the command to open it succedes.
*
'***********************************************************************
******************
Const conProc As String = "DS_Open"
Try
If meState < scanTwainState.escanDS_Open Then

Return OpenDS()
Else
Return True
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
Private Function DS_Enabled() As Boolean
'***********************************************************************
******************
'* PURPOSE: Enables a DS if it isn't already enabled. *
'***********************************************************************
******************
'* RETURNS: TRUE if the DS is enabled, or the command to enable it succedes.
*
'***********************************************************************
******************
Const conProc As String = "DS_Enabled"
Try
If meState < scanTwainState.escanDS_Enabled Then

Return EnableDS()
Else
Return True
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
Private Function GetOneValue(ByVal twCapability As twcCapability) As rctCapValue
'***********************************************************************
******************
'* PURPOSE: Gets a OneValue container's data and fills a rctCapValue.
*
'***********************************************************************
******************
'* PARAMETERS: twCapability - A populated capability. *
'***********************************************************************
******************
'* RETURNS: A generic capability. *
'***********************************************************************
******************
Dim pOneValue As IntPtr
Dim intPosition As Integer
Const conProc As String = "GetOneValue"
Try
CapValue.CapNumber = twCapability.Cap
pOneValue = GlobalLock(twCapability.Handle)
With CapValue
.ContainerType = scanContainerType.OneValue
.ItemType = CType(GetInteger16(pOneValue, intPosition), scanItemType)
.Default = GetSpecificValue(CapValue.ItemType, pOneValue, intPosition)
.Current = GetSpecificValue(CapValue.ItemType, pOneValue, intPosition)
'.Default
End With
GlobalUnlock(CType(twCapability.Handle, Integer))
mLog.AddError(ex)
Finally
End Try
Return CapValue
End Function
Private Function GetEnum(ByVal twCapability As twcCapability) As rctCapValue
'***********************************************************************
******************
'* PURPOSE: Gets an Enumeration container's data and fills a rctCapValue.
*
'***********************************************************************
******************
'***********************************************************************
******************
'***********************************************************************
******************
Dim pEnum As IntPtr
Const conProc As String = "GetEnum"
Try
pEnum = GlobalLock(twCapability.Handle)
With CapValue
.ContainerType = scanContainerType.Enumeration
.ItemType = CType(GetInteger16(pEnum, intPosition), scanItemType)
.NumItems = GetInteger32(pEnum, intPosition)
.Current = GetInteger32(pEnum, intPosition)
.Default = GetInteger32(pEnum, intPosition)
.ItemList = GetArrayMember(CapValue.ItemType, .NumItems, pEnum,
intPosition)
End With
mLog.AddError(ex)
Finally
End Try
Return CapValue
End Function
Private Function GetArray(ByVal twCapability As twcCapability) As rctCapValue
'***********************************************************************
******************
'* PURPOSE: Gets an Array container's data and fills a rctCapValue. *
'***********************************************************************
******************
'***********************************************************************
******************
'***********************************************************************
******************
Dim pArray As IntPtr
Const conProc As String = "GetArray"
Try
pArray = GlobalLock(twCapability.Handle)
With CapValue
.ContainerType = scanContainerType.Array
.ItemType = CType(GetInteger16(pArray, intPosition), scanItemType)
.NumItems = GetInteger32(pArray, intPosition)
.ItemList = GetArrayMember(CapValue.ItemType, .NumItems, pArray,
intPosition)
End With
mLog.AddError(ex)
Finally
End Try
Return CapValue
End Function
Private Function GetRange(ByVal twCapability As twcCapability) As rctCapValue
'***********************************************************************
******************
'* PURPOSE: Gets a Range container's data and fills a rctCapValue. *
'***********************************************************************
******************
'***********************************************************************
******************
'***********************************************************************
******************
Dim pRange As IntPtr
Const conProc As String = "GetRange"
Try
pRange = GlobalLock(twCapability.Handle)
With CapValue
.ContainerType = scanContainerType.Range
.ItemType = CType(GetInteger16(pRange, intPosition), scanItemType)
.MinValue = CType(GetSpecificValue(CapValue.ItemType, pRange,
intPosition), Integer)
.MaxValue = CType(GetSpecificValue(CapValue.ItemType, pRange,
.StepSize = CType(GetSpecificValue(CapValue.ItemType, pRange,
.Default = GetSpecificValue(CapValue.ItemType, pRange, intPosition)
.Current = GetSpecificValue(CapValue.ItemType, pRange, intPosition)
End With
mLog.AddError(ex)
Finally
End Try
Return CapValue
End Function
Private Function GetSpecificValue(ByVal eItemType As scanItemType, ByVal

pPointer As IntPtr, ByRef intOffset As Integer) As Object
'***********************************************************************
******************
'* PURPOSE: Gets a value from a container class or structure. *
'***********************************************************************
******************
'* PARAMETERS: eItemType - The datatype of the read bytes. *
'* pPointer - Pointer to the class or structure. *
'* intOffset - Number of bytes from the begining to read from. THIS *
'* PARAMETER WILL BE INCREMENTED BY THE NUMBER
OF BYTES THAT *
'* ARE READ. IT IS PASSED ByRef. *
'***********************************************************************
******************
'* RETURNS: An object containing the appropriate data type. *
'***********************************************************************
******************
Dim intWhole As Integer
Dim intFrac As Integer
Dim sngTemp As Single
Const conProc As String = "GetSpecificValue"
Try
Select Case eItemType
Case scanItemType.Bool, scanItemType.Int16

Return GetInteger16(pPointer, intOffset)
Case scanItemType.Int32
Return GetInteger32(pPointer, intOffset)
Case scanItemType.Fix32 'Some vendors (like HP) store numbers (like X or

YResolution) as Fix32 that will ALWAYS be integers
intWhole = GetInteger16(pPointer, intOffset)

intFrac = GetUInteger16(pPointer, intOffset)
If intFrac < 0 Then

intFrac += 65536
End If
sngTemp = CType(intWhole + (intFrac / 65536), Single)

Return sngTemp
Case scanItemType.Frame
Return GetFrame(pPointer, intOffset)
Case scanItemType.UInt32
'Return GetInteger32(pPointer, intOffset)
Return Nothing
Return GetUInteger16(pPointer, intOffset)
Case scanItemType.Str32
Return GetString32(pPointer, intOffset)
Case Else
MsgBox("Unexpected Item Type. Ignored")
Return Nothing
End Select
mLog.AddError(ex)
Finally
End Try
Return Nothing
End Function
Private Function GetArrayMember(ByVal eItemType As scanItemType, ByVal

intCount As Integer, ByVal pPointer As IntPtr, ByRef intOffset As Integer) As Object
'***********************************************************************
******************
'* PURPOSE: Gets an array from a container class or structure. *
'***********************************************************************
******************
'* PARAMETERS: eItemType - The datatype of the array element.
*
'* intCount - The number of elements. *
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: An array with intCount items. *
'***********************************************************************
******************
Dim r As Integer
Dim aList() As Object
Const conProc As String = "GetArrayMember"
intCount -= 1
ReDim aList(intCount)
Try
For r = 0 To intCount
aList(r) = GetSpecificValue(eItemType, pPointer, intOffset)
Next
mLog.AddError(ex)
Finally
End Try
Return aList
End Function
Private Function GetInteger16(ByVal pPointer As IntPtr, ByRef intOffset As Integer)

As Short
'***********************************************************************
******************
'* PURPOSE: Gets a short integer from a container class or structure. *
'***********************************************************************
******************
'* PARAMETERS: pPointer - Pointer to the class or structure. *
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A short integer. *
'***********************************************************************
******************
Dim shtReturnValue As Short
Const conProc As String = "GetInteger16"
Try
shtReturnValue = Marshal.ReadInt16(pPointer, intOffset)

intOffset += 2
mLog.AddError(ex)
Finally
End Try
Return shtReturnValue
End Function
Private Function GetUInteger16(ByVal pPointer As IntPtr, ByRef intOffset As Integer)

As UInt16
'***********************************************************************
******************
'* PURPOSE: Gets an unsigned short integer from a container class or structure.
*
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: An unsigned short integer. *
'***********************************************************************
******************
Dim shtReturnValue As Short
Dim ushtReturnValue As UInt16
Const conProc As String = "GetUInteger16"
Try
shtReturnValue = Marshal.ReadInt16(pPointer, intOffset)

If shtReturnValue < 0 Then
ushtReturnValue = CType(shtReturnValue + 65536, UShort)
Else
ushtReturnValue = CType(shtReturnValue, UShort)
End If
intOffset += 2
mLog.AddError(ex)
Finally
End Try
Return ushtReturnValue
End Function

As Integer
'***********************************************************************
******************
'* PURPOSE: Gets a integer from a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A integer. *
'***********************************************************************
******************
Dim intReturnValue As Integer
Try
intReturnValue = Marshal.ReadInt32(pPointer, intOffset)
intOffset += 4
mLog.AddError(ex)
Finally
End Try
Return intReturnValue
End Function
Private Function GetUInteger32(ByVal pPointer As IntPtr, ByRef intOffset As Integer)

As UInt32
'***********************************************************************
******************
'* PURPOSE: Gets an unsigned integer from a container class or structure.
*
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: An unsigned integer. *
'***********************************************************************
******************
Dim intReturnValue As Integer
Dim uintReturnValue As UInt32
Const conProc As String = "GetUInteger32"
Try
intReturnValue = Marshal.ReadInt32(pPointer, intOffset)

If intReturnValue < 0 Then
uintReturnValue = CType(intReturnValue + 4294967296, UInteger)
Else
uintReturnValue = CType(intReturnValue, UInteger)
End If
intOffset += 4
mLog.AddError(ex)
Finally
End Try
Return uintReturnValue
End Function

As Long
'***********************************************************************
******************
'* PURPOSE: Gets a long integer from a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A long integer. *
'***********************************************************************
******************
Dim lngReturnValue As Long
Try
lngReturnValue = Marshal.ReadInt64(pPointer, intOffset)
intOffset += 8
mLog.AddError(ex)
Finally
End Try
Return lngReturnValue
End Function
Private Function GetString32(ByVal pPointer As IntPtr, ByRef intOffset As Integer) As

String
'***********************************************************************
******************
'* PURPOSE: Gets a string from a container class or structure with a max length
of *
'* 32. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A string. *
'***********************************************************************
******************
Dim r As Integer
Dim origPosition As Int32 = intOffset
Dim byt As Byte
Dim strReturnedString As New System.Text.StringBuilder(34)
Dim strChar As Char
Const conProc As String = "GetString32"
Try
For r = 0 To 33
byt = Marshal.ReadByte(pPointer, intOffset)

strChar = DirectCast(ChrW(byt), Char)
If Not byt = 0 Then
strReturnedString.Append(strChar)
Else
Exit For
End If
intOffset += 1
Next
intOffset = origPosition + 34
Return strReturnedString.ToString
mLog.AddError(ex)
Finally
End Try
End Function
Private Function GetString128(ByVal pPointer As IntPtr, ByRef intOffset As Integer)

As String
'***********************************************************************
******************
of *
'* 128. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'***********************************************************************
******************
Dim r As Integer
Dim byt As Byte
Dim strChar As Char
Try
For r = 0 To 129

If Not byt = 0 Then
Else
Exit For
End If
intOffset += 1
Next

mLog.AddError(ex)
Finally
End Try
End Function
Private Function GetString255(ByVal pPointer As IntPtr, ByRef intOffset As Integer)

As String
'***********************************************************************
******************
of *
'* 255. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'***********************************************************************
******************
Dim r As Integer
Dim byt As Byte
Dim strChar As Char
Try
For r = 0 To 256

If Not byt = 0 Then
Else
Exit For
End If
intOffset += 1
Next

mLog.AddError(ex)
Finally
End Try
End Function
Friend Function GetFrame(ByVal pPointer As IntPtr, ByRef intOffset As Integer) As
twsFrame
'***********************************************************************
******************
'* PURPOSE: Gets a frame structure from a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A frame structure. *
'***********************************************************************
******************
Dim Frame As twsFrame
Frame.Left = GetFix32(pPointer, intOffset)

Frame.Top = GetFix32(pPointer, intOffset)
Frame.Right = GetFix32(pPointer, intOffset)
Frame.Bottom = GetFix32(pPointer, intOffset)
Return Frame
End Function
Friend Function GetFix32(ByVal pPointer As IntPtr, ByRef intOffset As Integer) As

twsFix32
'***********************************************************************
******************
'* PURPOSE: Gets a Fix32 structure from a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
'* RETURNS: A Fix32 structure. *
'***********************************************************************
******************
Dim Fix32 As twsFix32
Const conProc As String = "GetFix32"
Try
Fix32.Whole = GetInteger16(pPointer, intOffset)

Fix32.Frac = GetUInteger16(pPointer, intOffset)
Return Fix32
mLog.AddError(ex)
Finally
End Try
End Function
Private Sub PutSpecificValue(ByVal eItemType As scanItemType, ByVal Value As

Object, ByVal pOneValue As IntPtr, ByVal intOffest As Integer)
'***********************************************************************
******************
'* PURPOSE: Puts a value into a container class or structure. *
'***********************************************************************
******************
'* PARAMETERS: eItemType - The datatype of the written bytes. *
'* intOffset - Number of bytes from the begining to write to. THIS *
OF BYTES THAT *
'* ARE WRITTEN. IT IS PASSED ByRef. *
'***********************************************************************
******************
Const conProc As String = "PutSpecificValue"
Try
Select Case eItemType

Case scanItemType.Bool, scanItemType.Int8, scanItemType.UInt8
PutInteger8(CType(Value, Byte), pOneValue, intOffest)
PutInteger16(CType(Value, Short), pOneValue, intOffest)
PutInteger32(CType(Value, Integer), pOneValue, intOffest)
PutUInteger16(CType(Value, UInt16), pOneValue, intOffest)
PutUInteger32(CType(Value, UInt32), pOneValue, intOffest)
Case scanItemType.Fix32
Dim intWhole As Integer

Dim intFrac As UInt32
Dim twFix32 As twsFix32
intWhole = CType(Fix(Value), Integer)

intFrac = CType((CType(Value, Integer) - intWhole) * 65536, UInteger)
twFix32.Whole = CType(intWhole, Short)
twFix32.Frac = CType(intFrac, UShort)
PutInteger16(CType(intWhole, Short), pOneValue, intOffest)
PutInteger16(CType(intFrac, Short), pOneValue, intOffest)
Case Else
MsgBox("Unexpected Item Type. Ignored")
End Select
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutInteger8(ByVal byt As Byte, ByVal pPointer As IntPtr, ByRef intOffset
As Integer)
'***********************************************************************
******************
'* PURPOSE: Puts a byte into a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Const conProc As String = "PutInteger8"
Try
Marshal.WriteByte(pPointer, intOffset, byt)

intOffset += 1
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutInteger16(ByVal sht As Short, ByVal pPointer As IntPtr, ByRef

intOffset As Integer)
'***********************************************************************
******************
'* PURPOSE: Puts a short integer into a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Try
Marshal.WriteInt16(pPointer, intOffset, sht)

intOffset += 2
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutInteger32(ByVal int As Integer, ByVal pPointer As IntPtr, ByRef

'***********************************************************************
******************
'* PURPOSE: Puts a integer into a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Try
Marshal.WriteInt32(pPointer, intOffset, int)

intOffset += 4
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutInteger64(ByVal lng As Long, ByVal pPointer As IntPtr, ByRef

'***********************************************************************
******************
'* PURPOSE: Puts a long integer into a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Try
Marshal.WriteInt64(pPointer, intOffset, lng)
intOffset += 8
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutUInteger16(ByVal usht As UInt16, ByVal pPointer As IntPtr, ByRef

'***********************************************************************
******************
'* PURPOSE: Puts an unsigned short integer into a container class or structure.
*
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Const conProc As String = "PutUInteger16"
Try
Marshal.WriteInt16(pPointer, intOffset, CType(usht, Short))

intOffset += 2
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutUInteger32(ByVal uint As UInt32, ByVal pPointer As IntPtr, ByRef

'***********************************************************************
******************
'* PURPOSE: Puts an unsigned integer into a container class or structure. *
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Try
Marshal.WriteInt32(pPointer, intOffset, CType(uint, Integer))

intOffset += 4
mLog.AddError(ex)
Finally
End Try
End Sub
Private Sub PutUInteger64(ByVal ulng As UInt64, ByVal pPointer As IntPtr, ByRef
'***********************************************************************
******************
'* PURPOSE: Puts an unsigned long integer into a container class or structure.
*
'***********************************************************************
******************
OF BYTES THAT *
'***********************************************************************
******************
Try
Marshal.WriteInt64(pPointer, intOffset, CType(ulng, Long))

intOffset += 8
mLog.AddError(ex)
Finally
End Try
End Sub
Private Function ConvertToFix32(ByVal sngValue As Single) As twsFix32
'***********************************************************************
******************
'* PURPOSE: Converts a decimal number into a Fix32 structure. *
'***********************************************************************
******************
'* PARAMETERS: sngValue - Number to convert. *
'***********************************************************************
******************
'* RETURNS: A Fix32 structure. *
'***********************************************************************
******************
Dim intWhole As Short
Dim uintFrac As UInt16
Dim twFix32 As twsFix32
Const conProc As String = "ConvertToFix32"
Try
intWhole = CType(Fix(sngValue), Short)

uintFrac = CType((sngValue - intWhole) * 65536, UShort)
twFix32.Whole = intWhole
twFix32.Frac = uintFrac
Return twFix32
mLog.AddError(ex)
Finally
End Try
End Function
Private Function GetCapValue(ByVal CapValue As rctCapValue) As Object
'***********************************************************************
******************
'* PURPOSE: Gets the current value of a capability no matter what type of
container *
'* it is in. *
'***********************************************************************
******************
'* PARAMETERS: sngValue - Number to convert. *
'***********************************************************************
******************
'* RETURNS: An object containing the appropriate value type. *
'***********************************************************************
******************
Const conProc As String = "GetCapValue"
Try
Select Case CapValue.ContainerType

Case scanContainerType.Array
Return CapValue.ItemList(CapValue.Current)
Case scanContainerType.Enumeration
Return CapValue.ItemList(CapValue.Current)
Case scanContainerType.OneValue
Return CapValue.Current
Case scanContainerType.Range
Return CapValue.Current
Case Else
MsgBox("Invalid container type for GetCapValue")
Return Nothing
End Select
mLog.AddError(ex)
Finally
End Try
Return Nothing
End Function
Private Sub ErrorStatus()
'***********************************************************************
******************
'* PURPOSE: To gether error codes and possibly display them. *
'***********************************************************************
******************
Dim rc As twRC
Dim strMsg As String
Dim twStatus As twsStatus
Const conProc As String = "ErrorStatus"
Try
twStatus = New twsStatus

rc = DSM_Status(mtwApp, vbNullString, twDG.Control, twDAT.Status,
twMSG.Get, twStatus)
strMsg = "Failed because: CC = " & twStatus.ConditionCode & " and reserved =
" & twStatus.Reserved & "."
mLog.WriteMessage(strMsg)
If mbDebugMessages Then
MsgBox(strMsg)
End If
mLog.AddError(ex)
Finally
End Try
End Sub
Private Function PassMessage(ByVal m As Message) As twTwainCommand
'***********************************************************************
******************
'* PURPOSE: Parses the windows message to determine: 1) If twain is responsible
AND *
'* 2) what twain is saying. *
'***********************************************************************
******************
'* PARAMETERS: m - Windows message. *
'***********************************************************************
******************
'* RETURNS: An enum indicating the twain command if there is one, or
specifically *
'* RETURNS: that it is not a twain command. *
'***********************************************************************
******************
Dim rc As twRC
Dim intPos As Integer
Dim WinMsg As WINMSG_S
Dim twEventMsg As twsEvent
Const conProc As String = "PassMessage"
Try
If Equals(mtwSource.Id, IntPtr.Zero) Then

Return twTwainCommand.Not
End If
twEventMsg.EventPtr = Marshal.AllocHGlobal(Marshal.SizeOf(WinMsg))
intPos = GetMessagePos()
With WinMsg
.hwnd = m.HWnd
.message = m.Msg
.wParam = m.WParam
.lParam = m.LParam
.time = GetMessageTime()
.x = intPos
.y = CType(Int(intPos / 2 ^ 16), Integer)
End With
Marshal.StructureToPtr(WinMsg, twEventMsg.EventPtr, False)

twEventMsg.Message = 0
rc = DSM_Event(mtwApp, mtwSource, twDG.Control, twDAT.Event,
twMSG.ProcessEvent, twEventMsg)
If (rc = twRC.NotDSEvent) Then

Return twTwainCommand.Not
ElseIf rc = twRC.Failure Then
ErrorStatus()
End If
If (twEventMsg.Message = CType(twMSG.XFerReady, Short)) Then

meState = scanTwainState.escanTransferReady
Return twTwainCommand.TransferReady
End If
If (twEventMsg.Message = CType(twMSG.CloseDSReq, Short)) Then

Return twTwainCommand.CloseRequest
End If
If (twEventMsg.Message = CType(twMSG.CloseDSOK, Short)) Then
Return twTwainCommand.CloseOk
End If
If (twEventMsg.Message = CType(twMSG.DeviceEvent, Short)) Then
Return twTwainCommand.DeviceEvent
End If
Return twTwainCommand.Null
mLog.AddError(ex)
Finally
End Try
End Function
Private Function TransferPictures() As ArrayList
'***********************************************************************
******************
'* PURPOSE: Gets the actual data (handle to a DIB; file transfer would be done
here *
'* also). *
'***********************************************************************
******************
'* RETURNS: An arraylist of handles to DIBs. *
'***********************************************************************
******************
Dim rc As twRC
Dim pics As ArrayList = New ArrayList()
Dim hbitmap As IntPtr 'pointer to a handle of a DIB
'Dim twFileXfer As twsSetupFileXfer
Dim twImageInfo As twsImageInfo
Dim twPendingXfers As twcPendingXfers
Const conProc As String = "TransferPictures"
Try
If Equals(mtwSource.Id, IntPtr.Zero) Then

Return pics
End If
hbitmap = IntPtr.Zero
mintPageNumber = 1
Do
meState = scanTwainState.escanTransfering
twPendingXfers = New twcPendingXfers
twPendingXfers.Count = 0
hbitmap = IntPtr.Zero
twImageInfo = New twsImageInfo

rc = DS_ImageInfo(mtwApp, mtwSource, twDG.Image, twDAT.ImageInfo,
twMSG.Get, twImageInfo)
If (rc <> twRC.Success) Then
CleanUp()
Return pics
End If
mtwImageInfo = twImageInfo
'Begin transfer
'If meDestination = scanDestination.escanDestinationDIB Then
rc = DS_ImageNativeXfer(mtwApp, mtwSource, twDG.Image,
twDAT.ImageNativeXfer, twMSG.Get, hbitmap)
If (rc <> twRC.XferDone) Then
CleanUp()
Return pics
End If
'Else
' rc = DS_ImageFileXfer(mtwApp, mtwSource, twDG.Image,
twDAT.ImageFileXfer, twMSG.Get, vbNull)
' If (rc <> twRC.XferDone) Then
' CleanUp()
' Return pics
' End If
'End If
rc = DS_PendingXfer(mtwApp, mtwSource, twDG.Control,

twDAT.PendingXfers, twMSG.EndXfer, twPendingXfers)
If (rc <> twRC.Success) Then
CleanUp()
Return pics
End If
'If meDestination = scanDestination.escanDestinationDIB Then

pics.Add(hbitmap)
'Else
''Setup for next transfer
'mintPageNumber += 1
'mstrScanFileName = BuildFilePath("", mstrScanFileNamePrefix,
Format(mintPageNumber, "000"), meFileType.ToString)
'With twFileXfer
' .FileName = BuildFilePath(mstrScanDir, mstrScanFileNamePrefix,
Format(mintPageNumber, "000"), meFileType.ToString)
' .Format = meFileType
'End With
'rc = DS_SetupFileXfer(mtwApp, mtwSource, twDG.Control,
twDAT.SetupFileXfer, twMSG.Set, twFileXfer)
'End If
Loop While (twPendingXfers.Count <> 0)

twDAT.PendingXfers, twMSG.Reset, twPendingXfers)
Return pics
mLog.AddError(ex)
Return Nothing
Finally
End Try
End Function
Private Sub EndXfer()
'***********************************************************************
******************
'* PURPOSE: Informs the DS (scanner) that we are done getting data.
*
'***********************************************************************
******************
Dim rc As twRC
Dim twPendingXfers As twcPendingXfers
Const conProc As String = "EndXfer"
Try
'We started or tried to start a transfer, end it.

twPendingXfers = New twcPendingXfers
twDAT.PendingXfers, twMSG.EndXfer, twPendingXfers)
If twPendingXfers.Count > 0 Then

'If other transfers are pending, then cancel them
twDAT.PendingXfers, twMSG.Reset, twPendingXfers)
End If
If rc = twRC.Success Then
If meState >= scanTwainState.escanTransferReady Then
meState = scanTwainState.escanDS_Enabled
End If
Else
MsgBox("Failed to disable the source, going to state 4 with a rc of " & rc)
End If
End If
mLog.AddError(ex)
Finally
End Try
End Sub
'***********************************************************************
****
'* *
'* PUBLIC METHODS *
'* *
'***********************************************************************
****
''' <summary>
''' Create an instance of the Scanner object
''' </summary>
Public Sub New(ByVal objLog As clsLogging)
Const conProc As String = "New"
Try
mLog = objLog
meState = scanTwainState.escanPresentation
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Creates the form to intercept windows messages
''' </summary>
Public Sub InstanciateMessageForm()
'***********************************************************************
******************
'* PURPOSE: Instanciates the form that will intercept windows messages.
*
'***********************************************************************
******************
Const conProc As String = "InstanciateMessageForm"
Try
If Not frmMessageLoop Is Nothing Then
frmMessageLoop.Dispose()
End If
frmMessageLoop = New frmMessageIntercept

With frmMessageLoop
.Log = mLog
.Scan = Me
.InterceptMessageLoop(True)
End With
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Opens the Data Source Manager (DSM)
''' </summary>
''' <returns></returns>
Public Function OpenDSM() As Boolean
'***********************************************************************
******************
'* PURPOSE: Opens the DSM. App's Identity class gets filled here. *
'***********************************************************************
******************
'* RETURNS: TRUE on success. *
'***********************************************************************
******************
Dim rc As twRC
Dim myBuildInfo As FileVersionInfo
Const conProc As String = "OpenDSM"
Try
myBuildInfo = FileVersionInfo.GetVersionInfo(Application.ExecutablePath)
'Populate the structure that will be used for communication

mtwApp = New twcIdentity
With mtwApp
.Manufacturer = myBuildInfo.CompanyName
.ProductFamily = "Mar's work"
.ProductName = myBuildInfo.ProductName
.ProtocolMajor = mconTWON_PROTOCOLMAJOR
.ProtocolMinor = mconTWON_PROTOCOLMINOR
'.SupportedGroups = CType(twDG.Control Or twDG.Image, Integer)
.SupportedGroups = twDG.Image
With .Version
.Country = mconTWCY_USA
.Info = myBuildInfo.FileDescription
.Language = mconTWLG_ENGLISH_USA
.MajorNum = CType(myBuildInfo.FileMajorPart, Short)
.MinorNum = CType(myBuildInfo.FileMinorPart, Short)
End With
End With
InstanciateMessageForm()
'Open the DSM (Data Source Manager)

rc = DSM_OpenClose(mtwApp, vbNullString, twDG.Control, twDAT.Parent,
twMSG.OpenDSM, mfrmCaller.Handle)
meState = scanTwainState.escanDSM_Open
If mbDebugMessages Then MsgBox("DSM Opened. Given an Id of " &
mtwApp.Id.ToString & " and State = " & meState & ".")
Return True
Else
MsgBox(mconDSM_FailedToOpen & " with a rc of " & rc & " and State = " &
meState & ".", MsgBoxStyle.Critical)
Return False
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
''' <summary>
''' Coose the Data Source (DS) that you wish to use
''' </summary>
Public Function SelectDS() As Boolean
'***********************************************************************
******************
'* PURPOSE: Select a DS. Either the default, a user selected or an explicitly
*
'* entered name entered in the options form. *
'***********************************************************************
******************
'***********************************************************************
******************
Dim rc As twRC
Dim twSourceOfSource As twMSG
Dim strMessage As String
Const conProc As String = "SelectDS"
Try
strMessage = ""
'Select the source. 0 for id and null for ProductName gets the default source. Can
be passed with twMSG.OpenDS to open the default, skipping twMSG.GetDefault
mtwSource = New twcIdentity
With mtwSource
.Id = CType(0, IntPtr)
If meSourceSelect = scanSourceSelect.escanSourceSpecific And
mstrSourceName <> vbNullString Then
.ProductName = mstrSourceName
Else
.ProductName = Chr(0) ' vbNullString
End If
.SupportedGroups = CType(twDG.Control Or twDG.Image, Integer)
End With
If meSourceSelect <> scanSourceSelect.escanSourceUserSelect Then

'Select the default or specific named above; returns info in mtwSource
twSourceOfSource = twMSG.GetDefault
Else
'Let the user select; returns info in mtwSource
twSourceOfSource = twMSG.UserSelect
End If
rc = DSM_SelectOpenSource(mtwApp, vbNullString, twDG.Control,

twDAT.Identity, twSourceOfSource, mtwSource)
mbDS_Selected = True
If mbDebugMessages Then MsgBox("Selected: '" & mtwSource.ProductName
& "'")
Else
If meSourceSelect = scanSourceSelect.escanSourceDefault Then
strMessage = vbCrLf & "This could be because there are no TWAIN drivers
installed."
ElseIf meSourceSelect = scanSourceSelect.escanSourceSpecific Then
strMessage = vbCrLf & "This could be because of a misspelling of """ &
mstrSourceName & """. Try using the default."
End If
MsgBox(mconDSM_FailedToSelectSource & " with a rc of " & rc & "and
State = " & meState & "." & strMessage)
ErrorStatus()
mbDS_Selected = False
End If
Return mbDS_Selected
mLog.AddError(ex)
Return False
Finally
End Try
End Function
''' <summary>
''' Opens the Data Source (DS)
''' </summary>
Public Function OpenDS() As Boolean
'***********************************************************************
******************
'* PURPOSE: Opens a DS. Negociates any capabilities here. *
'***********************************************************************
******************
'***********************************************************************
******************
Dim rc As twRC
Const conProc As String = "OpenDS"
Try
'Open the source in mtwSource

rc = DSM_SelectOpenSource(mtwApp, vbNullString, twDG.Control,
twDAT.Identity, twMSG.OpenDS, mtwSource)
mstrOpenedDSName = mtwSource.ProductName
If mbDebugMessages Then MsgBox("Opened: '" & mtwSource.ProductName
& "', State = " & meState & ".")
meState = scanTwainState.escanDS_Open
Return True
Else
MsgBox(mconDSM_FailedToOpenSource & " with a rc of " & rc & ", State =
" & meState & "; and Name is " & mtwSource.ProductName, MsgBoxStyle.Critical)
Return False
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
'''' <summary>
'''' Sets up the source for transfering data to a file
'''' </summary>
'''' <returns></returns>
'''' <remarks></remarks>
'Public Function NegociateFileXfer() As Boolean
' Dim r As Integer

' Dim rc As twRC
' Dim bOKToProcede As Boolean
' Dim eFileXfer As twXferMech
' Dim strFilePath As String
' Dim rctReturnValue, rctNewValue As rctCapValue
' Dim twFileXfer As twsSetupFileXfer
' Const conProc = "NegociateFileXfer"
' Try
' mlog.EnterProc(conProc, mconModule)
' 'Negotiate with the source to see if it can write to a file

' rctReturnValue = GetCapability(scanCap.TransferMechanism)
' eFileXfer = rctReturnValue.Default
' For r = 0 To rctReturnValue.NumItems - 1

' If CType(rctReturnValue.ItemList(r), twXferMech) =
twXferMech.TWSX_FILE Then
' eFileXfer = rctReturnValue.ItemList(r)
' bOKToProcede = True
' Exit For
' End If
' Next
' If bOKToProcede Then

' 'Source can write out files
' rctNewValue = New rctCapValue
' With rctNewValue
' .CapNumber = scanCap.TransferMechanism
' .ContainerType = scanContainerType.OneValue
' .ItemType = scanItemType.UInt16
' .NewValue = eFileXfer
' End With
' bOKToProcede = SetCapability(rctNewValue)
' If bOKToProcede Then

' 'Succeded in setting file transfer mode.
' 'twFileXfer = New twsSetupFileXfer
' mstrScanFileName = BuildFilePath("", mstrScanFileNamePrefix, "001",
meFileType.ToString)
' strFilePath = BuildFilePath(mstrScanDir, mstrScanFileNamePrefix, "001",
meFileType.ToString)
' mintPageNumber = 1
' With twFileXfer
' .FileName = strFilePath
' .Format = meFileType
' End With
' rc = DS_SetupFileXfer(mtwApp, mtwSource, twDG.Control,
twDAT.SetupFileXfer, twMSG.Set, twFileXfer)
' 'DG_CONTROL / DAT_FILESYSTEM /
MSG_AUTOMATICCAPTUREDIRECTORY 'Set directory for file zfer
' 'DG_CONTROL / DAT_SETUPFILEXFER / MSG_GET
'Return info about the file that the Source will write the acquired data into
' 'DG_CONTROL / DAT_SETUPFILEXFER / MSG_GETDEFAULT
'Return the default file transfer information
' 'DG_CONTROL / DAT_SETUPFILEXFER / MSG_SET 'Set
file transfer information for next file transfer
' If rc <> twRC.Success Then
' MsgBox("Unable to set file transfer mode with a state = " & meState &
vbCrLf & "File path = " & strFilePath & "; type of " & meFileType.ToString,
MsgBoxStyle.Critical)
' End If
' Return rc = twRC.Success
' Else
' MsgBox("Unable to set file transfer mode with a state = " & meState &
vbCrLf & "Transfer mode cap = " & eFileXfer & "; " & eFileXfer.ToString,
' Return False
' End If
' Else
' MsgBox("The scanner does not report that it supports file transfers",
' Return False
' End If
' Catch ex As Exception
' mLog.AddError(ex)
' Return False
' Finally
' mLog.ExitProc(conProc)
' End Try
'End Function
''' <summary>
''' Sets up the source with capabilities from a passed in collection
''' </summary>
Public Function NegociateCaps() As Boolean
'***********************************************************************
******************
'* PURPOSE: Goes through the collection of capabilities and attempts to set them.
*
'***********************************************************************
******************
'* RETURNS: TRUE if no errors encountered. *
'***********************************************************************
******************
Dim bCapsLoaded As Boolean
Dim INICapValue As rctCapValue
Dim NewCapValue As rctCapValue
Const conProc As String = "NegociateCaps"
Try
'If Not mcolCaps Is Nothing AndAlso Not mcolCaps.Loaded Then

If Not mcolCaps Is Nothing Then
For Each INICapValue In mcolCaps
NewCapValue = GetCapability(INICapValue.CapNumber)
If Not NewCapValue Is Nothing Then
With NewCapValue
.ContainerType = scanContainerType.OneValue
.NewValue = INICapValue.NewValue
End With
SetCapability(NewCapValue)
End If
Next
mcolCaps.Loaded = True
bCapsLoaded = True
End If
Return bCapsLoaded
mLog.AddError(ex)
Return False
Finally
End Try
End Function
''' <summary>
''' Kicks off the image capturing
''' </summary>
Public Function EnableDS() As Boolean
'***********************************************************************
******************
'* PURPOSE: Enables the DS (allows it to start capturing) *
'***********************************************************************
******************
'***********************************************************************
******************
Dim rc As twRC
Dim twInterface As twcUserInterface
Const conProc As String = "EnableDS"
Try
twInterface = New twcUserInterface
With twInterface
If meSourceUI = scanSourceUI.escanSourceHide Then
.ShowUI = CType(False, Short)
Else
.ShowUI = CType(True, Short)
End If
.ParentHand = mfrmCaller.Handle
End With
rc = DSM_EnableSource(mtwApp, mtwSource, twDG.Control,
twDAT.UserInterface, twMSG.EnableDS, twInterface)
If mbDebugMessages Then MsgBox("Enabled: '" & mtwSource.ProductName
& "'"", State = " & meState & ".")
Return True
Else
ErrorStatus()
MsgBox(mconDSM_FailedToEnableSource & " with a rc of " & rc & ", State =
" & meState & "; and Name is " & mtwSource.ProductName, MsgBoxStyle.Critical)
Return False
End If
mLog.AddError(ex)
Return False
Finally
End Try
End Function
''' <summary>
''' All steps required to capture an image using the defaults.
''' </summary>
Public Function Scan() As Boolean
'***********************************************************************
******************
'* PURPOSE: Calls all the methods required to scan. They may be called
individually *
'* or this method may be called. Operation would be the same. *
'***********************************************************************
******************
'* RETURNS: TRUE if state is raised to 5 (enable DS). *
'***********************************************************************
******************
Dim bAbort As Boolean
Dim strAppContext As String
Const conProc As String = "Scan"
strAppContext = vbNullString
Try
'If we don't have the caller, we can not continue

If Not mfrmCaller Is Nothing Then
strAppContext = "Pre DSM_Open; meState = " & meState
If DSM_Open() Then 'Open the Data Source Manager if it is not open

strAppContext = "Pre DS_Selected; meState = " & meState
If DS_Selected() Then 'Select a source if one is not selected
strAppContext = "Pre DS_Open; meState = " & meState
If DS_Open() Then 'Open the source if it is not open
'Set some attributes that get set automatically thru the scanner's UI
If meSourceUI = scanSourceUI.escanSourceHide Then
strAppContext = "Pre NegociateCaps; meState = " & meState
If mbSetCaps Then
bAbort = Not NegociateCaps()
End If
End If
'If meDestination = scanDestination.escanDestinationFile Then

' strAppContext = "Pre NegociateFileXfer; meState = " & meState
' bAbort = Not NegociateFileXfer()
'End If
'Scan
If Not bAbort Then
strAppContext = "Pre DS_Enabled; meState = " & meState
If DS_Enabled() Then
'We wait for a message in the system message loop indicating that
the source is ready.
' When it is ready, it will be in state 6
' TWAIN 1.9; 7-224: That is, the Source should assert
MSG_XFERREADY as soon as it has data to transfer.
Return True
Else
MsgBox("Scan failed. " & mconDSM_FailedToEnableSource &
", State = " & meState & ".", MsgBoxStyle.Critical)
CleanUp()
End If
End If
Else
MsgBox("Scan failed. " & mconDSM_FailedToOpenSource & ", State
= " & meState & ".", MsgBoxStyle.Critical)
CleanUp()
End If
Else
MsgBox("Scan failed. " & mconDSM_FailedToSelectSource & ", State =
" & meState & ".", MsgBoxStyle.Critical)
CleanUp()
End If
Else
MsgBox("Scan failed. " & mconDSM_FailedToOpen & ", State = " &
meState & ".", MsgBoxStyle.Critical)
CleanUp()
End If
Else
MsgBox("No caller specified, operation cancelled.", MsgBoxStyle.Critical)
End If
mLog.AddError(ex, strAppContext)
Finally
End Try
End Function
''' <summary>
''' Used in the message loop
''' </summary>
Public Function FilterMessage(ByRef m As Message) As Boolean
'***********************************************************************
******************
'* PURPOSE: This is called from the callers message loop handler. After
PassMessage *
'* determines if it is a twain command, this will take the appropriate *
'* action depending on the message. Conclude the transfer when it is *
'* and Start transfering when the state reaches 6. *
'***********************************************************************
******************
'* RETURNS: FALSE if the message was for/from twain. Otherwise returns
TRUE (a *
'* windows message. *
'***********************************************************************
******************
Dim strContext As String
Dim pics As ArrayList
Dim cmd As twTwainCommand
Const conProc As String = "FilterMessage"
strContext = vbNullString
Try
cmd = PassMessage(m)
strContext = "After PassMessage"
If (cmd = twTwainCommand.Not) Then
Return False
End If
Select Case cmd

Case twTwainCommand.CloseRequest
strContext = "After CloseRequest"
CleanUp()
Case twTwainCommand.CloseOk
strContext = "After CloseOk"
CleanUp()
Case twTwainCommand.DeviceEvent
strContext = "After DeviceEvent"
Case twTwainCommand.TransferReady
strContext = "After TransferReady"

meState = scanTwainState.escanTransferReady 'We are in state 6
strContext = "Before TransferPictures"
pics = TransferPictures()
strContext = "Before InterceptMessageLoop"
frmMessageLoop.InterceptMessageLoop(False)
strContext = "After InterceptMessageLoop"
mfrmCaller.Pics = pics
strContext = "After Pics"
CleanUp()
strContext = "After CleanUp"
mfrmCaller.Enabled = True
End Select
Return True
mLog.AddError(ex, strContext)
Finally
End Try
End Function
''' <summary>
''' Call this when all images are captured.
''' </summary>
Public Sub DisalbeDS()
'***********************************************************************
******************
'* PURPOSE: Puts twain in a state to not receive transfers. Call this when *
'* capabilities need to be changed between captures. *
'***********************************************************************
******************
Dim rc As twRC
Dim twUI As twcUserInterface
Const conProc As String = "DisalbeDS"
Try
'Disable the Data Source

twUI = New twcUserInterface 'Not used
rc = DSM_EnableSource(mtwApp, mtwSource, twDG.Control,
twDAT.UserInterface, twMSG.DisableDS, twUI)
If meState >= scanTwainState.escanDS_Enabled Then
meState = scanTwainState.escanDS_Open
End If
Else
MsgBox("Failed to disable the source, going to state 4 with a rc of " & rc)
End If
End If
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Call this when finished with the source.
''' </summary>
Public Sub CloseDS()
'***********************************************************************
******************
'* PURPOSE: After the DS is disabled, it should be closed. *
'***********************************************************************
******************
Dim rc As twRC
Const conProc As String = "CloseDS"
Try
'Close the Data Source

rc = DSM_CloseDS(mtwApp, vbNullString, twDG.Control, twDAT.Identity,
twMSG.CloseDS, mtwSource)
If meState >= scanTwainState.escanDS_Open Then
meState = scanTwainState.escanDSM_Open
End If
Else
MsgBox("Failed to close the source, going to state 3 with a rc of " & rc)
End If
End If
mbDS_Selected = False
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Call this when completely finished capturing all images.
''' </summary>
Public Sub CloseDSM()
'***********************************************************************
******************
'* PURPOSE: After the DS is closed, the DSM should follow suit. *
'***********************************************************************
******************
Dim rc As twRC
Const conProc As String = "CloseDSM"
Try
'Close the Data Source Manager

rc = DSM_OpenClose(mtwApp, vbNullString, twDG.Control, twDAT.Parent,
twMSG.CloseDSM, mfrmCaller.Handle)
If meState >= scanTwainState.escanDSM_Open Then
meState = scanTwainState.escanDSM_Loaded
End If
Else
MsgBox("Failed to close the DSM, going to state 2 with a rc of " & rc)
End If
End If
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Will try close everything in the proper order.
''' </summary>
Public Sub CleanUp()
'***********************************************************************
******************
'* PURPOSE: Calls all the ending procedures in order. *
'***********************************************************************
******************
Const conProc As String = "CleanUp"
Try
If meState >= scanTwainState.escanTransferReady Then

EndXfer()
End If
If meState >= scanTwainState.escanDS_Enabled Then

DisalbeDS()
End If
If meState >= scanTwainState.escanDS_Open Then
CloseDS()
End If
If meState >= scanTwainState.escanDSM_Open Then
CloseDSM()
End If
mLog.AddError(ex)
Finally
End Try
End Sub
''' <summary>
''' Returns all the supported capabilities as a collection of objects.
''' </summary>
Public Function QueryCapabilities() As colCapValue
'***********************************************************************
******************
'* PURPOSE: Returns all the supported capabilities and values for a source.
*
'***********************************************************************
******************
'* RETURNS: Collection of capabilities. *
'***********************************************************************
******************
Dim r As Integer
Dim strContext As String
Dim SupportedCaps As rctCapValue
Dim AllCapValues As colCapValue
Const conProc As String = "QueryCapabilities"
'Put here to eliminate a compiler warning

AllCapValues = New colCapValue
strContext = vbNullString
Try
strContext = "Pre loop"

SupportedCaps = GetCapability(scanCap.SupportedCapabilities)
With SupportedCaps
For r = 0 To .NumItems - 1
strContext = "# = " & r.ToString & "; " & CType(.ItemList(r),
scanCap).ToString
CapValue = GetCapability(.ItemList(r))
If Not CapValue Is Nothing Then
AllCapValues.Add(CapValue)
End If
Next
End With
mLog.AddError(ex, strContext)
Finally
End Try
Return AllCapValues
End Function
''' <summary>
''' Do not need to call this.
''' </summary>
Protected Overrides Sub Finalize()
'***********************************************************************
******************
'* PURPOSE: Closes/disables everything we opened/enabled. *
'***********************************************************************
******************
Const conProc As String = "Finalize"
Try
CleanUp()
mLog.AddError(ex)
Finally
End Try
End Sub
Friend Function GetCapability(ByVal eCapability As scanCap) As rctCapValue
'***********************************************************************
******************
'* PURPOSE: Gets a specific capability. *
'***********************************************************************
******************
'* RETURNS: Generic capability. *
'***********************************************************************
******************
Dim rc As twRC
Dim twCapability As twcCapability
Const conProc As String = "GetCapability"
Try
twCapability = New twcCapability(eCapability)

rc = DS_Capability(mtwApp, mtwSource, twDG.Control, twDAT.Capability,
twMSG.Get, twCapability)
Select Case twCapability.ConType
Return GetOneValue(twCapability)
Return GetEnum(twCapability)
Return GetArray(twCapability)
Return GetRange(twCapability)
Case Else
MsgBox("Error, unknow value type received; " & twCapability.ConType)
Return Nothing
End Select
Else
ErrorStatus()
Return Nothing
End If
mLog.AddError(ex)
Finally
End Try
Return Nothing
End Function
Public Function GetFileTypes() As Array
'***********************************************************************
******************
'* PURPOSE: Gets a list of the file types that a source supports. *
'***********************************************************************
******************
'* RETURNS: An array of file types (extensions). *
'***********************************************************************
******************
Dim r As Integer
Dim intMaxIndex As Integer
Dim astrFileTypes() As String
Dim ReturnedFileTypes As rctCapValue
Const conProc As String = "GetFileTypes"
Try
ReturnedFileTypes = GetCapability(scanCap.ImageFileFormat)
intMaxIndex = ReturnedFileTypes.NumItems - 1
ReDim astrFileTypes(intMaxIndex)
For r = 0 To intMaxIndex
astrFileTypes(r) = CType(ReturnedFileTypes.ItemList(r),
scanFileType).ToString
Next
Return astrFileTypes
mLog.AddError(ex)
Finally
End Try
Return Nothing
End Function
Friend Function SetCapability(ByVal rctNewValue As rctCapValue) As Boolean
'***********************************************************************
******************
'* PURPOSE: Sets a specific capability passed in by a generic capability. *
'***********************************************************************
******************
'* RETURNS: TRUE if successfull. *
'***********************************************************************
******************
Dim rc As twRC
Dim pOneValue As IntPtr
Dim intOffest As Integer
Dim twCapability As twcCapability
'Dim twArray As twsArray
'Dim twEnum As twsEnumeration
Dim twOneValue As twsOneValue
'Dim twRange As twsRange
Const conProc As String = "SetCapability"
Try
twCapability = New twcCapability(rctNewValue.CapNumber)

Select Case rctNewValue.ContainerType
twCapability.ConType = scanContainerType.OneValue
With twOneValue
.ItemType = rctNewValue.ItemType
'.Item = ConvertType(rctNewValue.Default, eItemType)
.Item = rctNewValue.NewValue
End With
pOneValue = Marshal.AllocHGlobal(Marshal.SizeOf(twOneValue))
GlobalLock(pOneValue)
'PutInteger16(scanItemType.Int16, pOneValue, intOffest)
PutInteger16(CType(rctNewValue.ItemType, Short), pOneValue, intOffest)
PutSpecificValue(rctNewValue.ItemType, rctNewValue.NewValue,
pOneValue, intOffest)
End Select
twCapability.Handle = pOneValue
rc = DS_Capability(mtwApp, mtwSource, twDG.Control, twDAT.Capability,

twMSG.Set, twCapability)
GlobalUnlock(CType(pOneValue, Integer))
Marshal.FreeHGlobal(pOneValue)
mLog.AddError(ex)
Finally
End Try
Return True
Else
ErrorStatus()
Return False
End If
End Function
End Class
[/CODE]
Right now it requires this class for logging, although it isn't complete, it served my
purpose:
[CODE]' From Access 2000 Developer's Handbook, Volume I
' by Getz, Litwin, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
' Converted to .Net by John Maher
'Instructions
'------------
'
'1). Instanciate a new instance of this object (clsLogging)
'2). Set the output location for errors, default is AppPath
'3). Set the output location for logs, default is AppPath
'4). Upon entering a sub or function, call clsProcedureStack.EnterProc("Sub or
Function Name", "Module Name", optional context)
'5). Upon exiting a sub or function, call clsProcedureStack.ExitProc("Sub or Function
Name", optional context)
'6). When encountering an error, call AddError(ex) where ex is the exception
'
'Modifications
'-------------
'
'1/25/10 - JPM modified to get the logged in user instead of relying on a global. Also
excluded the database info since we use only one.
' Added a New methoid to set the objects. Also added 2 methods and changed
global to private. This is planned to be a relocatable mod.
' Eliminated object ProcedureStack and move the functions and modular-level
ProcStach object to the root of this object
'
'1/26/10 - Added logging of procs.
'
'
'TODO
'----
Public Class clsLogging
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _

ByVal lpLibFileName As String) As Integer
Private Declare Function GetProcAddress Lib "kernel32" Alias "GetProcAddress" ( _

ByVal hModule As Integer, ByVal lpProcName As String) As Integer
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias

"GetDiskFreeSpaceExA" ( _
ByVal lpRootPathName As String, _
ByVal curFreeBytesAvailableToCaller As Decimal, _
ByVal curTotalNumberOfBytes As Decimal, _
ByVal curTotalNumberOfFreeBytes As Decimal) As Boolean
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias

"GetLogicalDriveStringsA" ( _
ByVal cchBuffer As Integer, _
ByVal lpszBuffer As String) As Integer
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" ( _

ByVal lpszRootPathName As String) As Short
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias

"GetDiskFreeSpaceA" ( _
ByVal lpszRootPathName As String, _
ByRef lpSectorsPerCluster As Integer, _
ByRef lpBytesPerSector As Integer, _
ByRef lpFreeClusters As Integer, _
ByRef lpCusters As Integer) As Boolean
Public Structure FreeDiskSpaceType

Dim strDrive As String
Dim intType As Integer
Dim fValid As Boolean
Dim curFree As Decimal
Dim curSize As Decimal
End Structure
'Default log file names

Private mconErrorLogFile As String = "Error Log"
Private mconProcLogFile As String = "Error Log"
'LOHCo Mod 11/15/06 - added explicit type declarations.
Private Const mconDRIVE_REMOVABLE As Integer = 2
Private Const mconDRIVE_FIXED As Integer = 3
Private Const mconDRIVE_REMOTE As Integer = 4
Private Const mconDRIVE_CDROM As Integer = 5
Private Const mconDRIVE_RAMDISK As Integer = 6
Public Const mconNoMap As Integer = 0

Public Const mconExitSub As Integer = 1
Public Const mconResumeNext As Integer = 2
Public Const mconResume As Integer = 3
Public Const mconResumeMax As Integer = 3
'LOHCo Mod End
'JPM MOD 1/25/10 BEGIN4 of 4

' Modular variable to hold saved errors
Private mcolErrors As colSavedErrors
Private mstrErrorLogPath As String 'If null uses the app path.
Private mstrLogPath As String 'If null uses the app path.
Private mstrProcLog As String
' Modular variable to hold procedure stack
Private mobjTopProc As clsProcedure
Public Property ErrorLogPath() As String

Get
If mstrErrorLogPath <> vbNullString Then
Return mstrErrorLogPath
Else
Return System.AppDomain.CurrentDomain.BaseDirectory &
mconErrorLogFile
End If
End Get
Set(ByVal value As String)
mstrErrorLogPath = value
End Set
End Property
Public Property LogPath() As String

Get
Return mstrLogPath
End Get
mstrLogPath = value
End Set
End Property
Public ReadOnly Property ProcList() As String

Get
Return mstrProcLog
End Get
End Property
Public Sub New()
MyBase.New()
mcolErrors = New colSavedErrors
End Sub
Public Sub AddError(ByVal ex As Exception, Optional ByVal strAppContext As String

= vbNullString, Optional ByVal bSupressMessage As Boolean = False)
'JPM MOD - added optional parameter to supress printing of the general error
message. Useful if the app displays a more meaningfull message.
If strAppContext = "" Then

strAppContext = "Unspecified."
End If
mcolErrors.Add(ex, strAppContext)
HandleError(bSupressMessage)
End Sub
Public Function TopProc() As clsProcedure

' This returns a reference to the top
' procedure so a caller can walk the stack
TopProc = mobjTopProc
End Function
Private Function StackEmpty() As Boolean

' This makes sure the stack is not empty
' by checking to see if the top proc
' pointer is valid
StackEmpty = (mobjTopProc Is Nothing)
End Function
Public Function EnterProc(ByVal strName As String, ByVal strModule As String,

Optional ByVal strContext As String = vbNullString) As clsProcedure
' This pushes a new procedure onto the stack
Dim objProc As clsProcedure
objProc = New clsProcedure
'If this is the top proc then start the string from scratch
If mobjTopProc Is Nothing Then
mstrProcLog = vbNullString
End If
'Build a procedure log

mstrProcLog += "Enter> " & TimeOfDay & " - " & strModule & ":" & strName &
"; " & strContext & vbCrLf
' Set the procedure's strName and strModule properties

objProc.Name = strName
objProc.Module = strModule
' Make its NextProc property point to

' the one currently at the top of the stack
objProc.NextProc = mobjTopProc
' Make the new procedure the one at the top

mobjTopProc = objProc
' Return a reference to the new proc

Return mobjTopProc
End Function
Public Function ExitProc(ByVal strName As String, Optional ByVal strContext As
String = vbNullString) As Boolean
' This pops a procedure off the stack--
' To enforce FILO behavior we check the
' strName passed in against that of the top
' procedure
' Make sure the procedure stack is not empty

If Not StackEmpty() Then
' If the strName matches, pop the proc

' by making the next proc the top one--
' this destroys the pointer to the
' proc currently on top and it goes away
If mobjTopProc.Name = strName Then
'Build a procedure log

mstrProcLog += "Exit> " & TimeOfDay & " - " & strName & "; " & strContext
& vbCrLf
mobjTopProc = mobjTopProc.NextProc
ExitProc = True
Else
MsgBox("Error. Trying to pop wrong procedure. " & _
"You passed '" & strName & "'. " & _
"Current procedure is '" & _
mobjTopProc.Name & "'.", vbCritical)
End If
End If
End Function
'JPM MOD 1/25/10 END4 of 4
'JPM MOD 1/26/10 BEGIN

Public Sub WriteProcLog()
Dim intFile As Integer

Dim strLogPath As String
intFile = FreeFile()
If mstrLogPath <> vbNullString Then
strLogPath = mstrLogPath
Else
strLogPath = System.AppDomain.CurrentDomain.BaseDirectory &
mconProcLogFile
End If
FileOpen(intFile, strLogPath, OpenMode.Append)
PrintLine(intFile, StrDup(60, "="))
PrintLine(intFile, "Date: " & Now & ", ")
Print(intFile, mstrProcLog)
PrintLine(intFile, vbNullString)
FileClose(intFile)
End Sub
'JPM MOD 1/26/10 END
' LOHCo Modified to print only, not use their error reporting form.
Public Function HandleError(Optional ByVal bSupressMessage As Boolean = False)
As Integer
'JPM MOD - added optional parameter to supress printing of the general error
message. Useful if the app displays a more meaningfull message.

Const conBufferSize As Integer = 256
Dim strBuffer As String
Static fInError As Boolean

Dim strProcList As String
Dim objProc As clsProcedure
Dim objLastError As clsSavedError
Dim strMsg As String
Dim strTitle As String
'Dim strLogPath As String
On Error Resume Next
' Make sure we're not current in the

' error handler otherwise we'll end up
' with an infinite loop
If fInError Then
MsgBox("Already in error handler!", vbCritical)
'LOHCo Mod 11/15/06
'Stop
'LOHCo Mod End
Else
fInError = True
'LOHCo Mod various

' Removed code that calls the error reporting form and replaced it
' with the following code to pop a brief message to user
' log the error and then set the return code to bail out of the
' current procedure.
'JPM MOD 3/10/10 Moved this from above the FreeFile command to display
some more meaningful information
' Set pointer to last error that occurred.
objLastError = mcolErrors.LastError
If Not bSupressMessage Then

strMsg = "Unanticipated error encountered, error log being " _
& "written and processing terminating. Report this " _
& "error to the system administrator."
'JPM MOD 3/10/10 Added description to the message

strMsg &= vbCrLf & objLastError.Description
strTitle = "Error Encountered"

MsgBox(strMsg, CType(MsgBoxStyle.OkOnly + MsgBoxStyle.Critical,
Microsoft.VisualBasic.MsgBoxStyle), strTitle)
End If
objProc = TopProc()
strProcList = "Procedure Stack:" & vbCrLf
Do Until objProc Is Nothing
strProcList = strProcList & " Module: " & objProc.Module _
& " Procedure: " & objProc.Name & vbCrLf
objProc = objProc.NextProc
Loop

'Get the user id
strBuffer = SystemInformation.UserName
FileOpen(intFile, ErrorLogPath, OpenMode.Append)
PrintLine(intFile, StrDup(60, "-"))
Print(intFile, "User: " & strBuffer & ", ")
'Print(intFile, "DataBase: " & CurrentDb().Name)
Print(intFile, strProcList)
Print(intFile, "Description: " & objLastError.Description & " ")
Print(intFile, "Application Context: " & objLastError.AppContext)
FileClose(intFile)
'LOHCo Mod End
' Reset flag

fInError = False
End If
'LOHCo Mod
' Return constant to exit through the procedure's Exit_Procedure.
Return mconExitSub
'LOHCo Mod End
End Function
'JPM MOD 3/17/10 BEGIN

Public Sub WriteMessage(ByVal strMsg As String)

Dim strBuffer As String
strBuffer = SystemInformation.UserName
FileOpen(intFile, ErrorLogPath, OpenMode.Append)
PrintLine(intFile, StrDup(60, "="))
Print(intFile, "User: " & strBuffer & ", ")
Print(intFile, strMsg)
FileClose(intFile)
End Sub
'JPM MOD 3/17/10 END
Public Sub FreeDiskSpace(ByVal atyp() As FreeDiskSpaceType)

' Gets the free disk space on all drives
'
' From Microsoft Access 2000 Developer's Handbook
' by Litwin, Getz, and Gilbert. (Sybex)
'
' In:
' An array of user-defined types
' Out:
' The same array expanded and filled in
Dim strDrives As String
Dim i As Integer
Dim iBeg As Integer
Dim iEnd As Integer
Dim lngSectorsPerCluster As Long
Dim lngBytesPerSector As Long
Dim lngFreeClusters As Long
Dim lngClusters As Long
Dim iatyp As Integer
Dim lngRet As Long
Dim fRet As Boolean
On Error GoTo adhFreeDiskSpaceErr
strDrives = vbNullString
For i = 256 To 65535 Step 256
strDrives = Space(i)
lngRet = GetLogicalDriveStrings(Len(strDrives), strDrives)
If lngRet < Len(strDrives) Then
Exit For
End If
Next i
Erase atyp
iBeg = 1
iEnd = InStr(iBeg, strDrives, Chr(0))
Do Until iEnd = iBeg
ReDim Preserve atyp(UBound(atyp) + 1)
iatyp = UBound(atyp)
atyp(iatyp).strDrive = Mid$(strDrives, iBeg, iEnd - iBeg)
atyp(iatyp).intType = GetDriveType(atyp(iatyp).strDrive)
fRet = DiskSpace(atyp(iatyp).strDrive, atyp(iatyp).curSize, atyp(iatyp).curFree)
If fRet Then
atyp(iatyp).fValid = True
Else
atyp(iatyp).curFree = 0
atyp(iatyp).curSize = 0
atyp(iatyp).fValid = False
End If
iBeg = iEnd + 1
iEnd = InStr(iBeg, strDrives, Chr(0))
Loop
Exit Sub
adhFreeDiskSpaceErr:
Select Case Err.Number
Case 9 'Subscript out of range
ReDim atyp(0)
Resume Next
'LOHCo Mod 11/15/06
'Case Else
'Stop
'LOHCo Mod End
End Select
End Sub
Public Function DriveType(ByVal intType As Integer) As String

' Returns the drive type based on the number
' returned from an API call
'
' From Microsoft Access 2000 Developer's Handbook
' by Litwin, Getz, and Gilbert. (Sybex)
'
' In:
' Drive type number
' Out:
' Drive type string
Select Case intType
Case 0
Return "Unknown"
Case 1
Return "Unknown"
Case mconDRIVE_REMOVABLE
Return "Removable"
Case mconDRIVE_FIXED
Return "Fixed"
Case mconDRIVE_REMOTE
Return "Remote"
Case mconDRIVE_CDROM
Return "CD-ROM"
Case mconDRIVE_RAMDISK
Return "RAM Disk"
Case Else
Return "Unknown"
End Select
End Function
Private Function IsGetDiskFreeSpaceExOK() As Boolean
Dim hModule As Integer

Dim lngAddress As Long
hModule = LoadLibrary("kernel32.DLL")
If hModule <> 0 Then
lngAddress = GetProcAddress(hModule, "GetDiskFreeSpaceExA")
End If
IsGetDiskFreeSpaceExOK = (lngAddress <> 0)
End Function
Private Function DiskSpace(ByVal strDrive As String, _

ByVal curTotal As Decimal, ByVal curFree As Decimal) As Boolean
If IsGetDiskFreeSpaceExOK() Then
Dim curFreeToMe As Decimal
Dim curTotalBytes As Decimal
Dim curFreeBytes As Decimal
If GetDiskFreeSpaceEx(strDrive, _
curFreeToMe, curTotalBytes, curFreeBytes) Then
curTotal = curTotalBytes * 10000
curFree = curFreeBytes * 10000
DiskSpace = True
End If
Else
Dim intSectorsPerCluster As Integer
Dim intBytesPerSector As Integer
Dim intNumberOfFreeClusters As Integer
Dim intTotalNumberOfClusters As Integer
If GetDiskFreeSpace(strDrive, intSectorsPerCluster, _
intBytesPerSector, intNumberOfFreeClusters, intTotalNumberOfClusters) Then
curTotal = intBytesPerSector * intSectorsPerCluster *
intTotalNumberOfClusters
curFree = intBytesPerSector * intSectorsPerCluster *
intNumberOfFreeClusters
DiskSpace = True
End If
End If
End Function
'***********************************************************************
**********************
'* *
'* clsProcedure *
'* *
'***********************************************************************
**********************
Class clsProcedure 'Linked list
Private mstrName As String

Private mstrModule As String
Private mdatTimeEntered As Date
Private mobjNextProc As clsProcedure
' Name is the name of the procedure--

' note that it is a write-once property
Public Property Name() As String
Get
Return mstrName
End Get
If mstrName = "" Then
mstrName = value
End If
End Set
End Property
' Module is the name of the module this

' procedure is located in
Public Property [Module]() As String
Get
Return mstrModule
End Get
If mstrModule = "" Then
mstrModule = value
End If
End Set
End Property
' NextProc is used a pointer to the next

' procedure in the stack
Public Property NextProc() As clsProcedure
Get
Return mobjNextProc
End Get
Set(ByVal value As clsProcedure)
mobjNextProc = value
End Set
End Property
' TimeEntered is the date/time that the class

' instance was created
Public ReadOnly Property TimeEntered() As Date
Get
Return mdatTimeEntered
End Get
End Property
Public Sub New()

MyBase.New()
' Set date/time entered
mdatTimeEntered = Now
End Sub
End Class
'***********************************************************************
**********************
'* *
'* clsSavedError *
'* *
'***********************************************************************
**********************
Class clsSavedError
Private mstrKey As String

Private mstrID As String
Private mstrSource As String
Private mstrDescription As String
Private mdatDateTime As Date
Private mstrProcedure As String
'LOHCo Mod 1/16/06
Private mstrAppContext As String
Private mstrEmpID As String
'JPM Mod 1/25/10
Private mintIndex As Integer
Public ReadOnly Property ID() As String

Get
Return mstrID
End Get
End Property
' Key into the collection

Public Property Key() As String
Get
Return (mstrKey)
End Get
mstrKey = value
End Set
End Property
' Source.
Public Property Source() As String
Get
Return mstrSource
End Get
mstrSource = value
End Set
End Property
' Description.
Public Property Description() As String
Get
Return mstrDescription
End Get
mstrDescription = value
End Set
End Property
' DateTime.
Public Property DateTime() As Date
Get
Return mdatDateTime
End Get
Set(ByVal value As Date)
mdatDateTime = value
End Set
End Property
' Procedure.
Public Property Procedure() As String
Get
Return mstrProcedure
End Get
mstrProcedure = value
End Set
End Property
'LOHCo Mod 1/16/06

' AppContext.
Public Property AppContext() As String
Get
Return mstrAppContext
End Get
mstrAppContext = value
End Set
End Property
' EmpID.
Public Property EmpID() As String
Get
Return mstrEmpID
End Get
mstrEmpID = value
End Set
End Property
'LOHCo Mod End
Public Sub New()

MyBase.New()
' Set ID property
mstrID = "E" & CStr(Now.Ticks)
' Set procedure property

mstrProcedure = "unknown"
End Sub
Public Sub Save(ByVal objException As Exception, ByVal strAppContext As String,

ByVal strEmpID As String)
'LOHCo End
' The Save method takes an ErrObject object
' copies its properties to this object's
' properties
With objException
mstrSource = .Source
mstrDescription = .Message
End With
'LOHCo Mod 1/16/06
mstrAppContext = strAppContext
mstrEmpID = strEmpID
'LOHCo End
End Sub
Return mstrID
End Function
'JPM - Raise method obsolete

'Public Sub Raise()
' ' Raises a run time error using this object's
' ' properties.
' '
' ' From Microsoft Access 2000 Developer's Handbook, Volume I
' ' by Getz, Litwin, and Gilbert. (Sybex)
' ' Copyright 1999. All Rights Reserved.
' '
' ' In:
' ' nothing
' ' Out:
' ' n/a
' Err.Raise(mlngNumber, mstrSource, mstrDescription, _

' mstrHelpFile, mlngHelpContext)
'End Sub
End Class
'***********************************************************************
**********************
'* *
'* colSavedErrors *
'* *
'***********************************************************************
**********************
Class colSavedErrors
Implements IEnumerable, IEnumerator
Private mintIndex As Integer

Private mcolErrors As Collection
Public ReadOnly Property Count() As Long

Get
Return mcolErrors.Count
End Get
End Property
Public ReadOnly Property Current() As Object Implements IEnumerator.Current

Get
Return mcolErrors(mintIndex)
End Get
End Property
Public Sub New()
MyBase.New()
Reset()
mcolErrors = New Collection
End Sub
Public Function Add(ByVal objException As Exception, ByVal strAppContext As

String, _
Optional ByVal strEmpID As String = "") As clsSavedError
Dim objSavedError As clsSavedError

objSavedError = New clsSavedError
objSavedError.Save(objException, strAppContext, strEmpID)
'mcolErrors.Add(objSavedError, objSavedError.ID)
mcolErrors.Add(objSavedError)
Return objSavedError
End Function
Public Sub Clear()
Reset()
mcolErrors = New Collection
End Sub
Public Function GetEnumerator() As IEnumerator Implements

IEnumerable.GetEnumerator
Reset()
Return CType(Me, IEnumerator)
End Function
Public Function Item(ByVal objKey As Object) As clsSavedError
Dim intKey As Integer

Dim strKey As String
Dim objErr As clsSavedError
intKey = CType(Val(objKey), Integer)

If intKey > 0 Then
If intKey <= mcolErrors.Count Then
Return CType(mcolErrors(intKey), clsSavedError)
Else
Return Nothing
End If
Else
strKey = objKey.ToString
objErr = Nothing
For Each objErr In mcolErrors
If objErr.Key = strKey Then
Exit For
End If
Next
Return objErr
End If
End Function
Public Function LastError() As clsSavedError
If mcolErrors.Count > 0 Then

Return CType(mcolErrors(mcolErrors.Count), clsSavedError)
Else
Return Nothing
End If
End Function
Public Function MoveNext() As Boolean Implements IEnumerator.MoveNext
mintIndex += 1
Return (mintIndex <= mcolErrors.Count)
End Function
Public Sub Remove(ByVal objKey As Object)
Dim intKey As Integer

Dim strKey As String
Dim objErr As clsSavedError
intKey = CType(Val(objKey), Integer)

If intKey > 0 Then
If intKey <= mcolErrors.Count Then
mcolErrors.Remove(intKey)
End If
Else
strKey = objKey.ToString
For Each objErr In mcolErrors
If objErr.Key = strKey Then
mcolErrors.Remove(strKey)
Exit For
End If
Next
End If
End Sub
Public Sub Reset() Implements IEnumerator.Reset
mintIndex = 0
End Sub
End Class
End Class
[/CODE]
Useage:
[CODE] Private mScan As clsScan
mScan = New clsScan(mLog)

mScan.Caller = Me
If Not mScan.Scan() Then

Me.Enabled = True
MsgBox("Scan failed.", MsgBoxStyle.Critical)
End If
[/CODE]
A form to display the pictures is needed because it passes them back into a property of
that form. The form gets set as the Caller above:
[CODE]
Public WriteOnly Property Pics() As ArrayList
Set(ByVal alScannedPics As ArrayList)
Const conProc = "Set Property Pics"
Try
If mbBatchScan Then
mbBatchScan = False
'Check to see if we got anything back

If Not alScannedPics Is Nothing Then
malBatchPics = alScannedPics
WriteOutScannedData(alScannedPics)
SetUpFormForPicDisplay()
End If
End If
Catch ex As System.ArgumentException
MsgBox("Unable to save file. Please check that the capabilities are set
correctly and permissions / disk space")
mLog.AddError(ex, "System.ArgumentException: Sometimes caused when
trying to convert a color BMP to TIFF", True)
mLog.AddError(ex)
Finally
End Try
End Set
End Property
[/CODE]
Here is an ini file:

[CODE][Settings]
MainTop=127
MainLeft=197
OptionsTop=486
OptionsLeft=475
MainHeight=758
MainWidth=816
[DataAccess]
Database=TestERP
[Debug]
MessagesDisplay=False
[Destination]
Return=0
DIBSaveAsFileType=JPEG
ScannerSaveAsFileType=TIFF
[Source]
Select=0
UI=0
[Capabilities]
1= 0
257= 0
4098= 0
4099= 0
4103= 0
4109= 0
4110= 0
4111= 0
4112= 0
4116= 0
4117= 0
4369= 0
4370= 0
4376= 150
4377= 150
4378= 0
4399= 0
4400= 0
4401= 0
4432= 0
4433= 0
32797= 0
32817= 1
32876= 0
[/CODE]
It gets read by this:

[CODE] Public Function GetCapValuesFromINI() As clsScan.colCapValue
'Reads save capability settings from the ini file
Dim intLoc As Integer
Dim intLast As Integer
Dim strAllCaps As String
Dim colCaps As clsScan.colCapValue
Dim CapValue As clsScan.rctCapValue
colCaps = New clsScan.colCapValue

strAllCaps = GetValueForKey(mconCapSection, vbNullString, mstrINIFilePath)
If strAllCaps <> vbNullString Then
intLast = 1
intLoc = InStr(strAllCaps, vbNullChar)
While intLoc
CapValue = New clsScan.rctCapValue
CapValue.CapNumber = CType(Val(Mid(strAllCaps, intLast, intLoc - intLast)),
clsScan.scanCap)
CapValue.NewValue = Val(GetValueForKey(mconCapSection,
CapValue.CapNumber, mstrINIFilePath))
colCaps.Add(CapValue)
intLast = intLoc + 1
intLoc = InStr(intLast, strAllCaps, vbNullChar)
End While
End If
Return colCaps
End Function
[/CODE]
Which sets values like this:

[CODE] mScan.CustomCapCollection = GetCapValuesFromINI()
[/CODE]
Although that may be unnecessary, you can go with the defaults and manually change
things as you need. Just trying to give you everything I can think of.
"Where ever the TWAIN shall meet"

Scan

Uploaded by

Copyright:

Available Formats

Scan

Uploaded by

Document Information

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Scan

Uploaded by

Copyright:

Available Formats

I didn't quite get it ready for the codebank yet, but you can try it.

[CODE]'Special thanks to gaccettola (gabe on http://www.twain.org) from

'Prefixes: tws = TWain Structure

'Class is organized as follows:

Public Class clsScan

#Region "Message Intercept Form"

Private mLog As clsLogging

Public WriteOnly Property Log() As clsLogging

Public Function PreFilterMessage(ByRef m As Message) As Boolean Implements

Public Sub InterceptMessageLoop(ByVal bIntercept As Boolean)

Const conProc As String = "InterceptMessageLoop"

'some fields can be set to -1 if we don't care about them

Private Const mconModule As String = "clsScan" 'Used in message / error

Private Const mconTWAIN_DLL As String = "TWAIN_32.DLL"

Public Enum scanSourceSelect As Integer

Public Enum scanSourceUI As Integer

Public Enum scanDestination As Integer

Public Enum scanFileType As Short

Public Enum scanCap As UShort

Public Enum scanItemType As UInt16 'Copied from openTwain

''' <summary>An 16-bit signed integer<br></br>

' an 8-bit unsigned integer

''' <summary>An 8-bit unsigned integer<br></br>

' a 16-bit unsigned integer

Public Enum scanContainerType As Short

Private Enum twDAT As Short

Private Enum twMSG As Short

Private Enum twRC As Short

Private Enum twTwainCommand

Private Enum twUnits As Short

Private Enum twPixelTypeValues As Short

Private Enum twPixelType As Short

<Flags()> Private Enum twXferMech As Short

Friend Declare Function GlobalLock Lib "kernel32.dll" Alias "GlobalLock" ( _

Friend Declare Function GlobalUnlock Lib "kernel32.dll" Alias "GlobalUnlock" ( _

Private Declare Function GetMessagePos Lib "user32.dll" Alias "GetMessagePos" ()

Private Declare Function GetMessageTime Lib "user32.dll" Alias "GetMessageTime"

'Private Declare Function GlobalUnlock Lib "kernel32.dll" Alias "GlobalUnlock" ( _

<DllImport("twain_32.dll", EntryPoint:="#1")> Private Shared Function

Public Sub New()

<StructLayout(LayoutKind.Sequential, Pack:=2, CharSet:=CharSet.Ansi)> Friend

<StructLayout(LayoutKind.Sequential, Pack:=2)> Private Class twcCapability

Public Sub New(ByVal eCap As scanCap)

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsStatus

<StructLayout(LayoutKind.Sequential, Pack:=2)> Private Class twcUserInterface

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsEvent

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Class twsImageInfo

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Class twcPendingXfers

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsArray

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsEnumeration

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsOneValue

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsRange

<StructLayout(LayoutKind.Sequential, Pack:=2)> Friend Structure twsSetupFileXfer

Public Sub SetMembers(ByVal sngValue As Single)

Whole = CType(Fix(sngValue), Short)

Public Function GetValue() As Single

If Whole > 0 Then

Public Overrides Function ToString() As String

If Frac < 0 Then