お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"dBASEの削除関連をまとめて"

この発言に対し以下のコメントが寄せられています
#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 を9つ貼ってそれぞれの OnClick と、TForm.OnCreate を設定 する。TTable,TDataSource,TDBGrid を1つづつ貼って、(A)を目的の データベース名にするだけでOKです。 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'; //(A) 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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum