diff options
Diffstat (limited to 'wizards/source/access2base/Utils.xba')
| -rw-r--r-- | wizards/source/access2base/Utils.xba | 153 |
1 files changed, 86 insertions, 67 deletions
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba index 93e7ad9da87c..99c3cd883e2c 100644 --- a/wizards/source/access2base/Utils.xba +++ b/wizards/source/access2base/Utils.xba @@ -162,6 +162,29 @@ Public Function _DecimalPoint() As String End Function REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _Dump_A2B() As Variant +' For debugging purposes +Dim i As Integer, j As Integer, vCurrentDoc As Variant + On Local Error Resume Next + With _A2B_ + DebugPrint "Version", .VersionNumber + DebugPrint "TraceLevel", .MinimalTraceLevel + DebugPrint "TraceCount", .TraceLogCount + DebugPrint "CalledSub", .CalledSub + If IsArray(.CurrentDoc) Then + For i = 0 To UBound(.CurrentDoc) + vCurrentDoc = .CurrentDoc(i) + DebugPrint i, "URL", vCurrentDoc.URL + For j = 0 To UBound(vCurrentDoc.DbContainers) + DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName + DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title + Next j + Next i + End If + End With +End Function + +REM ----------------------------------------------------------------------------------------------------------------------- Private Function _ExtensionLocation() As String ' Return the URL pointing to the location where OO installed the Access2Base extension ' Adapted from http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Extensions/Location_of_Installed_Extensions @@ -179,40 +202,56 @@ REM get the data for the column specified by ColIndex REM get type name from metadata Dim vValue As Variant, sType As String, vDateTime As Variant +Dim bNullable As Boolean, bNull As Boolean, oValue As Object + On Local Error Goto 0 ' Disable error handler + vValue = Null ' Default value if error sType = poResultSet.MetaData.getColumnTypeName(piColIndex) - Select Case sType - Case "ARRAY": vValue = poResultSet.getArray(piColIndex) - Case "BLOB": vValue = poResultSet.getBlob(piColIndex) - Case "BIT", "BOOLEAN": vValue = poResultSet.getBoolean(piColIndex) - Case "BYTE": vValue = poResultSet.getByte(piColIndex) - Case "BYTES": vValue = poResultSet.getBytes(piColIndex) - Case "CLOB": vValue = poResultSet.getClob(piColIndex) - Case "DATE": vDateTime = poResultSet.getDate(piColIndex) - vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) - Case "DOUBLE", "REAL": vValue = poResultSet.getDouble(piColIndex) - Case "FLOAT": vValue = poResultSet.getFloat(piColIndex) - Case "INTEGER", "SMALLINT": vValue = poResultSet.getInt(piColIndex) - Case "LONG", "BIGINT": vValue = poResultSet.getLong(piColIndex) - Case "DECIMAL", "NUMERIC": vValue = poResultSet.getDouble(piColIndex) - Case "NULL": vValue = poResultSet.getNull(piColIndex) - Case "OBJECT": vValue = poResultSet.getObject(piColIndex) - Case "REF": vValue = poResultSet.getRef(piColIndex) - Case "SHORT", "TINYINT": vValue = poResultSet.getShort(piColIndex) - Case "CHAR", "VARCHAR", "LONGVARCHAR": vValue = poResultSet.getString(piColIndex) - Case "TIME": vDateTime = poResultSet.getTime(piColIndex) - vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) - Case "TIMESTAMP": vDateTime = poResultSet.getTimeStamp(piColIndex) - vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _ - + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) - Case Else - vValue = poResultSet.getString(piColIndex) 'GIVE STRING A TRY - If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess) - End Select + With poResultSet + bNullable = ( .MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE ) + Select Case sType + Case "ARRAY": vValue = .getArray(piColIndex) + Case "BINARY", "VARBINARY", "LONGVARBINARY" + Set oValue = .getBinaryStream(piColIndex) + If bNullable Then bNull = .wasNull() + If Not bNull Then vValue = CLng(oValue.getLength()) ' Return length, not content + oValue.closeInput() + Case "BLOB": vValue = .getBlob(piColIndex) + Case "BIT", "BOOLEAN": vValue = .getBoolean(piColIndex) + Case "BYTE": vValue = .getByte(piColIndex) + Case "BYTES": vValue = .getBytes(piColIndex) + Case "CLOB": vValue = .getClob(piColIndex) + Case "DATE": vDateTime = .getDate(piColIndex) + If bNullable Then bNull = .wasNull() + If Not bNull Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) + Case "DOUBLE", "REAL": vValue = .getDouble(piColIndex) + Case "FLOAT": vValue = .getFloat(piColIndex) + Case "INTEGER", "SMALLINT": vValue = .getInt(piColIndex) + Case "LONG", "BIGINT": vValue = .getLong(piColIndex) + Case "DECIMAL", "NUMERIC": vValue = .getDouble(piColIndex) + Case "NULL": vValue = .getNull(piColIndex) + Case "OBJECT": vValue = Null ' .getObject(piColIndex) does not work that well in Basic ... + Case "REF": vValue = .getRef(piColIndex) + Case "SHORT", "TINYINT": vValue = .getShort(piColIndex) + Case "CHAR", "VARCHAR", "LONGVARCHAR": vValue = .getString(piColIndex) + Case "TIME": vDateTime = .getTime(piColIndex) + If bNullable Then bNull = .wasNull() + If Not bNull Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) + Case "TIMESTAMP": vDateTime = .getTimeStamp(piColIndex) + If bNullable Then bNull = .wasNull() + If Not bNull Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _ + + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) + Case Else + vValue = .getString(piColIndex) 'GIVE STRING A TRY + If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess) + End Select + If bNullable Then bNull = .wasNull() + If bNull Then vValue = Null + End With _getResultSetColumnValue = vValue -End Function ' getResultSetColumnValue V 0.9.5 +End Function ' getResultSetColumnValue V 1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _FinalProperty(psShortcut As String) As String @@ -339,10 +378,16 @@ Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Option Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer Dim iTop As Integer, iBottom As Integer, iFound As Integer iItemVarType = VarType(pvItem) + If IsMissing(pvReturnValue) Then pvReturnValue = False If iItemVarType = vbNull Or IsNull(pvList) Then _InList = False ElseIf Not IsArray(pvList) Then - _InList = ( pvItem = pvList ) + If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList) ) Else bFound = ( pvItem = pvList ) + If Not pvReturnValue Then + _InList = bFound + Else + If bFound Then _InList = pvList Else _InList = False + End If ElseIf UBound(pvList) < LBound(pvList) Then ' Array not initialized _InList = False Else @@ -358,7 +403,7 @@ Dim iTop As Integer, iBottom As Integer, iFound As Integer If IsMissing(pbBinarySearch) Then pbBinarySearch = False If Not pbBinarySearch Then ' Linear search For i = LBound(pvList) To UBound(pvList) - If iItemVarType = vbString Then bFound = ( pvList(i) <> "" And UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) ) + If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) ) If bFound Then iFound = i Exit For @@ -374,18 +419,18 @@ Dim iTop As Integer, iBottom As Integer, iFound As Integer Else iTop = iFound - 1 End If - If iItemVarType = vbString Then bFound = ( pvList(i) <> "" And UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) ) + If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) ) Loop Until ( bFound ) Or ( iBottom > iTop ) End If If bFound Then - If IsMissing(pvReturnValue) Then _InList = True Else _InList = pvList(iFound) + If Not pvReturnValue Then _InList = True Else _InList = pvList(iFound) End If End If End If Exit Function -End Function ' InList V0.9.0 +End Function ' InList V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String @@ -438,27 +483,26 @@ Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant If Not bIsPseudo Then Goto Exit_Function -Dim oDatabase As Variant, oForms As Variant +Dim oDoc As Object, oForms As Variant bPseudoExists = False With vObject Select Case ._Type Case OBJFORM If ._Name <> "" Then ' Check validity of form name - Set oDatabase = _CurrentDb - If oDatabase._Standalone Then + Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc()) + If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else - Set oForms = oDatabase.Document.getFormDocuments() + Set oForms = oDoc.Document.getFormDocuments() bPseudoExists = ( oForms.HasByName(._Name) ) End If End If Case OBJDATABASE - If ._Standalone Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected + If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected Case OBJDIALOG If ._Name <> "" Then ' Check validity of dialog name - Set oDatabase = _CurrentDb - bPseudoExists = ( oDatabase._hasDialog(._Name) ) + bPseudoExists = ( Application._hasDialog(._Name) ) End If Case OBJCOLLECTION bPseudoExists = True @@ -499,7 +543,7 @@ Exit_Function: Exit_False: _IsPseudo = False Goto Exit_Function -End Function ' IsPseudo V0.9.1 +End Function ' IsPseudo V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Private Function _IsScalar(ByVal pvArg As Variant, Byval pvType As Variant, ByVal Optional pvValid As Variant) As Boolean @@ -545,31 +589,6 @@ Dim vSubStrings() As Variant, i As Integer, iLen As Integer End Function ' PCase V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- -Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String -' Returns psSql after substitution of [] by quote character -' [] square brackets in quoted strings not affected - -Dim sQuote As String 'RDBMS specific quote character -Dim vSubStrings() As Variant, i As Integer - - sQuote = CurrentDb.MetaData.IdentifierQuoteString - If sQuote = " " Then ' What's the string used to quote SQL identifiers? This returns a space " " if identifier quoting is not supported. - _QuoteString = psSql - Exit Function - End If - vSubStrings() = Split(psSql, sQuote) - For i = 0 To UBound(vSubStrings) - If (i Mod 2) = 0 Then ' Only even substrings are parsed for square brackets - vSubStrings(i) = Join(Split(vSubStrings(i), "["), sQuote) - vSubStrings(i) = Join(Split(vSubStrings(i), "]"), sQuote) - End If - Next i - - _ReplaceSquareBrackets = Join(vSubStrings, sQuote) - -End Function ' ReplaceSquareBrackets V0.7.5 - -REM ----------------------------------------------------------------------------------------------------------------------- Public Sub _ResetCalledSub(ByVal psSub As String) As String ' Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling ' Used to trace routine in/outs and to clarify error messages |