修正lazarus 3.0/fpc3.3.1交叉编译unidac应用（aarch64 linux）时UniProvider.pas编译出错

unidac在aarch64 linux交叉编译UniProvider.pas出错：

UniProvider.pas(1040,1) Error: Compilation raised exception internally

奇怪的是其他CPU类型是正常的。

解决办法：
1、修改UniProvider.pas,添加

{$if FPC_FULLVERSION<30301}

  TEnumeratorOption = class(TOption)
  private
    FTypeInfo: PTypeInfo;
    FMinValue: integer;
    FMaxValue: integer;
    FInternalType: boolean;
  protected
    procedure InternalGetValuesList(List: TStrings); override;

  public
    procedure SetTypeInfo(typeInfo: PTypeInfo);
    {$if FPC_FULLVERSION<30301}
    constructor Create(const OptionName: string; InternalIndex: integer; InternalClasses: array of TClass;
      DefaultValue: variant; TypeInfo: PTypeInfo);
    {$endif}
    function GetAsString(const Value: variant): string; override;
    function GetAsNative(const Value: string): variant; override;

    function CheckValue(const Value: string): boolean; override;
  end;

  TOptionsList = class(TStringList)

{$if FPC_FULLVERSION<30301}
constructor TEnumeratorOption.Create(const OptionName: string; InternalIndex: integer;
  InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);
var
  TypeData: PTypeData;
  TypeName: string;
begin
  inherited Create(OptionName, InternalIndex, InternalClasses, DefaultValue);

  FTypeInfo := TypeInfo;
  TypeData := GetTypeData(FTypeInfo);
  if TypeData <> nil then begin
    FMinValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MinValue;
    FMaxValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MaxValue;
  end;

{$IFDEF NEXTGEN}
  TypeName := GetTypeName(FTypeInfo);
{$ELSE}
  TypeName := string(FTypeInfo.Name);
{$ENDIF}

  FInternalType := (TypeName <> '') and (TypeName[1] = '_');
end;
{$endif}

修改相应的TxxxUniProvider.pas，添加

{$if FPC_FULLVERSION>=30301}

参考以下方法修改

procedure TAccessUniProvider.CreateConnectionOptions;
{$if FPC_FULLVERSION>=30301}
var
   tmpOption: TEnumeratorOption;
{$endif}
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TBooleanOption.Create('ColumnWiseBinding', prColumnWiseBinding, [TAccessConnection], False));
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeout, [TAccessConnection], 15));
    FConnectionOptions.Add(TBooleanOption.Create('ExclusiveLock', prExclusiveLock, [TAccessConnection], False));
    FConnectionOptions.Add(TBooleanOption.Create('ExtendedAnsiSQL', prExtendedAnsiSQL, [TAccessConnection], False));
    FConnectionOptions.Add(TBooleanOption.Create('ForceCreateDatabase', prForceCreateDatabase, [TAccessConnection], False));
    FConnectionOptions.Add(TStringOption.Create('SystemDatabase', prSystemDatabase, [TAccessConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TAccessConnection], False));
    {$if FPC_FULLVERSION>=30301}
    tmpOption:=TEnumeratorOption.Create('DriverVersion', prDriverVersion, [TAccessConnection], Variant(dvAuto));
    tmpOption.SetTypeInfo(TypeInfo(TDriverVersion));
    FConnectionOptions.Add(tmpOption);
    {$else}
    FConnectionOptions.Add(TEnumeratorOption.Create('DriverVersion', prDriverVersion, [TAccessConnection], Variant(dvAuto), TypeInfo(TDriverVersion)));
    {$endif}
  end;
end;

procedure TAccessUniProvider.CreateSQLOptions;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
    FSQLOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TAccessCommand], 0));
  end;
end;

procedure TAccessUniProvider.CreateDataSetOptions;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TAccessRecordSet], 0));
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TAccessRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TAccessRecordSet], True));
  end;
end;

相关单元按以上方法修改后就能交叉编译
注意（2024-11-07更新）：
unidac 10.3.0及之后的版本UniProvider中的TEnumeratorOption = class(TOption)删除了原来的procedure SetTypeInfo(typeInfo: PTypeInfo)，按上述方法编译时会出错。
添加下面红色代码就可以。

  TEnumeratorOption = class(TOption)
  private
    FTypeInfo: PTypeInfo;
    FMinValue: integer;
    FMaxValue: integer;
    FInternalType: boolean;
  protected
    procedure InternalGetValuesList(List: TStrings); override;
  public
    procedure SetTypeInfo(typeInfo: PTypeInfo);
    {$if FPC_FULLVERSION<30301}
    constructor Create(const OptionName: string; InternalIndex: integer; InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);
    {$endif}
    function GetAsString(const Value: variant): string; override;
    function GetAsNative(const Value: string): variant; override;

    function CheckValue(const Value: string): boolean; override;
  end;

procedure TEnumeratorOption.SetTypeInfo(typeInfo: PTypeInfo);
var
  TypeData: PTypeData;
  TypeName: string;
begin
  FTypeInfo := TypeInfo;
  TypeData := GetTypeData(FTypeInfo);
  if TypeData <> nil then begin
    FMinValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MinValue;
    FMaxValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MaxValue;
  end;

{$IFDEF NEXTGEN}
  TypeName := GetTypeName(FTypeInfo);
{$ELSE}
  TypeName := string(FTypeInfo.Name);
{$ENDIF}

  FInternalType := (TypeName <> '') and (TypeName[1] = '_');
end;

{$if FPC_FULLVERSION<30301}
constructor TEnumeratorOption.Create(const OptionName: string; InternalIndex: integer;
  InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);
var
  TypeData: PTypeData;
  TypeName: string;
begin

  inherited Create(OptionName, InternalIndex, InternalClasses, DefaultValue);

  FTypeInfo := TypeInfo;
  TypeData := GetTypeData(FTypeInfo);
  if TypeData <> nil then begin
    FMinValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MinValue;
    FMaxValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MaxValue;
  end;

{$IFDEF NEXTGEN}
  TypeName := GetTypeName(FTypeInfo);
{$ELSE}
  TypeName := string(FTypeInfo.Name);
{$ENDIF}

  FInternalType := (TypeName <> '') and (TypeName[1] = '_');
end;
{$endif}

2025-08-18更新方法：
1、UniProvider.pas新的修改方案：
将

private
    FOptionName: string;
    FInternalIndex: integer;
    FInternalClasses: TClassArray;
    FDefaultValue: variant;

改到public

  TOption = class
  private
    FOnGetValuesList: TOnGetValuesList;
    FOnAssignValue: TOnAssignValue;
  protected

    procedure ValidationError(const Value: string);

    procedure InternalGetValuesList(List: TStrings); virtual;
  public
    FOptionName: string;
    FInternalIndex: integer;
    FInternalClasses: TClassArray;
    FDefaultValue: variant;
    constructor Create(const OptionName: string; InternalIndex: integer; InternalClasses: array of TClass;
      DefaultValue: variant; OnAssign: TOnAssignValue = nil); overload;

    function GetDefaultValue: variant;

    function GetAsString(const Value: variant): string; virtual;
    function GetAsNative(const Value: string): variant; virtual;

  TEnumeratorOption = class(TOption)
  private
    FTypeInfo: PTypeInfo;
    FMinValue: integer;
    FMaxValue: integer;
    FInternalType: boolean;
  protected
    procedure InternalGetValuesList(List: TStrings); override;
  public
    {$if FPC_FULLVERSION<30301}
    constructor Create(const OptionName: string; InternalIndex: integer; InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);
    {$else}
    procedure SetTypeInfo(typeInfo: PTypeInfo);
    {$endif}
    function GetAsString(const Value: variant): string; override;
    function GetAsNative(const Value: string): variant; override;

    function CheckValue(const Value: string): boolean; override;
  end;

添加function EnumeratorOptionAdd(const OptionName: string; InternalIndex: integer;

InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo):TEnumeratorOption;声明

  procedure FillOptionsList(const OptionPrefix: string; OptionsList: TOptionsList; List: TStrings);
  procedure GetOptionValuesList(const OptionName: string; OptionsList: TOptionsList; List: TStrings);
  procedure ExtractOption(const Str: string; var OptionPrefix, OptionName, OptionValue: string);
  procedure WriteOptions(OptionsList: TOptionsList; List: TStrings; DestClass: TClass; SetPropFunc: TSetPropFunc);
  procedure SetSpecificOption(Connection: TCustomDAConnection; const Name, Value: string);
  procedure CheckProviderName(const ProviderName: string);
  function EnumeratorOptionAdd(const OptionName: string; InternalIndex: integer;
    InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo):TEnumeratorOption;

var
  UniProviders: TUniProviders;
  
implementation

uses
  CRFunctions, DAConsts, UniConsts, Uni;

将constructor TEnumeratorOption.Create(const OptionName: string; InternalIndex: integer;
InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);按以下修改：

{ TEnumeratorOption }
{$if FPC_FULLVERSION<30301}
constructor TEnumeratorOption.Create(const OptionName: string; InternalIndex: integer;
  InternalClasses: array of TClass; DefaultValue: variant; TypeInfo: PTypeInfo);
var
  TypeData: PTypeData;
  TypeName: string;
begin
  inherited Create(OptionName, InternalIndex, InternalClasses, DefaultValue);

  FTypeInfo := TypeInfo;
  TypeData := GetTypeData(FTypeInfo);
  if TypeData <> nil then begin
    FMinValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MinValue;
    FMaxValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MaxValue;
  end;

{$IFDEF NEXTGEN}
  TypeName := GetTypeName(FTypeInfo);
{$ELSE}
  TypeName := string(FTypeInfo.Name);
{$ENDIF}

  FInternalType := (TypeName <> '') and (TypeName[1] = '_');
end;
{$endif}

procedure TEnumeratorOption.SetTypeInfo(typeInfo: PTypeInfo);
var
  TypeData: PTypeData;
  TypeName: string;
begin
  FTypeInfo := TypeInfo;
  TypeData := GetTypeData(FTypeInfo);
  if TypeData <> nil then begin
    FMinValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MinValue;
    FMaxValue := TypeData{$IFNDEF CLR}^{$ENDIF}.MaxValue;
  end;

{$IFDEF NEXTGEN}
  TypeName := GetTypeName(FTypeInfo);
{$ELSE}
  TypeName := string(FTypeInfo.Name);
{$ENDIF}

  FInternalType := (TypeName <> '') and (TypeName[1] = '_');
end;

function EnumeratorOptionAdd(const OptionName: string; InternalIndex: integer;
  InternalClasses: array of TClass; DefaultValue: variant; _TypeInfo: PTypeInfo):TEnumeratorOption;
var
  tmpOption: TEnumeratorOption;
  i:Integer;
begin
  tmpOption:= TEnumeratorOption.Create;//(OptionName, InternalIndex, InternalClasses, DefaultValue);
  tmpOption.FOptionName:= OptionName;
  tmpOption.FInternalIndex := InternalIndex;
  tmpOption.FDefaultValue := DefaultValue;

  SetLength(tmpOption.FInternalClasses, Length(InternalClasses));
  for i := 0 to High(InternalClasses) do
    tmpOption.FInternalClasses[i] := InternalClasses[i];
  tmpOption.SetTypeInfo(_TypeInfo);
  Result:=tmpOption;
end;

2、将PostgreSQLUniProvider.pas的TEnumeratorOption.Createg改为{$if FPC_FULLVERSION>30202}EnumeratorOptionAdd{$else}TEnumeratorOption.Create{$endif}

    FConnectionOptions.Add(TEnumeratorOption.Create('IPVersion', prIPVersion, [TPgSQLConnection, TPgConnectionParameters], Variant(ivIPv4), TypeInfo(TIPVersion)));

改为:

    FConnectionOptions.Add({$if FPC_FULLVERSION>30202}EnumeratorOptionAdd{$else}TEnumeratorOption.Create{$endif}('IPVersion', prIPVersion, [TPgSQLConnection, TPgConnectionParameters], Variant(ivIPv4), TypeInfo(TIPVersion)));

其他数据库的接口也按这个方法替换。

posted on 2024-02-07 11:35 秋·风阅读(591) 评论(0) 收藏举报

刷新页面返回顶部

秋·风

公告