[Base] Access2Base - Last version: 6.3

[JPL]

@gelinp

I respond to mysqlf because I've got a solution from other forum

Could you please edit your post with the URL referencing your solution ?

Thanks.
JPL

[gelinp]

Hi,

I can't find into your documentation with OpenReport function how to fix values opening a report with params ? Also for Open Query ...

By the way I ask an other question : Is it possible to add a functionality to get controls inside a section of a formula ? I'm using a lot sections because it's a way to adapt subform with values entered by the user...

Thank you for your help.
Patrick

[JPL]

@gelinp,

I understand that you are requesting at once 3 enhancements to the Access2Base library:

(1) OpenReport with parameters
(2) OpenQuery of a query with parameters
(3) Controls inside sections

My answers:
(1) The reports are not yet implemented in A2B. This was originally due to the existence of 2 different Report Writers, the standard one and the Sun extension, each with its own API.
If I start working on that, only the Sun extension, which is integrated in LibreOffice, will be supported. At that time, probably (because I don't even know yet how to do it ...), the OpenReport command will be extended, like in MSAccess, with the Filter and Where arguments. Impossible to me, by the way, to give the LO release in which it could be implemented.

(2) Queries with parameters are not supported so far. It is also on my TODO list. Was not a priority. Development is not that easy and the effort seemed to me disproportional with the benefit (but I can revise my mind ... ). Indeed it is quiet easy to instead modify programmatically the RecordSource of a form or to add the WhereCondition argument to the OpenForm statement.

(3) I really don't understand your request ... ?

Sorry for this a bit disappointing reply ...

JPL

[gelinp]

Hi,

I've got a problem to detect if current record is a new one :
There is Form.Recordset.EditMode property, but A2B documentation show this property as Interger with 3 values, and Debug variable display only a boolean value...

Code: Select all   Expand viewCollapse view

REM Edit mode
Const dbEditNone = 0
Const dbEditInProgress = 1
Const dbEditAdd = 2

When I test my new record into a subform, I've got EditMode = false, and What I was attempting to get is EditMode=2 ...

I'musing LIbreOffice 5.4.2.2. With Access2Base_Version = "1.7.0"

Thank you for your help

[JPL]

@gelinp,

you're completely right, it's a bug in Access2Base: EditMode returns erroneously a boolean i.o. the promised integer.

This bug will be corrected in LibreOffice 6.1, the next major release.
In the meantime, you can use _EditMode (the corresponding internal variable) if you want, but, strictly, as a temporary workaround.

However ...
The EditMode property does not reveal if the current record in a form is a new one, it indicates if the recordset is (or not) being updated thru the AddNew, Edit, ... methods.

Hoping this will help.

JPL

[gelinp]

Thank you very much for your response. So, I'm looking for an other solution to determine if current enreg is a new One...

I've got an other problem, may be a bug or not I don't know. It's about OptionGroup into a subform. I put 2 radio buttons with same name "RadioButtonFormatCote", and there is also a group name property in Edit mode, so I put the same name "RadioButtonFormatCote".

I don't understand if I need the same name with a group control, I think no.

But when I run my basic code below :

Code: Select all   Expand viewCollapse view

[...]
Set A2BCtrlForm = _oTAdaptA2BForm.Controls("SubFormRecords", "subform)"
oA2BFormRecords = A2BCtrlForm.Form
[...]
Set ocOptionGroup = oA2BFormRecords.OptionGroup("RadioButtonFormatCote")
[...]


Then I've got an error in line 238 into _OptionGroup, about a calcul to determine radio button position ...

Could you verify it's ok with a subform ? Or give me a little Base file with code sample ? (I need to understand how to fix in edit form properties...)

[JPL]

@gelinp,

I agree that OptionGroups, RadioButtons, GroupBoxes, ... are a bit confusing. Let's try to explain:

First, a distinction has to be made between RadioButtons in forms or subforms vs. RadioButtons in dialogs. (These are design choices made by LO/AOO, not by myself ...)

What is common ?
- a GroupBox is purely a graphical element. It has its own name. It does not interfere with the behaviour of the contained radio buttons. So, let's forget about them. They have nothing to do with this topic.
- an OptionGroup is an artificial entity (defined in MSAccess and subsequently in Access2Base) grouping the inter-related radio buttons. Its main property is "Value" to specify which button is currently selected.

For Forms/Subforms:
- all RadioButtons share the same name whatever their relative position in the form.
- the corresponding OptionGroup has also the same name

For dialogs:
- each RadioButton has its own name. The buttons must have their TabIndex property in sequence without holes.
- the OptionGroup has as name that of the first RadioButton, i.e. that with the lowest TabIndex property.

Hoping this clarifies what should be clarified.
JPL

[gelinp]

Thank you for your explanation, now it's working. My problem was about a different name (a blank character at the end) about Group Names properties for radios buttons.

Also you say :

an OptionGroup is an artificial entity (defined in MSAccess and subsequently in Access2Base)

but there is also a group property with Radios Buttons and It need to use again same name as radios buttons in order to success. You can have a look at property "Nom du groupe" (Group Name) into capture attachment... (It's LibreOffice 5.2.7.2).

Finally I found out a way to fix this Bug, it was not a problem with same name sharing... : Access2Bass library use X-Y position to determine index of RadioButtons into the group. Then, I understanded that the order will be top to bottom and left to right... But my radio buttons may be not exactly aligned with Y (Top/Bottom ?) for horizontal alternative (or with X left for vertical alternative). So may be the order calculated by Access2Base will not be the same as I expected looking my screen. So I decided to use Align button bar to fix exactly the same Ytop for two Radios Buttons and then I fix the same order for activated sequence parameter into radio button. Then this way is fine, no bug at all ... So it's look like a bug to the order calcul and order expectation with IDE parameters ...

Expected will help to fix this little bug.

Thank you again

[gelinp]

I'm asking myself about the way to save data into the database (Form/SubForm -> Database) : When you said :

The Refresh method immediately updates the records in the underlying record source for a specified form to reflect changes made to the data by you or other users in a multiuser environment.

It looks like a requery not a save ...

By the way I've got error trying to use Refresh to a subform :

L'erreur #1 (Une exception s'est produite : ) s'est produite à la ligne 534 dans SubForm.Refresh

SubForm code is :

Code: Select all   Expand viewCollapse view

      
[...]
[533] Case UCase("RecordSource")
[534] If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
[535] DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
[536] DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND
[537] DatabaseForm.Filter = ""
[538] DatabaseForm.reload()
[...]


And this A2B code looks like a reload (similar to requery ?), and not a save ....

I find out Form.update method (not listed with Form methods but Recordset). But my problem is that after initial load, my Uno form indicate a new value sate (IsNew = true), may be because a calculated field, but I'm questioning myself again about this problem. I can see also after moving next/prev record...

So there is some questions how to update current record with A2B code :

• Recordset property is not listed into A2B Form object documentation ... I know a Form use Resultset, not Recordset to access Table, but It looks like a Form with SQL code use a Recordset... But how to code from a Form builded with Base IDE ? how to know about current form recodset is ready ?
• If I want to create a Recordset associated with my current Form in order to update, this recordset will be a readonly state ... So I can't use it to update ...

I suggest to add an update method to form/subform because there is already here Refresh and Requery ... Elthewhere, could you give me a snippet code to display how to update a Form already in changed state ?

thank you for your help !

[JPL]

@gelinp,

could you give me a snippet code to display how to update a Form already in changed state ?

I'm not sure about what you intend to do exactly ? Do you want to update the form or the database ?
If the database needs to be updated, then the update is in most cases implicit by moving to the next record. If the user wants to make the update manually, he uses the Save button.
The equivalent code should be similar to

Code: Select all   Expand viewCollapse view

DoCmd.RunCommand("RecSave")

Hoping this will help.
JPL

[gelinp]

YES , it's exactly what i was looking for. Thank you again

[AWBL]

Can you confirm whether or not VARCHAR_IGNORECASE is supported by the Field object? I was successfully modifying Field(x).Value, but the same code began throwing an error ("Error #12 (Variable not defined) occurred at line 776 in Field.setValue") when I changed text columns from VARCHAR to VARCHAR_IGNORECASE. Changing the value of Decimal and Date data types continues to work ok.

[JPL]

@AWBL,

Hi,

Access2Base uses the data types described in http://www.openoffice.org/api/docs/common/ref/com/sun/star/sdbc/DataType.html for AOO orhttps://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1sdbc_1_1DataType.html for LO.

Equivalences are also listed in http://www.access2base.com/access2base.html#DataType. There you can read that VARCHAR_IGNORECASE should be treated identically as VARCHAR.

However you demonstrated that this is not true ... and this is indeed a bug.

The good news is that I could reproduce the problem and that I know how to solve it. The bad news is that it is too late to have the bug corrected still in LO 6.1 (to be released in the coming days) unless you post a bug in bugzilla (https://bugs.documentfoundation.org/). I will anyway correct it for LO 6.2 (early 2019).

In the meantime, you better don't use VARCHAR_IGNORECASE fields ... or, as a dirty workaround, ... patch Access2Base yourself by commenting in line 704 in its Field module:

Code: Select all   Expand viewCollapse view

If Len(pvValue) > _Precision Then Goto Trace_Error_Length

Thanks for your comments and for using A2B.

JPL

[AWBL]

@JPL

Thanks for the quick response. I submitted Bug 118680. I tried to comment the noted line, but unfortunately, the code appears to be read-only. If it's not possible to apply that workaround, I'll update data differently until the fix can be incorporated. Appreciate the work on Access2Base!

EDIT: I found the file and applied the workaround.

[DrewJensen]

Howdy,

What a great job with the basic library, thank you.

A couple of questions, first regarding use of the TT Northwind example Base file. I would like to use that as an example file for migrating from HSQLdb to Firebird data engines. To that end I've first migrated the file by hand (or should say am in the middle of that now) using LibreOffice 6.1 and then will do it as a test case for the upcoming Migration Assistant slated for LibreOffice 6.2. Both the hand migration and the assisted migration would be used for blog posts about the subject.

So my first question is, do you mind if I use that file for that purpose?

Another question; In doing so have come across a few issues, at the moment one is dealing with DLOOKUP which generates an SQL error when used with Firebird. I would like to know if using the issue tracker at Libreoffice would work for such or if you prefer I contact you here or an other way? I would not want to only report the issue, but also offer code to fix the issues, where I can.

Anyway, wanted to touch base with you and looking forward to learning more about the Access2Base library.

As an aside; I watched a video of your presentation at this years FOSDEM regarding Base Documenter. Interesting and I'm looking forward to working with that when it is ready.

Best wishes,

Drew

[JPL]

The previous post from Drew Jensen has been replied with a private message.

JPL

[Rorschach]

Dear Sirs,

In http://www.access2base.com/basedocument ... html#00239 we can see:

Code: Select all   Expand viewCollapse view

Function BankersRound(ByRef pDecimals As Integer)
'Rounds pValue to pDecimals using the “bankers rounding”: rounding to the nearest even number.
'Rounds a value to a given number of decimals using the “bankers rounding”, that is rounding to the nearest even number.
'Input:
'-- pValue: the value to round.
'-- pDecimals: the number of decimals for the rounding.
'Output: The rounded number.
'Usage
'BankersRound(1,5, 0) -> 2
'BankersRound(2,5, 0) -> 2
[...]

but it looks like it's not correct, there it's talked about two parameters (pValue and pDecimals) although only one is seen in the function name. But instead, In https://wiki.documentfoundation.org/ima ... s_v0af.odt we can see

Code: Select all   Expand viewCollapse view

Function BankersRound(ByRef pValue As Double, pDecimals As Integer) As Double
Rounds a value to a given number of decimals using the “bankers rounding”, that is rounding to the nearest even number.
Input
    • pValue: the value to round.
    • pDecimals: the number of decimals for the rounding.
Output
The rounded number.
Usage
BankersRound(1.5, 0) → 2
BankersRound(2.5, 0) → 2
See also Round().


which makes sense. The same happens with `(1,5, 0)` which is a correct `(1.5, 0)` in the second web page.

Thanks. It seems that there's outdated information in http://www.access2base.com?

[JPL]

@Rorschach,

your post shows only that there is a bug (revealed by BaseDocumenter, author = myself) within the Basic Primitives library (author = Jean-François Nifenecker). There is indeed a major difference between the documentation (text) of the primitive "BankersRound" in the odt file you refer to and its implementation (macro).

BaseDocumenter obviously produces a documentation from macros not texts.

BTW the access2base site is not outdated because it illustrates functionalities of a piece of software (i.e. BaseDocumenter) based upon a - possibly outdated - version of another library.

Thanks for your remark.

JPL

[gelinp]

Bonjour,
J'utilise la dernière version 0.9.1 de Acess2Base. Je suis bien content de voir que vous avez encore perfectionné le framework Donc j'y reviens ...

Il me semle comprendre que maintenant les controls en boite de dialogue seraient DATAWARE ? C'est-à-dire qu'il serait possible de charger du contenu, par exemple dans une listBox d'une boite de dialogue, simplement en spécifiant le source de la liste box ... Pouvez-vous me le confirmer ? Si c'est bien le cas, alors c'est vraiment très très intéressant !

Aussi, je m'inétresse à la possibilité de charger rapidement une liste de pseudo-objets depuis le resultset d'une requête. Pour cela j'essaie d'utiliser la méthode GetRows d'un RecordSet. Mais l'appel GetRows affiche le message d'erreur suivant :

L'erreur #35 (Sous-procédure ou procédure fonction non définie) s'est produite à la ligne 606 dans Recordset.GetRows

Le code source est ci-dessous :

Code: Select all   Expand viewCollapse view

Author ........: Patrick GELIN
' Modified.......: 23/06/2019
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Sub DBOpen(Optional poEvent As Object)
   If GlobalScope.BasicLibraries.hasByName("Access2Base") Then
      GlobalScope.BasicLibraries.loadLibrary("Access2Base")
   End If
   Call Application.OpenConnection(ThisDatabaseDocument)
End Sub

Sub DBClose(Optional poEvent As Object)
   Call CloseConnection()
End Sub

Public Sub TEST_A2BGETROWS(oApplication As Object, oDebug As Object)
   const dbReadOnly = 4

   Dim orsRecords As Object
   Dim vDataBlock() As Variant
   Dim t0, t1 As Long
   
   On local error goto Erreur
   
   DBOpen()
   
   Set orsRecords = Application.CurrentDb().OpenRecordSet("SELECTALLNOTICES",,, dbReadOnly)
   with orsRecords
      Do while Not .EOF()
         t0 = GetSystemTicks
         Set vDataBlock = .GetRows(200)
         t1 = GetSystemTicks
         oDebug.Trace(Name, "vDataBlock(" & i & ") : " & UBound(vDataBlock) - LBound(vDataBlock) & " lignes, " & t1-t0 & " ticks")
      Loop
      .mClose()
   End With

   DBClose()
Exit_Sub:
   Exit Sub
Erreur:      
   TraceError("ERROR", Err, Name, Erl)
   DBClose()
   Stop
End Sub

Le RecordSet est bien executé, il contient plus de 200 enregistrements. J'ai consulté le code source dans Access2Base et dans la ligne 606 en question [ vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1) ] il semble y avoir un problème pour localiser l'appel à la méthode _getResultSetColumnValue déclarée privée dans un autre module ...

Merci pour votre aide ...
Patrick

[JPL]

@gelinp,

(you should have posted your topic in english ...)

J'utilise la dernière version 0.9.1 de Acess2Base.

This version is completely outdated. Which version do you really use ? (Check the first lines of the acConstants module in the library).

Il me semle comprendre que maintenant les controls en boite de dialogue seraient DATAWARE ?

I'm not aware at all that controls in dialogs could be data aware ?
But, indeed, loading database data in such a listbox programmatically should work. This seems to be what you're trying to build.

il semble y avoir un problème pour localiser l'appel à la méthode _getResultSetColumnValue déclarée privée dans un autre module ...

Indeed this is what the error message means. Anyway the Private status of the function declaration is ignored by Basic.

Please provide the exact LibreOffice/OpenOffice and the Access2Base versions. I can't for the moment reproduce the incident.

Regards. JPL

[gelinp]

Sorry for the mistake reporting Access2Base version. So correct is :

Global Const Access2Base_Version = "1.9.0"

So I understand DialogBox is not Dataware with LibreOffice or OpenOffice, but I belived that because I could'nt find anyway about this problem into Access2Base documentation ... So, I'm looking a way to add this dataware functionality because it's important for applications. I need to fetch lot of table rows into dialog controls such as ListBox. After, the problem is to load pagined rows automatically with scroll event... It's the resaon I'm looking for time about GetRows function call.

Also, I'm asking myself if access2base could help to manage events into pseudo code object, because with LibreOffice I need to write à simple functional module in order to write an event manager (to catch dialog events I would like to use only a single Dialog pseudo object to manage the dialog ...)

Thank you for your response ...
Patrick

[JPL]

I presume that "SELECTALLNOTICES" in your code is a table or query name.
Can you, please, list the field types of the underlying table(s) ?

What do you mean with "pseudo-objects" or "pseudo-code-objects" ?

Thanks.
JPL

[gelinp]

Pseudo object is modul of class ...

Below is DDL of table DOCLESNOTICES (Query SELECTALLNOPTICE = SELECT * FROM "DOCLESNOTICES"). I use a HSQLDB external server.

Code: Select all   Expand viewCollapse view

CREATE TABLE PUBLIC.PUBLIC.DOCLESNOTICES (
   ID BIGINT NOT NULL IDENTITY,
   TITRE VARCHAR(255) DEFAULT 'Nouveau document ...',
   DTEXPIRATION DATE,
   DTCREATION TIMESTAMP DEFAULT LOCALTIMESTAMP NOT NULL,
   DTMODIFICATION TIMESTAMP DEFAULT LOCALTIMESTAMP NOT NULL,
   DTIMPORT TIMESTAMP,
   MODELCOTE VARCHAR(50),
   DTEDITION VARCHAR(50),
   RESUME VARCHAR(2048),
   AUTEURS VARCHAR(200),
   "COLLATION" VARCHAR(200),
   EDITEURS VARCHAR(200),
   COLLECTION VARCHAR(150),
   FKNOTICEPERE BIGINT,
   ISBN VARCHAR(40),
   ISSN VARCHAR(10),
   CODEBARRE VARCHAR(30),
   MENTIONEDITION VARCHAR(100),
   CENTREINTERETS VARCHAR(512),
   MOTSCLES VARCHAR(100),
   FKFONDS BIGINT,
   TYPENOTICE VARCHAR(50) DEFAULT 'NOTICE PRINCIPALE' NOT NULL,
   REFERENCE VARCHAR(100),
   SUPPORT VARCHAR(30),
   NATURE VARCHAR(100),
   COLLECTIONNUM VARCHAR(30),
   TYPENATURE VARCHAR(30),
   CONSTRAINT SYS_PK_10350 PRIMARY KEY (ID),
   CONSTRAINT DOCLESNOTICES_DOCLESNOTICES_FK FOREIGN KEY (FKNOTICEPERE) REFERENCES PUBLIC.PUBLIC.DOCLESNOTICES(ID) ON DELETE CASCADE ON UPDATE CASCADE,
   CONSTRAINT DOCLESNOTICES_FK FOREIGN KEY (FKFONDS) REFERENCES PUBLIC.PUBLIC.AUTLESFONDSDOCUMENTAIRES(ID) ON DELETE CASCADE ON UPDATE CASCADE
);
CREATE INDEX SYS_IDX_DOCLESNOTICES_DOCLESNOTICES_FK_10359 ON PUBLIC.PUBLIC.DOCLESNOTICES (FKNOTICEPERE);
CREATE INDEX SYS_IDX_DOCLESNOTICES_FK_10361 ON PUBLIC.PUBLIC.DOCLESNOTICES (FKFONDS);
CREATE UNIQUE INDEX SYS_IDX_SYS_PK_10350_10354 ON PUBLIC.PUBLIC.DOCLESNOTICES (ID);

[JPL]

I'm asking myself if access2base could help to manage events into pseudo code object class module

Well, events are processed by a specific class module ?? Or, I don't understand your request.

The list of database fields you provide does not reveal why the GetRows method does not work.
May I suggest you to enter into the Basic debug mode and tell me more about the incident ?
(maybe via private messages to not overload this forum with our exchanges ?)

Thanks. JPL

[gelinp]

Thank you for your responsaes. So I find the bug and correct it. You have only to replace call to _getResultSetColumnValue into the line 606 into RecordSet :

Code: Select all   Expand viewCollapse view

vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1)

With

Code: Select all   Expand viewCollapse view

vMatrix(i, lSize) = Utils._getResultSetColumnValue(RowSet, i + 1)

So I could test with my laptop computer (AMD RYZEN 5 2600 WITH SSD) and find GetRows load about 40 lines per second (with Table 28 columns) and 390 lines per second (with Table 2 columns only, like a listbox need...). But GetRows result use 2D array format like ((ID1, ID2 ...), (FIELD1::VALUE1, FIELD1::VALUE2 ...) that is not suitable to populate a ListBox, so I need more time to translate and build ListBox items like ((ID1, FIELD1::VALUE1), (ID2, FIELD1::VALUE2) ...). Also If I want to map row to a service object, for example to manage domain job rules, I need also second form like ListBox...

What about memory cache into Uno RecordSet ? Do you think I could copy RecordSet cache row direct to my array ? What else about Fast fetching from ResultSet rows to Modul Class Collection ?

Thank again.

[JPL]

You have only to replace call to _getResultSetColumnValue into the line 606 into RecordSet

I don't understand why the module name (Utils) should be added but I'm ready to make the change.

GetRows result use 2D array format

Indeed this is the behaviour of VBA's GetRows(). Hence this design choice.
Performance is logically proportional with number of fields x number of rows. For each cell, depending on its type, the correct getXXX verb is addressed, the result analyzed for Null, etc. This takes time in Basic.

What about memory cache into Uno RecordSet ?

There is a cache mechanism indeed. A number of rows are fetched from the database at once: 50 by default for HSQLDB. But this operation only copies the concerned data in some memory buffer. However this does not prevent the application developer to get rows and fields one by one from there.

Finally, to load data easily and rapidly into a ListBox, USE A FORM ... !

JPL

[gelinp]

You already add Utils._getResultSetColumnValue in all other Access2BAse modules ... But I'm OK with you, it looks like there is no other _getResultSetColumnValue definition into Access2Base, so I was looking into other specifics modules of my install with same definition but I can't find anyway ...

I would like to use Dialog to manage complex selection field for a form. By example, If you want to use a form to mange books notices, You need to add authors. And it looks natural to call a dialog displaying all authors with filter on the name, you can select easily, or add a new Author, then you select it, et you call back to the form. The problem with form is that I need to delete all bar (menu, icons ...) and then ti's not a modal windows, and then I you like to close the form and call back to the first one and it look not very easy ...

Patrick

[gelinp]

Hi,

I've got a lot of problems with reantrancy events when I open a form. I tried to write a mutex (see code below) but it looks like there is no thread management with events ... In fact wait() basic sub doesn't wait for others events end but it's all the program in waiting. Same thing with stop() because all events stop running stop ...

I find I could stop form user interactions and prevent user flow events, but when I open a form there is a lot of events and I can't reorder or stop (changed row flow send before "when loading" ...). So do you know about this featur to manage mutex or semaphore with events reantrancy with LibreOffice ? What about last or next versions ?

I think if this futur doesn't exist I have to stop programming with Basic LibreOffice Base ... Do I have to try with Java connecting to LibreOffice Basic macros ? Documentation looks not complet and it's hard to understand how to pass (objects) parameters and manage deployment for end user ...

Thank you for your response.

-----------------------------------------------------------
CODE : TServiceMutex with a lot of debug call in order to understand Wait() or Stop() actions. This pseudo object code use 2 levels semaphores Public Verrouler() -> Private _Verrouiller() to lock and Public Liberer() -> Private _Liberer() to free. It result of the execution of this code that Wait look to stop all events to wait, and not only the active one ... Same thing with Stop(). So I use a function Verrouiller() As Boolean in order to exit caller and not stop all program ...

Code: Select all   Expand viewCollapse view

Private _TMTXFlagCore As Boolean 'True si le flag est levé (verrou interne posé)

Private _TMTXVerrouille As Boolean
Private _TMTXLibre As Boolean
Private _TMTXFolioteur As Object

Rem ===========================================================================
Rem                 CONSTRUCTEUR / DESCTRUCTEUR
Rem ===========================================================================

' #PROCEDURE# ==================================================================
' Name...........: Class_Initialize
' Description ...:
' Parameters ....:
' Syntax ........: TransiterEtat(NouvelEtat)
'                  NouvelEtat  - Etat à atteindre
' Return values .: Success - void
'                  Failure - sets @error
'                  |1 - NouvelEtat n'est pas un etat valide
'                  |2 - La transition n'est pas autorisée
' Author ........:
' Modified.......:  - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Class_Initialize()
   
   On local error goto Erreur   
   
   _TMTXVerrouille = true
   _TMTXLibre = false
   _TMTXStep = 400
   _TMTXChienMax = 20000
   _TMTXoDictFlags = FabriquerTDictionnaire(Name & "::TMTXoDictFlags")
   _TMTXFlagCore = _TMTXLibre
   _TMTXLockInTail = 0
   _TMTXLockOutTail = 0
   _TMTXLockedCounter = 0   
   
Exit_Sub:
   On error resume next
   Exit Sub
Erreur:
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Sub

' #PROCEDURE# ==================================================================
' Name...........: Class_Terminate()
' Description ...:
' Parameters ....:
' Syntax ........: TransiterEtat(NouvelEtat)
'                  NouvelEtat  - Etat à atteindre
' Return values .: Success - void
'                  Failure - sets @error
'                  |1 - NouvelEtat n'est pas un etat valide
'                  |2 - La transition n'est pas autorisée
' Author ........:
' Modified.......:  - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Class_Terminate()
   Dim It As Object
   
   Set It = _TMTXoDictFlags.Iterateur
   While It.Suivant
      It.Value = false
   Wend
   Dispose(_TMTXoDictFlags)
End Sub

Rem ===========================================================================
Rem                 PROPRIETES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: ChienMax
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......:  - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Let ChienMax(chienmax As Long)
   _TMTXChienMax = chienmax
End Property

' #PROCEDURE# ==================================================================
' Name...........: Counter
' Description ...: Le nombre de verrous posés.
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......:
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Get Counter As Long
   Counter = _TMTXLockedCounter
End Property

' #PROCEDURE# ==================================================================
' Name...........: StepWait
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......:  - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Let StepWait(milliseconds As Long)
   _TMTXStep = milliseconds
End Property

' #PROCEDURE# ==================================================================
' Name...........: NBElements
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......:  - code cleanup
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Property Get NBElements As Long   
   NBElements = _TMTXoDictFlags.NBElements
End Property

Public Property Let Titre(untitre As String)
   _TMTXoDictFlags.Titre  = unTitre
End Property

Public Property Get Titre As String
   Titre = _TMTXoDictFlags.Titre
End Property

Rem ===========================================================================
Rem                 METHODES PRIVEES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: _Verrouiller
' Portée.........: PRIVE
' Description ...: Verrouille l'utilisation interne de l'objet Mutex (aucune autre
'               méthode ne peut être appelée, de façon à garantir l'intégrité
'               de l'état interne du Mutex). Le Mutex est un singleton, donc
'               une ressource partagée qui ne oblige un accès séquentiel. Le
'               temps d'attente est fixé par _TMTXStep * ChienDeGarde. Pendant le
'               temps _TMTXStep le thread en attente est complètement endormi...
' Parameters ....: label : Un label assoccié au verrouillage (utile pour le fichier
'               de logs)
' Syntax ........:
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......: En cas d'abandon le trhead est stoppé, ce qui pourrait poser
'               problème si l'évènement n'est pas reproduit quelques temps
'               après.
' Related .......: Verouiller : Verouille une méthode externe au mutex.
' Link ..........:
' Example .......: Verrouiller("blocage par appelant ####")
Private Sub _Verrouiller(CallNumber As Long)
   
   Dim ChienDeGarde As  integer
   
   On local error goto Erreur
      
   Dim oDebug As Object
   oDebug = FabriquerTApplication.Debug
      
   'Si le mutex est déjà verrouillé en interne alors il faut attendre tant que
   'le chien de garde l'autorise ...
   _TMTXLockInTail = _TMTXLockInTail + 1
   ChienDeGarde = 0            
   While _TMTXFlagCore 'AND (ChienDeGarde < _TMTXChienMax)
      oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") " & _TMTXLockInTail & " verrouillages en cours ...", TRACE_ALL)
      Wait _TMTXStep
      'ChienDeGarde = ChienDeGarde + _TMTXStep      
   Wend
   
   'If ChienDeGarde = _TMTXChienMax Then
      'Attente trop longue : Abandon de la demande et stop du flux programmatique      
      'oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") a échoué sur chien de garde ...", TRACE_ALL)
      '_TMTXLockInTail = _TMTXLockInTail - 1
      'Stop
   'EndIf
   
Exit_Sub:
   On error resume next
   'On pose le verrouillage interne...   
   _TMTXFlagCore = _TMTXVerrouille      
   oDebug.Trace(Name, "+++ Verrouillage interne(" & CallNumber & ") activé +++", TRACE_ALL)
   Exit Sub
Erreur:
   _Liberer(CallNumber)
   oDebug.Trace(Name, "Tentative de verrouillage interne(" & CallNumber & ") a échoué sur erreur interne ...", TRACE_ALL)
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Sub

' #PROCEDURE# ==================================================================
' Name...........: _Liberer
' Portée.........: PRIVE
' Description ...: Libère le verrou interne du Mutex
' Parameters ....: label : Un label assoccié au verrouillage (utile pour le fichier
'               de logs)
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........: voir "_Verrouiller(label As String)"
' Example .......:
Private Sub _Liberer(CallNumber As Long)   
   
   
   On local error goto Erreur
   
   _TMTXFlagCore = _TMTXLibre   
   _TMTXLockInTail = IIf(_TMTXLockInTail - 1 <= 0, 0, _TMTXLockInTail - 1)

   Dim oDebug As Object
   oDebug = FabriquerTApplication.Debug
   oDebug.Trace(Name, "--- Verrouillage interne (" & CallNumber & ") libéré ---", TRACE_ALL)

Exit_Sub:
   On error resume next
   Exit Sub
Erreur:
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Sub

' #PROCEDURE# ==================================================================
' Name...........: Trace
' Portée.........:
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Private Sub Trace(oDebug As Object)
   
   oDebug.Trace(Name, "++++++++++++++++++++ "& Name & " ++++++++++++++++++++", TRACE_ALL)
   oDebug.Trace(Name, "ChienMax ...................... : " & ChienMax & " ms", TRACE_ALL)      
   oDebug.Trace(Name, "Delait d'attente .............. : " & _TMTXStep & " ms", TRACE_ALL)
   oDebug.Trace(Name, "", TRACE_ALL)
   oDebug.Trace(Name, "Total des verrous posés ....... : " & _TMTXLockedCounter, TRACE_ALL)
   oDebug.Trace(Name, "Appels internes en cours ...... : " & _TMTXLockInTail, TRACE_ALL)   
   oDebug.Trace(Name, "Appels externes en cours  ..... : " & _TMTXLockOutTail, TRACE_ALL)      
   _TMTXoDictFlags.Trace(oDebug)
   oDebug.Trace(Name, "-------------------- "& Name & " --------------------", TRACE_ALL)
End Sub

Rem ===========================================================================
Rem                 METHODES PUBLIQUES
Rem ===========================================================================
' #PROCEDURE# ==================================================================
' Name...........: Create
' Portée.........: PUBLIQUE
' Description ...:
' Parameters ....:
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 13/11/2019
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Sub Create(Folioteur As Object)

   If IsNull(Folioteur) Then Err = 14
   
   On local error Goto Erreur
   
   _TMTXFolioteur = Folioteur
   _TMTXFolioteur.Reset("MUTEX")

Exit_Sub:
   On error resume next
   Exit Sub
Erreur:
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Sub

' #PROCEDURE# ==================================================================
' Name...........: Verrouiller
' Portée.........: PUBLIQUE
' Description ...: Pose d'un verrou pour éviter un appel réentrant sur la méthode
'               appelante.
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......: Le verrou est posé avec un flag true dans le dictionnaire.
' Related .......:
' Link ..........:
' Example .......:
Public Function Verrouiller(sFlag As String) As Boolean
   
   Dim ChienDeGarde As Integer
   Dim lIndice As Long
   Dim Duolet As Object
   Dim CallNumber As Long
   
   If NOT Assigned(sFlag) Then Err = 14
   
   On local error goto Erreur
   
   CallNumber = _TMTXFolioteur.Execute("MUTEX")
   _TMTXLockOutTail = _TMTXLockOutTail + 1
   
   Dim oDebug As Object
   oDebug = FabriquerTApplication.Debug   
      
   _Verrouiller(CallNumber)
         Patrick GELIN
   'Si le flag du verrou n'existe pas alors il est ajouté à la
   'collection courrante directement en mode réservation.   
   If NOT _TMTXoDictFlags.Contient(sFlag, lIndice) Then
      _TMTXoDictFlags.Ajouter(sFlag, _TMTXVerrouille)      
      Goto Exit_Function      
   EndIf      
   
   Set Duolet = _TMTXoDictFlags.DuoletAtIndice(lIndice)
   'Attente de la libération du verrou externe ...
   ChienDeGarde = 0   
   
   While Duolet.Value AND (ChienDeGarde <= _TMTXChienMax)
      oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & CallNumber & ") " & _TMTXLockOutTail & "appel-s en cours ...", TRACE_ALL)      
      Trace(oDebug)
      wait _TMTXStep
      ChienDeGarde = ChienDeGarde + _TMTXStep      
   Wend
   
   If (ChienDeGarde = _TMTXChienMax) Then      
      Liberer(sFlag)      
      _liberer(CallNumber)
      oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & "." & CallNumber & ") échouée (sur chien de garde) ...", TRACE_ALL)
      Verrouiller = False
      Exit Function
   EndIf

Exit_Function:
   On error resume next      
   Duolet.Value = _TMTXVerrouille
   _TMTXLockedCounter = _TMTXLockedCounter + 1   
   Verrouiller = True   
   _Liberer(CallNumber)
   oDebug.Trace(Name, "+++ Verrouillage externe(" & sFlag & "." & CallNumber & ") activé +++", TRACE_ALL)
   Exit Function
Erreur:
   Liberer(sFlag)      
   _liberer(CallNumber)   
   oDebug.Trace(Name, "Tentative de verrouillage externe(" & sFlag & "." & CallNumber & ") échouée (sur erreur interne=) ...", TRACE_ALL)
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Function

' #PROCEDURE# ==================================================================
' Name...........: Liberer
' Description ...: Libère le verrou nommé en paramètre.
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Sub Liberer(sFlag As String)
   
   Dim Duolet As Object
   Dim lIndice As Long
   
   On local error goto Erreur
   
   If not _TMTXoDictFlags.Contient(sFlag, lIndice) Then
      Goto Exit_sub
   EndIf   
   Set Duolet = _TMTXoDictFlags.DuoletAtIndice(lIndice)
   Duolet.Value = _TMTXLibre
   _TMTXLockOutTail = _TMTXLockOutTail - 1
   
   Dim oDebug As Object
   oDebug = FabriquerTApplication.Debug
   oDebug.Trace(Name, "--- Verrouillage externe " & sFlag & " libéré ---", TRACE_ALL)
   
Exit_Sub:
   On error resume next
   Exit Sub
Erreur:
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Sub

' #PROCEDURE# ==================================================================
' Name...........: EstLibre
' Description ...: Vrai si le verrou nommé en paramètre est actif.
'               (valeur false dans le dictionnaire)
' Parameters ....: sFlag : String : Le nom du verrou
' Syntax ........:
' Return values .: Success - void
' Author ........:
' Modified.......: 30/01/2018
' Remarks .......:
' Related .......:
' Link ..........:
' Example .......:
Public Function EstLibre(sFlag As String) As Boolean
   
   Dim result As Boolean
   Dim lIndice As Long
   
   On local error goto Erreur
   
   result = true     
   If _TMTXoDictFlags.Contient(sFlag, lIndice) Then
      result = NOT _TMTXoDictFlags.ValueAtIndice(lIndice)
   EndIf
   EstLibre = result
   
Exit_Function:
   On error resume next
   Exit Function
Erreur:
   TraceError("ERROR", Err, Name, Erl)   
   Stop
End Function



[JPL]

@gelinp,

I confirm that the behaviour of Stop and Wait is exactly what you describe.

Code: Select all   Expand viewCollapse view

I've got a lot of problems with reantrancy events when I open a form.

What are "reentrancy events" ?? Which problems ?

I doubt any future version of LibreOffice would ever allow Basic scripts to manage multithreading safely.

I'm afraid I exceeded my competence level ...

All the best. JPL

[gelinp]

Event reentrancy is events fired many time in a very short time...

It could be events fired when form opened and then if the user clicks in form faster than the events are processed. In all this case, an event handler did not finish its treatment a new event call it. So what to do if event handler need to access database table : with concurrency : you need a Semaphore or Mutex ...

There is two way to find reentrancy with Base Forms :

• when the user quickly clicks on the form;
• At the opening of the form

I know Before Record Action and Before Record change send twices for every action (INSERT, UPDATE, DELETE). and record change, respectively. Therefore, you I could make sure that the desired action is not performed twice (if I don't want that). The first time these two events are trigerred by the FormController and the second by the DataForm service.

I don't know what it is about Acess. But, in my point of view, it's a problem that happens faster and more often than we want to say for anyone who wants to program Base...

Patrick