Page 1 of 1

Providing OpenOffice Base experience to others

Posted: Wed Nov 23, 2016 3:59 pm
by JohnDrake
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

#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

'********************************************************************************************************
'	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