Attached bas file with support for SQLite3 via ODBC
' Copyright (C) 2010 Andrew 'Drew' Jensen ' atjen...@openoffice.org ' ' This program is free software: you can redistribute it and/or modify ' it under the terms of the GNU General Public License as published by ' the Free Software Foundation, either version 3 of the License, or ' (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' ' To review a full a copy of the GNU General Public License ' please see, <http://www.gnu.org/licenses/>. ' '// '// The library module was intended to be used as a aid in '// working around an anomily in the 3.2 release of OpenOffice.org Base '// '// For reference see: '// http://www.openoffice.org/issues/show_bug.cgi?id=108377 '// '// The library includes 4 rooutines for use in these '// Insert Data Only forms '// '// Two are suitable for use from menu, toolbar, HotKey, '// or dialog displayed by data entry form '// '// insertdFistDataForm '// reloadFistDataForm '// '// Two when called from a button owned by the dataform '// that owns the controls to write to the database '// '// insertThisDataForm '// reloadThisDataForm option explicit '// GLOBALS '// GLOBAL BoundFields() as string '// Timestamp fields can be associeated with '// both a date and time GUI control '// '// In face any data field could be bound to any '// number of GUI Control Models '// '// Data fields do not have to be bound to '// any GUI Control Model '// '// in our loops then we will iterated '// over the GUI Control Models '// to avoid any non bound data fields '// '// but this means we must watch for '// controls bound to more then one '// data field - such as timestamp fields '// '// to do this we will employ an array '// to keep track of each field name '// we come across as we move through '// the Control Models '// '// haveField '// '// helper function for insertDataForm '// function haveField( DataFieldName as string ) as boolean dim cntr dim foundit as boolean if UBound(BoundFields) = 0 then haveField = False REDIM BoundFields(1) BoundFields(1) = DataFieldName else foundit = false for cntr = 0 to UBound(BoundFields) - 1 if BoundFields(cntr) = DataFieldName then foundit = True end if next if not foundit then cntr = UBound(BoundFields) REDIM BoundFields( cntr + 1 ) BoundFields( uBound(BoundFields) ) = DataFieldName haveField = False else haveField = True end if end if end function '// '// reloadFistDataForm '// '// can be called from menu or toolbar or HotKey '// can be called from dialog displayed by data entry form '// '// will clear all controls of the first dataform '// on the top most base form window '// sub reloadFistDataForm() '// '// only want to work with forms '// '// a Query window will not be picked up with '// in ActiveFrame '// NULL Model then if isNull( thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model ) then exit sub end if '// '// Report Builder editor '// if thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model.supportsService("com.sun.star.sdb.ReportDesign") then exit sub end if '// ASSUME - ASSUME - ASSUME '// this is a form '// unlses of course it is a ReportWizard report? '// thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model.DrawPage.Forms(0).reload end sub '// '// insertFirstDataForm '// '// can be called from menu or toolbar or Kotkey '// can be called from dialog displayed by data entry form '// '// will write the values from the bound data columns controls '// of the first dataform on the top most base form window '// sub insertFirstDataForm() '// '// only want to work with forms '// '// a Query window will not be picked up with '// in ActiveFrame '// NULL Model then if isNull( thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model ) then exit sub end if '// '// Report Builder editor '// if thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model.supportsService("com.sun.star.sdb.ReportDesign") then exit sub end if '// ASSUME - ASSUME - ASSUME '// this is a form '// unlses of course it is a ReportWizard report? '// InsertDataForm( thisDatabaseDocument.CurrentController.Frame.ActiveFrame.Controller.Model.DrawPage.Forms(0) ) end sub '// '// reloadThisDataForm '// '// can be called from a button that has a dataform as parent '// sub reloadThisDataForm( oEvent as object ) oEvent.Source.Model.Parent.reload end sub '// '// insertThisDataForm '// '// can be called from a button that has a dataform as parent '// sub insertThisDataForm( oEvent as object ) InsertDataForm( oEvent.Source.Model.Parent ) end sub '// '// insertDataForm '// do it '// sub InsertDataForm(oDataForm as object ) dim CurrentConnection dim CurrentControl dim cntr, fldcnt dim strCmdFirst, strCmdLast, SQLCmd, QuoteString dim QryComposer dim prepStatement '// '// use the connection that is '// used by the datatform control '// CurrentConnection = oDataForm.ActiveCOnnection '// '// only inerested in quote used for identifieers '// QuoteString = CurrentConnection.MetaData.IdentifierQuoteString '// '// use this for getting different '// parts of the SQL command used '// by the dataform control '// in our case here '// the table name for the SQL statement '// QryComposer = CurrentConnection.createQueryComposer '// '// populate the composer with the '// current dataforms SQL command '// QryComposer.Query = oDataForm.ActiveCommand '// reset our BoudFields array for keeping '// track of duplicate data fields '// REDIM BoundFields(0) '// '// build the two parts of '// of an SQL insert statement '// '// '// iterate over the contols '// to extract the column names '// from the bound data controls '// '// makse sure variables as null strCmdFirst = "" strCmdLast = "" '// '// ensure that data in GUI conttol is '// written to the bound data controls '// '// no commit for image controls? '// for cntr = 0 to oDataForm.Count - 1 CurrentControl = oDataForm.ControlModels(cntr) if CurrentControl.ServiceName <> "stardiv.one.form.component.ImageControl" then select case CurrentControl.ServiceName '// '// include only those controls types '// that support bound data controls '// case "stardiv.one.form.component.Edit", "stardiv.one.form.component.DateField", "stardiv.one.form.component.ImageControl" CurrentControl.commit end select end if next '// if SQLite '// use Statement instead of prepared statement '// if InStr( thisDataBaseDocument.dataSource.URL, "sdbc:odbc:SQLite3" ) = 1 then for cntr = 0 to oDataForm.Count - 1 CurrentControl = oDataForm.ControlModels(cntr) select case CurrentControl.ServiceName '// '// include only those controls types '// that support bound data controls '// case "stardiv.one.form.component.Edit", "stardiv.one.form.component.DateField" ' , "stardiv.one.form.component.ImageControl" '// '// reversed order '// form can have control models after the last '// data control '// if not haveField( CurrentControl.BoundField.Name ) then strCmdFirst = strCmdFirst + QuoteString + CurrentControl.BoundField.Name + QuoteString if CurrentControl.BoundField.isAutoIncrement then strCmdLast = strCmdLast + " NULL " else select case CurrentControl.ServiceName case "stardiv.one.form.component.Edit" if CurrentControl.BoundField.getString <> "" then strCmdLast = strCmdLast + " '" + CurrentControl.BoundField.getString + "'" else strCmdLast = strCmdLast + " NULL " end if case "stardiv.one.form.component.DateField" if CurrentControl.BoundField.getString <> "" then strCmdLast = strCmdLast + CurrentControl.BoundField.getString else strCmdLast = strCmdLast + " NULL " end if end select end if if cntr <> oDataForm.Count - 1 AND strCmdFirst <> ""then strCmdFirst = strCmdFirst + + ", " strCmdLast = strCmdLast + ", " end if end if end select next SQLCmd = "INSERT INTO " + QuoteString + QryComposer.Tables(0).Name + QuoteString + " ( " + strCmdFirst + " ) VALUES ( " + strCmdLast + " )" dim oStatement oStatement = CurrentConnection.createStatement on error goto insertDataFormSQLite oStatement.executeUpdate( SQLCmd ) exit sub insertDataFormSQLite: MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"<< insertDataForm >>" exit sub end if '// NOT SQLite '// for cntr = 0 to oDataForm.Count - 1 CurrentControl = oDataForm.ControlModels(cntr) select case CurrentControl.ServiceName '// '// include only those controls types '// that support bound data controls '// case "stardiv.one.form.component.Edit", "stardiv.one.form.component.DateField", "stardiv.one.form.component.ImageControl" '// '// reversed order '// form can have control models after the last '// data control '// if not haveField( CurrentControl.BoundField.Name ) then if cntr <> oDataForm.Count - 1 AND strCmdFirst <> "" then strCmdFirst = strCmdFirst + + ", " strCmdLast = strCmdLast + ", " end if strCmdFirst = strCmdFirst + QuoteString + CurrentControl.BoundField.Name + QuoteString strCmdLast = strCmdLast + " ? " end if end select next '// '// build the final SQL statement '// '// MySQL native connector requires schema (catalog) name along with table name '// if InStr( thisDataBaseDocument.DataSource.URL, "sdbc:mysql" ) = 1 then '// '// dataform.updateSchema makes sense but returns "" '// so instead the catalog set in the connection '// SQLCmd = "INSERT INTO " + QuoteString + CurrentConnection.Catalog + QuoteString + "." + QuoteString + QryComposer.Tables(0).Name + QuoteString + " ( " + strCmdFirst + " ) VALUES ( " + strCmdLast + " )" else '// '// otherwise assume no catalog (schema) name is required '// True for embedded HSQLdb, dBase, MS Access '// SQLCmd = "INSERT INTO " + QuoteString + QryComposer.Tables(0).Name + QuoteString + " ( " + strCmdFirst + " ) VALUES ( " + strCmdLast + " )" end if '// '// and prepare it for data '// prepStatement = CurrentConnection.PrepareStatement( SQLCmd ) '// reset our BoudFields array for keeping '// track of duplicate data fields '// again '// REDIM BoundFields(0) '// '// again iterate over the contols '// this time to fill the '// parameters in the prepared statement '// with data '// for cntr = 0 to oDataForm.Count - 1 CurrentControl = oDataForm.ControlModels(cntr) select case CurrentControl.ServiceName case "stardiv.one.form.component.Edit", "stardiv.one.form.component.DateField", "stardiv.one.form.component.ImageControl" if not haveField( CurrentControl.BoundField.Name ) then '// '// fldnct <> oDataForm.Count '// only count controls with bound columns '// fldcnt = fldcnt + 1 '// '// ensure that data in GUI conttol is '// written to the bound data controls '// '// no commit for image controls? '// if CurrentControl.ServiceName <> "stardiv.one.form.component.ImageControl" then CurrentControl.commit end if '// '// fetch the columns value '// to make wasNull valid '// CurrentControl.BoundField.getString '// '// NULLS get special attention '// if CurrentControl.BoundField.wasNull then '// '// should account for different data typs '// but for expediency '// prepStatement.setNull( fldcnt, 0 ) else '// '// now put the data into '// the prepared statement '// parameters '// '// image controls are special '// if CurrentControl.ServiceName = "stardiv.one.form.component.ImageControl" then '// '// setBinaryStream insted of setBlob '// as setBlob is not implemented on all '// drivers '// dim oStream as object oStream = CurrentControl.BoundField.getBinaryStream prepStatement.setBinaryStream( fldcnt, oStream, oStream.Length ) else '// '// for expediency '// move the rest as strings '// prepStatement.setString( fldcnt, CurrentControl.BoundField.getString ) end if end if end if '// end case end select next '// set error trap '// on error goto executeUpdateError '// '// post the data to the table '// prepStatement.executeUpdate '// '// clean up the GUI controls '// by reseting the dataform '// oDataForm.Reload '// '// and exit exit sub '// '// error on insert '// tell and resume '// executeUpdateError: MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"<< insertDataForm >>" end sub
--------------------------------------------------------------------- To unsubscribe, e-mail: dev-unsubscr...@dba.openoffice.org For additional commands, e-mail: dev-h...@dba.openoffice.org