powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сохранение бинарных данных
52 сообщений из 52, показаны все 3 страниц
Сохранение бинарных данных
    #39716849
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Нужно в базу записывать небольшие куски (до 60 байт) бинарных данных. Также на это поле нужен уникальный ключ.

Создал в базе поле
Код: sql
1.
DATA  VARCHAR(60) CHARACTER SET NONE


А как теперь записать в него данные, при условии, что в подключении указано
Код: sql
1.
lc_ctype=WIN1251



Как пробовал
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
IBDataSet1.FieldByName('Data').AsString := #130#131#132;
//============
IBDataSet1.FieldByName('Data').AsAnsiString := #130#131#132;
//============
SetLength(LData, 3);
LData[0] := 130;
LData[1] := 131;
LData[2] := 132;
IBDataSet1.FieldByName('Data').AsBytes := LData;
//============
LStrm := IBDataSet1.CreateBlobStream(IBDataSet1.FieldByName('Data'), bmWrite);
try
  LStrm.WriteData(LData, Length(LData));
finally
  LStrm.Free;
end;

везде вылетает ошибка
arithmetic exception, numeric overflow, or string truncation

Cannot transliterate character between character sets.


Сервер IB2009. Компоненты IBX. Delphi XE3

С уважением, Vasilisk
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716850
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

OCTETS в Interbase нету?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716857
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов ДенисOCTETS в Interbase нету?

Должно быть. Это очень древняя вещь.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716865
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

попробуй

Код: sql
1.
DATA  VARCHAR(60) CHARACTER SET OCTETS
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716868
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов ДенисOCTETS в Interbase нету?Есть. Сейчас щупаю
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716880
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов Дениспопробуй

Код: sql
1.
DATA  VARCHAR(60) CHARACTER SET OCTETS

Адекватно записать данные не удается

Код: pascal
1.
2.
 IBDataSet3.FieldByName('Data').AsBytes := LData;
  IBDataSet3.FieldByName('Data').SetData(LData);

вычисляет длину данных как
Код: pascal
1.
StrLen(PChar(Buffer))

соответственно два стоящих подряд #0#0 усекает данные. SetAsAnsiString определена как
Код: pascal
1.
2.
3.
4.
procedure TField.SetAsAnsiString(const Value: AnsiString);
begin
  SetAsString(string(Value));
end;

и теперь один #0 усекает строку.

Вызов CreateBlobStream приводит к AV
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716884
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Все, что приходит в голову - это сохранять в HEX или на клиента отдавать поле как BLOB
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716893
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Выкинуть DataSet и использовать IBSQL не предлагать?..
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716896
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Dimitry SibiryakovВыкинуть DataSet и использовать IBSQL не предлагать?..Пока нет.

Внутренний фреймворк заточен на TDataSet
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716925
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если отнаследоваться от TIBDataSet, переопределить InternalInitFieldDefs и на CHARSET NONE/OCTETS вернуть FieldType = ftBlob взлетит?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716942
hvlad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Какого типа поле создаётся в датасете ?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39716979
Фотография kdv
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

собственно, поскольку в большинстве компонент varchar или char преобразуется в строку C с окончанием нулями, то никакие бинарные данные туда записать нельзя. OCTETS может чего и даст, но не факт.
Поэтому, бинарные данные пишутся только в блоб.
_Vasilisk_Также на это поле нужен уникальный ключ.
это ахинея, ответственно заявляю. По бинарным данным, особенно длиной 60 байт, не может быть никакого уникального ключа.
Читаем
http://www.ibase.ru/natural-keys-versus-atrificial-keys-by-tentser/
выход - доп. столбец как хэш этих 60 бинарных байт, и вот его уже можно делать уникальным.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717040
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kdvв большинстве компонент varchar или char преобразуется в строку C с окончанием нулями

Нет, так делают только очень-очень глупые компоненты, а таких всё-таки не большинство.

kdvПо бинарным данным, особенно длиной 60 байт, не может быть никакого уникального
ключа.
Да ну? 4 или 8 бинарных байт целого - уникальный ключ в порядке, 16 байт гуида -
уникальный ключ в порядке, а на 60 вдруг внезапный качественный скачок и уникальный ключ
невозможен? Ты ещё скажи, что на строках вообще уникальные ограничения невозможны...
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717097
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hvladКакого типа поле создаётся в датасете ?ftString (TIBStringField)
kdvвыход - доп. столбец как хэш этих 60 бинарных байт, и вот его уже можно делать уникальным.Это не выход

1. Хеш по определению не может быть уникальным
2. Хеш это те-же бинарные данные, которые нужно как-то сохранять
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717100
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Хеш (тем паче их много разных) - всё же имеет представление в виде строки.
Хотя в твоём случае особого смысла в нём нет, лучше добить обработку binary.

Data содержит корректные данные (байты) ? Строковое представление тебе,
по сути, вроде бы не нужно.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717102
hvlad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_hvladКакого типа поле создаётся в датасете ?ftString (TIBStringField)А должно быть [var]binary. Без этого не получится.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717104
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гаджимурадов РустамХеш (тем паче их много разных) - всё же имеет представление в виде строки.Я с тем же успехом могу данные записать в hex
Гаджимурадов РустамData содержит корректные данные (байты) ?Ты сейчас о поле? Я же говорю - обрезается до перого #0 если такой встретится
Гаджимурадов РустамСтроковое представление тебе, по сути, вроде бы не нужно.Нет
Гаджимурадов Рустамлучше добить обработку binary.В понедельник еще поковыряюсь
hvladА должно быть [var]binary.Это какой тип?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717107
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_> Ты сейчас о поле? Я же говорю - обрезается

Нет, конечно, о свойстве (не помню, доступно ли оно в TField).
Хотя если у тебя даже Get/SetData не пашут, то, наверное, нет.

> Это какой тип?

ftBytes, видимо.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39717116
hvlad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_hvladА должно быть [var]binary.Это какой тип?Насколько я понимаю и помню эту кухню, нужно править TIBCustomDataSet.InternalInitFieldDefs, чтобы оно создавало ftVarBytes (ftBytes)
при наличии чарсета OCTETS у поля SQL_VARYING (SQL_TEXT)
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718271
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hvladНасколько я понимаю и помню эту кухню, нужно править TIBCustomDataSet.InternalInitFieldDefs, чтобы оно создавало ftVarBytes (ftBytes)
при наличии чарсета OCTETS у поля SQL_VARYING (SQL_TEXT)Не взлетело.

При подмене типа получаем картину
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
procedure TDataSet.SetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean);
var
  StackBuf: TArray<Byte>;
begin
  if NativeFormat then
    SetFieldData(Field, Buffer)
  else
  begin
    SetLength(StackBuf, Field.DataSize);
    if Buffer <> nil then
      DataConvert(Field, Buffer, StackBuf, True);
    SetFieldData(Field, StackBuf);
  end;
end;

procedure TDataSet.DataConvert(Field: TField; Source, Dest: TValueBuffer; ToNative: Boolean);
var
  DataSize: Word;
  DateTimeRec: TDateTimeRec;
begin
  case Field.DataType of
    ..........
    ftVarBytes:
      if ToNative then
      begin
        DataSize := Length(Source);
        Move(DataSize, Dest[0], SizeOf(Word));
        Move(Source[0], Dest[SizeOf(Word)], DataSize);
      end
      else
      begin
        Move(Source[0], DataSize, SizeOf(Word));
        Move(Source[SizeOf(Word)], Dest[0], DataSize);
      end;

В начало буфера добавляется еще и длина. А потом, контрольный в голову
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: TValueBuffer);
var
  Buff : TRecordBuffer;
begin
  Buff := GetActiveBuf;
  ...............
        Move(Buffer[0], Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
               PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
        if (PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
           (PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
          PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer)) * 2;
        PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;

InternalSetFieldData имела в виду мои ftVarBytes

Если тип поля в InternalInitFieldDefs вернуть как ftBlob, то на Post возникает "Internal error"
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718278
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Код: pascal
1.
StrLen(PChar(Buffer))



ну это чепуха для бинарных данных
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718297
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов Денисну это чепуха для бинарных данныхЯ знаю. Но так оно есть.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718298
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну раз уж начал править, правь
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718302
hvlad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_В начало буфера добавляется еще и длинаУ себя в буфере могут и фазу луны хранить, тебе-то что
_Vasilisk_InternalSetFieldData имела в виду мои ftVarBytesНу так надо её наказать научить

PS За многократное повторение PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] автора этого кода нужно сколько же раз проклясть канделябром...
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718310
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Код: pascal
1.
2.
        if (PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
           (PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then



добавь проверку CHARSET. Как не подскажу, пока нет времени разбираться
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718311
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Мимопроходящийну раз уж начал править, правьЯ не правлю. Я наследуюсь
hvladУ себя в буфере могут и фазу луны хранить, тебе-то чтоРазмер буфера совпадает с размером поля. И лишние два байта могут быть не к месту
hvladНу так надо её наказать научитьДумаю
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718312
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hvlad,

это писатели IBX
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718316
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов ДенисКак не подскажу
Код: pascal
1.
(SqlSubtype and $FF) in [0, 1]  // CHARSET NONE, OCTETS
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718321
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

не трогай NONE, только OCTETS
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718323
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
16.10.2018 17:16, _Vasilisk_ пишет:
> Я не правлю. Я наследуюсь

не взлетит.

не боись, каждый дельфятник должен иметь своего клона IBX ;-)
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718339
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Симонов Денисне трогай NONE, только OCTETSУчту. А почему?
Мимопроходящий> Я не правлю. Я наследуюсь

не взлетит.Взлетит. Уже вижу как
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718388
Vlad F
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Потом покаж, я в свой клон от XE5 вставлю.))
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718389
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_Если тип поля в InternalInitFieldDefs вернуть как ftBlob, то на Post возникает "Internal error"

Может быть потому, что блобы надо записывать в БД отдельно и заранее, а в строку записываются только номера (хэндлы) блобов.

Вообще попробуй своё приложение писать одновременно на IBX и UIB
Потому что UIB гораздо ниже к FB API и некоторые подробности, спрятанные в "красивых" компонентах - в UIB вылезают и колют.

И чтобы понять как именно тебе править работу с FB API в IBX - можно будет для образца смотреть в каком порядке и с какими данными вызываются функции FB в UIB и подгонять твой форк IBX под этакий эталон
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718390
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Vlad F,

может вам на пару IBX2 портануть и поддерживать ?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718392
Vlad F
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Arioch,

А может на троих или на пятерых? Мимипроходящий вон тож постоянно напрашивается.))
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718394
Котовасия
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ariochпопробуй своё приложение писать одновременно на IBX и UIB
Разный интерфейс, второй как будто пьяный делал.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718397
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
16.10.2018 18:52, Vlad F пишет:
> А может на троих или на пятерых? Мимипроходящий вон тож постоянно напрашивается.))

не взлетит.
у меня форк порождён от IBX 4.42
сейчас там от творчества Джефа осталось очень мало.
но начиналось всё как у Василиска, с попытки обойтись малой кровью...
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718400
Котовасия
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Мимопроходящий,

и небось сидишь на D5...
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718406
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Все. Я пас. ftVarBytes не спасло
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
begin
   ..............
          data := cr + PRecordData(cr)^.rdFields[j].fdDataOfs;
          case PRecordData(cr)^.rdFields[j].fdDataType of
            SQL_TEXT, SQL_VARYING:
            begin
              SetString(st, PChar(data), PRecordData(cr)^.rdFields[j].fdDataLength div 2);
              Qry.Params[i].AsString := st;
            end;
  ................
end;

Кому интересно - вот наработки
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
  TIBDataSetEx = class(TIBDataSet)
  strict private
    class function IsBinaryField(AField: TField): Boolean; static;
    class function GetVarBytesLenPtr(const ABuffer: TValueBuffer): PWord; static;
    procedure SetFieldBinaryData(AField: TField; const ABuffer: TValueBuffer);
    function GetMappedFieldPositionPtr: PInteger;
    function GetMappedFieldPosition(AIdx: Integer): Integer;
  protected
    procedure InternalInitFieldDefs; override;
    procedure SetFieldData(AField: TField; ABuffer: TValueBuffer); override;
    procedure DataConvert(AField: TField; ASource, ADest: TValueBuffer; AToNative: Boolean); override;
  end;

{ TIBDataSetEx }

class function TIBDataSetEx.IsBinaryField(AField: TField): Boolean;
begin
  Result := (AField.FieldNo >= 0) and (AField.DataType in [ftVarBytes, ftBytes]);
end;

class function TIBDataSetEx.GetVarBytesLenPtr(const ABuffer: TValueBuffer): PWord;
begin
  Result := @ABuffer[Length(ABuffer) - SizeOf(Word)];
end;

procedure TIBDataSetEx.SetFieldBinaryData(AField: TField; const ABuffer: TValueBuffer);
var
  LRecData: PRecordData;
  LFldData: PFieldData;
begin
  LRecData := PRecordData(GetActiveBuf);
  LFldData := @LRecData^.rdFields[GetMappedFieldPosition(AField.FieldNo - 1)];
  if not LFldData^.fdIsNull then begin
    if AField.DataType = ftVarBytes then
      LFldData^.fdDataLength := GetVarBytesLenPtr(ABuffer)^
    else
      LFldData^.fdDataLength := Length(ABuffer);
  end;
end;

function TIBDataSetEx.GetMappedFieldPositionPtr: PInteger;
const
  {$IF IBXConst.IBX_Version = 17.17}
  CMappedFieldPositionOffset = 512;
  {$ELSE}
    {$MESSAGE ERROR 'Check TIBCustomDataSet.MappedFieldPosition Offset'}
  {$ENDIF}
begin
  Result := PPointer(OffsetPtr(Self, CMappedFieldPositionOffset))^;
end;

function TIBDataSetEx.GetMappedFieldPosition(AIdx: Integer): Integer;
var
  LBasePtr: PIntegerArray;
begin
  LBasePtr := PIntegerArray(GetMappedFieldPositionPtr);
  Result := LBasePtr^[AIdx];
end;

procedure TIBDataSetEx.InternalInitFieldDefs;
var
  LMappedFieldPosition: PInteger;
  Li: Integer;
  LVar: TSQLVAR;
  LSqlType: SmallInt;
  LSubType: SmallInt;
  LSize: Integer;
begin
  FieldDefs.BeginUpdate;
  try
    inherited InternalInitFieldDefs;
    LMappedFieldPosition := GetMappedFieldPositionPtr;
    for Li := 0 to FieldDefs.Count - 1 do begin
      LVar := QSelect.Current[LMappedFieldPosition^ - 1].Data;
      Inc(LMappedFieldPosition);
      LSqlType := LVar.sqltype and not 1;
      if (LSqlType = SQL_VARYING) or (LSqlType = SQL_TEXT) then begin
        LSubType := LVar.SqlSubtype and $FF;
        if LSubType = 1 then begin // CHARSET OCTETS
          LSize := FieldDefs[Li].Size;
          if LSqlType = SQL_VARYING then
            FieldDefs[Li].DataType := ftVarBytes
          else
            FieldDefs[Li].DataType := ftBytes;
          FieldDefs[Li].Size := LSize;
        end;
      end;
    end;
  finally
    FieldDefs.EndUpdate;
  end;
end;

procedure TIBDataSetEx.SetFieldData(AField: TField; ABuffer: TValueBuffer);
begin
  inherited SetFieldData(AField, ABuffer);
  if IsBinaryField(AField) then
    SetFieldBinaryData(AField, ABuffer);
end;

procedure TIBDataSetEx.DataConvert(AField: TField; ASource, ADest: TValueBuffer;
  AToNative: Boolean);
var
  LDataSizePtr: PWord;
  LDataSize: Word;
begin
  case AField.DataType of
    ftBytes: begin
      if AToNative then begin
        Move(ASource[0], ADest[0], Length(ASource));
        FillChar(ADest[Length(ASource)], Length(ADest) - Length(ASource), 0);
      end else
        Move(ASource[0], ADest[0], AField.DataSize);
    end;
    ftVarBytes: begin
      if AToNative then begin
        LDataSize := Length(ASource);
        Move(ASource[0], ADest[0], LDataSize);
        LDataSizePtr := GetVarBytesLenPtr(ADest);
        LDataSizePtr^ := LDataSize;
      end else begin
        LDataSizePtr := GetVarBytesLenPtr(ASource);
        LDataSize := LDataSizePtr^;
        Move(ASource[0], ADest[0], LDataSize);
      end;
    end
  else
    inherited DataConvert(AField, ASource, ADest, AToNative);
  end;
end;


Может допилю, как время будет, но врядли
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718407
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Arioch_Vasilisk_Если тип поля в InternalInitFieldDefs вернуть как ftBlob, то на Post возникает "Internal error"
Может быть потому, что блобы надо записывать в БД отдельно и заранее, а в строку записываются только номера (хэндлы) блобов.Internal error это мой косяк. Внимания не обращайте
AriochВообще попробуй своё приложение писать одновременно на IBX и UIB
Потому что UIB гораздо ниже к FB API и некоторые подробности, спрятанные в "красивых" компонентах - в UIB вылезают и колют.На TIBSQL задача решается. Интересовало решение на TIBDataSet
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718409
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_> На TIBSQL задача решается.

С правками или без?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718412
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Arioch,

API-шная часть IBX2 кстати распространяется и отдельно
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718420
Котовасия
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AriochVlad F,

может вам на пару IBX2 портануть и поддерживать ?
Нафик этот ибх2 нужен обычному прикладнику.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718423
hvlad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_Все. Я пас. ftVarBytes не спаслоПосмотри на ADODB - там всё работало
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718433
Vlad F
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

А как дышал, как дышал!! (с) ))
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718452
Фотография Симонов Денис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

быстро сдался. А уж хотел предложить в исходники FibPlus заглянуть, там это поправили. Один фиг их тут 100500 раз выкладывали
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718478
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я тоже хотел посоветовать заглянуть в FibPlus,
но не уверен, что игра вообще стоит свеч, если
у него есть воркэраунды. Разве что на будущее
или из спортивного интереса.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718488
Vlad F
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Короче, надо пока он пребывает типа в коме тырить из него все, что плохо лежит. Я сам, помнится лет пятнадцать тому, не удержался и позаимствовал у йом алиас-менеджер, приторочив сей трофей к IBX.))

Модератор: Тема перенесена из форума "Firebird, InterBase".
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718672
Фотография Dimonka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А какой нибудь энкодинг совсем не предлагать? например хранить в виде HEX строки в 60 * 2 байтах?
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718718
Котовасия
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гаджимурадов РустамЯ тоже хотел посоветовать заглянуть в FibPlus,
но не уверен, что игра вообще стоит свеч, если
у него есть воркэраунды. Разве что на будущее
или из спортивного интереса.
В фиб+ все работает. Я гуиды хранил в октетс чар полях (зачем-то), никаких проблем не было.
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718807
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гаджимурадов Рустам_Vasilisk_> На TIBSQL задача решается.
С правками или без?Без. Но с потенциальными граблями

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
  IBSQL2.ParamByName('Data').AsBytes := LData;
........
procedure TIBXSQLVAR.SetAsBytes(const Value: TBytes);
var
  ss : TBytesStream;
begin
  if (FXSQLVAR.SqlDef = SQL_BLOB) then
  begin
    ss := TBytesStream.Create(Value);
    try
      LoadFromStream(ss);
    finally
      ss.Free;
    end;
  end
  else
    AsString := StringOf(Value);
end;

function StringOf(const Bytes: TBytes): UnicodeString;
begin
  if Assigned(Bytes) then
    Result := TEncoding.Default.GetString(Bytes, Low(Bytes), High(Bytes) + 1)
  else
    Result := '';
end;

procedure TIBXSQLVAR.SetAsString(const Value: String);
begin
  SetAsCPString(Value, FSQL.Database.CharacterSetCodePage); // AnsiString
end;

procedure TIBXSQLVAR.SetAsCPString(const Value: String; CodePage : Integer);
begin
  ........
  if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
  begin
    if CodePage <> 0 then
    begin
      Encoding := TMBCSEncoding.Create(CodePage);
      try
        bt := Encoding.GetBytes(Value);
        SetStringValue;
      finally
        Encoding.Free;
      end;
    end
end;

Т.е. вначале массив байт конвертируется в юникодную строку на основании текущей кодировки системы, а потом полученная строка конвертируется обратно в массив байт, но уже на основании кодировки базы. Т.е. может и не совпасть.

С другой стороны, никто не мешает сделать так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
var
  LData: TBytes;
  LVar: TSQLVAR;
begin
  .....
  LVar := IBSQL2.ParamByName('Data').Data;
  LVar.SqlType := SQL_TEXT or (LVar.sqltype and 1);
  LVar.sqllen := Length(LData);
  LVar.SetDataSize(0, LVar.sqllen + 1);
  Move(LData[0], LVar.sqldata^, LVar.sqllen);
  IBSQL2.ParamByName('Data').Modified := True;

обернув все в хелпер и добавив проверки по вкусу

Симонов Денисбыстро сдался.Работу работать нужно
DimonkaА какой нибудь энкодинг совсем не предлагать? 21702895

КотовасияВ фиб+ все работает.Я даже больше скажу - в FireDAC все работает
...
Рейтинг: 0 / 0
Сохранение бинарных данных
    #39718818
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
17.10.2018 14:28, _Vasilisk_ пишет:
> в FireDAC все работает

ну дык он не на пустом месте писался ;)
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
52 сообщений из 52, показаны все 3 страниц
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сохранение бинарных данных
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]