libreoffice-canzeley-client 0.5.0-2 / usr / lib / libreoffice / share / extensions / canzeley-client / Kanzleiprogramm / SysDatenMod1.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SysDatenMod1" script:language="StarBasic">REM                        *****  BASIC  *****
REM        	              ***** Canzeley *****
REM              Copyright (C) 2008, 2009, 2016 Dr. Michael Stehmann
REM                  info@rechtsanwalt-stehmann.de
REM This program is free software: you can redistribute it and/or modify it
REM under the terms of the GNU General Public License as published by the
REM Free Software Foundation, either version 3 of the License, or any later version.
REM This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
REM without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
REM See the GNU General Public License for more details.
REM You should have received a copy of the GNU General Public License along with this program.
REM If not, see &lt;http://www.gnu.org/licenses/&gt;.
REM                      *** Version 0.5.0 ***

REM **** Kanzleiprogramm - SysDatenMod1 ****

Option Explicit

Private sOs As String
Private sAutoMount As String
Private oTabellen As Object
Private oTabelle As Object
Private oZelle As Object
Private iDocSpeichern As Integer
Private sAutoMountRecent As String
Private sDataBaseNameRecent As String
Private sVuDPfadRecent As String
Private sSystemdatei As String
Private sDateiname As String


Sub ProgrammStart

	iSysDatenFrom = 0

OSFeststellen
SystemdatenFeststellen

	If iAbbruchFlag = 1 Then
		Exit Sub
	End If
	
SystemdatenErgaenzen

RegDBMod1.RegDBNamePruefen

	If iPruef = 1 Then
		iAbbruchFlag = 1
		Exit Sub
	End If

DBAnbindMod.Datenbankanbindung

	If iPruef = 1 Then
		iAbbruchFlag = 1
		Exit Sub
	End If
	
	If iOs = 4 And iAutoMount = 1 Then
	
	FSMod.Mounttest

		If iMountTest = 0 Then MountFehlerSuche
		
		If iAbbruchFlag = 1 Then Exit Sub
	
	End If

End Sub


Sub OSFeststellen

Dim sP2H As String
Dim sHomePfad As String

REM * Betriebssystem ermitteln *
REM * Unixoid (incl. MacOS) = 4 *
REM * Windows               = 1 *

	iOs = GetGuiType
	
REM * Die Bezeichnung der Umgebungsvariablen, die den Pfad zum *
REM * Home-Verzeichnis des jeweiligen Nutzers enthält, ist OS-spezifisch *	
	
	Select Case iOs
	
		Case 1
			sOs = &quot;Windows&quot;
			sP2H = &quot;HOMEPATH&quot;
			
		Case 4
			sOs = &quot;unixoid&quot;
			sP2H = &quot;HOME&quot;
			
		Case Else
			sOs = &quot;unbekannt&quot;
			MsgBox &quot;Merkwürdiges Betriebssystem!&quot;
						
	End Select
	
REM * Pfad zum Home-Verzeichnis des jeweiligen Nutzers ermitteln *

	sHomePfad = environ(sP2H)

REM * Pfad mit Dateinamen bilden *
REM * Bei Windows muss noch der Laufwerksbuchstabe hinzugefuegt werden *
	
	If iOs = 1 Then	
		sSystemdatei =  environ(&quot;HOMEDRIVE&quot;) + sHomePfad + &quot;\canzeleysystemdaten.txt&quot;
	Else
		sSystemdatei =  ConvertToURL(sHomePfad) + &quot;/.canzeleysystemdaten&quot;
	End If

End Sub


Sub SystemdatenFeststellen

	If Not FileExists(sSystemdatei) Then
	
	SystemdatendateiErzeugen
	
	Else
	
	SystemdatenAuslesen
	
	End If

End Sub


Sub SystemdatendateiErzeugen

Dim iFileNo1 As Integer

REM * Datei durch Oeffnen zum Schreiben erzeugen *
	
	iFileNo1=freeFile
	
	Open sSystemdatei For Output As #iFileNo1
		Write #iFileNo1,&quot;&quot;,&quot;&quot;,&quot;&quot;,&quot;&quot;
	Close #iFileNo1
		
End Sub


Sub SystemdatenAuslesen

Dim iFileNo As Integer

On Local Error Goto DateiLeer

	iFileNo=freeFile
	
	Open sSystemdatei For Input As #iFileNo
		Input #iFileNo, sVuDPfad, sDataBaseName, sAutoMount,sPDFVuD
	Close #iFileNo
	
Exit Sub

DateiLeer:
SystemdatendateiErzeugen

End Sub


Sub SystemdatenErgaenzen

	iDocSpeichern = 0
	
	If sVuDPfad = &quot;&quot; Then
		iDocSpeichern = 1
		MsgBox &quot;Wählen Sie den Pfad zum Verzeichnis, das die Canzeley-Dokumente enthält!&quot;		
	VuDPfadAbfragen
	End If
	
	If sDataBaseName = &quot;&quot; Then
		iDocSpeichern = 1
		MsgBox &quot;Wählen Sie die Datenbankdatei nach ihrem registrierten Namen!&quot;
	DataBaseNameAbfragen
	Else
	RegDBMod1.RegDBNamePruefenUndWaehlen
	End If

	If iOs = 4 And sAutoMount = &quot;&quot; Then
	AutoMountAbfragen
	Else	
	AutoMountWertBilden
	End If
	
	If iDocSpeichern = 1 Then ProgrammdokumentSpeichern

End Sub


REM ** Die beiden folgenden Makros befassen sich mit dem Pfad **
REM ** zu dem Verzeichnis, welches die (Unter-)Verzeichnisse „Vorlagen“ und „Dokumente“ enthaelt **
Sub VuDPfadAbfragen

Dim oVDlg As Object
Dim iVDlg As Integer
Dim j As Integer

REM * Verzeichnisauswahldialog wird aufgerufen *
	oVDlg = CreateUnoService(&quot;com.sun.star.ui.dialogs.FolderPicker&quot;)

	iVDlg = oVDlg.Execute()

REM * Wenn &quot;Auswählen&quot; gedrueckt wurde, ist iVDlg = 1, sonst 0 *
REM * Wenn &quot;Auswählen&quot; gedrueckt wurde,	wird der ausgewählte Pfad *
REM * in sVuDPfad geschrieben *
	If iVDlg = 1 Then sVuDPfad = oVDlg.getDirectory()
			
	If sVuDPfad = &quot;&quot; Then	
		iAbbruchFlag = 1
		Exit Sub		
	Else	
	VuDPfadBilden	
	End If
				
End Sub


Sub VuDPfadBilden

Dim iVuDPfadL As Integer

	If iOs = 1 Then
		sVuDPfad = ConvertToUrl(sVuDPfad)
	End If

REM * &quot;file://&quot; wird entfernt *
	If Left(sVuDPfad, 7) = &quot;file://&quot; Then
		iVuDPfadL = Len(sVuDPfad)
		If iOs = 1 Then
			sVuDPfad = Right(sVuDPfad, iVuDPfadL-8)
		Else
			sVuDPfad = Right(sVuDPfad, iVuDPfadL-7)
		End If
	End If
	
REM * Patch fuer MacOSX MountainLion +
REM * &quot;localhost&quot; wird entfernt *
	If Left(sVuDPfad,9) = &quot;localhost&quot; Then
		iVuDPfadL = Len(sVuDPfad)
		sVuDPfad = Right(sVuDPfad, iVuDPfadL-9)
	End If

REM * Am Ende steht auf jeden Fall ein &quot;/&quot; *	
	If Right(sVuDPfad, 1) &lt;&gt; &quot;/&quot; Then
		sVuDPfad = sVuDPfad+&quot;/&quot;
	End If
	
End Sub


REM ** Die beiden folgenden Makros befassen sich mit der Datei **
REM ** einschliesslich Pfad (Verzeichnis), welche den PDF-Reader enthaelt**
Sub VuDPDFAbfragen

Dim oFDlg As Object
Dim iFDlg As Integer
Dim j As Integer

REM * Verzeichnisauswahldialog wird aufgerufen *
	oFDlg = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)

	iFDlg = oFDlg.Execute()

REM * Wenn &quot;Auswählen&quot; gedrueckt wurde, ist iVDlg = 1, sonst 0 *
REM * Wenn &quot;Auswählen&quot; gedrueckt wurde,	wird der ausgewählte Pfad *
REM * in sVuDPfad geschrieben *
	If iFDlg = 1 Then sPDFVuD = oFDlg.Files(0)
			
	If sPDFVuD &lt;&gt; &quot;&quot; Then
	VuDPDFBilden
	End If

End Sub


Sub VuDPDFBilden

Dim iPDFVuDL As Integer

	If iOs = 1 Then
		sPDFVuD = ConvertToUrl(sPDFVuD)
	End If

REM * &quot;file://&quot; wird entfernt *
	If Left(sPDFVuD, 7) = &quot;file://&quot; Then
		iPDFVuDL = Len(sPDFVuD)
		If iOs = 1 Then
			sPDFVuD = Right(sPDFVuD, iPDFVuDL-8)
		Else
			sPDFVuD = Right(sPDFVuD, iPDFVuDL-7)
		End If
	End If
	
End Sub


Sub DataBaseNameAbfragen

RegDBMod1.RegDBAnzeigen
		
	If sDataBaseName = &quot;&quot; Then
		iAbbruchFlag = 1
		Exit Sub
	End If

End Sub


Sub AutoMountAbfragen
	
	iAutoMount = MsgBox(&quot;Durch Programm mounten?&quot;,4+256+32,&quot;Eingabe Systemdatum&quot;)
		
	If iAutoMount = 6 Then
		iAutoMount = 1
		sAutoMount = &quot;Ja&quot;
	Else
		iAutoMount = 0
		sAutoMount = &quot;Nein&quot;
	End If
	
	iDocSpeichern = 1	
				
End Sub


Sub AutoMountWertBilden
	
	If sAutoMount = &quot;JA&quot; Or sAutoMount = &quot;ja&quot; Then
		sAutoMount = &quot;Ja&quot;
	End If
	
	If sAutoMount = &quot;Ja&quot; Then
		iAutoMount = 1
	Else
		iAutoMount = 0
	End If
						
End Sub


Sub ProgrammdokumentSpeichern

Dim iFileNo2 As Integer

SystemdatendateiErzeugen

	iFileNo2=freeFile
	
	Open sSystemdatei For Output As #iFileNo2
		Write #iFileNo2, sVuDPfad, sDataBaseName, sAutoMount, sPDFVuD
	Close #iFileNo2

		
End Sub


Sub MountFehlerSuche

Dim iAntwort As Integer

	iAntwort = MsgBox (&quot;Befindet sich in dem zu mountenden Verzeichnis eine Datei &apos;mounttest.txt&apos;?&quot;, 4+32+256, &quot;Mounten mißlungen!&quot;)

	If iAntwort = 7 Then
		MsgBox &quot;Bitte in dem zu mountenden Verzeichnis die Datei &apos;mounttest.txt&apos; einfügen&quot;
		iAbbruchFlag = 1
	Else
	NeuerMountPoint	
	End If
	
End Sub


Sub NeuerMountPoint

	MsgBox &quot;Wählen Sie einen neuen Mountpoint!&quot;
	
VuDPfadAbfragen
FSMod.Mounttest

	If iMountTest = 0 Then
		MsgBox (&quot;Mounten erneut mißlungen! Bitte Ursache suchen!&quot;,16,&quot;Erneuter Fehlschlag&quot;)
		iAbbruchFlag = 1
	Else
		MsgBox (&quot;Mounten gelungen!&quot;,64,&quot;Es hat geklappt!&quot;)
	End If
	 
End Sub


REM ** Dieses Makro wird vom &quot;SystemdatenAendern&quot;-Menuepunkt aufgerufen **
Sub SystemDatenAendern

	iSysDatenFrom = 1

OSFeststellen
SystemdatenFeststellen
AutoMountWertBilden

CreateSysDatenDia
OSAnzeige
VersionAnzeige

	If sDBVersion &lt;&gt; &quot;&quot; Then DBVersionAnzeige

PfadAnzeige
PDFPfadAnzeige
DBDateiAnzeige
AutomountLabel
StructLabel

SysDatenDiaAusfuehren

End Sub


Sub CreateSysDatenDia

	DialogLibraries.LoadLibrary(&quot;Kanzleiprogramm&quot;)
	oDlg = CreateUnoDialog(DialogLibraries.Kanzleiprogramm.SysDatenDia)

End Sub


Sub OSAnzeige

Dim oLabel As Object

	oLabel = oDlg.GetControl(&quot;OSLabel&quot;)
	oLabel.model.Label = sOs

End Sub


Sub VersionAnzeige

Dim oLabel As Object

	oLabel = oDlg.GetControl(&quot;VersionUndBuild&quot;)
	oLabel.model.Label = &quot;Version: &quot;+csVersion+&quot; - Build: &quot;+csBuild

End Sub


Sub DBVersionAnzeige

Dim oLabel As Object

	oLabel = oDlg.GetControl(&quot;DBVersionTextLabel&quot;)
	oLabel.model.Label = sDBVersion	

End Sub


Sub AutomountLabel

Dim oLabel As Object
Dim oMountTest As Object

	oDlg.getControl(&quot;UnMountButton&quot;).enable = False
	
	If iOs &lt;&gt; 4 Then
		oDlg.getControl(&quot;JaOptionButton&quot;).enable = False
		oDlg.getControl(&quot;NeinOptionButton&quot;).enable = False
		oDlg.getControl(&quot;MountTestButton&quot;).enable = False
		
	End If
	
	If iOs = 4 Then
		
		oLabel = oDlg.GetControl(&quot;AutomountLabel&quot;)
		oLabel.model.Label = &quot;Automount:&quot;
		
		oDlg.getControl(&quot;JaOptionButton&quot;).enable = True
		oDlg.getControl(&quot;JaOptionButton&quot;).label = &quot;Ja&quot;
		
		oDlg.getControl(&quot;NeinOptionButton&quot;).enable = True
		oDlg.getControl(&quot;NeinOptionButton&quot;).label = &quot;Nein&quot;
		
		sAutoMountRecent = sAutoMount
		
		If iAutoMount = 1 Then
		
			oDlg.getControl(&quot;JaOptionButton&quot;).state = True
			
			oDlg.getControl(&quot;MountTestButton&quot;).enable = True
			oMountTest = oDlg.getControl(&quot;MountTestButton&quot;)
			oMountTest.setLabel(&quot;Testen&quot;)
			
		Else
			oDlg.getControl(&quot;NeinOptionButton&quot;).state = True
		End If
		
	End If
	
End Sub


Sub PfadAnzeige

Dim oLabel As Object

	If sVuDPfad = &quot;&quot; Then
		MsgBox &quot;Wählen Sie den Pfad zum Verzeichnis, das die Canzeley-Dokumente enthält!&quot;
	VuDPfadAbfragen
	ProgrammdokumentSpeichern
	End If
	
	oLabel = oDlg.GetControl(&quot;PfadTextLabel&quot;)
	oLabel.model.Label = sVuDPfad
	
End Sub


Sub PDFPfadAnzeige

Dim oLabel As Object

	oLabel = oDlg.GetControl(&quot;PDFTextLabel&quot;)
	oLabel.model.Label = sPDFVuD
	
End Sub



Sub DBDateiAnzeige

Dim oLabel As Object

	If sDataBaseName = &quot;&quot; Then
		MsgBox &quot;Wählen Sie die Datenbankdatei nach ihrem registrierten Namen!&quot;
	RegDBMod1.RegDBAnzeigen
	ProgrammdokumentSpeichern
	Else
	RegDBMod1.RegDBNamePruefenUndWaehlen
	End If
	
	oLabel = oDlg.GetControl(&quot;DBNameLabel&quot;)
	oLabel.model.Label = sDataBaseName

End Sub

REM ** Makro zeigt an, ob date-Wert Struct sein muss **
Sub StructLabel

Dim oLabel As Object
Dim sStructAntwort As String

LibOMod.IsDateStruct

	If bDateStruct = false Then
		sStructAntwort = &quot;Nein und das ist gut so!&quot;
	Elseif bDateStruct = true Then
		sStructAntwort = &quot;Leider ja&quot;
	Else
		sStructAntwort = &quot;Weiß nicht&quot;
	End If
				
	oLabel = oDlg.GetControl(&quot;StructAntwort&quot;)
	oLabel.model.Label = sStructAntwort

End Sub


Sub SysDatenDiaAusfuehren

	oDlg.Execute()

End Sub


REM **Dieses Makro wird durch Klicken auf die **
REM **Schaltfäche &quot;SysDatenDia.SpeichernButton&quot; aufgerufen **
Sub Speichern2Doc

	iPruef = 0
	iDocSpeichern = 0
	
VuDPfadSpeichern	
DataBaseNameSpeichern

	If iOs = 4 Then AutomountWertSpeichern

	If iPruef = 1 Then Exit Sub
	
	If iDocSpeichern = 1 Then ProgrammdokumentSpeichern

SysDatenDiaSchliessen
	
End Sub


Sub VuDPfadSpeichern

	If sVuDPfad = &quot;&quot; Then
		MsgBox(&quot;Ohne Angabe des Pfades zum Verzeichnis, das die (Unter-)Verzeichnisse „Vorlagen“ und „Dokumente“ enthält, funktioniert das Programm nicht!&quot;,16,&quot;Fehlende Eingabe&quot;)
		iPruef = 1
		Exit Sub
	End If
	
	If sVuDPfad &lt;&gt; sVuDPfadRecent Then
		iDocSpeichern = 1
	End If


End Sub


Sub DataBaseNameSpeichern

	If sDataBaseName = &quot;&quot; Then
		MsgBox(&quot;Ohne Angabe des reg. Namens der Datenbankdatei funktioniert das Programm nicht!&quot;,16,&quot;Fehlende Eingabe&quot;)
		iPruef = 1
	Else
	RegDBMod1.RegDBNamePruefen
	End If
	
	If iPruef = 1 Then Exit Sub
	
	If sDataBaseName &lt;&gt; sDataBaseNameRecent Then
		iDocSpeichern = 1
	End If

End Sub


Sub AutomountWertSpeichern

	If oDlg.GetControl(&quot;JaOptionButton&quot;).state Then
		sAutoMount = &quot;Ja&quot;
	Else
		sAutoMount = &quot;Nein&quot;
	End If
	
	If sAutoMount &lt;&gt; sAutoMountRecent Then
		iDocSpeichern = 1	
	End If
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.SchliessenButton&quot; **
REM ** oder vom Makro &quot;SysDatenMod1.Speichern2Doc&quot; aufgerufen **
Sub SysDatenDiaSchliessen
	
	oDlg.EndExecute()
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.PfadAendernButton&quot; aufgerufen **
Sub PfadAendernButton

VuDPfadAbfragen
VuDPfadBilden
PfadAnzeige
	iDocSpeichern = 1
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.PDFAendernButton&quot; aufgerufen **
Sub PDFAendernButton

VuDPDFAbfragen
VuDPDFBilden
PDFPfadAnzeige
	iDocSpeichern = 1
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.DBNameAendernButton&quot; aufgerufen **
Sub DBNameAendernButton

RegDBMod1.RegDBAnzeigen
DBDateiAnzeige
	iDocSpeichern = 1
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.DBVerbTestenButton&quot; aufgerufen **
Sub DBVerbindungTesten

	sDBVersion = &quot;&quot;
DBVersionAnzeige	
	
DBAnbindMod.Datenbankanbindung

	If iAbbruchFlag = 1 Then sDBVersion = &quot;Verbindung gescheitert!&quot;
	
DBVersionAnzeige	

End Sub


REM ** Dieses Makro wird bei einer Änderung des Status der **
REM ** Schaltfächen &quot;SysDatenDia.JaOptionButton&quot; oder &quot;SysDatenDia.NeinOptionButton&quot; aufgerufen **
Sub StatusAenderung

Dim oMountTest As Object
Dim oLabel As Object

	If oDlg.GetControl(&quot;JaOptionButton&quot;).state Then
		sAutoMount = &quot;Ja&quot;
	Else
		sAutoMount = &quot;Nein&quot;
	End If
	
	If 	sAutoMount = &quot;Ja&quot; Then

		oDlg.getControl(&quot;MountTestButton&quot;).enable = True
		oMountTest = oDlg.getControl(&quot;MountTestButton&quot;)
		oMountTest.setLabel(&quot;Testen&quot;)
		
		iAutoMount = 1
			
	Else
			
		oMountTest = oDlg.getControl(&quot;MountTestButton&quot;)
		oMountTest.setLabel(&quot;&quot;)	
		oDlg.getControl(&quot;MountTestButton&quot;).enable = False
		
		iAutoMount = 0
		
	End If
	
	oLabel = oDlg.GetControl(&quot;MountTestLabel&quot;)
	oLabel.model.Label = &quot;&quot;
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.MountTestButton&quot; aufgerufen **
Sub SysDatenMountTest

Dim oLabel As Object
Dim oUnMount As Object

FSMod.Mounttest

	oLabel = oDlg.GetControl(&quot;MountTestLabel&quot;)

	If iMountTest = 1 Then
	
		oLabel.model.Label = &quot;Gelungen!&quot;
		
		oDlg.getControl(&quot;UnMountButton&quot;).enable = True
		oUnMount = oDlg.getControl(&quot;UnMountButton&quot;)
		oUnMount.setLabel(&quot;umount&quot;)
		
	Else
		oLabel.model.Label = &quot;Mißlungen!&quot;
	End If
	
End Sub


REM ** Dieses Makro wird durch Klicken auf die **
REM ** Schaltfäche &quot;SysDatenDia.UnMountButton&quot; aufgerufen **
Sub SysDatenUnMount

Dim oLabel As Object
Dim oUnMount As Object

FSMod.Umount

	oLabel = oDlg.GetControl(&quot;MountTestLabel&quot;)
	oLabel.model.Label = &quot;&quot;
	
	oUnMount = oDlg.getControl(&quot;UnMountButton&quot;)
	oUnMount.setLabel(&quot;&quot;)
	oDlg.getControl(&quot;UnMountButton&quot;).enable = False
	
End Sub

</script:module>