/*----------------------------------------------------------------------------*/ /* 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 a MS Access databases using ActiveX/OLE needs: MS Access installed links: */ accessApp =.OleObject~new("Access.Application") dbFileName=directory()"\ooRexxDemo.mdb" -- define database file name if SysFileExists(dbFileName) then -- open existing database accessApp~openCurrentDatabase(dbFileName) else accessApp~newCurrentDatabase(dbFileName) -- create new database conn=accessApp~currentProject~connection -- get connection object 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 accessApp~closeCurrentDatabase -- close database call compressAndRepair accessApp, dbFileName -- compress database say ".rexxInfo~architecture:" pp(.rexxInfo~architecture) "(bitness)" /* ------------------------------------------------------------------------- */ ::routine dropTable use arg conn -- fetch 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' (does it exist?)" say center(" end of dropTable ", 70, "-") say return /* ------------------------------------------------------------------------- */ ::routine createTable use arg conn -- fetch 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 -- fetch connection to database -- define a few names to insert into the database s=.set~of("Chip Davis", "Christian Michel", "David Ashley", - "Erich Steinböck", "Florian Große-Coosmann", "Frank Clark", - "Gil Barmwater", "Jan Engehausen", "Lavrentios Servissoglou", - "Jean-Louis Faucher", "Kurt Märker", "Lee Peedin", - "Manfred Schweizer", "Mark Hessling", "Mark Miesfeld", - "Mike F. Cowlishaw", "Pam Taylor", "P.O. Jonsson", - "Reiner Micke", "René Jansen", "Rick McGuire", - "Rony G. Flatscher", "Stefan Dörsam", "Uwe Berger", - "Walter Pachl" - ) -- an entry in the .local or .environment directory can be referenced by using an -- environment symbol, e.g. the entry "TOTAL.RECS" can be referred to with its -- environment symbol ".TOTAL.RECS" (note the leading dot) from any Rexx program .local~total.recs=s~items -- save number of records in local environment say "inserting" pp(.total.recs) "record(s) into the table..." say do counter c name over s -- iterate over collected items (arbitrary order) sql="insert into myTable (id, name) values ("right(c,2)", '"name"' )" say " " right(c,2)":" pp(sql) -- show sql statement conn~execute(sql) -- execute the statement end say center(" end of fillTable ", 70, "-") say /* ------------------------------------------------------------------------- */ ::routine showTable use arg conn -- fetch connection to database sql="select * from myTable order by id" rs=conn~execute(sql) rs~moveFirst -- just make sure, it is pointing to the first record do counter c while rs~eof=.false -- loop over record set say " " right(c,2) - "id="pp(rs~fields["id"]~value~right(2)) - "name="pp(rs~fields["name"]~value) rs~moveNext end rs~close say center(" end of showTable ", 70, "-") say return /* ------------------------------------------------------------------------- */ ::routine deleteAndShow -- delete a random row use arg conn -- fetch 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,.total.recs) say " executing" pp(sql) "..." param=.OLEVariant~new(count) conn~execute(sql, param) say " " pp(param~!varValue_) "record deleted." say .local~total.recs=.total.recs-1 -- adjust total number of records call showTable conn -- show presently stored records /* ------------------------------------------------------------------------- */ ::routine updateAndShow use arg conn -- fetch 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,.total.recs) 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 use strict arg accessApp, dbFileName say "before compress & repair, database file size:" pp(stream(dbFileName, "c", "query size")) compressedName=SysTempFileName(dbFileName"-cmp???") -- get a unique new file name dbEngine=accessApp~DBEngine -- get database engine dbEngine~compactDatabase(dbFileName, compressedName) -- 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 -- "pretty print" ;) return "[" || arg(1) || "]"