UNIT MDBUTILS;
InterfaceUses 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;
TableRec = Record Name, Table, Foreigntable: String; Attributes: Integer; Fields: TfieldRecArray; end; tfieldRAY;
TINDEXREC = Record Name: stringe; primary, unique, required: boolean; fields: tfieldRecArray; end; tindexrecarray = array of tindexrec;
TPARUE: 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; // relationsfunction GetRelations (dbname, pwd: string): TrelationArray ; procedure ClearRelations (dbname, pwd: string); procedure CreateRelations (dbname, pwd: string; rs: TrelationArray); // recordsetfunction createMDBTable (db: database; tbname: string; fldArray: TFieldRecArray; IdxArray: TIndexRecArray): tableDef; procedure Altermdbtable; TBName: string; fldArray: tfieldRecArray; IDxArray: Tin dexRecArray); // 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); // querydefsfunction getQuerydefs (dbname, pwd: string): TquerydefArray; function clearQuerydefs (db: database): boolean; function createQueryDef (db: database; qdf: TqueryDef : querydef; function createquerydefs (DB: Database; QA: tQueryDefarray): boolean; importation
Function CreateQuerydedefs: 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 getQuerydedefs: 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.tablededefs.delete (TBNAME); db.tabledefs.refresh; end;
Procedure COPYMDBTABLE (DB: Database; Srctdf, DSTTTDF: 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 Try if Assigned (srctdf.fields [DSTTTDF.FIELDS [i] .name]) THEN S: = S ','; s: = S DSTTDF.FIELDS [I] .Name; End; Except end; end; if s <> '' Then Db.execute (Format (Sqlstr, [DSTTTDF.NAME, S, S, SRCTDF.NAME]), DBSQLPASSTHROUGH; END ;
procedure renameMDbtable (db: database; srctbname, dstTbname: string); var tdf: tabledef; begin tdf: = db.TableDefs [srctbname]; if assigned (tdf) then begin tdf.Set_Name (dstTbname); db.TableDefs.Refresh; end; end; procedure AlterMdbTable (db: database; tbname: string; fldArray: TfieldRecArray; IdxArray: TindexRecArray); var tdfold, tdfnew: tabledef; fld: field; idx: _index; i, j: integer; bfound: boolean; begin tdfold: = db.TableDefs [tbname]; if not assigned (tdfold) then exit; tdfnew: = createmdbTable (db, 'temp2002xh', fldArray, idxArray); copymdbTable (db, tdfold, tdfnew); dropmdbTable (db, tbname) RenamemdbTable (DB, 'Temp2002xh', TBNAME); END;
function createMDBTable (db: database; tbname: string; fldArray: TFieldRecArray; IdxArray: TIndexRecArray): tableDef; var tb: tabledef; fld: field; idx: _index; i, j: integer; begin tb: = db.CreateTableDef (tbname , 0, '', '); for i: = 0 to high (fldaRray) do beg: = tb.createfield (FldArray [i] .fieldname, FldArray [i] .fieldType, FldaRray [i] .fieldsize FLD.SET_REQUIRED (FLDARRAY [I] .Required; fld.set_defaultValue (FldArray [i] .default "; tb.fields.Append (ford); end; for i: = 0 to high (idxArray) Do Begin IDX: = Tb.createIndex (idxaRray [i] .name); idx.set_primary (idxaRray [i] .primary; idx.set_unique (idxaRray [i] .unique); idx.set_required (idxaRray [i] .Required; for J: = 0 to high (idxaarray [i] .fields) do begin fld: = idx.createfield (idxArray [i] .fields [j] .fieldname, idxArray [i] .fields [j] .fieldtype, IDxArray [i ] .fields [j] .fieldsize; idx.fields.Append (fld); end; tb.indexes.Append (idx); end; db.tablededefs.append (tb); result: = Tb; end;
procedure CompactMdbDatabaseX (Dbname: string); var pwd: string; tmpdb: string; begin pwd: = getMdbPassword (dbname); tmpdb: = getWinTempfile; tmpDb: = changefileExt (tmpdb, 'mdb.'); compactMdbDatabase (dbname, tmpdb, PWD, '', ISACCESS97 (DBNAME)); if FileExists (TMPDB) THEN BEGIN COPYFILE (PCHAR (TMPDB), PCHAR (DBNAME), DELETEFILE (TMPDB); End; End; Procedure CreateRerances (DBName, PWD: String rs: TRELATIONARRAY; var DB: Database; I, J: Integer; FLD: Field; R: Relation; Begin DB: = OpenDatabase (DBNAME, PWD); for i: = 0 to high (rs) Do Begin R: = DB.CreateRelation (RS [i] .Name, RS [i] .Table, RS [i] .atientable, RS [i] .attributes); for j: = 0 to high (RS [i] .fields) DO Begin fld: = r.createfield (RS [i] .fields [j] .fieldname, RS [i] .fields [j] .fieldtype, RS [i] .fields [j] .fieldsize; fld.set_foreignname (RS [i] .fields [j] .foreignname); r.fields.append (fld); end; db.reletions.Append (r); end;
Function OpenDatabase (DBNAME, PWD: STRING): Database; Var DB: Database; DBENGINE: _DBENGINE; Begin IF PWD <> 'Then PWD: ='; PWD = ' PWD; if isaccess97 (dbname) THEN BEGIN DBENGINE: = CreateComObject (dao97.CLASS_DBEngine) as _DBEngine; db: = dbengine.OpenDatabase (dbname, dbDriverNoPrompt, false, pwd); end else begin dbengine: = CreateComObject (dao2000.CLASS_DBEngine) as _DBEngine; db: = dbengine.OpenDatabase (dbname, dbDriverNoPrompt , False, PWD) end; Result: = DB; END;
Function getRay; var DB: Database; VAR DB: DBASE; I, J: Integer; R: Relation; TDF: Tabledef; Fn: String; FLDATABASE (DBNAME, PWD); DBNAME, PWD SETLENGTH (Result, DB.RELATIONS.COUNT); for i: = 0 to db.reletions.count -1 do begin r: = db.releations [i]; result [i] .name: = r.Name; Result [ i] .table: = r.Table; TDF: = db.tablededefs [r.Table]; Result [i] .foreigntable: = r.ForeIgntable; Result [i] .attributes: = r.attributes; setlength (Result) I] .fields, r.fields.count; for j: = 0 to r.fields.count -1 do begin result [i] .fields [j] .fieldname: = r.fields [j] name; fn : = r.fields [j] .name; fld: = TDF.Fields [fn]; Result [i] .fields [j] .fieldsize: = fld.size; result [i] .fields [j] .fieldtype: = Fld.Type_; Try Result [i] .fields [j] .foreignname: = r.fields [j] .foreignName; Except showMessage ('error'); end; end; end;
Function isaccess97 (DBNAME: STRING): Boolean; Var Fi: file of byte; i: integer; by: byte; begin assignfile (fi, dbname); reset (fi); result: = false; // read file i: = 0; Repeat if not EOF (FI) THEN BEGIN READ (FI, BY); INC (i); if i = $ 15 dam Result: = by <> 1; break; end; end; unsefile; closefile (FI); End; Procedure Clearrelation; var DB: Database; DBENGINE: _DBEENGINE; TEMPNAME: STRING; I: Integer; Begin IF PWD <> 'THEN PWD: ='; PWD = ' pwd; if isAccess97 (dbname) then begin dbengine: = CreateComObject (dao97.CLASS_DBEngine) as _DBEngine; db: = dbengine.OpenDatabase (dbname, dbDriverNoPrompt, false, pwd); end else begin dbengine: = CreateComObject (dao2000.CLASS_DBEngine) as _DBENGINE; DB: = DBENGINE.OPENDATABASE (DBNAME, DBDRIVERNOPROMPT, FALSE, PWD) end; for i: = db.reletions.count -1 downto 0 do db.reletions.delete (db.reletions.Item [i] .name) ; End; Function Createmdb (DBNAME, PWD: String): Boolean; VA r dbengine: _dbEngine; begin result: = true; try dbengine: = CreateComObject (CLASS_DBEngine) as _DBEngine; dbengine.CreateDatabase (dbname, '; pwd =' pwd, dbVersion30); except result: = false; end; end;
Function Connectado (Adoconnection; DBNAME, PWD: String): boolean; var s: string; begin result: = false; s: = 'provider = microsoft.jet.oledb.4.0;'; s: = s 'user ID = Admin; '; s: = s ' data source = ' dbname '; '; s: = s ' mode = share deny none; '; s: = s ' Jet OLEDB: Database Password = "' PWD '" ; "Try adoconnection.connected: = false; adoconnection.connectionstring: = s; adoconnection.connected: = true; Except end; result: = adoconnection.connected;
Function GETMDBPASSWORD (Filename: String): String; Const xraarr97: Array [0..12] of byte = ($ 86, $ FB, $ EC, $ 37, $ 5D, $ 44, $ 9C, $ FA, $ C6, $ 5E $ 28, $ E6, $ 13); xraarr2000: Array [0..28] of byte = ($ A2, $ 69, $ EC, $ FA, $ E2, $ CC, $ 28 $ E6, $ 60, $ 70, $ 06, $ 7B, $ DF, $ B1, $ 53, $ 66, $ 13, $ 43, $ EB); VAR i: Integer , S1: String; Fi: file of byte; by: Byte; Access97: Boolean; FileError: boolean; count: integer; begin result: = '; // init filerror: = false; access97: = true; // open * .MBD File Assignfile (Fi, FileName); Reset (Fi); // read file i: = 0; Repeat if Not Eof (FI) THEN Begin Read (Fi, BY); INC (i); if i = $ 15 Then access97: = by <> 1; end; until (i = $ 42) or EOF (FI); if EOF (FI) THEN RAISE EXCEPTION.CREATE ('invalid database file'); // r password string S1: = ''; If Access97 Then Count: = 12 else count: = 28; for i: = 0 to count do if not Eof (f I) The begin read (Fi, by); S1: = S1 chr (by); end; if EOF (FI) THEN RAISE Exception.create ('invalid database file'); // Close File Closefile (Fi) ; // decode string for i: = 0 to count do if access97 TEN S1 [i 1]: = CHR (ORD (S1 [i 1]) xorrr97 [i]) ELSE S1 [i 1]: = CHR (ORD (S1 [i 1]) xorarr2000 [i]); if Access97 Then Result: = S1 Else Begin Result: = '; for i: = 0 to Length (S1) Div 2 Do Begin Result: = Result Widechar (ORD (S1 [i * 2 1]) ORD (S1 [i * 2 2]) SHL 8); end; end;
// note: srcdbname and dstdbname cann't be the sameprocedure CompactMdbDatabase (srcDbname, dstDbname, oldpwd, newpwd: string; bAccess97: boolean = true); var idbEngine: _dbEngine; begin if oldpwd <> '' then oldpwd: = '; pwd = ' oldpwd; if newpwd <>' 'then newpwd: ='; pwd = ' newpwd; if bAccess97 then begin idbengine: = CreateComObject (dao97.CLASS_DBEngine) as _DBEngine; idbEngine.CompactDatabase (srcDbname, dstDbname, newpwd, dbVersion30, oldpwd); end else begin idbengine: = CreateComObject (dao2000.CLASS_DBEngine) as _DBEngine; idbEngine.CompactDatabase (srcDbname, dstDbname, newpwd, dbVersion40, oldpwd); end; end;
Function GetWINTEMPFILE: STRING; VAR FN, PN: Array [0..max_path-1] of char; becom getTemppath; GetTempFileName (PN, 'Temp', 999, fn); result: = fn; end; // note try to clear access2000 database's pwd may raise an errorprocedure changeMdbPwd (dbname, oldpwd, newpwd: string; bAccess97: boolean = true); var db: database; dbEngine: _dbengine; tempname: string; begin if bAccess97 then begin dbengine: = CreateComObject (dao97.CLASS_DBEngine) as _DBEngine; db: = dbengine.OpenDatabase (dbname, dbDriverNoPrompt, false, '; pwd =' oldpwd); db.NewPassword (oldpwd, widestring (newpwd)); db.Close; end else begin if (newpwd <> '') and (oldpwd <> '') then begin dbengine: = CreateComObject (dao2000.CLASS_DBEngine) as _DBEngine; if oldpwd <> '' then db: = dbengine.OpenDatabase (dbname, dbDriverNoPrompt, false , '; PWD =' OLDPWD) Else DB: = DBENGINE.OPENDATABASE (DBNAME, DBDRIVERNOPT, FALSE, ''); DB.NEWPASSWORD (OldPwd, WideString (newpwd)); db.close; Else Begin tempname: = changefileext (getwintempfile, 'mdb.'); compactmdbDatabase (dbname, tempname, oldpwd, newpwd, false); copyfile (pchar (tempname), pchar (dbname), false); deletefile (tempname); end; end; end; procedure clearLinkTables (dbname, pwd: string); var engine: _dbengine; dbs: database; i: Integer; tdtest, tdfloop: TableDef; strtb, strConnect: string; tdfLinked: tableDef; begin engine: = createcomobject (CLASS_DBEngine) as _dbEngine; dbs: = engine.opendatabase (dbname, dbdrivernoprompt, false, '; name = dbs; pwd =' pwd);
For i: = dbs.tablededefs.count-1 Downto 0 do begin Tdfloop: = dbs.tabledefs.Item [i]; if ((TDFLOOP.Attributes and dbattachedtable) <> 0) or (TDFLOOP.ATTRIBUTES AND DBATTACHEXCLUSIVE) < > 0) Or ((tdfloop.Attributes And dbAttachSavePWD) <> 0) Then dbs.TableDefs.Delete (tdfloop.Name) end; end; // link tables between databasesprocedure connectx (srcName, srcPwd, dstName, dstPwd, suffix: String ); var engine: _dbengine; dbsSrc, dbsDst: database; i, j: Integer; tdtest, tdfloop: TableDef; strtb, strConnect: string; tdfLinked: tableDef; begin engine: = createcomobject (CLASS_DBEngine) as _dbengine; dbssrc: = engine .OpenDatabase (srcname, dbDriverNoPrompt, false, '; name = dbsrc; pwd =' srcpwd); dbsDst: = engine.OpenDatabase (dstname, dbDriverNoPrompt, false, '; name = dbdst; pwd =' dstpwd); for i : = DBSDST.TABEDEFS.COUNT-1 DOWNTO 0 DO BEGIN TDFLOOP: = dbsdst.tablededefs.Item [i]; if ((TDFLOOP.Attributes and dbattachedtable <> 0) OR ((Tdfloop.attributes and D) BattachexClusive) <> 0) or (tdfloop.attributes and dbattachsavepwd) <> 0) THEN DBSDST.TABLEDEFS.DELETE (TDFLOOP.NAME) end;
For i: = 0 to dbsrc.tabledefs.count-1 do begin tdfloop: = dbsrc.tabledefs [i]; if (tdfloop.attributes and dbsystemObject) = 0 THEN BEGIN straTRTB: = TDFLOOP.NAME; for J: = 0 To DBSDST.TABEDEFS.COUNT-1 DO BEGIN TDTEST: = dbsdst.tablededefs.Item [j]; if tdtest.name = start.attributes and dbattachedtable <> 0) or ((TDTest.attributes) OR And dbAttachExclusive) <> 0) Or ((tdTest.Attributes And dbAttachSavePWD) <> 0)) Then strtb: = strtb suffix Else begin dbsDst.TableDefs.Delete (strtb); end; end; end; strConnect: = '; DATABASE = ' srcName '; pwd = ' srcPwd; tdfLinked: = dbsDst.CreateTableDef (strtb, 0, tdfLoop.name, strConnect); dbsDst.TableDefs.Append (tdfLinked); end; end; end; end.
