308 lines
13 KiB
Rexx
Executable File
308 lines
13 KiB
Rexx
Executable File
/*----------------------------------------------------------------------------*/
|
|
/* Copyright (c) 2006-2024 Rexx Language Association. All rights reserved. */
|
|
/* */
|
|
/* This program and the accompanying materials are made available under */
|
|
/* the terms of the Common Public License v1.0 which accompanies this */
|
|
/* distribution. A copy is also available at the following address: */
|
|
/* https://www.oorexx.org/license.html */
|
|
/* */
|
|
/* Redistribution and use in source and binary forms, with or */
|
|
/* without modification, are permitted provided that the following */
|
|
/* conditions are met: */
|
|
/* */
|
|
/* Redistributions of source code must retain the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer. */
|
|
/* Redistributions in binary form must reproduce the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer in */
|
|
/* the documentation and/or other materials provided with the distribution. */
|
|
/* */
|
|
/* Neither the name of Rexx Language Association nor the names */
|
|
/* of its contributors may be used to endorse or promote products */
|
|
/* derived from this software without specific prior written permission. */
|
|
/* */
|
|
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
|
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
|
|
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
|
|
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
|
|
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
|
|
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
|
|
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
|
|
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
|
|
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
|
|
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
|
|
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
|
|
/* */
|
|
/*----------------------------------------------------------------------------*/
|
|
|
|
/*
|
|
purpose: Demonstrate how one can interact with Jet (MS Access) databases using ActiveX/OLE
|
|
needs: MS Access resp. the JetEngine installed
|
|
|
|
notes: This sample can only run on a 32-bit ooRexx. The Jet Engine can not
|
|
read Office 2007 database file formats. Therefore, we check if
|
|
Access is 2007, and if so, force the database to be created in
|
|
Access 2003 format. Look at the createDataBaseFile() routine for
|
|
how this is done.
|
|
|
|
This sample uses some public routines from the oleUtils framework.
|
|
getAddressingMode()
|
|
createOleObject()
|
|
|
|
links: <https://docs.microsoft.com/en-us/office/vba/api/overview/access>
|
|
<https://docs.microsoft.com/en-us/office/vba/access/concepts/miscellaneous/concepts-access-vba-reference>
|
|
<https://docs.microsoft.com/en-us/office/vba/api/overview/access/object-model>
|
|
*/
|
|
|
|
-- This first function just checks to be sure the sample can execute on the
|
|
-- current system. Look at the function code at the end of the file for the
|
|
-- details. The function returns the oleObject, access application object, on
|
|
-- success and .nil if this sample can not run on the current system.
|
|
accessApplication = checkSystem()
|
|
if accessApplication == .nil then return
|
|
|
|
|
|
dbFileName=directory()"\ooRexxDemo.mdb" -- define database file name
|
|
call createDataBaseFile dbFileName, accessApplication -- create database file, if necessary
|
|
|
|
conn=.oleobject~new("ADODB.Connection") -- create an ADO conncection to the database
|
|
conn~provider="Microsoft.Jet.OLEDB.4.0" -- tell the connection what driver to use
|
|
|
|
conn~open(dbFileName) -- open a connection to the database
|
|
|
|
call dropTable conn -- make sure table is dropped
|
|
call createTable conn -- create a table in the database
|
|
call fillTable conn -- enter records to the table
|
|
call showTable conn -- show presently stored records
|
|
call deleteAndShow conn -- delete a record, show results
|
|
call updateAndShow conn -- update a few records, show results
|
|
|
|
conn~close -- close connection to the database
|
|
|
|
call compressAndRepair dbFileName
|
|
|
|
::requires 'oleUtils.frm'
|
|
|
|
::routine createDataBaseFile
|
|
use strict arg dbFileName, appAccess
|
|
|
|
if stream(dbFileName, "c", "query exists")="" then -- database file does not exist
|
|
do
|
|
-- We have to know if this is Access 2007 or not. The Jet Engine can not
|
|
-- read the Access 2007 default file format. So, if this is Access 2007,
|
|
-- we force the database to be created Access 2002-2003 format.
|
|
|
|
-- create the database file
|
|
if appAccess~version >= 12 then do
|
|
formatConstant = appAccess~getConstant('acNewDatabaseFormatAccess2002')
|
|
appAccess~NewCurrentDatabase(dbFileName, formatConstant)
|
|
|
|
-- With Access 2007, we have to explicitly close the database, or the
|
|
-- Jet Engine can not open it. Prior to Access 2007, this step is not
|
|
-- needed.
|
|
appAccess~closeCurrentDatabase
|
|
end
|
|
else do
|
|
-- Prior to Access 2007, the NewCurrentDatabase only takes 1 argument.
|
|
appAccess~NewCurrentDatabase(dbFileName)
|
|
end
|
|
say "created database file" pp(dbFileName)
|
|
end
|
|
else
|
|
say "database file" pp(dbFileName) "exists already"
|
|
|
|
say center(" end of createDataBaseFile ", 70, "-")
|
|
say
|
|
|
|
-- This is the last place in this example where the Access application object
|
|
-- is needed. So we close it now. All the work is actually done by the Jet
|
|
-- Engine.
|
|
appAccess~quit
|
|
|
|
|
|
::routine dropTable
|
|
use arg conn -- retrieve connection to database
|
|
|
|
signal on any -- intercept any exception
|
|
conn~execute("drop table myTable") -- execute SQL statement
|
|
say "dropped 'myTable'"
|
|
say center(" end of dropTable ", 70, "-")
|
|
say
|
|
return
|
|
any:
|
|
say "could not drop 'myTable'"
|
|
say condition("C") condition("D")
|
|
say center(" end of dropTable ", 70, "-")
|
|
say
|
|
return
|
|
|
|
::routine createTable
|
|
use arg conn -- retrieve connection to database
|
|
|
|
sql="create table myTable (id integer, name text (30) )"
|
|
say "executing" pp(sql) "..."
|
|
conn~execute(sql)
|
|
say center(" end of createTable ", 70, "-")
|
|
say
|
|
|
|
::routine fillTable
|
|
use arg conn -- retrieve connection to database
|
|
|
|
-- define a few names to insert into the database
|
|
s=.set~of("Chip Davis", "Christian Michel", "David Ashley", -
|
|
"Florian Große-Coosmann", "Frank Clark", "Gil Barmwater", -
|
|
"Jan Engehausen", "Lavrentios Servissoglou", "Lee Peedin", -
|
|
"Manfred Schweizer", "Mark Hessling", "Pam Taylor", -
|
|
"Reiner Micke", "René Jansen", "Rick McGuire", -
|
|
"Rony G. Flatscher", "Stefan Dörsam", "Uwe Berger", -
|
|
"Walter Pachl", "Mark Miesfeld" -
|
|
)
|
|
|
|
.local~tmp.nrRecs=s~items -- save number of records in local environment
|
|
.local~tmp.length=length(.tmp.nrRecs) -- save length
|
|
|
|
say "inserting" pp(.tmp.nrRecs) "record(s) into the table..."
|
|
say
|
|
|
|
i=0
|
|
do name over s -- iterate over collected items (arbitrary order)
|
|
i=i+1 -- calc unique id value
|
|
sql="insert into myTable (id, name) values ("i~right(.tmp.length)", '"name"' )"
|
|
say " " i~right(.tmp.length)":" pp(sql) -- show sql statement
|
|
conn~execute(sql) -- execute the statement
|
|
end
|
|
say center(" end of fillTable ", 70, "-")
|
|
say
|
|
|
|
|
|
::routine showTable
|
|
use arg conn -- retrieve connection to database
|
|
|
|
rs=.oleObject~new("ADODB.Recordset") -- create an ADO recordset object
|
|
|
|
rs~CursorType = 1 -- .ole.const~adOpenKeyset
|
|
rs~LockType = 3 -- .ole.const~adLockOptimistic
|
|
sql="select * from myTable order by id"
|
|
rs~open(sql, conn) -- open the table
|
|
totRecs=rs~recordCount -- get recordCount
|
|
say "nr. of records:" pp(totRecs)":"
|
|
say
|
|
rs~moveFirst -- just make sure, it is pointing to the first record
|
|
do i=1 to totRecs while rs~eof=.false -- loop over record set
|
|
say " " i~right(.tmp.length)":" -
|
|
"id="pp(rs~fields["id"]~value~right(.tmp.length)) -
|
|
"name="pp(rs~fields["name"]~value)
|
|
rs~moveNext
|
|
end
|
|
rs~close
|
|
say center(" end of showTable ", 70, "-")
|
|
say
|
|
|
|
::routine deleteAndShow
|
|
use arg conn -- retrieve connection to database
|
|
|
|
say "deleting a record from the table:"
|
|
say
|
|
-- delete row with an arbitrary value for the field "id"
|
|
sql="delete from myTable where id="random(1,.tmp.nrRecs)
|
|
say " executing" pp(sql) "..."
|
|
conn~execute(sql)
|
|
say
|
|
|
|
.local~tmp.nrRecs=.tmp.nrRecs-1 -- subtract 1 from total number of records
|
|
.local~tmp.length=length(.tmp.nrRecs) -- save length
|
|
|
|
call showTable conn -- show presently stored records
|
|
|
|
::routine updateAndShow
|
|
use arg conn -- retrieve connection to database
|
|
|
|
say "updating a few records from the table:"
|
|
say
|
|
-- update some records randomly
|
|
sql="update myTable set id=id*3 where id >" random(1,.tmp.nrRecs)
|
|
say " executing" pp(sql) "..."
|
|
param = .OLEVariant~new(count)
|
|
conn~execute(sql, param)
|
|
say " " pp(param~!varValue_) "record(s) affected."
|
|
say
|
|
|
|
call showTable conn -- show presently stored records
|
|
|
|
|
|
::routine compressAndRepair -- Jet (= MS Access) databases tend to grow considerably
|
|
parse arg dbFileName
|
|
|
|
say "before compress & repair, database file size:" pp(stream(dbFileName, "c", "query size"))
|
|
compressedName=SysTempFileName(dbFileName"-cmp???") -- get a unique new file name
|
|
|
|
/*
|
|
-- Hint: if your MDB-database is secured with a database password, you must supply
|
|
-- that password in the variable "pw":
|
|
|
|
if pw="" then pwdString=""
|
|
else pwdString=";Jet OLEDB:Database Password="pw
|
|
|
|
fromString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="dbFileName || pwdString
|
|
toString ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="compressedName || pwdString
|
|
*/
|
|
|
|
-- Hint: MDB database files have no database password set
|
|
fromString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="dbFileName
|
|
toString ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="compressedName
|
|
|
|
|
|
jro=.oleObject~new("JRO.JetEngine")
|
|
jro~compactDatabase(fromString, toString) -- carry out compact & repair
|
|
say "after compress & repair, database file size:" pp(stream(compressedName, "c", "query size"))
|
|
|
|
-- create a unique backup file name containing date and time of backup
|
|
newBkpFileName=dbFileName"-bkp-"date("S")"-"time()~changestr(":","")
|
|
|
|
say "renaming work files..."
|
|
-- rename original database file name to backup file name
|
|
cmdText="ren" '"'dbFileName'"' filespec("Name", newBkpFileName)
|
|
say "DOS command:" pp(cmdText)
|
|
address cmd cmdText -- use ADDRESS CMD explicitly
|
|
|
|
-- now rename new compressed file to original databse file name
|
|
cmdText="ren" '"'compressedName'"' filespec("Name", dbFileName)
|
|
say "DOS command:" pp(cmdText)
|
|
cmdText -- this uses ADDRESS CMD implicitly
|
|
say center(" end of compressAndRepair ", 70, "-")
|
|
say
|
|
|
|
|
|
::routine pp
|
|
return "[" || arg(1) || "]"
|
|
|
|
::routine checkSystem
|
|
|
|
mode = getAddressingMode()
|
|
if mode == 64 then do
|
|
say
|
|
say 'You are running a 64-bit compiled ooRexx'
|
|
say
|
|
say 'This sample relies on the Microsoft Jet Database Engine.'
|
|
say 'There is no 64-bit version of Jet, therefore a 64-bit'
|
|
say 'compiled ooRexx can not run this sample. This sample'
|
|
say 'may be upgraded in the future to work with Access 2007'
|
|
say 'and its Microsoft Access Engine (ACE). ACE is also'
|
|
say '32-bit. It is not clear at the current time whether ACE'
|
|
say 'will be ported to 64-bit.'
|
|
say
|
|
say 'Sorry, this sample is 32-bit only.'
|
|
|
|
return .nil
|
|
end
|
|
|
|
-- We have to have Access, exit gracefully if not.
|
|
accessApplication = createOleObject("Access.Application", .true)
|
|
if accessApplication == .nil then do
|
|
say
|
|
say 'This example requires Microsoft Access, which does not seem'
|
|
say 'to be installed. Quitting.'
|
|
end
|
|
|
|
return accessApplication
|
|
|