【原创】修复freepascal自带的tdbf组件使用中文字段时转换为utf8时可能出现文字错的问题

秋·风 / 2024-10-13 / 原文

tdbf不支持utf8，中文字段名称转utf8时可能出现文字错：

原因：

tdbf在处理字段名称使用AnsiUpperCase将字段名称转为大写，如果为中文字段名，在转为utf8时可能有问题。

修改方法：

打开fpcsrc\packages\fcl-db\src\dbase\dbf_dbffile.pas
修改第816/1236/1246/1842/2758行，将AnsiUpperCase改为UpperCase。
重新编译fpcsrc源码或将dbase文件夹拷贝到project目录，重新编译project
测试代码:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, dbf, DB, Forms, Controls, Graphics, Dialogs, DBGrids,lazutf8,
  StdCtrls, LConvEncoding;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    Dbf1: TDbf;
    dbgrid1 : tdbgrid;
    Memo1: TMemo;

    function Dbf1Translate(Dbf: TDbf; Src, Dest: PChar; ToOem: Boolean
      ): Integer;
    procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
  dbf1.Open;
  caption := inttostr(dbf1.CodePage);

  for i := 0 to Dbf1.Fields.Count-1 do
  begin
   if Dbf1.Fields[i] is TStringField then
        TStringField(Dbf1.Fields[i]).Transliterate := true;
   memo1.Lines.Add(CP936ToUTF8(dbf1.Fields[i].FieldName));
   dbgrid1.Columns[i].Title.Caption:=CP936ToUTF8(dbf1.Fields[i].FieldName);
  end;
end;

function TForm1.Dbf1Translate(Dbf: TDbf; Src, Dest: PChar; ToOem: Boolean
  ): Integer;
begin
  StrCopy(Dest, PChar(CP936ToUTF8(Src)));
  Result := StrLen(Dest);
end;

end.

object Form1: TForm1
  Left = 405
  Height = 804
  Top = 250
  Width = 1524
  Caption = 'Form1'
  ClientHeight = 804
  ClientWidth = 1524
  DesignTimePPI = 144
  OnCreate = FormCreate
  object DBGrid1: TDBGrid
    Left = 0
    Height = 408
    Top = 0
    Width = 1524
    Align = alClient
    Color = clWindow
    Columns = <>
    DataSource = DataSource1
    TabOrder = 0
  end
  object Memo1: TMemo
    Left = 0
    Height = 396
    Top = 408
    Width = 1524
    Align = alBottom
    Lines.Strings = (
      'Memo1'
    )
    TabOrder = 1
  end
  object Button1: TButton
    Left = 1284
    Height = 38
    Top = 480
    Width = 112
    Caption = 'Button1'
    TabOrder = 2
  end
  object Dbf1: TDbf
    DateTimeHandling = dtDateTime
    FilePath = 'C:\Users\szlbz\Downloads\dbfTest\'
    IndexDefs = <>
    TableName = '区划信息.dbf'
    TableLevel = 30
    UseAutoInc = True
    OnTranslate = Dbf1Translate
    FilterOptions = []
    Left = 180
    Top = 108
  end
  object DataSource1: TDataSource
    DataSet = Dbf1
    Left = 60
    Top = 108
  end
end