こんにちは、高田浩です。

現在、xBase.pas なる xBASE言語ライク環境の開発中なのですが、
その中からの紹介です。

CreateTable では実現できない dBase 形式の数値型の桁指定です。
それを所定のフィールド定義が書かれたテキストファイルで用意し
て、それを読み込んで DBF を生成するものです。

構造定義ファイルは下記の[AllFld.STR]でテストしてみて下さい。
尚、日付型など幅が固定のものは指定しなくても生成します。

テーブル生成の条件はそれぞれのdBASEバージョン( dBASE III plus ,
dBASE IV , dBXL )での規則に従ってください。
従わなくても生成されてしまいます。が、dBASE側で誤動作します。


xBASEコマンドの CREATE FROM といったところ。
-----------------------------------------------------------------
unit xBaseSub;

interface
uses BDE,DB,DBTables,Classes,SysUtils,Forms;

  procedure xCreateFrom(        {CREATE FROM}
     StrFile      : string;        {参照する構造定義ファイル名}
     NewFile      : string         {生成するDBFファイル名}
     );

    {本来の使用では COPY STRUCTURE EXTENDED で作成したデータ構造}
    {ファイル[DBF]から生成するのですが、汎用型にするために以下の}
    {構造を記述したテキストファイルを参照して作成する方法にしてい}
    {ます。                                                     }

    {","で区切って「名」「型」「幅」「小数桁」「コメント」      }
    {注：全角空白文字は使用しないこと、型は必ず半角大文字です   }

    {[AllFld.STR]仮称                                           }
    {文字  , C , 10, 0 , 最大254バイト                          }
    {日付  , D ,  8, 0 , 固定8バイト                            }
    {倫理  , L ,  1, 0 , 固定1バイト                            }
    {メモ  , M ,  0, 0 , 固定10バイト                           }
    {数値  , N , 15, 0 , 整数部15桁・最大19バイト               }
    {数値  , N ,  5, 3 , 小数部3桁・最大19バイト(幅>=小数桁+2)  }

implementation

procedure xCreateFrom(StrFile,NewFile:string);
type
  TStru = array[ 1..128 , 1..5 ] of string;
var
  NewDbf : TTable;
  Stru : TStru;
  StruList : TStrings;
  LineLen     : integer;
  LineStr,FildStr,Str : string;
  ListCnt,FildCnt,LCnt,SCnt : integer;
  i : integer;
begin
  StruList := TStringList.Create;
  NewDbf := TTable.Create(Application);
  try
    {フィールドの情報を取得する}
    StruList.LoadFromFile(StrFile);
    ListCnt  := StruList.Count;
    for LCnt := 1 to ListCnt do begin
      LineStr := StruList.Strings[LCnt - 1 ];
      LineLen := Length(WideString(LineStr)) + 1;
      FildStr := '';
      FildCnt := 1;
      Str:='';
      for SCnt := 1 to LineLen do begin
        Str := Copy(WideString(LineStr),SCnt,1);
        if ( Str <> ',' ) and ( SCnt < LineLen ) then
          FildStr := FildStr + Str
        else begin
          case FildCnt of
            1: Stru[LCnt,1] := trim(FildStr);
            2: Stru[LCnt,2] := trim(FildStr);
            3: Stru[LCnt,3] := trim(FildStr);
            4: Stru[LCnt,4] := trim(FildStr);
            5: Stru[LCnt,5] := trim(FildStr);
          end;
          inc(FildCnt);
          FildStr := '';
        end
      end;
    end;
    {テーブルの作成}
    with NewDbf do begin
      TableType := ttDBase;
      TableName := NewFile;
      with FieldDefs do begin
        Clear;
        for i := 1 to ListCnt do begin
          if Stru[i,2] = 'C' then
            Add(Stru[i,1], ftString, StrToInt(Stru[i,3]), false)
          else if Stru[i,2] = 'D' then
            Add(Stru[i,1], ftDate, 0, false)
          else if Stru[i,2] = 'L' then
            Add(Stru[i,1], ftBoolean, 0, false)
          else if Stru[i,2] = 'M' then
            Add(Stru[i,1], ftMemo, 0, false)
          else if Stru[i,2] = 'N' then begin
            Add(Stru[i,1], ftBCD, 0, false);
            Items[i-1].Precision := StrToInt(Stru[i,3]);
            Items[i-1].Size      := StrToInt(Stru[i,4]);
          end;
        end;
      end;
      CreateTable;
    end;
  finally
    StruList.Free;
    NewDbf.Free;
  end;
end;

end.

-------------------------------------------------------------------

実行例

procedure TForm1.Button1Click(Sender: TObject);
begin
  xCreateFrom('C:\顧客名簿.STR','C:\顧客名簿.DBF');
end;

追伸：ソースを改良したレスを下さる方は、それが xBase.pas に
　　　組み込まれることをご了解ください。

xBase.pas 開発資料収集を SBORLAND (4)dBASE 会議室に展開中･･･
xBase保護団体「xBaseを絶滅の危機から救え！」（失笑）

_/dBASE3-4形式_/VdB7&Delphi4pro_/_/KFE06073_/_/高田浩_/_/
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/01/13 -

Original document by 高田　浩        氏 ID:(KFE06073)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。