最近使用bufdataset时发现可以创建ftVariant类型,但无法正常读写。经搜索,发现fpc官方早在2011年就有解决方案,但到今天最新的fpc3.3.1还没支持,按issues的方法,经测试读写ok,如果你也需要在bufDataSet要用到ftVariant,可以参考以下方法:
打开fpcsrc\packages\fcl-db\src\base\bufdataset.pas
打到以下代码,添加红色的部分的代码:
打开fpcsrc\packages\fcl-db\src\base\bufdataset.pas
打到以下代码,添加红色的部分的代码:
function TCustomBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
和
procedure TCustomBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
function TCustomBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean; var CurrBuff : TRecordBuffer; vData : variant; begin Result := False; if State = dsOldValue then begin if FSavedState = dsInsert then CurrBuff := nil // old values = null else if GetActiveRecordUpdateBuffer then CurrBuff := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer else // There is no UpdateBuffer for ActiveRecord, so there are no explicit old values available // then we can assume, that old values = current values CurrBuff := CurrentIndexBuf.CurrentBuffer; end else CurrBuff := GetCurrentBuffer; if not assigned(CurrBuff) then Exit; //Null value If Field.FieldNo > 0 then // If =-1, then calculated/lookup field or =0 unbound field begin if GetFieldIsNull(pbyte(CurrBuff),Field.FieldNo-1) then Exit; if assigned(Buffer) then begin inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]); if Field.IsBlob then // we need GetFieldSize for BLOB but Field.DataSize for others - #36747 Move(CurrBuff^, Buffer^, GetFieldSize(FieldDefs[Field.FieldNo-1])) else if Field.DataType =ftVariant then begin vData:=PVariant(CurrBuff)^; PVariant(Buffer)^ := vData; end else Move(CurrBuff^, Buffer^, Field.DataSize); end; Result := True; end else begin Inc(CurrBuff, GetRecordSize + Field.Offset); Result := Boolean(CurrBuff^); if Result and assigned(Buffer) then begin inc(CurrBuff); Move(CurrBuff^, Buffer^, Field.DataSize); end; end; end; procedure TCustomBufDataset.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); begin SetFieldData(Field,Buffer); end; procedure TCustomBufDataset.SetFieldData(Field: TField; Buffer: Pointer); var CurrBuff : pointer; NullMask : pbyte; vData : variant; begin if not (State in dsWriteModes) then DatabaseErrorFmt(SNotEditing, [Name], Self); CurrBuff := GetCurrentBuffer; If Field.FieldNo > 0 then // If =-1, then calculated/lookup field or =0 unbound field begin if Field.ReadOnly and not (State in [dsSetKey, dsFilter, dsRefreshFields]) then DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]); if State in [dsEdit, dsInsert, dsNewValue] then Field.Validate(Buffer); NullMask := CurrBuff; inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]); if assigned(buffer) then begin if Field.IsBlob then // we need GetFieldSize for BLOB but Field.DataSize for others - #36747 Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1])) else if Field.DataType =ftVariant then begin vData:=PVariant(Buffer)^; PVariant(CurrBuff)^ := vData; end else Move(Buffer^, CurrBuff^, Field.DataSize); unSetFieldIsNull(NullMask,Field.FieldNo-1); end else SetFieldIsNull(NullMask,Field.FieldNo-1); end else begin Inc(CurrBuff, GetRecordSize + Field.Offset); Boolean(CurrBuff^) := Buffer <> nil; inc(CurrBuff); if assigned(Buffer) then begin if Field.DataType =ftVariant then begin vData:=PVariant(Buffer)^; PVariant(CurrBuff)^ := vData; end else Move(Buffer^, CurrBuff^, Field.DataSize); end; end; if not (State in [dsCalcFields, dsFilter, dsNewValue]) then DataEvent(deFieldChange, PtrInt(Field)); end;
添加以上红色代码后,将bufdataset.pas拷贝到你的project的文件夹,重新编译project就可以了。
【推荐】国内首个AI IDE,深度理解中文开发场景,立即下载体验Trae
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· Manus的开源复刻OpenManus初探
· AI 智能体引爆开源社区「GitHub 热点速览」
· 从HTTP原因短语缺失研究HTTP/2和HTTP/3的设计差异
· 三行代码完成国际化适配,妙~啊~
2022-06-01 lazarus使用建议