Providing OpenOffice Base experience to others

Some examples to be used directly
Forum rules
No question in this forum please
For any question related to a topic, create a new thread in the relevant section.

Providing OpenOffice Base experience to others

Postby JohnDrake » 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:

Code: Select all   Expand viewCollapse view
#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


The other Basic code can be found hereunder:
Code: Select all   Expand viewCollapse view
'********************************************************************************************************
'   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


Placed code tags around the code, floris v, moderator
OpenOffice 4.1.3 on Windows 7, 64 bits
JohnDrake
 
Posts: 3
Joined: Wed Nov 23, 2016 3:26 pm

Return to Database Examples

Who is online

Users browsing this forum: No registered users and 0 guests