Providing OpenOffice Base experience to others
Posted: Wed Nov 23, 2016 3:59 pm
Hello,
I am a senior IT since 1968. I am now retired. I when through most of IT position in my career and I remember my good times as a developper. I discovered Open Office forum and all the activity of you folks, interested in discovering, exploiting Open Office. I started myself trying to migrate a MS access school Library to Open Office, not without many difficulties. But thanks to you guys, I build a complete functionning Library system which will be used to reduce the costs of the school where I volunteer. I want to make a present to the community by giving a working Open Office Basic code.
I hope this can compensate what I, myself, extracted from this forum.
Also a solution to close properly Open Office Base using a small AutoIT script which causes no damage. AutoIt allows to compile and produce an EXE file called within my macros. That's the one here below:
The other Basic code can be found hereunder:
Placed code tags around the code, floris v, moderator
I am a senior IT since 1968. I am now retired. I when through most of IT position in my career and I remember my good times as a developper. I discovered Open Office forum and all the activity of you folks, interested in discovering, exploiting Open Office. I started myself trying to migrate a MS access school Library to Open Office, not without many difficulties. But thanks to you guys, I build a complete functionning Library system which will be used to reduce the costs of the school where I volunteer. I want to make a present to the community by giving a working Open Office Basic code.
I hope this can compensate what I, myself, extracted from this forum.
Also a solution to close properly Open Office Base using a small AutoIT script which causes no damage. AutoIt allows to compile and produce an EXE file called within my macros. That's the one here below:
Code: Select all
#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Outfile_x64=CloseOOOBCDI.exe
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <MsgBoxConstants.au3>
CloseOOOBCDI()
Func CloseOOOBCDI()
; Test if the window exists and display the results.
If WinExists("[TITLE:OOOBCDI.odb - OpenOffice Base]") Then
MsgBox($MB_SYSTEMMODAL, "", "OOOBCDI est active, Le programme va se fermer !! ENTER")
WinClose("[TITLE:OOOBCDI.odb - OpenOffice Base]")
Else
MsgBox($MB_SYSTEMMODAL, "", "Window does not exist")
EndIf
EndFunc
Code: Select all
'********************************************************************************************************
' Registers Books returned to the library. The reader can be manual or barcode
'********************************************************************************************************
Function EnregRetours
dim CodeLivre as string
dim Rendule as date
Recommencer:
EnrRetours(CodeLivre, RenduLe)
If CodeLivre = "" then goto Bypass
goto Recommencer
Bypass:
Beep
msgbox "Fin d'enregistrement"
stop
end Function
'********************************************************************************************************
' Registers loans to readers. input manual or barcode
'********************************************************************************************************
Function EnregSorties
dim InputVal as string
dim CodeLivre as string
dim Rendule as date
Recommencer:
IdentEleve(InputVal)
if InputVal = "" then goto Bypass
EnrPrets(InputVal, CodeLivre, RenduLe)
goto Recommencer
Bypass:
Beep
msgbox "Fin d'enregistrement" + chr$(13) + "Cliquez Nouvel Eleve" + chr$(13) + "pour un nouvel enregistrement"
end Function
'********************************************************************************************************
' Validate Reader's code
'********************************************************************************************************
Function IdentEleve(InputVal as string)
dim maRequete as Object, resultat as Object, CheckResult as string
On error goto TraitementErreur
SaisieEleve:
OpenDatabase(maConnexion)
InputVal = InputBox("Code de l'élève:", "Introduisez le code de l'élève", "")
if InputVal = "" then goto FinDeSaisie
selectSQL = "select ""Numéro"", ""Nom et prénom"" from ""Lecteurs"" where ""Numéro"" = " & InputVal
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
resultat.next
CheckResult = resultat.getColumns().getByName("Nom et prénom").getString()
FinDeSaisie:
CloseDatabase(maConnexion)
Exit Function
TraitementErreur:
' MsgBox "Error code: " + Err + Chr$(13) + Error$
beep
beep
MsgBox "ERREUR ELEVE: " + InputVal + Chr$(13) + " N'existe pas, recommencez"
CloseDatabase(maConnexion)
Goto SaisieEleve
End function
'********************************************************************************************************
' Function to record loans
'********************************************************************************************************
Function EnrPrets(InputVal as string, CodeLivre as string, RenduLe as date)
dim maRequete as Object, resultat as Object
dim StrCodeLivre as string, RenduLe as date, StrRenduLe as string
dim StrDate as string, DateSortie as string, bOK as boolean
On error goto TraitementErreur
NextLivre:
OpenDatabase(maConnexion)
CodeLivre = InputBox("Code du livre:", "Introduisez le code du livre", "")
if CodeLivre = "" then goto FinEnregistrement
StrCodeLivre = "'" & CodeLivre & "'"
StrDate = "'" & year(Date) & "-" & month(date) & "-" & day(date) & "'"
selectSQL = "select ""Numéro lecteur"", ""Code livre"", ""Date"", ""Rendu le"" from ""Prêts"" where ""Code livre"" = " & StrCodeLivre
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
bOK = 1
do while bOK
bOK = resultat.next
DateSortie = resultat.getColumns().getByName("Date").getString()
RenduLe = resultat.getColumns().getByName("Rendu le").getString()
if RenduLe = "00:00:00" then
beep
beep
msgbox "Ce livre est déjà sorti" + chr$(13) + "Enregistrez un autre livre"
CloseDatabase(maConnexion)
goto NextLivre
end if
' msgbox "==>" & DateSortie & " - " & RenduLe
loop
exit function
TraitementErreur:
' MsgBox "Error code: " + Err + Chr$(13) + Error$
if err = 1 then
' on error Goto Oups
' insert into "Prêts" ("Numéro lecteur", "Code livre", "Date") values (4, 'A20-026', '2016-11-02')
selectSQL = "INSERT INTO ""Prêts"" (""Numéro lecteur"", ""Code livre"", ""Date"", ""NbJours"") VALUES (" & _
InputVal & ", " & StrCodeLivre & ", " & StrDate & ", " & 7 & ")"
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
CloseDatabase(maConnexion)
Resume NextLivre
else
beep
beep
MsgBox "Error code: " + Err + Chr$(13) + Error$
stop
endif
Oups:
beep
beep
msgbox "Ce livre :" & CodeLivre & " N'existe pas ou est déjà sorti"
CloseDatabase(maConnexion)
Resume NextLivre
FinEnregistrement:
CloseDatabase(maConnexion)
End function
'********************************************************************************************************
' Function to record returned books
'********************************************************************************************************
Function EnrRetours(CodeLivre as string, RenduLe as date)
dim maRequete as Object, resultat as Object
dim StrCodeLivre as string, RenduLe as date, StrRenduLe as string
dim StrDate as string, DateSortie as string, bOK as boolean
Dim LivreSorti as integer, RecNumber as integer
On error goto TraitementErreur
NextLivre:
OpenDatabase(maConnexion)
CodeLivre = InputBox("Code du livre:", "Introduisez le code du livre", "")
if CodeLivre = "" then goto FinEnregistrement
StrCodeLivre = "'" & CodeLivre & "'"
selectSQL = "select ""ID"", ""Numéro lecteur"", ""Code livre"", ""Date"", ""Rendu le"" from ""Prêts"" where ""Code livre"" = " & StrCodeLivre
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
LivreSorti = 0
StrDate = "'" & Year(Date) & "-" & Month(date) & "-" & Day(date) & "'"
bOK = 1
do while bOK
bOK = resultat.next
DateSortie = resultat.getColumns().getByName("Date").getString()
RenduLe = resultat.getColumns().getByName("Rendu le").getString()
LivreSorti = LivreSorti + 1
if RenduLe = "00:00:00" then
RecNumber = resultat.getColumns().getByName("ID").getString()
LivreSorti = LivreSorti - 1
' UPDATE <table> SET <champ1> = expression1 [ , <champ2> = expression2,...] [ WHERE expression ]
selectSQL = "UPDATE ""Prêts"" SET ""Rendu le"" =" & StrDate & " where ""Code livre"" = " & StrCodeLivre & " and ""ID"" =" & RecNumber
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
exit do
end if
loop
CloseDatabase(maConnexion)
exit function
TraitementErreur:
if LivreSorti > 0 then
beep
beep
msgbox "Ce livre n'est PAS sorti" + chr$(13) + "Enregistrez un autre livre"
CloseDatabase(maConnexion)
resume NextLivre
end if
beep
beep
MsgBox "Error code: " + Err + Chr$(13) + Error$
stop
FinEnregistrement:
CloseDatabase(maConnexion)
End function
'********************************************************************************************************
' Function to open the database
'********************************************************************************************************
Function OpenDatabase(maConnexion)
dim maRequete as Object, resultat as Object
dim selectSQL as String
Dim NomSource As String, login As String, password As String
Dim maSource As Object, monDbContext As Object
on error goto ErrorHandling
' Création du contexte
NomSource = "OOOBCDI"
monDbContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
maSource = monDbContext.getByName(NomSource)
login = ""
password = ""
maConnexion = maSource.getConnection(login, password)
if IsNull(maConnexion) then
MsgBox("Connexion impossible", 16)
Stop
end if
exit function
ErrorHandling:
MsgBox "Error code: " + Err + Chr$(13) + Error$
End Function
Function CloseDatabase(maConnexion)
maConnexion.close
maConnexion.dispose
End Function
'********************************************************************************************************
' function to open a form
'********************************************************************************************************
Sub OuvForm(evt As Object)
'*************************************************************************************************
'Lancée par l'appui sur un bouton
' Permet l'ouverture d'un formulaire dont le nom est renseigné dans le champ
' "Complément d'information" du bouton
'=================================================================================================
Dim oForms As Object
Dim sNomForm As String
sNomForm = evt.Source.Model.tag
oForms = ThisComponent.Parent.FormDocuments
IF oForms.hasByName(sNomForm) Then
oForms.getByName(sNomForm).open
Else
MsgBox("Formulaire inconnu : " & sNomForm, 16)
End IF
End Sub
'********************************************************************************************************
' Function to open a report
'********************************************************************************************************
Sub OuvRap(evt As Object)
'*************************************************************************************************
'Lancée par l'appui sur un bouton
' Permet l'ouverture d'un rapport dont le nom est renseigné dans le champ
' "Complément d'information" du bouton
'=================================================================================================
Dim oForms As Object
Dim sNomRapport As String
sNomRapport = evt.Source.Model.tag
oForms = ThisComponent.Parent.ReportDocuments
IF oForms.hasByName(sNomRapport) Then
oForms.getByName(sNomRapport).open
Else
MsgBox("Rapport inconnu : " & sNomRapport, 16)
End IF
End Sub
'********************************************************************************************************
' Test for input free fields
'********************************************************************************************************
Sub MesChamps
'
dim monDocument As Object
dim monForm As Object
dim monChampNum As Double
dim monChamp1 As String
dim monChamp2 As String
dim maCase As Boolean
'
monDocument = StarDesktop.CurrentComponent
monForm = monDocument.DrawPage.Forms.GetByIndex(0)
monChampNum = monForm.GetByName("ZONENUM").EffectiveValue
' MsgBox momChampNum
' maCase = monForm.GetByName("CheckBoxTest").EffectiveValue
' MsgBox maCase
monChamp1 = monForm.GetByName("MAZONE").Text
monChamp2 = monForm.GetByName("MAZONE2").Text
MonChampNum = MonChampNum * 2
MsgBox monChamp1 & "-" & monChamp2 & "-" & monChampNum
monForm.GetByName("ZONENUM").EffectiveValue = monChampNum
monForm.GetByName("ZONENUM").commit
End Sub
'********************************************************************************************************
' Sub to reset field used as input during free fields test
'********************************************************************************************************
Sub MesChampsReset
'
dim monDocument As Object
dim monForm As Object
dim monChampNum As Double
dim monChamp1 As String
dim monChamp2 As String
dim maCase As Boolean
'
monDocument = StarDesktop.CurrentComponent
monForm = monDocument.DrawPage.Forms.GetByIndex(0)
monForm.GetByName("ZONENUM").EffectiveValue = 0
monForm.GetByName("MAZONE").Text = ""
monForm.GetByName("MAZONE2").Text = ""
' monForm.GetByName("ZONENUM").EffectiveValue = monChampNum
monForm.GetByName("ZONENUM").commit
End Sub
'********************************************************************************************************
' Sub to erase two flags
'********************************************************************************************************
sub EraseLabelsFlag
dim maRequete as Object, resultat as Object
On error goto TraitementErreur
beep
beep
If MsgBox ("Attention, cette action est irréversible" & chr$(13) & _
"Voulez-vous continuer ?", 292, "Mise à jour des témoins") = 6 Then
' Yes button pressed
Else
Stop
End IF
OpenDatabase(maConnexion)
selectSQL = "UPDATE ""Livres"" SET ""Etiquette Livre"" ='', ""Etiquette Fiche"" ='' where ""Etiquette Livre"" =1 or ""Etiquette Fiche"" =1"
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
Goto FinEnregistrement
TraitementErreur:
beep
beep
MsgBox "Error code: " + Err + Chr$(13) + Error$
stop
FinEnregistrement:
CloseDatabase(maConnexion)
msgbox "Fin du traitement"
End Sub
'****************************************************************************************
' Routine qui permet de préparer le string pour un BARCODE128. Pêchée sur le net
' function to prepare correct coding string for CODE128. Found in the forum
'****************************************************************************************
Public Function code128(chaine as string)
'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
'This function is governed by the GNU Lesser General Public License (GNU LGPL)
'V 2.0.0
'Paramètres : une chaine
'Parameters : a string
'Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
' * an empty string if the supplied parameter is no good
Dim i%, checksum&, mini%, dummy%, tableB As Boolean
code128 = ""
If Len(chaine) > 0 Then
'Vérifier si caractères valides
'Check for valid characters
For i% = 1 To Len(chaine)
Select Case Asc(Mid$(chaine, i%, 1))
Case 32 To 126, 203
Case Else
i% = 0
Exit For
End Select
Next
'Calculer la chaine de code en optimisant l'usage des tables B et C
'Calculation of the code string with optimized use of tables B and C
code128 = ""
tableB = True
If i% > 0 Then
i% = 1 'i% devient l'index sur la chaine / i% become the string index
Do While i% <= Len(chaine)
If tableB Then
'Voir si intéressant de passer en table C / See if interesting to switch to table C
'Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres / yes for 4 digits at start or end, else if 6 digits
If i% = 1 Or i% + 3 = Len(chaine) Then mini% = 4 Else mini% = 6
GoSub testnum
If mini% < 0 Then 'Choix table C / Choice of table C
If i% = 1 Then 'Débuter sur table C / Starting with table C
code128 = Chr$(210)
Else 'Commuter sur table C / Switch to table C
code128 = code128 & Chr$(204)
End If
tableB = False
Else
If i% = 1 Then code128 = Chr$(209) 'Débuter sur table B / Starting with table B
End If
End If
If Not tableB Then
'On est sur la table C, essayer de traiter 2 chiffres / We are on table C, try to process 2 digits
mini% = 2
GoSub testnum
If mini% < 0 Then 'OK pour 2 chiffres, les traiter / OK for 2 digits, process it
dummy% = Val(Mid$(chaine, i%, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
code128 = code128 & Chr$(dummy%)
i% = i% + 2
Else 'On n'a pas 2 chiffres, repasser en table B / We haven't 2 digits, switch to table B
code128 = code128 & Chr$(205)
tableB = True
End If
End If
If tableB Then
'Traiter 1 caractère en table B / Process 1 digit with table B
code128 = code128 & Mid$(chaine, i%, 1)
i% = i% + 1
End If
Loop
'Calcul de la clé de contrôle / Calculation of the checksum
For i% = 1 To Len(code128)
dummy% = Asc(Mid$(code128, i%, 1))
If dummy% < 127 Then dummy% = dummy% - 32 Else dummy% = dummy% - 105
If i% = 1 Then checksum& = dummy%
checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
Next
'Calcul du code ASCII de la clé / Calculation of the checksum ASCII code
checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
'Ajout de la clé et du STOP / Add the checksum and the STOP
code128 = code128 & Chr$(checksum&) & Chr$(211)
End If
End If
Exit Function
testnum:
'si les mini% caractères à partir de i% sont numériques, alors mini%=0
'if the mini% characters from i% are numeric, then mini%=0
mini% = mini% - 1
If i% + mini% <= Len(chaine) Then
Do While mini% >= 0
If Asc(Mid$(chaine, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine, i% + mini%, 1)) > 57 Then Exit Do
mini% = mini% - 1
Loop
End If
Return
End Function
'*******************************************************************************************
' Cette routine prépare la colonne BARCODE en y ajoutant les codes de CODE128
' Sets up BARCODE column with prefix and suffix suitable for CODE128
'*******************************************************************************************
Sub PrepareLabels
dim maRequete as Object, resultat as Object
dim SELCODE as string, BARCODE as string
dim bOK as boolean, APOSBC as string
On error goto TraitementErreur
OpenDatabase(maConnexion)
bOK = 1
do while bOK
selectSQL = "select ""Code"", ""BARCODE"" from ""Livres"" WHERE ""BARCODE"" is null "
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
bOK = resultat.next
if bOK then
else
goto FinTraitement
end if
SELCODE = ""
BARCODE = ""
SELCODE = resultat.getcolumns().getByName("Code").getString()
SELCODE = trim(SELCODE)
APOSBC = CODE128(SELCODE)
BARCODE = "'" & DbleApostr(APOSBC) & "'"
selectSQL = "UPDATE ""Livres"" SET ""BARCODE"" = " & BARCODE & " WHERE ""Code"" ='" & SELCODE & "'"
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
' end if
loop
Goto FinTraitement
TraitementErreur:
beep
beep
MsgBox "Error code: " + Err + Chr$(13) + Error$
stop
FinTraitement:
msgbox "Fin du traitement BC Livres"
CloseDatabase(maConnexion)
End Sub
'*************************************************************************************
' dédoublement des apostrophes pour la confection du CODE 128
' when the code128 generates apostrophs, this routine will double them
'*************************************************************************************
Function DbleApostr ( sEntree As String ) As String
Dim lLongueur As Long, sChar As String
Dim sSortie As String, i As Long
dim PositionOfMatch as integer
lLongueur = Len ( sEntree )
PositionOfMatch = InStr(1, sEntree, "'")
if PositionOfMatch <> 0 then
else
DbleApostr = sEntree
exit function
endif
sSortie = ""
For i = 1 to lLongueur
sChar = Mid ( sEntree, i, 1 )
If sChar = "'" then
sChar = "''"
End If
sSortie = sSortie & sChar
Next i
DbleApostr = sSortie
End Function
'***********************************************************************************************
' Cette routine prépare la colonne BARCODE Lecteurs en y ajoutant les codes nécessaires au CODE128
' This routine sets up BARCODE COLUMNS for readers by adding suitable prefix and suffixes
'***********************************************************************************************
Sub PrepareLecteurs
dim maRequete as Object, resultat as Object
dim SELCODE as string, BARCODE as string
dim bOK as boolean, APOSBC as string
On error goto TraitementErreur
OpenDatabase(maConnexion)
bOK = 1
do while bOK
selectSQL = "select ""Numéro"", ""BARCODE"" from ""Lecteurs"" WHERE ""BARCODE"" is null "
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
bOK = resultat.next
if bOK then
else
goto FinTraitement
end if
SELCODE = ""
BARCODE = ""
SELCODE = resultat.getcolumns().getByName("Numéro").getString()
SELCODE = trim(SELCODE)
APOSBC = CODE128(SELCODE)
BARCODE = "'" & DbleApostr(APOSBC) & "'"
selectSQL = "UPDATE ""Lecteurs"" SET ""BARCODE"" = " & BARCODE & " WHERE ""Numéro"" ='" & SELCODE & "'"
maRequete = maConnexion.createStatement()
resultat = maRequete.executeQuery(selectSQL)
' end if
loop
Goto FinTraitement
TraitementErreur:
beep
beep
MsgBox "Error code: " + Err + Chr$(13) + Error$
stop
FinTraitement:
msgbox "Fin du traitement Lecteurs"
CloseDatabase(maConnexion)
End Sub
'***********************************************************************************************
' Cette routine ouvre le modèle des étiquettes BARCODE pour livres
' This routine calls up the mailmerge form within Base to prepare BARCODES labels print
'***********************************************************************************************
Sub OuvrirEtiqBC
Dim oShell As Object
Dim Fichier As String
Fichier ="C:\OOOBCDI\OOOBCDI_ETIQUETTES.odt"
oShell = createUnoService("com.sun.star.system.SystemShellExecute")
oShell.execute(ConvertToUrl( Fichier ), "", 0)
End Sub
'***********************************************************************************************
' Cette routine ferme OOOBCDI avec l'aide d'AUTOIT
' This routine closes OOOBCDI with the help of an external application made with AutoIt
'***********************************************************************************************
Sub FermerOOOBCDI
Dim oShell As Object
Dim Fichier As String
Fichier ="C:\OOOBCDI\CloseOOOBCDI.exe"
oShell = createUnoService("com.sun.star.system.SystemShellExecute")
oShell.execute(ConvertToUrl( Fichier ), "", 0)
End Sub