mdb Utils (Access)[1]

unit mdbutils;

interface
uses windows,classes,sysutils,dao2000,dao97, comobj,adodb{$ifdef ver140},variants{$endif},dialogs;

type
  tfieldrec=record
    fieldname:string;
    fieldtype,fieldsize:integer;
    required:boolean;
    defaultvalue:olevariant;
    foreignname:string;
  end;
  tfieldrecarray=array of tfieldrec;

  trelationrec=record
    name,table,foreigntable:string;
    attributes:integer;
    fields:tfieldrecarray;
  end;
  trelationarray=array of trelationrec;

  tindexrec=record
    name:string;
    primary,unique,required:boolean;
    fields:tfieldrecarray;
  end;
  tindexrecarray=array of tindexrec;

  tparamrec=record
    value :olevariant;
    type_:smallint;
    direction:smallint;
    name : widestring;
  end;
  tparamrecarray=array of tparamrec;

  tquerydef=record
    name:string;
    sql:string;
  end;
  tquerydefarray=array of tquerydef;

function getwintempfile:string;
procedure compactmdbdatabase(srcdbname,dstdbname,oldpwd,newpwd:string;baccess97:boolean=true);
procedure compactmdbdatabasex(dbname:string);
procedure changemdbpwd(dbname,oldpwd,newpwd:string;baccess97:boolean=true);
procedure clearlinktables(dbname,pwd:string);
procedure connectx(srcname, srcpwd, dstname, dstpwd,suffix: string);
function getmdbpassword(filename:string):string;
function connectado(adoconnection:tadoconnection;dbname,pwd:string):boolean;
function createmdb(dbname,pwd:string):boolean;
function isaccess97(dbname:string):boolean;
function opendatabase(dbname,pwd:string):database;
//relations
function getrelations(dbname,pwd:string):trelationarray;
procedure clearrelations(dbname,pwd:string);
procedure createrelations(dbname,pwd:string;rs:trelationarray);
//recordset
function createmdbtable(db:database;tbname:string;fldarray:tfieldrecarray;idxarray:tindexrecarray):tabledef;
procedure altermdbtable(db:database;tbname:string;fldarray:tfieldrecarray;idxarray:tindexrecarray);
//function comparemdbtable(srcdb,dstdb:database;tbname:string;var outstr:string):boolean;
procedure renamemdbtable(db:database;srctbname,dsttbname:string);
procedure copymdbtable(db:database;srctdf,dsttdf:tabledef);
procedure dropmdbtable(db:database;tbname:string);

//querydefs
function getquerydefs(dbname,pwd:string):tquerydefarray;
function clearquerydefs(db:database):boolean;
function createquerydef(db:database;qdf:tquerydef):querydef;
function createquerydefs(db:database;qa:tquerydefarray):boolean;
implementation

function createquerydefs(db:database;qa:tquerydefarray):boolean;
var i:integer;
begin
  result := false;
  for i:=0 to high(qa) do
  begin
    db.createquerydef(qa[i].name,qa[i].sql);
  end;
  result := true;
end;
function createquerydef(db:database;qdf:tquerydef):querydef;
var i:integer;
begin
  result := nil;
  result := db.createquerydef(qdf.name,qdf.sql);
end;

function clearquerydefs(db:database):boolean;
var i:integer;
begin
  for i:= db.querydefs.count -1 downto 0 do
  begin
    db.querydefs.delete(db.querydefs[i].name);
  end;
  db.querydefs.refresh;
end;

function getquerydefs(dbname,pwd:string):tquerydefarray;
var db:database;
    i,j:integer;
begin
  db := opendatabase(dbname,pwd);
  setlength(result,db.querydefs.count);
  for i:=0 to db.querydefs.count-1 do
  begin
    result[i].name := db.querydefs[i].name;
    result[i].sql := db.querydefs[i].sql;
  end;
end;

procedure dropmdbtable(db:database;tbname:string);
begin
  db.tabledefs.delete(tbname);
  db.tabledefs.refresh;
end;

procedure copymdbtable(db:database;srctdf,dsttdf:tabledef);
const
  sqlstr='insert into %s select %s from %s';
var s:string;
    i:integer;
begin
  s := '';
  for i:=0 to dsttdf.fields.count -1 do
  begin