Imports System.ComponentModel Imports System.IO Imports System.Xml Imports System.Xml.Serialization Public Class frmMain Dim WithEvents evh As Generic_Event_Handler = Globals.EVH 'Dim sec As New MySecurity Private Sub BeendenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub Private Sub StammdatenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles StammdatenToolStripMenuItem.Click End Sub Private Sub SpaltentitelToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SpaltentitelToolStripMenuItem.Click Dim f As New frmSysadminTableSelector() Dim tablename As String tablename = (f.get_tablename()) If tablename = "" Then Exit Sub Dim db As New clsDB db.Generate_SpaltenData(tablename) End Sub Private Sub StammdatenToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles StammdatenToolStripMenuItem1.Click Dim f As New frmStammdaten f.MdiParent = Me f.Show() End Sub Private Sub LocalizeString(sender As Object, e As DevComponents.DotNetBar.LocalizeEventArgs) If e.Key = "monthcalendar_todaybutton" Then e.LocalizedValue = "Heute" End If If e.Key = "monthcalendar_clearbutton" Then e.LocalizedValue = "Löschen" End If e.Handled = True End Sub Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load AddHandler DevComponents.DotNetBar.LocalizationKeys.LocalizeString, AddressOf LocalizeString Dim args As String() = Environment.GetCommandLineArgs() Try If args(1) = "dmstest" Then My.Settings.TempPath = Application.StartupPath + "\Demo\" My.Settings.DocArchivPath = Application.StartupPath + "\Demo" My.Settings.ConnectionString = "data source=shu00;initial catalog=dpm2018_1;integrated security=SSPI;persist security info=false;workstation id=;packet size=4096;user id=sa;password=*shu29" Dim db As New clsDB db.Get_Spaltendata() Globals.Spaltendaten = db.dsDaten.Tables(0) Globals.ActUser = 1 Dim f As New dmstest f.MdiParent = Me f.Show() Exit Sub End If If args(1) = "PADM" Then My.Settings.SoftwareType = "PADM" Catch End Try Globals.License.Read_LicenseFile(Application.StartupPath + "\keyfile.key") If Globals.License.DemoMode Then Dim f As New frmDemoMode f.ShowDialog() My.Settings.TempPath = Application.StartupPath + "\Demo" My.Settings.DocArchivPath = Application.StartupPath + "\Demo" Globals.License.Gueltigbis = Now.AddDays(30) End If If Globals.License.Gueltigbis < Now Then MsgBox("Ihre Lizenz ist abgelaufen. Sie können diese erneuern.") Me.Close() Application.Exit() Exit Sub End If Dim ddif As Integer ddif = DateDiff(DateInterval.Day, Now, Globals.License.Gueltigbis) If ddif < 15 Then MsgBox("Achtung. Ihre Lizenz ist noch " + ddif.ToString + " Tage gültig. Erneuern Sie diese rechtzeitig.", vbInformation) End If Globals.Mainweindow = Me If check_db_connection() Then Dim db1 As New clsDB If UCase(db1.Get_Option(40000)) = "TRUE" Then Globals.Applicationtype = ApplicationTypes.Projektabrechnung Me.PatientToolStripMenuItem.Text = "Kunden" Me.FirmenToolStripMenuItem.Visible = False End If db1.Dispose() Dim db As New clsDB db.Get_Spaltendata() Globals.Spaltendaten = db.dsDaten.Tables(0) If frmLogin.Check_User Then PatientToolStripMenuItem_Click(sender, e) Else ActUser = -1 Dim f As New frmLogin f.ShowDialog() If ActUser = -1 Then Application.Exit() Me.Close() Exit Sub End If PatientToolStripMenuItem_Click(sender, e) End If Else MsgBox("Die Datenbank konnte nicht gefunden werden. Die Anwendung wird geschlossen.", vbExclamation) Application.Exit() End End If Me.Label1.Text = Globals.Databasename Me.Label1.Left = Me.Width - 100 - Me.Label1.Width Me.Text = My.Settings.SoftwareType + " - " + Globals.Databasename Refresh_Printerconfig() 'sec.Set_Form_Security(Me) Me.FinanzenToolStripMenuItem.Visible = True Me.AuswertungenToolStripMenuItem.Visible = True Me.StammdatenToolStripMenuItem.Visible = True Select Case Globals.Funktionsstufe Case 2 Me.FinanzenToolStripMenuItem.Visible = False Me.AuswertungenToolStripMenuItem.Visible = False Me.StammdatenToolStripMenuItem.Visible = False End Select Check_Tempdir() IntTables.Inttables.Tables.Clear() Dim db2 As New clsDB Globals.MailClient = db2.Get_Option(9805) Globals.Hide_Gueltig_bis = UCase(db2.Get_Option(9100)) = "TRUE" Globals.MenuString = db2.Get_Option("9101") Globals.Recall_nach_Abschluss = UCase(db2.Get_Option(9102)) = "TRUE" db2 = Nothing End Sub Sub Check_Tempdir() Dim splitter() As String splitter = My.Settings.TempPath.Split("\") Dim root As String root = splitter(0) + "\" + splitter(1) If Not System.IO.Directory.Exists(root) Then System.IO.Directory.CreateDirectory(root) End If If splitter.Length > 2 Then For i = 2 To splitter.Length - 1 root = root + "\" + splitter(i) If Not System.IO.Directory.Exists(root) Then System.IO.Directory.CreateDirectory(root) End If Next End If For i = 2 To splitter.Length - 2 Next If Not System.IO.Directory.Exists(My.Settings.TempPath) Then System.IO.Directory.CreateDirectory(My.Settings.TempPath) End If Delete_Files(My.Settings.TempPath, 4) Try If Globals.License.DMS = True Then Dim db As New clsDB db.Get_Tabledata("dms", "", "Select * from dms_settings where nreintrag=6") Delete_Files(db.dsDaten.Tables(0).Rows(0).Item(2), -1) End If Catch End Try End Sub Sub Delete_Files(ByVal path As String, ByVal intervall As Integer) Try Dim theFiles() As String = System.IO.Directory.GetFiles(path) For Each currentFile As String In theFiles Dim theFileInfo As New System.IO.FileInfo(currentFile) Dim dateDiff As TimeSpan = DateTime.Now.Subtract(theFileInfo.CreationTime.Date) If dateDiff.Days >= intervall Then System.IO.File.Delete(currentFile) End If Next Catch End Try End Sub Sub Refresh_Printerconfig() Me.cbboxPrinterConfig.Items.Clear() Dim ppath As String ppath = Application.StartupPath + "\" + Globals.Auswertungsverzeicnis + "\PrinterConfig" Dim di As DirectoryInfo = New DirectoryInfo(ppath) Me.cbboxPrinterConfig.Items.Clear() Me.cbboxPrinterConfig.Items.Add("") For Each fi In di.GetFiles() Me.cbboxPrinterConfig.Items.Add(fi.Name) Next End Sub Function check_db_connection() As Boolean If System.IO.File.Exists(Application.StartupPath + "\Connectionstrings.cfg") Then Dim f As New frmDBConnection f.BringToFront() f.ShowDialog() If f.DialogResult = DialogResult.OK Then My.Settings.ConnectionString = f.Connectionstring Globals.Spaltendaten.Clear() Globals.SQLStatements.Clear() IntTables.Inttables.Tables.Clear() IntTables.orte.Clear() Return True Else Return False End If Else Return True End If End Function Private Sub PatientToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PatientToolStripMenuItem.Click Me.Cursor = Cursors.WaitCursor Dim f As New Patient f.MdiParent = Me f.Show() f.tsbtnfirst_Click(sender, e) Me.Cursor = Cursors.Default End Sub Private Sub AuswertungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AuswertungenToolStripMenuItem.Click Dim f As New frmAuswertung f.MdiParent = Me f.Show() End Sub Private Sub PruefzifferToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PruefzifferToolStripMenuItem.Click Dim a As String a = InputBox("Zahl") MsgBox(Pruefziffer(a)) End Sub Public Function Pruefziffer(ByVal zahl As String) As String Dim ptab(9, 9) As Integer Dim pz(9) As Integer Dim s1, s2, s3 As String Dim i1, i2 As Long s1 = "0,9,4,6,8,2,7,1,3,5" s2 = s1 For i1 = 0 To 9 For i2 = 0 To 9 ptab(i1, i2) = Mid(s2, (i2 * 2) + 1, 1) Next s3 = Microsoft.VisualBasic.Left(s1, 1) s1 = Microsoft.VisualBasic.Right(s1, Len(s1) - 2) s1 = s1 + "," + s3 s2 = s1 Next pz(0) = 0 pz(1) = 9 pz(2) = 8 pz(3) = 7 pz(4) = 6 pz(5) = 5 pz(6) = 4 pz(7) = 3 pz(8) = 2 pz(9) = 1 Dim i, x, y, z, e As Integer Dim xx As String y = 0 For i = 1 To Len(zahl) x = Val(Mid(zahl, i, 1)) y = ptab(x, y) Next Pruefziffer = Str(pz(y)) End Function Private Sub RechnungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RechnungenToolStripMenuItem.Click Dim f As New frmFakturierung f.MdiParent = Me f.Show() End Sub Private Sub AuswertungenToolStripMenuItem1_Click(sender As Object, e As EventArgs) End Sub Private Sub FirmenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FirmenToolStripMenuItem.Click Dim f As New frmFirma f.MdiParent = Me f.Show() End Sub Private Sub DruckerToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DruckerToolStripMenuItem.Click Dim f As New frmPrinterselect f.MdiParent = Me f.Show() End Sub Private Sub ZahlungsdateiVerarbeitenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ZahlungsdateiVerarbeitenToolStripMenuItem.Click Dim f As New frmZahlung f.MdiParent = Me f.Show() End Sub Private Sub AuswertungenToolStripMenuItem2_Click(sender As Object, e As EventArgs) Handles AuswertungenToolStripMenuItem2.Click Dim f As New frmAuswertung f.MdiParent = Me f.Show() End Sub Private Sub AbmeldenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AbmeldenToolStripMenuItem.Click If MsgBox("Möchten Sie sich abmelden?", vbYesNo + vbQuestion) = vbYes Then Globals.LogedIn = False While Globals.LogedIn = False Dim f As New frmLogin f.ShowDialog() End While Me.FinanzenToolStripMenuItem.Visible = True Me.AuswertungenToolStripMenuItem.Visible = True Me.StammdatenToolStripMenuItem.Visible = True Select Case Globals.Funktionsstufe Case 2 Me.FinanzenToolStripMenuItem.Visible = False Me.AuswertungenToolStripMenuItem.Visible = False Me.StammdatenToolStripMenuItem.Visible = False End Select End If End Sub Private Sub EncryptToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles EncryptToolStripMenuItem.Click Dim db As New clsDB db.Get_Tabledata("Privat") For Each r As DataRow In db.dsDaten.Tables(0).Rows r("Name") = Crypto.EncryptText(r("Name"), encryptkey) r("Vorname") = Crypto.EncryptText(r("Vorname"), encryptkey) r("Strasse") = Crypto.EncryptText(r("Strasse"), encryptkey) r("PLZ") = Crypto.EncryptText(r("PLZ"), encryptkey) r("Ort") = Crypto.EncryptText(r("Ort"), encryptkey) r("Telp") = Crypto.EncryptText(r("Telp"), encryptkey) Next db.Update_Data() End Sub Private Sub ToolStripMenuItem3_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem3.Click For Each frm As Form In Me.MdiChildren frm.Close() Next frmMain_Load(sender, e) End Sub Private Sub SepaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SepaToolStripMenuItem.Click End Sub Private Sub cbboxPrinterConfig_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbboxPrinterConfig.SelectedIndexChanged If MsgBox("Druckereinstellungen anpassen?", vbYesNo + vbQuestion) = vbYes Then Dim ppath As String ppath = Application.StartupPath + "\" + Globals.Auswertungsverzeicnis + "\PrinterConfig\" + Me.cbboxPrinterConfig.Text Dim f As New frmAuswertung frmAuswertungen.Chenge_Profile(ppath) End If End Sub Private Sub evh_Refresh_PrinterConfig() Handles evh.Refresh_PrinterConfig Refresh_Printerconfig() End Sub Private Sub SecurityObjekgeToolStripMenuItem_Click(sender As Object, e As EventArgs) End Sub Private Sub MahnungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles MahnungenToolStripMenuItem.Click Dim f As New Mahnungen f.MdiParent = Me f.Show() End Sub Private Sub frmMain_Resize(sender As Object, e As EventArgs) Handles Me.Resize Me.Label1.Left = Me.Width - 100 - Me.Label1.Width End Sub Private Sub SuchenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SuchenToolStripMenuItem.Click Dim f As New frmSuche f.MdiParent = Me f.Show() End Sub Private Sub RechnungskopienToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RechnungskopienToolStripMenuItem.Click Dim f As New frmRechnungskopien f.MdiParent = Me f.Show() End Sub Private Sub CAMT054ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CAMT054ToolStripMenuItem.Click 'Try Dim serializer As New XmlSerializer(GetType(Document)) Dim reader As New IO.StreamReader("E:\Software-Projekte\DPM\CAMT\Dentis 2018-08-15 1531322859509.054\camt.054_SIC_04_038415740520_NN_0384157405201000_20180711_172739509_213.xml") Dim xdocument As Document = serializer.Deserialize(reader) Dim a As List(Of AccountNotification7) = xdocument.BkToCstmrDbtCdtNtfctn.Ntfctn.ToList For Each accountinformation As AccountNotification7 In a For Each r4 As ReportEntry4 In accountinformation.Ntry For Each ed As EntryDetails3 In r4.NtryDtls For Each td As EntryTransaction4 In ed.TxDtls MsgBox(td.Amt.Value.ToString) MsgBox(td.RmtInf.Strd(0).CdtrRefInf.Ref) Try MsgBox(td.Chrgs.TtlChrgsAndTaxAmt.Value) Catch End Try Next Next Next Next 'For i As Integer = 0 To a.Count - 1 ' For ii As Integer = 0 To a(i).Ntry.Count - 1 ' For iii As Integer = 0 To a(i).Ntry(ii).NtryDtls.Count - 1 ' For iiii As Integer = 0 To a(i).Ntry(ii).NtryDtls ' MsgBox(a(i).Ntry(ii).NtryDtls(iii).) ' Next ' Next ' MsgBox(a(i).Ntry(0).NtryDtls 'Next reader.Close() reader.Dispose() 'Catch EX As Exception 'MsgBox(EX.Message) 'End Try End Sub Private Sub AgendaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AgendaToolStripMenuItem.Click Dim f As New frmAgenda f.MdiParent = Me f.Show() End Sub Private Sub ÜberDPMToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ÜberDPMToolStripMenuItem.Click Dim f As New frmDemoMode("Über DPM") f.ShowDialog() End Sub Private Sub frmMain_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing If Globals.Filemanagement.Filecollection.Count > 0 Then If MsgBox("Sie haben noch Dokumente, welche in Bearbeitung sind. Programm trotzdem beenden?", vbYesNo + vbQuestion) = vbNo Then e.Cancel = True End If End If End Sub Private Sub DatenbankSicherungErstellenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DatenbankSicherungErstellenToolStripMenuItem.Click Me.SaveFileDialog1.Filter = "Datenbank-Sicherungen (*.bak)|*.bak" If Me.SaveFileDialog1.ShowDialog = DialogResult.OK Then Dim db As New clsDB db.SaveDatabase(Me.SaveFileDialog1.FileName) End If End Sub Private Sub DatenbankSicherungZurückladenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DatenbankSicherungZurückladenToolStripMenuItem.Click If MsgBox("Sind Sie sicher, dass Sie einen gespeicherten Datenbestand wieder herstellen möchten?", vbYesNo + vbQuestion) = vbYes Then Me.OpenFileDialog1.Filter = "Datenbank-Sicherungen (*.bak)|*.bak" If Me.OpenFileDialog1.ShowDialog = DialogResult.OK Then Dim db As New clsDB db.RestoreDatabase(Me.OpenFileDialog1.FileName) End If End If End Sub Private Sub DatenbankSicherungErstellenToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles DatenbankSicherungErstellenToolStripMenuItem1.Click Shell(Application.StartupPath + "\sqlbackup.cmd", AppWinStyle.NormalFocus) End Sub Private Sub TemporäreVorschaudateienLöschenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles TemporäreVorschaudateienLöschenToolStripMenuItem.Click If Globals.PreViewDir = "" Then Dim db As New clsDB db.Get_Tabledata("dms", "", "Select * from dms_Settings where nreintrag=6") Globals.PreViewDir = db.dsDaten.Tables(0).Rows(0).Item(2) If Not System.IO.Directory.Exists(Globals.PreViewDir) Then System.IO.Directory.CreateDirectory(Globals.PreViewDir) End If End If Try Dim directoryName As String = Globals.PreViewDir For Each deleteFile In Directory.GetFiles(directoryName, "*.*", SearchOption.TopDirectoryOnly) Try File.Delete(deleteFile) Catch End Try Next Catch End Try End Sub Private Sub SQLScriptAusführenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SQLScriptAusführenToolStripMenuItem.Click Dim f As New frmSQLCript f.MdiParent = Me f.Show() End Sub Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing End Sub Private Sub InterneTabellenLöschenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles InterneTabellenLöschenToolStripMenuItem.Click IntTables.Inttables.Tables.Clear() End Sub Private Sub ProgrammEinstellungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ProgrammEinstellungenToolStripMenuItem.Click Dim f As New frmProgrammeinstellungen f.MdiParent = Me f.Show() End Sub Private Sub SpaltentitelToolStripMenuItem_Click_1(sender As Object, e As EventArgs) End Sub Private Sub FormulareToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FormulareToolStripMenuItem.Click Dim f As New frmAuswertungen f.MdiParent = Me f.Show() End Sub Private Sub SecurityObjekteToolStripMenuItem_Click(sender As Object, e As EventArgs) End Sub 'Private Sub SecurityObjekteToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SecurityObjekteToolStripMenuItem.Click ' Dim formselector As New frmFormSelector ' formselector.ListForms.Items.Clear() ' formselector.ListForms.Items.Add(Me.Name) ' For Each x As Form In Me.MdiChildren ' formselector.ListForms.Items.Add(x.Name) ' Next ' formselector.ShowDialog() ' For Each it As Object In formselector.ListForms.SelectedItems ' If it = Me.Name Then ' Select Case formselector.DialogResult ' Case Windows.Forms.DialogResult.Retry ' sec.Check_Obsoloet(Me) ' Case Windows.Forms.DialogResult.OK ' sec.List_Form_Controls(Me) ' Case Windows.Forms.DialogResult.Ignore ' sec.Delete_Obsoloet(Me) ' End Select ' Else ' For Each x As Form In Me.MdiChildren ' If x.Name = it Then ' Select Case formselector.DialogResult ' Case Windows.Forms.DialogResult.Retry ' sec.Check_Obsoloet(x) ' Case Windows.Forms.DialogResult.OK ' sec.List_Form_Controls(x) ' Case Windows.Forms.DialogResult.Ignore ' sec.Delete_Obsoloet(x) ' End Select ' End If ' Next ' End If ' Next ' Exit Sub 'End Sub End Class