f_access.pas

劳保管理 ACCESS数据库 作为设计的一个参考

  ShowMessage('Cannot create the Alias ' + 'AccessDao');
  Exit;
 end;

 // Create TmpTable for append in AccessDao.Mdb
 if not FileExists(Dir + 'AccessDao.Dbf') then begin
  with Table1 do begin
   Close;
   DataBaseName := Dir;
   TableName    := 'AccessDao.Dbf';
   NewTable(Table1);
   Open;
   Append;
   FieldByName('cString').AsString := 'Fields compatible dBase - MsAccess';
   Post;
   Close;
  end;
 end;

 if not FileExists(Dir + 'AccessDao.Mdb') then begin
  AppendTableDao(Table1,Dir + 'AccessDao.Mdb','AccessDao',True);
  DeleteFile(Dir + 'AccessDao.Dbf');
 end;

 // Create example Table of dBase
 if not FileExists(Dir + 'DbfExample.Dbf') then begin
  with Table1 do begin
   Close;
   DataBaseName := Dir;
   TableName    := 'DbfExample.Dbf';
   with FieldDefs do begin
    Clear;
    Add('Text',      ftString,      20, False);
    Add('Valor',     ftInteger,      0, False);
   end;
   CreateTable;
   Open;
   for i := 1 to 10 do begin
    Append;
    FieldByName('Text').AsString   := 'Table .dbf Field ' + IntToStr(i);
    FieldByName('Valor').AsInteger := i;
    Post;
   end;
  end;
 end;

 // Create example Table of Paradox
 if not FileExists(Dir + 'ParadoxExample.Db') then begin
  with Table1 do begin
   Close;
   DataBaseName := Dir;
   TableName    := 'ParadoxExample.Db';
   with FieldDefs do begin
    Clear;
    Add('Text',      ftString,      20, False);
    Add('Valor',     ftInteger,      0, False);
   end;
   CreateTable;
   Open;
   for i := 1 to 10 do begin
    Append;
    FieldByName('Text').AsString   := 'Table .db Field ' + IntToStr(i);
    FieldByName('Valor').AsInteger := i;
    Post;
   end;
  end;
 end;
end;

function AppendTableDao(var Table1: TTable;
                        DbAccessName,TbAccessName: String;
                        OverWrite: Boolean): Integer;
var
 DbEngine,DbAccess,DbDataBase,DbTable : Variant;
 i: Integer;
 Exists: Boolean;
begin

 Result := 0; // Records append
 TimeStart := Now;
 Exists := False;
 // To verify the extension of the new table
 if Pos( '.MDB', UpperCase(DbAccessName)) = 0 then Exit;

 if not GetEngine(DbEngine) then Exit;

 try
  DbAccess := DbEngine.WorkSpaces[0];
  if not FileExists(DbAccessName) then begin // The file .mdb of Access doesn't exist
   // To create the database Access
   DbDataBase := DbAccess.CreateDatabase(DbAccessName,DbLangGeneral,DbVersion30);
   // To create the object Table
   DbTable := DbDataBase.CreateTableDef(TbAccessName);
   // To create the Table
   CreateAccessFields(Table1,DbDataBase,DbTable);
  end else begin // The file .mdb of Access exists
   // To create the database Access
   DbDataBase := DbAccess.OpenDataBase(DbAccessName,,False,);
   for i := 0 to DbDataBase.TableDefs.Count - 1 do // To look if the table exists
    if DbDataBase.TableDefs[i].Name = TbAccessName then Exists := True;

   if not Exists then begin // The table doesn't exist and we believe it
    DbTable := DbDataBase.CreateTableDef(TbAccessName);
    // To create the fields
    CreateAccessFields(Table1,DbDataBase,DbTable);
   end else begin // The table exists
    if OverWrite
     then
      begin // Overwrite
       DbDataBase.TableDefs.Delete(TbAccessName);
       DbTable := DbDataBase.CreateTableDef(TbAccessName);
       CreateAccessFields(Table1,DbDataBase,DbTable);
      end
     else // Not overwrite
      DbTable := DbDataBase.CreateTableDef(TbAccessName);
   end;
  end;

  // Open the table
  DbTable := DbDataBase.OpenRecordSet(TbAccessName,dbOpenTable);

  // Append the table
  Result := CopyToAccess(Table1, DbTable); // Record append
 finally
  DbAccess.Close;
 end;

 Screen.Cursor := crDefault;
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
 ShowSigecom('Record append : ' + IntToStr(Result));
end;

function AppendTableBde(var TableSource, TableAccess: TTable; OverWrite: Boolean): Integer;
var
 i: Integer;
begin
 Result := 0;
 TimeStart := Now;
 TableSource.Open;
 with TableAccess do begin
  Close;
  if OverWrite then begin
   with FieldDefs do begin
    Clear;
    for i := 0 to TableSource.FieldCount -1 do
     Add(TableSource.FieldDefs.Items[i].Name,
         TableSource.FieldDefs.Items[i].DataType,
         TableSource.FieldDefs.Items[i].Size,
         False);
   end;
   CreateTable;
   Open;
  end;
 end;

 with TableSource do begin
  if not Active then Open;
  while not Eof do begin
   TableAccess.Append;
   for i := 0 to FieldCount -1 do TableAccess.Fields[i].Assign(Fields[i]);
   TableAccess.Post;
   Inc(Result);
   Next;
  end;
 end;

 Screen.Cursor := crDefault;
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
 ShowSigecom('Record append : ' + IntToStr(Result));
end;

function QueryBDE(var Query1: TQuery; Alias,SqlFilter: String): Integer;
begin
 Result := 0;
 TimeStart := Now;
 if (Alias = '') or (SqlFilter = '') then Exit;
 with Query1 do begin
  // Config the query
  if Active then Close;
  DataBaseName := Alias;
  SQL.clear;
  SQL.Add(SqlFilter);
  try
   Active := True; // To execute the query
  finally
   if Active then Result := RecordCount; // Query  executed
   Screen.Cursor := crDefault;
  end;
 end;
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
 ShowSigecom('Record filter : ' + IntToStr(Result));
end;

function QueryDao(var DataBase1: TDataBase; var TableSource, TableQuery: TTable;
                  DbAccessName,TbAccessName,SqlFilter: String): Integer;
var
 DbEngine,DbAccess,DbDataBase,DbTable : Variant;
 i,k: Integer;
 Exists: Boolean;
 bSource: Boolean;
 sNameTableSource: String;
begin
 // This function returns in the table TableQuery the registrations that
 // complete the condition demanded SQL

 Result  := 0; // Records append
 // To verify the extension of the new table
 if Pos( '.MDB', UpperCase(DbAccessName)) = 0 then Exit;

 if not FileExists(DbAccessName) then Exit; // The file .mdb of Access doesn't exist

 TimeStart := Now;
 Exists    := False;
 bSource   := False;

 with TableQuery do begin
  Close;
  DataBaseName := ExtractFilePath(Application.ExeName);
  TableName    := 'TmpAccessDao.Dbf';
 end;

 try
  DbEngine := CreateOleObject('Dao.DbEngine.35');
  DbAccess := DbEngine.WorkSpaces[0];
  // To create the database Access
  DbDataBase := DbAccess.OpenDataBase(DbAccessName,,False,);
  for i := 0 to DbDataBase.TableDefs.Count - 1 do // To look if the table exists
   if DbDataBase.TableDefs[i].Name = TbAccessName
    then begin
     Exists := True;
     Break;
    end;

  if not Exists then Exit; // The table doesn't exist
  DbTable := DbDataBase.OpenRecordset(SqlFilter,dbOpenDynaSet);
  k := 0;
  if DbTable.RecordCount > 0 then begin // Initially it always returns value 1
   // To prepare the table with the data of the query
   bSource := TableSource.Active;
   if not TableSource.Active then TableSource.Open;
   sNameTableSource := TableSource.TableName;
   with TableQuery do begin
    with FieldDefs do begin
     Clear;
     for i := 0 to TableSource.FieldCount -1 do
      Add(TableSource.FieldDefs.Items[i].Name,
          TableSource.FieldDefs.Items[i].DataType,
          TableSource.FieldDefs.Items[i].Size,
          False);
    end;
    CreateTable;
    Open;

    DbTable.MoveFirst;

    while not DbTable.Eof do begin
     Append;
     for i := 0 to FieldCount -1 do begin
      if FieldDefs.Items[i].DataType in [ftString, ftBytes, ftVarBytes, ftWideString,
                                         ftBytes,ftVarBytes,ftMemo, ftFmtMemo,ftWideString]
       then try
             // If the field is empty, return error when delphi is running
             Fields[i].Text := DbTable.Fields[i];
            except
            end;
      if FieldDefs.Items[i].DataType in [ftSmallint,ftInteger,ftWord,ftLargeInt,
                                         ftFloat,ftCurrency,ftBoolean,ftDate,
                                         ftTime,ftDateTime,ftParadoxOle,ftDBaseOle,
                                         ftAutoInc,ftCursor,ftADT,ftArray,ftReference,
                                         ftDataSet]
       then try
             Fields[i].Value := DbTable.Fields[i].Value;
            except
            end;
     end;
     Post;
     Inc(k);
     DbTable.MoveNext;
    end;
   end;
   Result := k;
  end;
 finally
  DbAccess.Close;
  TableSource.Active := bSource; // It returns the active state from the table to their initial situation
  TableQuery.Close; // Save Changes to HD in dBase
  TableQuery.Open;

 ConfigDataBase(DataBase1,False);
  with TableSource do begin
   Close;
   DataBaseName := sAlias;
   TableName    := sNameTableSource;
   try
    Open;
   except
   end;
  end;

 end;
 Screen.Cursor := crDefault;
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
 ShowSigecom('Record append : ' + IntToStr(Result));

end;

function CompactDataBaseDao(DbAccessName: String): Boolean;
var
 DbEngine: Variant;
 TmpFile: String;
begin

 Result := False; // Records append
 TimeStart := Now;
 if Dir = '' then Exit;
 TmpFile := Dir + 'TmpAccess.Mdb';
 // To verify the extension of the new table
 if Pos( '.MDB', UpperCase(DbAccessName)) = 0 then Exit;

 // Check if exists the file .mdb of Access
 if not FileExists(DbAccessName) then Exit;

 try
  if not GetEngine(DbEngine) then Exit;
  if FileExists(TmpFile) then DeleteFile(TmpFile);
  DbEngine.CompactDataBase(DbAccessName,TmpFile);
  DeleteFile(DbAccessName);
  RenameFile(TmpFile,DbAccessName);
  Result := True;
 except
  Screen.Cursor := crDefault;
  Exit;
 end;
 Screen.Cursor := crDefault;
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
// if Result then ShowSigecom('DataBase ' + DbAccessName + ' compact');
end;

function RepairDataBaseDao(DbAccessName: String): Boolean;
var
 DbEngine: Variant;
begin

 Result := False; // Records append
 TimeStart := Now;
 if Dir = '' then Exit;

 // Check if exists the file .mdb of Access
 if not FileExists(DbAccessName) then Exit;

 try
  if not GetEngine(DbEngine) then Exit;
  DbEngine.RepairDataBase(DbAccessName);
  Result := True;
 except
  Screen.Cursor := crDefault;
  Exit;
 end;
 Screen.Cursor := crDefault;
// if Result then ShowSigecom('DataBase ' + DbAccessName + ' repaired');
end;

procedure ShowSigecom(Text: String);
begin
 DecodeTime(Now - TimeStart,Hour,Min,Sec,MSec);  // To put the hour bis miliseconds
 ShowMessage('(c) Sigecom  -  http://www.arrakis.es/~sigecom' + #13 +  #13 + Text + #13 +
             'Time : ' + IntToStr(Hour) + ':' + IntToStr(Min) + ':' +
                         IntToStr(Sec)  + ':' + IntToStr(MSec));
end;

procedure InfoIndex(Table1: TTable; sIndexName: String; var IndexInfo: TComboBox);
 function BoolVal(InBool: Boolean): String;
  begin
    if InBool = True then Result:= 'True'
    else Result:= 'False';
  end;
var
 IndexDesc : IDXDesc;
 KeyArray  : String;
 x         : Integer;
 bActive   : Boolean;
 sIndex    : String;
begin
 IndexInfo.Text := '';
 {To obtain the data related to each one from the index}
 try
  bActive := Table1.Active;
  sIndex  := Table1.IndexName;
  if not Table1.Active then Table1.Open;
  Table1.IndexName := sIndexName;
  DbiGetIndexDesc(Table1.Handle,0,IndexDesc);
  IndexInfo.Clear;
  with IndexInfo.Items do begin
   Add('Key Expression : ' + IndexDesc.szKeyExp);
   Add('Index Name : ' + IndexDesc.szname);
   Add('Tag Name (dBASE) : ' + IndexDesc.szTagName);
   Add('Index Format : ' + IndexDesc.szformat);
   Add('Primary : ' + BoolVal(IndexDesc.bPrimary));
   Add('Descending : ' + BoolVal(IndexDesc.bDescending));
   Add('Maintained : ' + BoolVal(IndexDesc.bMaintained));
   Add('Subset : ' + BoolVal(IndexDesc.bSubset));
   Add('ExpIdx : ' + BoolVal(IndexDesc.bExpIdx));
   Add('Fields In Key : ' + IntToStr(IndexDesc.iFldsInKey));
   Add('Key Length : ' + IntToStr(IndexDesc.iKeyLen));
   Add('Out of Date : ' + BoolVal(IndexDesc.bOutofDate));
   Add('Key Expression Type : ' + IntToStr(IndexDesc.iKeyExpType));
   KeyArray := '';
   for x:= 0 to IndexDesc.iFldsInKey -1 do
    KeyArray := KeyArray + IntToStr(IndexDesc.aiKeyFld[x]) + ', ';
   Add('Field Numbers used in Key : ' + KeyArray);
   Add('Key Condition : ' + IndexDesc.szKeyCond);
   Add('Case Insensitive : ' + BoolVal(IndexDesc.bCaseInsensitive));
   Add('iBlockSize : ' + IntToStr(IndexDesc.iBlockSize));
   Add('iRestrNum : ' + IntToStr(IndexDesc.iRestrNum));
   IndexInfo.Text := 'Key Expression : ' + IndexDesc.szKeyExp;
  end;
 finally
  Table1.IndexName := sIndex;
  Table1.Active    := bActive;
 end;
end;

end.