秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

出现的问题:

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

问题原因:

tdbf在处理字段名称使用AnsiUpperCase将字段名称转为大写,使用AnsiUpperCase需要配置,但不知道是怎样配置才可以将中文字段名转为utf8时不会有问题,我这个方法比较粗暴,直接将AnsiUpperCase改为UpperCase就能解决

修改方法:

1、打开fpcsrc\packages\fcl-db\src\dbase\dbf_dbffile.pas
修改816/1236/1246/1842/2758行,将AnsiUpperCase改为UpperCase。
2、打开fpcsrc\packages\fcl-db\src\dbase\dbf.pas
修改3144/3152行,将AnsiUpperCase改为UpperCase。
3、打开fpcsrc\packages\fcl-db\src\dbase\dbf_idxfile.pas
修改4185/4190行,将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

修改后编译的demo:

 

posted on 2024-10-12 20:27  秋·风  阅读(48)  评论(0编辑  收藏  举报