この発言に対し以下のコメントが寄せられています

#01308　高田　浩        さん　RE:dBASEの削除関連をまとめて




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

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

dBASEは削除するとそのレコードの先頭にデリートマークとして"*"が
書き込まれます。dBASE特有のものなので TTable にはそれを扱うた
めのプロパティやメソッドがないようです。

そこでdBASEの削除関連をまとめて紹介します。

現在のテーブルを var で宣言した Alias 変数に代入することで汎用
にしているので、例示のように Alias := Table1 などとしてお使いく
ださい。

使用条件はそれぞれのバージョンでの xBASE に従ってください。
（多分、あまり差はないと思う）


-----------------------------------------------------------------
unit xBaseSub;

interface

uses BDE,DB,DBTables,Dialogs,SysUtils;

  procedure xDelete ;                 {DELETE}
  procedure xPack ;                   {PACK}
  procedure xRecall ;                 {RECALL}
  procedure xRecallAll ;              {RECALL ALL}
  procedure xZap ;                    {ZAP}

  procedure xSetExclusiveOn ;         {SET EXCLUSIVE ON}
  procedure xSetExclusiveOff ;        {SET EXCLUSIVE OFF}
  procedure xSetDeletedOn ;           {SET DELETED ON}
  procedure xSetDeletedOff ;          {SET DELETED OFF}

  function xDeleted                   {DELETED()}
      : boolean;

var
  Alias : TTable;

implementation

{DELETE}

procedure xDelete;
begin with Alias do begin
  //Delete;{通常はこちらを使用します}
  UpdateCursorPos;
  Check(DbiDeleteRecord(Handle,nil));
  refresh;{もしくは resync([]);}
end;end;

{PACK}

procedure xPack;
begin with Alias do begin
  if Exclusive then
    Check(DbiPackTable(DBHandle,Handle,nil,szDBASE,true))
  else
    ShowMessage('排他モードではありません');
  refresh;
end;end;

{RECALL}

procedure xRecall;
var
  curProp:curProps;
begin with Alias do begin
  UpdateCursorPos;
  DisableControls;
  Check(DbiGetCursorProps(Handle,curProp));
  if curProp.bDeletedOn then begin
    if xDeleted then begin
      Check(DbiUndeleteRecord(Handle));
      ShowMessage('1 レコード 復元されました');
    end;
  end else
    ShowMessage('削除マーク付きレコードの表示モードではありません');
  refresh;
end;end;

{RECALL ALL}

procedure xRecallAll;
var
  curProp:curProps;
  Cnt:double;
begin with Alias do begin
  UpdateCursorPos;
  Check(DbiGetCursorProps(Handle,curProp));
  if curProp.bDeletedOn then begin
    first;
    Cnt:=0;
    while not Eof do begin
      if xDeleted then begin
        xRecall;
        Cnt:=Cnt+1;
      end;
      next;
    end;
    ShowMessage(FloatToStr(Cnt)+'レコード 復元されました');
    first;
    refresh;
  end else
    ShowMessage('削除マーク付きレコードの表示モードではありません');
  EnableControls;
end;end;

{ZAP}

procedure xZap;
begin with Alias do begin
  if Exclusive then
    //EmptyTable;{通常はこちたを使用します}
    Check(DbiEmptyTable(DBHandle,Handle,nil,szDBASE))
  else
    ShowMessage('排他モードではありません');
  refresh;
end;end;

{SET EXCLUSIVE ON/OFF}

procedure xSetExclusiveOn;
begin with Alias do begin
  close;
  exclusive:=true;
  open;
  refresh;
end;end;
procedure xSetExclusiveOff;
begin with Alias do begin
  close;
  exclusive:=false;
  open;
  refresh;
end;end;

{SET DELETED ON/OFF}

procedure xSetDeletedOn;
begin with Alias do begin
  Check(DbiSetProp(hDBIObj(Handle),
curSOFTDELETEON,LongInt(false)));
  refresh;
end;end;

procedure xSetDeletedOff;
begin with Alias do begin
  Check(DbiSetProp(hDBIObj(Handle), curSOFTDELETEON,LongInt(true)));
  refresh;
end;end;

{DELETED()}

function xDeleted: boolean;
var
  recProp:RECProps;
begin with Alias do begin
  UpdateCursorPos;
  Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @recProp));
  xDeleted := recProp.bDeleteFlag;
end;end;

end.

-------------------------------------------------------------------
【実行例】

Button を９つ貼ってそれぞれの OnClick と、TForm.OnCreate を設定
する。TTable,TDataSource,TDBGrid を１つづつ貼って、(Ａ)を目的の
データベース名にするだけでＯＫです。

dBASEのバージョンは[3][4]だけは大丈夫かと、、。

implementation

uses xBaseSub;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DataSource1.DataSet:=Table1;
  DBGrid1.DataSource:=DataSource1;
  Alias:=Table1;
  with Alias do begin
    TableName:='C:\DOS\AP\DBASE\SAMPLES\商品.DBF'; //(Ａ)
    TableType:=ttDBase;
    Exclusive:=false;
    Open;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin xSetDeletedOn end;

procedure TForm1.Button2Click(Sender: TObject);
begin xSetDeletedOff end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if xDeleted then ShowMessage('削除されています')
              else ShowMessage('削除されていません');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin xRecall end;

procedure TForm1.Button5Click(Sender: TObject);
begin xPack end;

procedure TForm1.Button6Click(Sender: TObject);
begin xDelete end;

procedure TForm1.Button7Click(Sender: TObject);
begin xZap end;

procedure TForm1.Button8Click(Sender: TObject);
begin xRecallAll end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  if Alias.Exclusive then begin
    xSetExclusiveOff;
    ShowMessage('共有モードにしました');
  end else begin
    xSetExclusiveOn;
    ShowMessage('排他モードにしました');
  end;
end;


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

xBase.pas 開発資料収集を SBORLAND (4)dBASE 会議室に展開中

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


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

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

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