Guest User

Untitled

a guest
Nov 8th, 2013
3,231
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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
RAW Paste Data