umain.pas

AbsDataBase5.16 最新版

      end;
    if (IsStopped) then
      mImportDetails.Lines.Add('Import stopped by user')
    else
      mImportDetails.Lines.Add('Import finished');
end;


function HasVChk(Table: TTable; Field: TField; var VChk: TVChk): boolean;

function ValToStr(VCHK: DBIVCHK; FldType: word): string;
var
  L: longint;
  I: Integer;
  D: Double;
  MyDate: BDE.DBIDATE;
  MyTime: BDE.Time;
  Hour, Minute, MSecond: Word;
  MyTS: BDE.TimeStamp;
  W1: word;
  Month, Day: word;
  Year: Smallint;
begin

  case FldType of

    fldZSTRING: Result := PChar(@VCHK);

    fldFLOAT:

    begin

      Move(VCHK, D, sizeof(D));

      Result := FloatToStr(D);

    end;

    fldINT32, fldUINT32:

    begin

      Move(VCHK, L, sizeof(L));

      Result := IntToStr(L);

    end;

    fldINT16:

    begin

      Move(VCHK, I, sizeof(I));

      Result := IntToStr(I);

    end;

    fldUINT16:

    begin

      Move(VCHK, W1, sizeof(W1));

      Result := IntToStr(W1);

    end;

    fldDATE:

    begin

      Move(VCHK, MyDate, sizeof(MyDate));

      if MyDate < 0 then

        Result := 'TODAY'

      else

      begin

        Check(DbiDateDecode(MyDate, Month, Day, Year));

        Result := Format('%d/%d/%d', [Month, Day, Year]);

      end;

    end;

    fldTIME:

    begin

      Move(VCHK, MyTime, sizeof(MyTime));

      if MyTime < 0 then

        Result := 'NOW'

      else

      begin

        Check(DbiTimeDecode(MyTime, Hour, Minute, MSecond));

        if Hour < 12 then

          Result := Format('%d:%d:%d AM', [Hour, Minute, MSecond div 1000])

        else

          Result := Format('%d:%d:%d PM', [Hour - 12, Minute, MSecond div 1000]);

      end;

    end;

    fldTIMESTAMP:

    begin

      Move(VCHK, MyTS, sizeof(MyTS));

      if MyTS = 0 then

        Result := 'NOW'

      else

      begin

        Check(DbiTimeStampDecode(MyTS, MyDate, MyTime));

        Check(DbiDateDecode(MyDate, Month, Day, Year));

        Check(DbiTimeDecode(MyTime, Hour, Minute, MSecond));

        if Hour < 12 then
          Result := Format('%d/%d/%d @ %d:%d:%d AM',
                   [Month, Day, Year, Hour, Minute, MSecond div 1000])
        else
          Result := Format('%d/%d/%d @ %d:%d:%d PM',

                   [Month, Day, Year, Hour - 12, Minute, MSecond div 1000]);
      end;
    end;
  end;
end;

var
  Props: CURProps;
  V: VCHKDesc;
  hCur: hDBICur;
  pField: pFLDDesc;
begin
  Result := False;
  Check(DbiGetCursorProps(Table.Handle, Props));
  if Props.iValChecks > 0 then
  begin
    Check(DbiOpenVChkList(Table.DBHandle, PChar(Table.TableName),
              Props.szTableType, hCur));
    pField := AllocMem(Props.iFields * sizeof(FLDDesc));
    try
      while DbiGetNextRecord(hCur, dbiNOLOCK, @V, nil) = DBIERR_NONE do

      begin

        if V.iFldNum = Field.Index + 1 then

        begin

          Result := true;

          VChk.Required := V.bRequired;

          VChk.HasDefault := V.bHasDefVal;

          VChk.HasMin := V.bHasMinVal;

          VChk.HasMax := V.bHasMaxVal;



          Check(DbiGetFieldDescs(Table.Handle, pField));

          Inc(pField, Field.Index);

          if VChk.HasDefault = TRUE then

            VChk.DefValue := ValToStr(V.aDefVal, pField^.iFldType);

          if VChk.HasMin = TRUE then

            VChk.MinValue := ValToStr(V.aMinVal, pField^.iFldType);

          if VChk.HasMax = TRUE then

            VChk.MaxValue := ValToStr(V.aMaxVal, pField^.iFldType);

          Dec(pField, Field.Index);

        end;

      end;

    finally
      FreeMem(pField);
      Check(DbiCloseCursor(hCur));
    end;
  end;
end;
procedure CreateTableProc;
begin
  fMain.Table.CreateTable;
end;

procedure TfMain.PerformExport;
var
  i: Integer;
  PromptOverwrite: Boolean;
  mr: TModalResult;
  Log: String;
begin
  PromptOverwrite := True;
  IsStopped := False;
  AbsDB.Close;
  Table.Close;
  mExportDetails.Clear;
  mExportDetails.Lines.Add(Format('Export tables from "%s"',[edExportedDB.Text]));
  AbsDB.DatabaseFileName := edExportedDB.Text;
  try
    AbsDB.Open;
  except
    MessageDlg(Format('Cannot open "%s" database file',[AbsDB.DatabaseFileName]),mtError,[mbOk],0);
    btBack.Enabled := True;
    exit;
  end;
  Table.DatabaseName := lbExportAlias.Items[lbExportAlias.ItemIndex];
  gOverallExport.MaxValue := lbExportTables.SelCount;
  gOverallExport.Progress := 0;
  // Export tables
  for i := 0 to lbExportTables.Count - 1 do
    if (lbExportTables.Selected[i]) then
      begin
        if (IsStopped) then
          break;
        ABSTable.Close;
        Table.Close;
        Table.TableName := lbExportTables.Items[i];
        ABSTable.TableName := lbExportTables.Items[i];
        // overwrite existing table?
        if (Table.Exists and PromptOverwrite) then
          begin
            mr := MessageDlg(Format('Table "%s" exists in "%s" database. Do you want to overwrite it?',[Table.TableName, Table.DatabaseName]),
        			               mtConfirmation,[mbYes,mbNo,mbAll],0);
            if (mr = mrNo) then
              begin
                mExportDetails.Lines.Add(Format('Tables "%s" already exists, its Export cancelled by user',[Table.TableName]));
                gOverallExport.Progress := gOverallExport.Progress + 1;
                continue;
              end
            else
              if (mr = mrAll) then
                PromptOverwrite := False;
          end;
        // Export table
        lExportTable.Caption := Format('Exporting table "%s"',[ABSTable.TableName]);
        mExportDetails.Lines.Add(lExportTable.Caption);
        Log := '';
        try
          ABSTable.ExportTable(Table, CreateTableProc, Log);
          Table.Close;
          Table.Open;
          ABSTable.Open;
          if (Log = '') then Log := 'No errors';
          mExportDetails.Lines.Add(Format('Table "%s" Exported. %d records transferred, %d records skipped. ErrorLog: %s',
             [ABSTable.TableName, Table.RecordCount, ABSTable.RecordCount-Table.RecordCount, Log]));
        except
          on E: Exception do
             mExportDetails.Lines.Add(Format('Table "%s" Export failed. Error: %s. ErrorLog: %s',
                                   [ABSTable.TableName, E.Message, Log]));
        end;
        gOverallExport.Progress := gOverallExport.Progress + 1;
      end;
    if (IsStopped) then
      mExportDetails.Lines.Add('Export stopped by user')
    else
      mExportDetails.Lines.Add('Export finished');
end;


procedure TfMain.lbImportAliasesClick(Sender: TObject);
begin
 DBTables.Session.GetTableNames(lbImportAliases.Items[lbImportAliases.ItemIndex],'',True,True,lbImportAliasTables.Items);
 lbImportAliasTablesClick(Sender);
end;

procedure TfMain.lbImportAliasTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbImportAliasTables.SelCount > 0);
end;

procedure TfMain.dlbImportChange(Sender: TObject);
begin
  DBTables.Session.GetTableNames(dlbImport.Directory,'',True,True,lbImportFolderTables.Items);
  lbImportFolderTablesClick(Sender);
end;

procedure TfMain.lbImportFolderTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbImportFolderTables.SelCount > 0);
end;

procedure TfMain.btBrowseImportDestinationDBClick(Sender: TObject);
begin
  if (odAbsDb.Execute) then
    edImportDestDB.Text := odAbsDb.FileName;
end;

procedure TfMain.btStopImportClick(Sender: TObject);
begin
  IsStopped := True;
end;

procedure TfMain.ABSTableBeforeImport(Sender: TObject);
begin
  gTableImport.Progress := 0;
end;

procedure TfMain.ABSTableImportProgress(Sender: TObject;
  PercentDone: Integer; var Continue: Boolean);
begin
  gTableImport.Progress := PercentDone;
  Continue := not IsStopped;
  Application.ProcessMessages;
end;

procedure TfMain.btSelectDBToExportClick(Sender: TObject);
begin
  if (odAbsDb.Execute) then
    edExportedDB.Text := odAbsDb.FileName;
end;

procedure TfMain.lbExportTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbExportTables.SelCount > 0);
end;

procedure TfMain.btStopExportClick(Sender: TObject);
begin
  IsStopped := True;
end;

procedure TfMain.ABSTableBeforeExport(Sender: TObject);
begin
  gTableExport.Progress := 0;
end;

procedure TfMain.ABSTableExportProgress(Sender: TObject;
  PercentDone: Integer; var Continue: Boolean);
begin
  gTableExport.Progress := PercentDone;
  Continue := not IsStopped;
  Application.ProcessMessages;
end;

procedure TfMain.ABSTableAfterExport(Sender: TObject);
begin
  gTableExport.Progress := 100;
end;

end.