Board index » delphi » Creating Btrieve table with TITAN low-level

Creating Btrieve table with TITAN low-level

Hello !

Does anyone work with Btrieve file in Delphi using TITAN !
I don't know how to create empty files using titan Low-level
btrieve access functions, because docs are very POOR !

Thanks !

 

Re:Creating Btrieve table with TITAN low-level


Quote
Boris Lorger <boris.lor...@guest.arnes.si> wrote:
>Hello !
>Does anyone work with Btrieve file in Delphi using TITAN !
>I don't know how to create empty files using titan Low-level
>btrieve access functions, because docs are very POOR !
>Thanks !

I've got this working fine in my Titan application.  Here's a utility
unit that has some routines I call to create tables, etc.  The table
create routine is passed a btrieve file spec structure.  You need to
be familiar with btrieve to set it up.

----------------------------------------------------------------
unit BtrUtil;

interface

uses
  BSETYPES,
  BtrTypes,
  DBTables;

const
  BtrFFlVariableLen  = 1;      { Btrieve file flag option }
  BtrIdxAltColSeq    = 32;

type
  TAlternateSequence = record
                         Header : byte;
                         Name   : packed array [1..8] of char;
                         Table  : packed array [1..256] of byte;
                       end;

procedure UpperCaseACS(var ACS : TAlternateSequence);
  {-produces Alternate Collating Sequence for case-insensitive string
sorts}

procedure BtrCreateFile(FileName, OwnerName: string; var FileSpec);
  {-raises exception on failure}

function LastBtrError(Table : TTable) : integer;
  {-returns last Btrieve error for associated table; table must be
open!}

implementation

uses
  SysUtils,
  BtrLocal,
  BtrWOBJ;

{$I C:\TITAN\SOURCE\BTRIEVE.INC}  { Btrieve constants }

procedure UpperCaseACS(var ACS : TAlternateSequence);
var
  Index : integer;
begin
  ACS.Header := $AC;
  ACS.Name := 'UPPER   ';
  for Index := 1 to 97 do
    ACS.Table[Index] := Index-1;
  for Index := 98 to 123 do
    ACS.Table[Index] := Index - 33;   {convert lower to upper}
  for Index := 124 to 256 do
    ACS.Table[Index] := Index-1;
end; {procedure UpperCaseACS }

procedure Str2Array(var StrP,CharArrayP; Len: byte);
{converts a string to a character array of length - Len }
type
  ArrayType  = array[1..255] of Char;
  StringType = String;
var
  CharArray    : ArrayType absolute CharArrayP;
  St           : StringType absolute StrP;
  StrLen,Index : byte;
begin
  StrLen := Length(St);
  for Index := 1 to Len do
    if Index <= StrLen then
      CharArray[Index] := St[Index]
    else
      CharArray[Index] := ' ';
end; { procedure Str2Array }

procedure BtrCreateFile(FileName, OwnerName: string; var FileSpec);
{ note: FileSpec is left untyped in the event that a FileSpec is
passed
  which does not match the standard TFileSpecs }
var
  Status : integer;
  KeyBuf : TKeyBuffer;
  Titan : TWinBtr;
begin
  {Titan := TWinBtr.Create;}
  Titan := TWinBtr.Create(nil);
  try
    Str2Array(FileName, KeyBuf, 255);
    Titan.KeyBuffer := KeyBuf;
    Titan.KeyNumber := 0;
    Status := Titan.Special(ISAM_CREATE, addr(FileSpec),
SizeOf(TFileSpecs));
    if Status <> 0 then
      raise Exception.Create(Format('Error #%d creating
%s',[Status,FileName]));

    if OwnerName <> '' then
    begin
      { open file to set owner name }
      Titan.KeyBuffer := KeyBuf;
      Titan.KeyNumber := NORMAL;
      Status := Titan.Special(ISAM_OPEN, nil, 0);
      if Status <> 0 then
        raise Exception.Create(Format('Error #%d opening
%s',[Status,FileName]));

      Str2Array(OwnerName, KeyBuf, 255);
      Titan.KeyBuffer := KeyBuf;
      Titan.KeyNumber := 0;  { all operations require owner name; no
encryption }
      Status := Titan.Special(ISAM_SET_OWNER, addr(KeyBuf),
Length(OwnerName));
      if Status <> 0 then
        raise Exception.Create(Format('Error #%d setting owner name
for %s',[Status,FileName]));

      Status := Titan.Special(ISAM_CLOSE, nil, 0);
      if Status <> 0 then
        raise Exception.Create(Format('Error #%d closing
%s',[Status,FileName]));
    end;
  finally
    Titan.Free;
  end;
end;

function LastBtrError(Table : TTable) : integer;
  {-returns last Btrieve error for associated table; table must be
open!}
var
  Titan : TWinBtr;
begin
  Titan := GetBtrieveObject(Table);
  if Titan <> nil then
    result := Titan.Status
  else
    result := 0;
end;

end.

Re:Creating Btrieve table with TITAN low-level


Thanks for the unit Steve !

I will try to implement it in my application.
But I still have few question.

1. Is there any documentation on call Titan.Special i noticed you
are using , or any other documentation on titan functions ?
Where to find it?

2.How to fill FileSpec?

I hope i'm not bothering you too much.

Bye, Boris

Other Threads