dbunit.pas

企业进销存管理系统

        Exit;
      end;
    end
    else
    begin
      Result := False;
      Exit;
    end;
  finally
    BaseTable.Close;
  end;

  CheckList := TList.Create;
  try
    { init CheckList with an NOOP entry for each field in CheckTable }
    for i := 0 to CheckTable.FieldDefs.Count - 1 do
      CheckList.Add(Pointer(Ord(crNOOP)));

    { first check the field count }
    TableHasChanged := not (CheckTable.FieldDefs.Count = BaseTable.FieldDefs.Count);

    { Check fields }
    for i := 0 to BaseTable.FieldDefs.Count -1 do { iterate through the new table structure }
    begin
      FOpType[i] := crNOOP;  { init to NOOP ... will always override }
      { Can we find the field (by name) in the original structure }
      try
        OrigFldIndex := CheckTable.FieldDefs.IndexOf(BaseTable.FieldDefs.Items[i].Name);

        { if found, check for modifications }
        if (OrigFldIndex >= 0) then
        begin

          { get field definition reference }
          OrgFldDefs := CheckTable.FieldDefs.Items[OrigFldIndex];

          { Set the Field number to the original field location }
          pCurFld^.iFldNum := OrgFldDefs.FieldNo;

          { Has the field changed ... }

          { DataType }
          CurrentFieldHasChanged := OrgFldDefs.DataType <> BaseTable.FieldDefs.Items[i].DataType;

          { Size }
          if not CurrentFieldHasChanged then
            CurrentFieldHasChanged := OrgFldDefs.Size <> BaseTable.FieldDefs.Items[i].Size;

          { Required }
          if not CurrentFieldHasChanged then
            CurrentFieldHasChanged := OrgFldDefs.Required <> BaseTable.FieldDefs.Items[i].Required;

          { Set the Restructure operation type according to if the field has changed }
          if CurrentFieldHasChanged then
          begin
            TableHasChanged := True;
            FOpType[i] := crMODIFY;
            { flag field in check table as being matched }
            CheckList[OrigFldIndex] := Pointer(Ord(crMODIFY));
          end
          else
          begin
            FOpType[i] := crCOPY;
            { flag field in check table as being matched }
            CheckList[OrigFldIndex] := Pointer(Ord(crCOPY));
          end;
        end;

      except
        { should never happen }
      end;

      inc(pCurFld);

    end;

    { loop back thru to catch renamed fields (which MUST be in the same
      field location and have a matching type)}
    pCurFld := pfldDes;
    for i := 0 to BaseTable.FieldDefs.Count -1 do
    begin
      if (FOpType[i] = crNOOP) then
      begin
        if (i < CheckList.Count) then
        begin
          { if original field is yet to be matched and type is
            the same ... assume field is being renamed }
          if (LongInt(CheckList[i]) = Ord(crNOOP)) And
             (CheckTable.FieldDefs.Items[i].DataType =
              BaseTable.FieldDefs.Items[i].DataType) then
          begin
            FOpType[i] := crModify;
            { Set the Field number to original table field number }
            pCurFld^.iFldNum := CheckTable.FieldDefs.Items[i].FieldNo;
            TableHasChanged := True;
          end
          else  { must be a new field }
          begin
            FOpType[i] := crADD;
            { Set the Field number to ZERO for new fields }
            pCurFld^.iFldNum := 0;
            TableHasChanged := True;
          end;
        end
        else  { must be a new field }
        begin
          FOpType[i] := crADD;
          { Set the Field number to ZERO for new fields }
          pCurFld^.iFldNum := 0;
          TableHasChanged := True;
        end;
      end;
      inc(pCurFld);
    end;

    { Check Indices }

    { first check the Index count }
    if not TableHasChanged then
      TableHasChanged := not (CheckTable.IndexDefs.Count = BaseTable.IndexDefs.Count);

    { check each field, set the field count to the Highers value, drop or add indexes as required }
    if CheckTable.IndexDefs.Count < BaseTable.IndexDefs.Count then
      IndexCount := BaseTable.IndexDefs.Count
    else
      IndexCount := CheckTable.IndexDefs.Count;

    { check each Index }
    for i := 0 to IndexCount -1 do { cannot rely on the index being created in the same order }
    begin
      { Reset }
      CurrentIndexHasChanged := False;

      { If current index is the primary key lookup using a null name }
      try
        if UpperCase(BaseTable.IndexDefs.Items[i].Name) = 'PRIMARY' then
          IndexLookupName := ''
        else
          IndexLookupName := BaseTable.IndexDefs.Items[i].Name;

        { Try to Find Each Index in the compare table 'live' table }
        IndexID := CheckTable.IndexDefs.IndexOF(IndexLookupName);

        if IndexID = -1 then { index was not found }
        begin
          TableHasChanged := True;
          IOPType[i] := crADD; { new Index }
          Continue;
        end;

        { Fields }
        if not CurrentIndexHasChanged then
          CurrentIndexHasChanged := CompareText(CheckTable.IndexDefs.Items[i].Fields,
                                                BaseTable.IndexDefs.Items[IndexID].Fields) <> 0;

        { Options }
        if not CurrentIndexHasChanged then
          CurrentIndexHasChanged := CheckTable.IndexDefs.Items[i].Options <> BaseTable.IndexDefs.Items[IndexID].Options;

        if CurrentIndexHasChanged then
          IOPType[i] := crMODIFY
        else
          IOPType[i] := crREDO;

      except
        CurrentIndexHasChanged := True;
        IOPType[i] := crDROP;
      end;

      if not TableHasChanged then
        TableHasChanged := CurrentIndexHasChanged;

    end;

    { In this version the table restructure routine uses a destructive approach to index
      restructuring and deletes all indices prior to the BDE restructure call. Thus the
      index definition used during the BDE call must all be set to operation type crADD. }
    for i := 0 to 255 do
      IOpType[i] := crADD;

    Result := not TableHasChanged;

  finally
    CheckList.Free;
  end;

end;


{ DBRestructureTableFromTable -- restructures target table to match base table
  (see help for complete description) }
function DBRestructureTableFromTable(strTargetDataBase, strTargetTableName,
                                     strBaseDatabase, strBaseTableName: String;
                                     FOptype: array of CROptype; IOptype: array of CROptype;
                                     var pFldDes: pFldDesc): Boolean;
var
  BaseTable       : TTable;
  TargetTable     : TTable;
  hDb             : hDbiDb;
  CursorProps     : CurProps;
  FDesc           : pFldDesc;
  IDesc           : PIdxDesc;
  pVDesc          : pVCHKDesc;
  ImemSize, VMemSize : Integer;
  TblDesc         : CRTblDesc;
  DBRslt          : DBIResult;
  DBName          : DBIPATH;
begin
  Result := False; { Assume Failure for now }
  FDesc := nil;
  pFldDes := nil;  { this was an error ... do not allocate }

  try
    BaseTable := TTable.Create(Application);
    try
      TargetTable := TTable.Create(Application);
      try
        { Setup BaseTable Table }
        with BaseTable do
        begin
          DataBaseName := strBaseDataBase;
          TableName := strBaseTableName;
          FieldDefs.Update;
          IndexDefs.Update;
        end;

        { Setup TargetTable Table }
        with TargetTable do
        begin
          DataBaseName := strTargetDataBase;
          TableName := strTargetTableName;
          FieldDefs.Update;
          IndexDefs.Update;
        end;

        BaseTable.Open;
        try
          { Open a NULL database handle }
          DBRslt := DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb);
          PublishBDEResult(DBRslt);
          if DBRslt = DBIERR_NONE then
          begin

            try
              { set the database directory }
              DBAnsiToNative(strTargetDatabase, DBName, (SizeOf(DBName) - 1));
              DBRslt := DbiSetDirectory(hDb, DBName);
              PublishBDEResult(DBRslt);
              if DBRslt = DBIERR_NONE then
              begin
                { get table cursor properties }
                DBRslt := DbiGetCursorProps(BaseTable.Handle, CursorProps);
                PublishBDEResult(DBRslt);
                if DBRslt = DBIERR_NONE then
                begin
                  { Alocate memory for Index descriptor }
                  ImemSize := (CursorProps.iIndexes) * SizeOf(IDXDesc);
                  IDesc := AllocMem(ImemSize);
                  try
                    { Alocate memory for Validity check descriptor }
                    VMemSize := (CursorProps.iValChecks) * SizeOf(pVDesc);
                    pVDesc := AllocMem(VMemSize);
                    try
                      { Get Index descriptions }
{$IFDEF WIN32}
                      DBRslt := DbiGetIndexDescs(BaseTable.Handle, IDesc);
{$ELSE}
                      DBRslt := DbiGetIndexDescs(BaseTable.Handle, IDesc^);
{$ENDIF}
                      PublishBDEResult(DBRslt);
                      if (DBRslt = DBIERR_NONE) Or (DBRslt = DBIERR_NOTINDEXED) then
                      begin
                        FillChar(TblDesc, SizeOf(CRTblDesc), #0);
                        StrPCopy(TblDesc.szTblName, strTargetTableName);
                        TblDesc.szTblType := DBGetTableType(strTargetTableName);

                        { Compare the tables to ensure that the OPtype structures are correct }
                        DBCompareTables(TargetTable, BaseTable, FOpType, IOpType, Fdesc);

                        { Set Table properties }
                        { Fields }

                        with TblDesc do
                        begin
                          iFldCount := CursorProps.iFields;
                          pecrFldOp := @FOpType;
                          pfldDesc := FDesc;
                          { Indices }
                          iIdxCount := CursorProps.iIndexes;
                          pecrIdxOp := @IOpType;
                          pIdxDesc := IDesc;
                        end