Тема: VBS: bmp2jpg
Подскажите, есть ли решение для конвертации BMP2JPG на лету средствами VBS. Необходимо из одной базы изоображение в формате BMP копировать в другую, в формате JPG
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Подскажите, есть ли решение для конвертации BMP2JPG на лету средствами VBS. Необходимо из одной базы изоображение в формате BMP копировать в другую, в формате JPG
Вот
только форматы поменять местами и вперёд...
Только как его прикрутить?
pavlikspb, зависит от того, как именно хранится изображение в базе данных, как извлекается, что собой представляет (какой тип данных VBScript) после извлечения.
Сейчас оно хранится в двоичных данных в формате *.bmp надо его копировать в другую таблицу тоже в двоичном коде только в формате jpg.
pavlikspb, этих данных недостаточно. Важно знать что за база (например, чтобы правильно построить ConnectionString), тип поля, в котором хранятся данные, и как, в каком именно виде добавлялись эти самые данные в таблицу базы данных, ибо от этого зависит код.
Дабы Вы имели более внятное представление, почему я спрашиваю, приведу пример.
Пусть у нас в некоей папке («E:\Песочница\0017») лежат две базы данных («db1.mdb» и «db2.mdb»). В каждой базе есть таблица («Table1» и «Table2» соответственно). В таблице есть поле типа LongVarBinary (может быть и банальное Memo, не суть важно) в котором могут храниться бинарные [а не двоичные ] данные («Image1» и «Image2» соответственно) [всё, что относится к первой базе — заканчивается в примере на «1», ко второй базе — заканчивается на «2»; для понятности].
Предположим, что данные из файлов изображений добавлялись в поле посредством ADODB.Stream как массив байт. Пишем следующий код для переноса данных из «Table1.Image1» в «Table2.Image2» (см. замечание ниже по первой части кода):
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
Помеченное комментарием:
'*****************************************************************************
' Загрузка изображений из папки в первую базу данных
'*****************************************************************************
…
'*****************************************************************************
нужно только для данного примера и предназначено для заполнения исходной таблицы бинарными данными из файлов изображений. В оригинальной базе у Вас уже есть заполненная исходная таблица.
Таким образом, напишите здесь:
* тип базы данных, провайдер OLEDB;
* тип поля, в котором хранятся данные;
* как именно, каким конкретным кодом или «ручками» заполнялось это поле.
Тогда уже можно будет пытаться давать более конкретные рекомендации.
Базы данных две, источник - IB 7.1, приемник mysql. Источник поле TCARDIMAGES.FIMG - BLOB, приемник - PREVIEW_RASTER from PHOTO тип longblob. Может это сможет помочь :
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
выгружает корректно из обеих баз изоображения в файлы jpg и bmp соответственно, осталось только загрузить....
По поводу как в базу попадают изоображения - это программно-аппаратные комплексы, автоматизированной системы контроля доступа, оба разных производителей, так сложилось, что возникла необходимость заткнуть дыру из-за выхода из строя одного контроллера - другим, так как сроки поставки были заявлены новых около 2 месяцев (реально ждали перед этим порядка 8). Вот и встала задача осуществлять между ними обмен...
Интересовало как раз формирование параметра «byteArray» из содержимого поля. Ну, да ладно. Коль есть «byteArray» — значит, Вы его как-то из содержимого поля формируете.
Тогда вот Вам функция, принимающая на вход байтовый массив (представляющий собой содержимое «*.bmp» изображения) и возвращающая на выходе байтовый массив же (представляющий собой содержимое конвертированного в «*.jpg» изображения):
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
Насчёт: VBS: Копирование данных из IB в mysql
…как передать значение из запроса Select передать данные в запрос INSERT
смотрите сами: если входной внутренний язык какой-либо базы поддерживает вызов хранимых процедур, в которых можно задействовать Automation — то, полагаю, можно вместить вызов функции, подобной приведённой, в запрос. Иначе же — старый дедовский способ с перебором и добавлением записей по одной.
не выходит каменный цветок..., в базу данные грузятся, а вот в окне программы не отображаются, когда пытаюсь функцией Function SaveBinaryData вставленным мной выше выгрузить изоображение, которое я перекинул Вашей функцией выдает ошибку - Аргументы имеют неверный тип, выходят за пределы допустимого диапозона или вступают в конфликт друг с другом - это может быть связано с типом данных этих полей? Может то пространство которое остается догружать нулями?
А с копированием я разобрался, мне как раз дедушкин способ и нужен...слишком много полей которые требуют дополнительной конвертации. Я потом заполню ту тему самим примером. Большое спасибо за оказываемую помощь!
pavlikspb, давайте для начала убедимся, что всё нормально с конвертацией. Такое:
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
у Вас отрабатывает нормально?
Да, отлично отрабатывает, только jpg получается по размеру больше, чем bmp на 1/3
сейчас конвертер из базы данных выдает ошибку - Параметр задан неверно. Источник:WIA.Vector.1
Да, отлично отрабатывает, только jpg получается по размеру больше, чем bmp на 1/3
Какие-то странные у Вас картинки, коллега:
1. Type of arrBytes: Byte() ; size: 2654262 2. Type of arrBytes: Byte() ; size: 307345
Выложите-ка тот «*.bmp», с которым Вы пробовали, и получившийся «*.jpg» на какой-либо файлообменник (желательно в архиве, дабы быть уверенным в отсутствии преобразований). Я постараюсь вечером забрать и посмотреть у себя. А Вы пока можете попробовать нарисовать что-нибудь в «mspaint.exe», сохранить в «*.bmp» и попробовать код на нём.
Здесь: Архив
Коллега, вообще-то Ваш «in.BMP» — на самом деле самый натуральный «*.jpg».
Я так понимаю, теперь вопрос с конвертацией вовсе отпадает?
класс....меня уже второй раз....
Ну хоть ни так обидно...потому что каждый раз с пользой, с чувством, мерой, расстановкой...
Буль - пребуль спасибо!
Странно, все равно в mysql лезть не хочет(((.....
для мускуля бинарные данные должны выглядеть не как массив, а как последовательность хекс-кодов без пробелов
класс....меня уже второй раз....
Ну хоть ни так обидно...потому что каждый раз с пользой, с чувством, мерой, расстановкой...
Если можно, ещё раз, пожалуйста, для меня и по-русски.
где-то я видел, такую функцию...будем искать
pavlikspb пишет:класс....меня уже второй раз....
Ну хоть ни так обидно...потому что каждый раз с пользой, с чувством, мерой, расстановкой...Если можно, ещё раз, пожалуйста, для меня и по-русски.
Этот скрипт предназначен для перекидывания данных из одной системы контроля доступа в другую. Со всеми полями которые надо было перекидывать по пользователям я разобрался, осталось только три поля: 1. Код карты
2. Уменьшенное изоображение
3. Изоображение в полный размер
самое важное из оставшихся полей было - код карты. Вот я с ним намучился, строил невероятные алгоритмы, добавлял или отнимал смещение, а оказалось все банально - надо было всего лишь перевести данные из десятичного формата в шестнадцатиричный - это был первый раз. А вот это второй - я беру файл bmp и через программный комплекс загружаю в базу. Загружаю bmp, значит думаю и хранит он в bmp, а оказывается нет.
Большое Вам спасибо за помощь, к сожалению в другом виде свою благодарность мне выразить пока нечем, но может и я пригожусь...
P.S.: Проблема пока по загрузке изоображений не решена.
Не удается мне перекинуть изоображения с одной базы в другую.... У меня, почти при всех действиях, вылетает окно Windows XP с ошибкой Windows Based Script Host.
Как я понимаю, если этот код читает из mysql изоображение в файл:
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
или я неправильно думаю?
У меня, почти при всех действиях, вылетает окно Windows XP с ошибкой Windows Based Script Host.
4. Как правильно задать вопрос, чтобы быть услышанным, пп. 4.11/4.12
Как я понимаю, если этот код читает из mysql изоображение в файл … или я неправильно думаю?или я неправильно думаю?
Наверное, неправильно, ибо ни тот, ни другой код непосредственного отношения к базам данных не имеют.
Предварительно ознакомьтесь, как настроить сервер для работы через ADO на работу с полями типа BLOB в MySQL: MySQL :: Accessing MySQL BLOB columns using Visual Basic 6.
Например, вот так можно записать содержимое бинарного файла в поле «Image3» типа «MEDIUMBLOB» в таблицу «Table3» базы данных «test» MySQL:
Option Explicit
Const adOpenStatic = 3
Const adLockOptimistic = 3
Dim objConnection
Dim objRecordSet
Dim objStream
Set objConnection = WScript.CreateObject("ADODB.Connection")
Set objRecordSet = WScript.CreateObject("ADODB.Recordset")
Set objStream = WScript.CreateObject("ADODB.Stream")
objConnection.Open _
"DRIVER={MySQL ODBC 3.51 Driver};Server=localhost;UID=xxx;Password=xxx;Database=test;OPTION=16427"
With objRecordSet
.Open "SELECT * FROM Table3", objConnection, adOpenStatic, adLockOptimistic
.AddNew ' или поиск требуемой записи
.Fields.Item("Image3").Value = ReadBinaryData("E:\Песочница\0017\01.jpg")
.Update
.Close
End With
objConnection.Close
WScript.Quit 0
Function ReadBinaryData(strFileName)
Const adTypeBinary = 1
Const adReadAll = -1
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.LoadFromFile strFileName
ReadBinaryData = .Read(adReadAll)
.Close
End With
End Function
Размер передаваемых таким способом данных (суммарно всех полей) должен укладываться, как описано в статье по ссылке выше, в значение:
%ProgramFiles%\MySQL\MySQL Server 5.0\my.ini
…
[mysqld]
# The maximum size of a query packet the server can handle as well as
# maximum query size server can process (Important when working with
# large BLOBs). enlarged dynamically, for each connection.
max_allowed_packet = …
…
В противном случае Вы можете получить ошибку:
Got a packet bigger than 'max_allowed_packet' bytes
Тут уже можно будет пробовать поманипулировать порциями данных посредством «AppendChunk» (я пока не пробовал).
После добавления содержимого файла изображения в MySQL Query Browser в поле «Image3» можно увидеть добавленную картинку (вот подойдёт ли такой формат Вашему АПК — не знаю, смотреть Вам).
Все оказалось проще, чем мы здесь обсуждали - ни какой конвертации делать не надо, а решил все вот так:
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()
Большое спасибо)))
Что за объект WIA?
Спасибо.
Будем изучать. Я так понимаю, что этот объект по-умолчанию присутствует в XP?
P.S. Сейчас я данные сохраняю через GDI+.
Я так понимаю, что этот объект по-умолчанию присутствует в XP?
Только версии 1. Вообще же рекомендуется установка версии 2.0 (Download details: Windows® Image Acquisition Automation Library v2.0 Tool: Image acquisition and manipulation component for VB and scripting), доступной для загрузки отдельно. Требует наличия SP1. Хотя реальная скриптовая работа возможна как раз с версии 2.0.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться