unit PxBuildr;

{¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤}
{						}
{       by Randy Beck                           }
{	    http://www.randybeck.com            }
{	    email:  rb@randybeck.com		}
{                                               }
{¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤}

// This unit contains a procedure to easily create Paradox tables
// with optional index files.
//
// Here is a sample usage:
//
// Success := PxBuild(Database1.Handle, 'Example1.db',
//                NewSItem('Account, N*',
//                NewSItem('Transaction, S*',
//                NewSItem('Name, A20+',
//                NewSItem('Amount, $',
//                         nil))))
//                );
//
// Each field must be defined by field name and type, followed by
// an optional asterisk ("*") and/or plus ("+"), to indicate
// a key field, or index.
//
// Note that this procedure has undergone comparatively little
// testing.
//
// There is a similar function for the Paradox Engine on my web
// site, buried in my tvDMX project source code.

interface

uses
  SysUtils, DBTables, BDE;

type
  PSItem = ^TSItem;
  TSItem =  RECORD
      Value: pchar;
      Next: PSItem;
  end;

function  NewSItem(const S: string; ANext: PSItem) : PSItem;
procedure DisposeSItem(AItem: PSItem);
function  PxBuild(hDb: hDBIDb; TblName: string; AFields: PSItem) : boolean;

implementation

function  NewSItem(const S: string; ANext: PSItem) : PSItem;
var  Item: PSItem;
begin
  New(Item);
  Item^.Value := StrNew(@S[1]);
  Item^.Next := ANext;
  NewSItem := Item;
end;

procedure DisposeSItem(AItem: PSItem);
begin
  If AItem <> nil then
  begin
    StrDispose(AItem^.Value);
    Dispose(AItem);
  end;
end;


type
  pFLDDescArray = ^tFLDDescArray;
  tFLDDescArray = packed array[1..255] of FLDDesc;


function  PxBuild(hDb: hDBIDb; TblName: string; AFields: PSItem) : boolean;
var  NewFlds: pFLDDescArray;
     TblDesc: CRTblDesc;
     TheIndex: IDXDesc;
     DBType: string;
     i,FNum: integer;
     FldCount,KeyFields: integer;
     Err,W: word;
     F: PSItem;
     N,T: string[80];
     SecInx: set of byte;

    procedure CheckT;
    begin
      If (T[length(T)] = '*') then KeyFields := FNum;
      If (T[length(T)] = '+') then SecInx := SecInx + [FNum];
      If (T[length(T)] in ['*','+']) then Dec(T[0]);
    end;

begin
  Result := FALSE;
  FldCount := 0;
  F := AFields;
  While (F <> nil) do
  begin
    Inc(FldCount);
    F := F^.Next;
  end;

  If (FldCount > 0) then
  begin
    NewFlds := AllocMem(FldCount * sizeof(FLDDesc));
    FillChar(NewFlds^, FldCount * sizeof(FLDDesc), 0);
    try

      F := AFields;
      KeyFields := 0;
      FNum := 0;
      While (F <> nil) do
      begin
        If (F^.Value <> nil) then
        begin
          Inc(FNum);
          N := strpas(F^.Value);
          T := N;
          While not (N[length(N)] in [#0,' ',',']) do Dec(N[0]);
          Delete(T,1,length(N));
          While (N[length(N)] in [' ',',']) do Dec(N[0]);
          CheckT;
          CheckT;

          With NewFlds^[FNum] do
          begin
            If T = '' then
            begin
            end
            else begin
              Case upcase(T[1]) of
                'A':  iFldType := fldPDXCHAR;       // Alpha (string)
                'N':  iFldType := fldPDXNUM;        // Numeric
                '$':  iFldType := fldPDXMONEY;      // Money
                'D':  iFldType := fldPDXDATE;       // Date
                'S':  iFldType := fldPDXSHORT;      // Short
                'M':  iFldType := fldPDXMEMO;       // Text Memo       (blob)
                'B':  iFldType := fldPDXBINARYBLOB; // Binary data     (blob)
                'F':  iFldType := fldPDXFMTMEMO;    // Formatted text  (blob)
                'O':  iFldType := fldPDXOLEBLOB;    // OLE object      (blob)
                'G':  iFldType := fldPDXGRAPHIC;    // Graphics object (blob)
                   // fldPDXBLOB = fldPDXMEMO;
                'I':  iFldType := fldPDXLONG;       // Long
                'T':  iFldType := fldPDXTIME;       // Time
                '@':  iFldType := fldPDXDATETIME;   // Time Stamp
                'L':  iFldType := fldPDXBOOL;       // Logical
                '+':  iFldType := fldPDXAUTOINC;    // Auto increment (long)
                'Y':  iFldType := fldPDXBYTES;      // Fixed number of bytes
                '#':  iFldType := fldPDXBCD;        // BCD (32 digits)
              else  begin
                    end;
              end;

              iFldNum := FNum;
              If length(N) > 1 then
                Move(N[1], szName[0], length(N));
              If length(T) > 1 then
              begin
                iUnits1 := StrToIntDef(copy(T,2,pred(length(T))), 0);
              end;
            end;
          end;
        end;
        F := F^.Next;
      end;

      SetLength(DBType, StrLen(PChar(DBType)));
      DBType := szParadox;

      FillChar(TblDesc, sizeof(TblDesc), 0);
      StrPCopy(TblDesc.szTblName, TblName);
      StrPCopy(TblDesc.szTblType, DBType);
      TblDesc.iFldCount := FldCount;

      TblDesc.pFldDesc := pFLDDesc(NewFlds);

      Err := DbiCreateTable(hDb, True, TblDesc);
      Check(Err);

      If KeyFields > 0 then
      begin
        FillChar(TheIndex, sizeof(TheIndex), 0);
        With TheIndex do
        begin
          iIndexId := 0;
          bPrimary := TRUE;
          bUnique := TRUE;
          bDescending := FALSE;
          bMaintained := TRUE;
          bSubset := FALSE;
          bExpIdx := FALSE;
          iFldsInKey := KeyFields;
          For i := 1 to KeyFields do
            aiKeyFld[pred(i)] := i;
          bCaseInsensitive := FALSE;
        end;
        Err := DbiAddIndex(hDb, nil, pchar(TblName), szParadox, TheIndex, nil);
        Check(Err);

        F := AFields;
        FNum := 0;
        While (F <> nil) do
        begin
          If (F^.Value <> nil) then
          begin
            Inc(FNum);
            N := strpas(F^.Value);
            T := N;
            While not (N[length(N)] in [#0,' ',',']) do Dec(N[0]);
            Delete(T,1,length(N));
            While (N[length(N)] in [' ',',']) do Dec(N[0]);

            If pos('+', T) > 0 then
            begin
              FillChar(TheIndex, sizeof(TheIndex), 0);
              With TheIndex do
              begin
                iIndexId := 0;
                StrPCopy(szName, N);
                bPrimary := FALSE;
                bUnique := FALSE;
                bDescending := FALSE;
                bMaintained := TRUE;
                bSubset := FALSE;
                bExpIdx := FALSE;
                iFldsInKey := 1;
                aiKeyFld[0] := FNum;
                bCaseInsensitive := FALSE;  // ???
              end;
              Check(DbiAddIndex(hDb, nil, pchar(TblName), szParadox, TheIndex, nil));
            end;

          end;

          F := F^.Next;
        end;
      end;

      Result := TRUE;
    finally
      FreeMem(NewFlds, FldCount * sizeof(FLDDesc));
      While (AFields <> nil) do
      begin
        F := AFields;
        AFields := AFields^.Next;
        StrDispose(F^.Value);
        Dispose(F);
      end;
    end;
  end;
end;


end.