VBS: bmp2jpg

Option Explicit

Const adOpenStatic     = 3
Const adLockOptimistic = 3
Const adTypeBinary     = 1


Dim objFSO
Dim objFile

Dim objConnection1
Dim objRecordSet1

Dim objConnection2
Dim objRecordSet2

Dim objStream

Dim objImageFile
Dim objVector


Set objFSO           = WScript.CreateObject("Scripting.FileSystemObject")

Set objConnection1   = WScript.CreateObject("ADODB.Connection")
Set objRecordSet1    = WScript.CreateObject("ADODB.Recordset")

Set objConnection2   = WScript.CreateObject("ADODB.Connection")
Set objRecordSet2    = WScript.CreateObject("ADODB.Recordset")

Set objStream        = WScript.CreateObject("ADODB.Stream")

Set objImageFile     = WScript.CreateObject("WIA.ImageFile")
Set objVector        = WScript.CreateObject("WIA.Vector")

'*****************************************************************************
' Загрузка изображений из папки в первую базу данных
'*****************************************************************************
objConnection1.Open _
    "Provider    = Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source = 'E:\Песочница\0017\db1.mdb'" 

With objRecordSet1
    .Open "SELECT * FROM Table1", objConnection1, adOpenStatic, adLockOptimistic
    
    objStream.Type = adTypeBinary
    objStream.Open
    
    For Each objFile In objFSO.GetFolder("E:\Песочница\0017").Files
        If UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("bmp") Then
            objStream.LoadFromFile objFile.Path
            
            .AddNew
            .Fields.Item("Image1").Value = objStream.Read
            .Update
        End If
    Next
    
    objStream.Close
    
    .Close
End With

objConnection1.Close
'*****************************************************************************

' Собственно, извлечение, конвертация и перенос
objConnection1.Open _
    "Provider    = Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source = 'E:\Песочница\0017\db1.mdb'" 
    
objConnection2.Open _
    "Provider    = Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source = 'E:\Песочница\0017\db2.mdb'" 

objRecordSet2.Open "SELECT * FROM Table2", objConnection2, adOpenStatic, adLockOptimistic

With objRecordSet1
    .Open "SELECT * FROM Table1", objConnection1, adOpenStatic, adLockOptimistic
    
    Do Until .EOF
        objVector.BinaryData = .Fields.Item("Image1").Value
        Set objImageFile = ConvertBmp2Jpg(objVector.ImageFile)
        
        With objRecordSet2
            .AddNew
            
            .Fields.Item("Image2").Value = objImageFile.FileData.BinaryData
            .Update
        End With
        
        .MoveNext
    Loop
    
    .Close
End With

objRecordSet2.Close
objConnection2.Close

objConnection1.Close

WScript.Quit 0

Function ConvertBmp2Jpg(objImageFile)
    Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    
    With WScript.CreateObject("WIA.ImageProcess")
        .Filters.Add .FilterInfos("Convert").FilterID
        .Filters.Item(1).Properties.Item("FormatID").Value = wiaFormatJPEG
        
        Set ConvertBmp2Jpg = .Apply(objImageFile)
    End With
End Function

'*****************************************************************************
' Загрузка изображений из папки в первую базу данных
'*****************************************************************************
…
'*****************************************************************************

Function ConvertBmp2Jpg(ByRef arrByteImage)
    Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    
    Dim objVector
    
    Set objVector        = WScript.CreateObject("WIA.Vector")
    
    objVector.BinaryData = arrByteImage
    
    With WScript.CreateObject("WIA.ImageProcess")
        .Filters.Add .FilterInfos("Convert").FilterID
        .Filters.Item(1).Properties.Item("FormatID").Value = wiaFormatJPEG
        
        ConvertBmp2Jpg = (.Apply(objVector.ImageFile)).FileData.BinaryData
    End With
End Function

Option Explicit

Dim arrBytes

arrBytes = ReadBinaryData("E:\Песочница\0017\01.bmp")
WScript.Echo "1. Type of arrBytes:", TypeName(arrBytes), "; size:", LenB(arrBytes)

arrBytes = ConvertBmp2Jpg(arrBytes)
WScript.Echo "2. Type of arrBytes:", TypeName(arrBytes), "; size:", LenB(arrBytes)

SaveBinaryData "E:\Песочница\0017\01.jpg", arrBytes

WScript.Quit 0


Function ReadBinaryData(filename)
    Const adTypeBinary          = 1
    Const adReadAll             = -1
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .LoadFromFile filename
        ReadBinaryData = .Read(adReadAll)
        .Close
    End With
End Function

Function SaveBinaryData(filename, byteArray)
    Const adTypeBinary          = 1
    Const adSaveCreateOverWrite = 2
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write byteArray
        .SaveToFile filename, adSaveCreateOverWrite
        .Close
    End With
End Function

Function ConvertBmp2Jpg(ByRef arrByteImage)
    Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    
    Dim objVector
    
    Set objVector        = WScript.CreateObject("WIA.Vector")
    
    objVector.BinaryData = arrByteImage
    
    With WScript.CreateObject("WIA.ImageProcess")
        .Filters.Add .FilterInfos("Convert").FilterID
        .Filters.Item(1).Properties.Item("FormatID").Value = wiaFormatJPEG
        
        ConvertBmp2Jpg = (.Apply(objVector.ImageFile)).FileData.BinaryData
    End With
End Function

Function SaveBinaryData(filename, byteArray)
    Const adSaveCreateOverWrite = 2
    With CreateObject("ADODB.Stream")
        .Type = 1 'adTypeBinary
        .Open
        .Write byteArray
        .SaveToFile filename, adSaveCreateOverWrite
        .Close
    End With
End Function

Function ReadBinaryFile(filename)
    Dim bArr
    With CreateObject("ADODB.Stream")
        .Type = 1 'adTypeBinary
        .Open
        .LoadFromFile filename
        bArr = .Read
        .Close
        ReadBinaryFile = bArr
    End With
End Function

Set objCommand = CreateObject("ADODB.Command")          
objCommand.ActiveConnection = connS                                
objCommand.CommandText = "INSERT INTO PHOTO (ID,PREVIEW_WIDTH,PREVIEW_HEIGHT,PREVIEW_RASTER,HIRES_WIDTH,HIRES_HEIGHT,HIRES_RASTER) VALUES ("&rsA1(0)&",256,307,?,256,307,?)"  ' Копируем фото из одной базы в другую
objCommand.CommandType = 1
objCommand.Parameters.Append( objCommand.CreateParameter("x",128,1,-1,data) )                                ' Создаем параметр 1
objCommand.Parameters.Append( objCommand.CreateParameter("y",128,1,-1,data) )                                ' Создаем параметр 2
objCommand.Execute()