SHOW:
|
|
- or go back to the newest paste.
1 | '==================== sunbrother(гав-гав)яндекс ру ===== http://www.vbsedit.com/ ===== | |
2 | Option Explicit | |
3 | ||
4 | Const ScannerDeviceType = 1 | |
5 | Const ColorIntent = 1 | |
6 | Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" | |
7 | ||
8 | ||
9 | Dim objDeviceManager | |
10 | Dim objDeviceInfos | |
11 | Dim objDevice | |
12 | ||
13 | Dim objImageFile | |
14 | Dim objImageProcess | |
15 | ||
16 | Dim strPath2Save | |
17 | Dim strFormat | |
18 | Dim intQuality | |
19 | Dim intDPI | |
20 | Dim intHorizontalSize | |
21 | Dim intVerticalSize | |
22 | ||
23 | dim daty | |
24 | dim datm | |
25 | dim datd | |
26 | dim dath | |
27 | dim datn | |
28 | dim dats | |
29 | ||
30 | 'как бы ни было смешно - но это формирование даты и времени для имени файла | |
31 | daty = DatePart("yyyy",Now()) | |
32 | datm = DatePart("m",Now()) | |
33 | datd = DatePart("d",Now()) | |
34 | dath = DatePart("h",Now()) | |
35 | datn = DatePart("n",Now()) | |
36 | dats = DatePart("s",Now()) | |
37 | ||
38 | ||
39 | ||
40 | ' Задаём характеристики изображения | |
41 | strPath2Save = "d:\scan\" & daty & "-" & datm & "-" & datd & "-" & dath & "-" & datn & "-" & dats & ".jpg" ' Полное имя файла для сохранения | |
42 | strFormat = wiaFormatJPEG ' Формат файла — *.jpg | |
43 | intQuality = 85 ' Качество jpg | |
44 | intDPI = 150 ' Разрешение — 150 dpi | |
45 | intHorizontalSize = (210 / 25.4) * intDPI ' Размер по горизонтали — A4 | |
46 | intVerticalSize = (296 / 25.4) * intDPI ' Размер по вертикали — A4 | |
47 | ||
48 | ||
49 | Set objDeviceManager = WScript.CreateObject("WIA.DeviceManager") | |
50 | Set objDeviceInfos = objDeviceManager.DeviceInfos | |
51 | ||
52 | If objDeviceInfos.Count > 0 Then | |
53 | ' Выбираем устройство для сканирования. Если оно единственное, то сие произойдёт без отображения диалога. | |
54 | Set objDevice = WScript.CreateObject("WIA.CommonDialog").ShowSelectDevice(ScannerDeviceType, False, False) | |
55 | ' Кроме того, зная DeviceID устройства, можно использовать иной способ подключения, например: | |
56 | 'Dim objDeviceInfo | |
57 | ' | |
58 | 'For Each objDeviceInfo In objDeviceManager.DeviceInfos | |
59 | ' WScript.Echo objDeviceInfo.DeviceID | |
60 | ' | |
61 | ' If objDeviceInfo.DeviceID = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0000" Then | |
62 | ' Set objDevice = objDeviceInfo.Connect | |
63 | ' End If | |
64 | 'Next | |
65 | ||
66 | If Not objDevice Is Nothing Then | |
67 | ' WScript.Echo objDevice.Properties.Item("Name") & " [" & objDevice.DeviceID & "]" | |
68 | ' WScript.Echo "Scanning..." | |
69 | ||
70 | With objDevice | |
71 | With .Items(1) | |
72 | ' Задаём требуемые характеристики изображения для сканирования | |
73 | With .Properties | |
74 | .Item("6146").Value = ColorIntent ' Цветовая модель (Current Intent) | |
75 | ||
76 | ' Разрешение… | |
77 | .Item("6147").Value = intDPI ' …по горизонтали (Horizontal Resolution) | |
78 | .Item("6148").Value = intDPI ' …по вертикали (Vertical Resolution) | |
79 | ||
80 | ' Начало области сканирования… | |
81 | .Item("6149").Value = 0 ' …по горизонтали (Horizontal Start Position) | |
82 | .Item("6150").Value = 0 ' …по вертикали (Vertical Start Position) | |
83 | ||
84 | ' Размер области сканирования… | |
85 | .Item("6151").Value = intHorizontalSize ' …по горизонтали (Horizontal Extent) | |
86 | .Item("6152").Value = intVerticalSize ' …по вертикали (Vertical Extent) | |
87 | End With | |
88 | ||
89 | ' Инициируем начало операции сканирования | |
90 | Set objImageFile = .Transfer() | |
91 | ||
92 | ' Конвертируем полученное изображение | |
93 | ' WScript.Echo "Converting..." | |
94 | ||
95 | Set objImageProcess = WScript.CreateObject("WIA.ImageProcess") | |
96 | ||
97 | With objImageProcess | |
98 | With .Filters | |
99 | .Add objImageProcess.FilterInfos("Convert").FilterID | |
100 | ||
101 | With .Item(1).Properties | |
102 | .Item("FormatID").Value = strFormat ' Формат изображения | |
103 | .Item("Quality").Value = intQuality ' Качество изображения | |
104 | End With | |
105 | End With | |
106 | ||
107 | Set objImageFile = .Apply(objImageFile) | |
108 | End With | |
109 | End With | |
110 | End With | |
111 | ||
112 | ' Если файл существует — предварительно удаляем его | |
113 | With WScript.CreateObject("Scripting.FileSystemObject") | |
114 | If .FileExists(strPath2Save) Then | |
115 | .DeleteFile strPath2Save | |
116 | End If | |
117 | End With | |
118 | ||
119 | ' Сохраняем полученное изображение | |
120 | objImageFile.SaveFile strPath2Save | |
121 | ||
122 | ' WScript.Echo "Complete." | |
123 | ||
124 | Set objDevice = Nothing | |
125 | Else | |
126 | WScript.Echo "Cancel scanning by user" | |
127 | End If | |
128 | Else | |
129 | WScript.Echo "No connected devices" | |
130 | End If | |
131 | ||
132 | Set objDeviceManager = Nothing | |
133 | Set objDeviceInfos = Nothing | |
134 | ||
135 | WScript.Quit 0 |