const
  TABLE_POST_INTERVAL=25;        // table posts, per thread in ms

type
  // dbsession
  TDBSession=class
  private
    FSession:TDBISAMSession;
    FDatabase:TDBISAMDatabase;
    FTable:TDBISAMTable;
  end;

  // dbthread
  TDBThread=class(TThread)
  private
    FTerminated:Boolean;
    FEnableUserMinorVersion:Boolean;
    FMinorVersion: Integer;
    FID:Integer;
    FDBSession:TDBSession;
  protected
    procedure Execute; override;
    constructor Create(lID:Integer;lEnableUserMinorVersion:Boolean);
  public
    destructor Destroy; override;
  end;

  TfrmMain = class(TForm)
    EThreads: TEdit;
    Label1: TLabel;
    BCreateWithout: TButton;
    MThreads: TMemo;
    BCreateWith: TButton;
    procedure BCreateWithoutClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure BCreateWithClick(Sender: TObject);
  private
    { Private declarations }
    FThreads:TList;
    FID:Integer;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

// log message
procedure LogMsg(lString:String);

begin
  frmMain.MThreads.Lines.Add(lString);
end;

// click, create threads without userminorversion
procedure TfrmMain.BCreateWithoutClick(Sender: TObject);

var
  lDBThread:TDBThread;
  lThreads,loop1:Integer;

begin
  try
    try
      lThreads:=StrToInt(EThreads.Text);
    except
      lThreads:=1;
    end;
    for loop1:=0 to lThreads-1 do
      begin
        Inc(FID);
        lDBThread:=TDBThread.Create(FID,FALSE);
        if lDBThread<>NIL then
          begin
            FThreads.Add(lDBThread);
            with lDBThread do
              begin
                FreeOnTerminate:=FALSE;
                Resume;
              end;
          end;
      end;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TfrmMain.BCreateWithoutClick');
  end;
end;

// click, create threads with userminorversion
procedure TfrmMain.BCreateWithClick(Sender: TObject);

var
  lDBThread:TDBThread;
  lThreads,loop1:Integer;

begin
  try
    try
      lThreads:=StrToInt(EThreads.Text);
    except
      lThreads:=1;
    end;
    for loop1:=0 to lThreads-1 do
      begin
        Inc(FID);
        lDBThread:=TDBThread.Create(FID,TRUE);
        if lDBThread<>NIL then
          begin
            FThreads.Add(lDBThread);
            with lDBThread do
              begin
                FreeOnTerminate:=FALSE;
                Resume;
              end;
          end;
      end;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TfrmMain.BCreateWithClick');
  end;
end;

// close
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

var
  lDBThread:TDBThread;
  loop1:Integer;
  lTicks:Cardinal;

begin
  try
    for loop1:=FThreads.Count-1 downto 0 do
      begin
        lDBThread:=TDBThread(FThreads[loop1]);
        if lDBThread<>NIL then
          with lDBThread do
            begin
              LogMsg('Closing Thread ('+IntToStr(lDBThread.FID)+')');

              // terminate thread
              Terminate;

              // wait for terminate
              lTicks:=GetTickCount;
              while (not FTerminated) and
                (GetTickCount-lTicks<1000) do
                Sleep(25);

              // ungraceful?
              if not FTerminated then
                LogMsg('Closed Ungraceful Thread ('+IntToStr(lDBThread.FID)+')');

              // destroy
              Free;
            end;
        FThreads.Delete(loop1);
      end;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TfrmMain.FormClose');
  end;
end;

// create
procedure TfrmMain.FormCreate(Sender: TObject);

begin
  try
    FThreads:=TList.Create;
    FID:=0;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TfrmMain.FormCreate');
  end;
end;

// tdbthread, constructor
constructor TDBThread.Create(lID:Integer;lEnableUserMinorVersion:Boolean);

begin
  try
    // init
    FTerminated:=TRUE;
    FEnableUserMinorVersion:=lEnableUserMinorVersion;

    // init, session id
    FID:=lID;

    // init, dbsession
    FDBSession:=TDBSession.Create;
    if FDBSession<>NIL then
      begin
        with FDBSession do
          begin
            // create session
            FSession:=TDBISAMSession.Create(NIL);
            if FSession<>NIL then
              begin
                FSession.SessionName:='Session'+IntToStr(lID);
                LogMsg('Creating Session ('+IntToStr(lID)+')');

                // create database
                FDatabase:=TDBISAMDatabase.Create(NIL);
                if FDatabase<>NIL then
                  with FDatabase do
                    begin
                      SessionName:=FSession.SessionName;
                      DatabaseName:='DB';
                      Directory:=ExtractFilePath(Application.ExeName);
                      Connected:=TRUE;

                      // create table
                      FTable:=TDBISAMTable.Create(NIL);
                      if FTable<>NIL then
                        begin
                          FTable.SessionName:=FSession.SessionName;
                          FTable.DatabaseName:=FDatabase.DatabaseName;
                        end;
                    end;
              end;

            // prepare table
            if FTable<>NIL then
              with FTable do
                begin
                  if not Active then
                    TableName:=ExtractFilePath(Application.ExeName)+'DBTable';
                  if not Exists then
                    begin
                      with FieldDefs do
                        begin
                          Add('Field1',ftString,250,FALSE);
                        end;
                      CreateTable(0,1,1234);
                      LogMsg('Creating Table');
                    end;
                end;
          end;
      end;

    // inherited
    inherited Create(TRUE);
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TDBThread.Create');
  end;
end;

// tdbthread, destructor
destructor TDBThread.Destroy;

begin
  try
    // destroy
    if FDBSession<>NIL then
      with FDBSession do
        begin
          if FDatabase<>NIL then
            FDatabase.Connected:=FALSE;
          if FTable<>NIL then
            FreeAndNIL(FTable);
          if FDatabase<>NIL then
            FreeAndNIL(FDatabase);
          if FSession<>NIL then
            FreeAndNIL(FSession);
        end;

    // inherited
    inherited Destroy;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TDBThread.Destroy');
  end;
end;

// tdbthread, execute
procedure TDBThread.Execute;

begin
  try
    FTerminated:=FALSE;
    while not Terminated do
      begin
        if FDBSession<>NIL then
          with FDBSession do
            if FTable<>NIL then
              with FTable do
                begin
                  // PROBLEM HERE
                  // with appends it causes #9218 errors
                  // with edits and deletes it cause other DBISAM errors
                  // and it causes complete database corruption
                  if FEnableUserMinorVersion then
                    FMinorVersion:=UserMinorVersion;

                  // append
                  IndexName:='';
                  if not Active then
                    Open;
                  Append;
                  FieldByName('Field1').AsString:='Thread '+IntToStr(FID)+' Posted '+DateTimeToStr(Now);
                  Post;
                  Close;
                  Sleep(TABLE_POST_INTERVAL);
                end;
      end;
    FTerminated:=TRUE;
  except
    on e:exception do
      LogMsg('Exception: ['+e.message+'] TDBThread.Execute');
  end;
end;