1715 lines
77 KiB
VB.net
1715 lines
77 KiB
VB.net
|
|
Imports System.Drawing.Printing
|
|
Imports GrapeCity.ActiveReports
|
|
|
|
Imports System.Threading
|
|
Imports System.Reflection
|
|
Imports System.ComponentModel
|
|
Imports ClosedXML.Excel
|
|
Imports System.Text.RegularExpressions
|
|
Imports iTextSharp.text.pdf
|
|
Imports SDL.eu.europa.ec
|
|
|
|
Public Class cBerechtignungenFunctions
|
|
|
|
Public Shared Function loadBerechtigungen(mit_id) As List(Of cBerechtigungen)
|
|
Dim cOptionenDAL As New cOptionenDAL
|
|
Return cOptionenDAL.getBerechtigungen(mit_id)
|
|
End Function
|
|
|
|
Public Shared Function hasBerechtigungOLD(BERECHTIGUNEN As List(Of cBerechtigungen), id As Integer) As Boolean
|
|
' If BERECHTIGUNEN Is Nothing Then Return False
|
|
If BERECHTIGUNEN Is Nothing Then Return False
|
|
For Each b In BERECHTIGUNEN
|
|
If b.id = id And b.allowed Then Return True
|
|
Next
|
|
|
|
Return False
|
|
End Function
|
|
|
|
End Class
|
|
|
|
Public Class cBindFC
|
|
Public Shared Sub binddata(o As Object, bindingParam As String, bindingSource As BindingSource, dataName As String, Optional bindingNullValue As String = "", Optional formatString As String = "")
|
|
o.DataBindings.Clear()
|
|
o.DataBindings.Add(New Binding(bindingParam, bindingSource, dataName, True, DataSourceUpdateMode.OnPropertyChanged, bindingNullValue, formatString))
|
|
End Sub
|
|
End Class
|
|
|
|
Public Class cProgramFunctions
|
|
|
|
Public Shared Function printRpt(rpt As GrapeCity.ActiveReports.SectionReport, printername As String, Optional runReport As Boolean = True) As Boolean
|
|
Try
|
|
rpt.Document.Printer.PrinterName = ""
|
|
' System.Diagnostics.Debug.WriteLine("Hier 3: " & Now.ToString("HH:mm:ss.ffff"))
|
|
If runReport Then rpt.Run(False)
|
|
' System.Diagnostics.Debug.WriteLine("Hier 4: " & Now.ToString("HH:mm:ss.ffff"))
|
|
If printername <> "" Then
|
|
rpt.Document.Printer.PrinterName = printername
|
|
Else
|
|
Dim p As New PrintDialog
|
|
If p.ShowDialog() = DialogResult.OK Then
|
|
printername = p.PrinterSettings.PrinterName
|
|
rpt.Document.Printer.PrinterName = printername
|
|
Else
|
|
rpt.Dispose()
|
|
End If
|
|
End If
|
|
|
|
'Test
|
|
rpt.Document.Printer.PaperSize = rpt.Document.Printer.PrinterSettings.DefaultPageSettings.PaperSize
|
|
rpt.Document.Printer.PrinterSettings.Copies = 1
|
|
Dim dt1 = Now
|
|
|
|
System.Diagnostics.Debug.WriteLine("Report START: " & dt1.ToString("HH:mm:ss.ffff"))
|
|
If Not rpt.Document.Print(False, False, True) Then
|
|
MsgBox("Problem beim Drucken.")
|
|
End If
|
|
Dim dt2 = Now
|
|
System.Diagnostics.Debug.WriteLine("Report END: " & dt2.ToString("HH:mm:ss.ffff") & " (DIFFERENZ: " & DateDiff(DateInterval.Second, dt1, dt2) & " Sekunden)")
|
|
|
|
|
|
rpt.Dispose()
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
Return False
|
|
End Try
|
|
|
|
End Function
|
|
|
|
Public Shared Sub showRpt(rpt As GrapeCity.ActiveReports.SectionReport, Rptname As String, Optional allowPrint As Boolean = True)
|
|
Dim print As New frmPrintLayout
|
|
print.Text = Rptname
|
|
print.Viewer.LoadDocument(rpt)
|
|
print.showBar = allowPrint
|
|
print.Viewer.ViewType = GrapeCity.Viewer.Common.Model.ViewType.Continuous
|
|
print.Show()
|
|
End Sub
|
|
|
|
Shared Function validUID2(UstIdKz As String, UstIdNr As String)
|
|
|
|
Dim vat As New SDL.eu.europa.ec.checkVatService
|
|
|
|
' Dim EU3t As New SDL.eu.europa.ec.checkVatService("checkVatPort", "http://ec.europa.eu/taxation_customs/vies/checkVatService.wsdl") '"urn:ec.europa.eu:taxud:vies:services:checkVat:types")
|
|
' Dim EU4 As New EU_Uid_Pruefung.checkVatPortTyp
|
|
' EU3.checkVatPortType()
|
|
' "EU_Uid_Pruefung.checkVatPortType"
|
|
' Dim valid As Boolean = False
|
|
'Dim name As String = ""
|
|
'Dim adress As String = ""
|
|
|
|
Dim countryCode As String = UstIdKz
|
|
Dim vatNumber As String = UstIdNr
|
|
Dim traderName As String
|
|
Dim traderCompanyType As String
|
|
Dim traderStreet As String
|
|
Dim traderPostcode As String
|
|
Dim traderCity As String
|
|
Dim requesterCountryCode As String = "AT"
|
|
Dim requesterVatNumber As String = "U62663022"
|
|
Dim valid As Boolean = False
|
|
Dim traderAddress As String
|
|
Dim traderNameMatch As matchCode
|
|
Dim traderNameMatchSpecified As Boolean
|
|
Dim traderCompanyTypeMatch As matchCode
|
|
Dim traderCompanyTypeMatchSpecified As Boolean
|
|
Dim traderStreetMatch As matchCode
|
|
Dim traderStreetMatchSpecified As Boolean
|
|
Dim traderPostcodeMatch As matchCode
|
|
Dim traderPostcodeMatchSpecified As Boolean
|
|
Dim traderCityMatch As matchCode
|
|
Dim traderCityMatchSpecified As Boolean
|
|
Dim requestIdentifier As String
|
|
|
|
|
|
|
|
' Dim ass As New EU_UID_Pruefung.checkVatPortTypeClient()
|
|
|
|
' ass.checkVatPortTypeClient()
|
|
|
|
' Dim s = EU3t.checkVat("AT", "U53187000", valid, name, adress)
|
|
'Dim s = vat.checkVat(ADRESSE.UstIdKz, ADRESSE.UstIdNr, valid, name, adress)
|
|
Dim s = vat.checkVatApprox(countryCode, vatNumber, traderName, traderCompanyType, traderStreet, traderPostcode, traderCity, requesterCountryCode, requesterVatNumber, valid, traderAddress, traderNameMatch, traderNameMatchSpecified, traderCompanyTypeMatch, traderCompanyTypeMatchSpecified, traderStreetMatch, traderStreetMatchSpecified, traderPostcodeMatch, traderPostcodeMatchSpecified, traderCityMatch, traderCityMatchSpecified, requestIdentifier)
|
|
Return valid
|
|
End Function
|
|
|
|
Shared Function getISO2Land(LandKz As String)
|
|
If LandKz Is Nothing Then Return Nothing
|
|
Dim sqlstr = "SELECT TOP 1 isnull([Länderverzeichnis für die Außenhandelsstatistik].LandKz,'') AS LandKzISO2 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE Währungstabelle.LandKz='" & LandKz & "' "
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
|
|
End Function
|
|
|
|
|
|
Shared Function getISO1Land(LandKz As String)
|
|
Dim sqlstr = "SELECT TOP 1 isnull(Währungstabelle.LandKz,'') AS LandKzISO1 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE [Länderverzeichnis für die Außenhandelsstatistik].LandKz='" & LandKz & "' "
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
|
|
End Function
|
|
Shared Function isEULand(LandKz As String)
|
|
Dim sqlstr = "SELECT count(*) FROM [Währungstabelle] where LandKz='" & LandKz & "' and MitgliedslandEU=1"
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return CBool(SQL.getValueTxtBySql(sqlstr, "FMZOLL"))
|
|
End Function
|
|
|
|
Shared Function getLandBez_fromISO1Land(LandKz As String, Optional returnValue As Object = Nothing, Optional RechnungSprache As String = "DE")
|
|
If LandKz Is Nothing Then Return returnValue
|
|
Select Case RechnungSprache
|
|
Case "EN"
|
|
Select Case LandKz
|
|
Case "GB" : Return "UNITED KINGDOM"
|
|
Case "FR" : Return "FRANCE"
|
|
Case "ES" : Return "SPAIN"
|
|
Case "IT" : Return "ITALY"
|
|
Case "TR" : Return "TURKEY"
|
|
End Select
|
|
End Select
|
|
Dim sqlstr = "SELECT TOP 1 isnull([Länderverzeichnis für die Außenhandelsstatistik].[LandBez],'') AS [LandBez] FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE Währungstabelle.LandKz='" & LandKz & "' "
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
|
|
End Function
|
|
|
|
Shared Sub setControlReadOnly(ControlObj As Control, Optional readonlyBool As Boolean = True)
|
|
' ControlObj.Enabled = False
|
|
' Exit Sub
|
|
Try
|
|
For Each o In ControlObj.Controls
|
|
If TypeOf o Is Label Then
|
|
'Nix...
|
|
ElseIf checkProperty(o, "ReadOnly") Then
|
|
o.readonly = True
|
|
ElseIf TypeOf o Is CheckBox Or TypeOf o Is VERAG_PROG_ALLGEMEIN.MyCheckbox Then
|
|
o.Enabled = False
|
|
Else
|
|
o.Enabled = False
|
|
End If
|
|
Next
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
End Try
|
|
End Sub
|
|
|
|
Shared Function checkProperty(ByVal objectt As Object, ByVal propertyy As String) As Boolean
|
|
Dim type As Type = objectt.GetType
|
|
Return type.GetProperty(propertyy) IsNot Nothing
|
|
End Function
|
|
|
|
Function isEmptyNull(o) As Object
|
|
Return IIf(o = "", Nothing, o)
|
|
End Function
|
|
|
|
Shared SQL_VERAG As New VERAG_PROG_ALLGEMEIN.SQL
|
|
|
|
Shared Function openThereforeNavigator(AbfertigungsNr As String, Filiale As Integer)
|
|
Try
|
|
Dim abfertNr = AbfertigungsNr & "%"
|
|
Dim docid As String = ""
|
|
If Filiale = 4801 Then
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat17] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
ElseIf Filiale = 5601 Then
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat393] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat394] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
ElseIf Filiale = 5701 Then
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat395] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat397] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
Else
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].TheCat1083 WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat889] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat398] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat291] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat153] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat119] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat109] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat101] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat84] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat72] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat59] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat36] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat14] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat130] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON") ' WAI
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat131] WHERE [String] LIKE '" & abfertNr & "' ORDER BY [Eingabedatum] DESC", "SCANCANON") ' SBG
|
|
End If
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorZollvollmachten(KundenNr As String, VM_Artid As Integer)
|
|
Select Case VM_Artid
|
|
Case 1, 7 : Return openThereforeNavigatorZollvollmachten_DE(KundenNr)
|
|
Case 2, 8 : Return openThereforeNavigatorFiskalVM_DE(KundenNr)
|
|
Case 4, 9 : Return openThereforeNavigatorFiskalVM_AT(KundenNr)
|
|
Case 12, 13 : Return openThereforeNavigatorVM_AT(KundenNr)
|
|
End Select
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorZollvollmachten_DE(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat32] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorTarifnummern(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat82] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorKudnenInfo(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat57] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
|
|
Shared Function openThereforeNavigatorVM_AT(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat76] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorFiskalVM_AT(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat205] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
Shared Function openThereforeNavigatorFiskalVM_DE(KundenNr As String)
|
|
Try
|
|
Dim srch = KundenNr & "%"
|
|
Dim docid As String = ""
|
|
docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat205] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat128] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat114] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat99] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat88] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat67] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat64] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
If Not IsNumeric(docid) OrElse docid <= 0 Then docid = SQL_VERAG.getValueTxtBySql("SELECT TOP 1 isnull([DocNo],-1) FROM [Therefore].[dbo].[TheCat46] WHERE [String] LIKE '" & srch & "' ORDER BY [Eingabedatum] DESC", "SCANCANON")
|
|
|
|
|
|
If IsNumeric(docid) AndAlso docid > 0 Then
|
|
' Process.Start("theviewer.exe -" & docid)
|
|
' Process.Start("C:\Program Files (x86)\Therefore\theviewer.exe -" & docid)
|
|
Try
|
|
Shell("C:\Program Files (x86)\Therefore\theviewer.exe -d" & docid)
|
|
Catch ex As Exception
|
|
Shell("C:\Program Files\Therefore\theviewer.exe -d" & docid)
|
|
End Try
|
|
Else
|
|
MsgBox("Das Dokument konnte nicht gefunden werden.")
|
|
End If
|
|
Return True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler beim Öffnen!" & vbNewLine & ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return False
|
|
End Function
|
|
|
|
|
|
Public Sub showKd(kdnr As Integer)
|
|
'For Each frm As Form In Application.OpenForms.Item("frmKundenUebersichtZOLL") Is Nothing
|
|
If Not Application.OpenForms.Item("frmKundenUebersichtZOLL") Is Nothing Then
|
|
Application.OpenForms.Item("frmKundenUebersichtZOLL").BringToFront()
|
|
Exit Sub
|
|
End If
|
|
' Next
|
|
Dim zoll As New SDL.frmKundenUebersichtZOLL(kdnr)
|
|
zoll.Show()
|
|
End Sub
|
|
|
|
|
|
Public Function checkSDLNrPartnerKdNr(kdnr, sdlNr) As Boolean
|
|
Dim kundenSQL As New kundenSQL
|
|
Dim PartnerKdNrFromFMZOLL As cPartnerKdNRFMZoll = kundenSQL.getPartnerKdNrFromFMZOLL(kdnr)
|
|
Select Case sdlNr
|
|
' Case 100 'GEHT NOCH NICHT; ERST FESTLEGEN DER KDNR AUSPROGRAMMIEREN
|
|
' If PartnerKdNrFromFMZOLL.IDSKundenNr Is Nothing Or PartnerKdNrFromFMZOLL.IDSKundenNr = "" Then 'IDS
|
|
' Return False
|
|
' End If
|
|
Case 101
|
|
If PartnerKdNrFromFMZOLL.WölflKundenNr Is Nothing Or PartnerKdNrFromFMZOLL.WölflKundenNr = "" Then Return False
|
|
Case 200
|
|
If PartnerKdNrFromFMZOLL.ATKundenNr Is Nothing Or PartnerKdNrFromFMZOLL.ATKundenNr = "" Then Return False
|
|
Case 212 'UTA
|
|
If PartnerKdNrFromFMZOLL.UTAKundenNr Is Nothing Or PartnerKdNrFromFMZOLL.UTAKundenNr = "" Then Return False
|
|
Case 202 'TELEPASS
|
|
If PartnerKdNrFromFMZOLL.TELEPASS_Kd_Nr Is Nothing Or PartnerKdNrFromFMZOLL.TELEPASS_Kd_Nr = "" Then Return False
|
|
Case 201 'MAUT DE
|
|
If PartnerKdNrFromFMZOLL.MautDE_FlottenPIN Is Nothing Or PartnerKdNrFromFMZOLL.MautDE_FlottenPIN = "" Or
|
|
PartnerKdNrFromFMZOLL.MautDE_MasterPIN Is Nothing Or PartnerKdNrFromFMZOLL.MautDE_MasterPIN = "" Or
|
|
PartnerKdNrFromFMZOLL.MautDE_BenutzerNr Is Nothing Or PartnerKdNrFromFMZOLL.MautDE_BenutzerNr = "" Then
|
|
Return False
|
|
End If
|
|
Case 203, 204, 206, 207, 208, 209, 210, 211, 205, 213 'MSE 205??
|
|
If PartnerKdNrFromFMZOLL.MSEKundenNr Is Nothing Or PartnerKdNrFromFMZOLL.MSEKundenNr = "" Then Return False
|
|
End Select
|
|
|
|
Return True
|
|
End Function
|
|
|
|
Public Shared Function fctRound(varNr As Object, Optional varPl As Integer = 2) As Double
|
|
'by Konrad Marfurt + ("" by) Luke Chung + Karl Donaubauer
|
|
|
|
'raus hier bei nicht-nummerischem Argument
|
|
If Not IsNumeric(varNr) Then Exit Function
|
|
|
|
fctRound = Fix("" & varNr * (10 ^ varPl) + Math.Sign(varNr) * 0.5) / (10 ^ varPl)
|
|
|
|
End Function
|
|
|
|
Public Shared Sub initBONDrucker(cboPrinter As ComboBox, Optional srch As String = "")
|
|
'Wenn ein Standard BON Drucker existiert, dann diesen
|
|
If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_BON <> String.Empty Then
|
|
initDrucker(cboPrinter, VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_BON)
|
|
Else
|
|
initDrucker(cboPrinter, srch)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Public Shared Sub initDrucker(cboPrinter As ComboBox, Optional srch As String = "", Optional usePRINTER_LIST As Boolean = True)
|
|
' alle installierten Drucker ermitteln und
|
|
' in in ein ArrayList-Objekt speichern
|
|
Dim sPrinters As ArrayList
|
|
If usePRINTER_LIST AndAlso VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST IsNot Nothing Then
|
|
sPrinters = VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST
|
|
Else
|
|
sPrinters = New ArrayList
|
|
For Each sPrinter As String In System.Drawing.Printing.PrinterSettings.InstalledPrinters
|
|
sPrinters.Add(sPrinter)
|
|
Next
|
|
End If
|
|
|
|
' Array sortieren
|
|
sPrinters.Sort()
|
|
|
|
' jetzt alle Drucker in sortierter Reihenfolge in einer
|
|
' ComboBox zur Auswahl anbieten
|
|
For i As Integer = 0 To sPrinters.Count - 1
|
|
cboPrinter.Items.Add(sPrinters(i))
|
|
Next
|
|
|
|
If sPrinters.Count > 0 Then
|
|
cboPrinter.SelectedIndex = 0
|
|
If srch <> "" Then
|
|
For Each i In cboPrinter.Items
|
|
If i.ToString.ToUpper.Contains(srch.ToUpper) Then
|
|
cboPrinter.SelectedItem = i
|
|
Exit Sub
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
|
|
'Standard-Drucker as AVISO_OPTIONS:
|
|
If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD <> String.Empty Then
|
|
For Each i In cboPrinter.Items
|
|
If i.ToString.ToUpper.Contains(VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD.ToUpper) Then ' If i.ToString = srchPrinter Then ' Contains, weil sonst \\dc02\ stört
|
|
cboPrinter.SelectedItem = i
|
|
Exit Sub
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
'Standard-Drucker:
|
|
Dim oPS As New System.Drawing.Printing.PrinterSettings
|
|
For Each i In cboPrinter.Items
|
|
If i.ToString.ToUpper.Contains(oPS.PrinterName.ToUpper) Then ' If i.ToString = srchPrinter Then ' Contains, weil sonst \\dc02\ stört
|
|
cboPrinter.SelectedItem = i
|
|
Exit Sub
|
|
End If
|
|
Next
|
|
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Public Shared Function getDruckernameBySearch(srch As String, Optional elseStandard As Boolean = True) As String
|
|
' alle installierten Drucker ermitteln und
|
|
' in in ein ArrayList-Objekt speichern
|
|
'Dim sPrinters As New ArrayList
|
|
'For Each sPrinter As String In PrinterSettings.InstalledPrinters
|
|
' sPrinters.Add(sPrinter)
|
|
'Next
|
|
|
|
' Array sortieren
|
|
'sPrinters.Sort()
|
|
|
|
' jetzt alle Drucker in sortierter Reihenfolge in einer
|
|
' ComboBox zur Auswahl anbieten
|
|
|
|
If System.Drawing.Printing.PrinterSettings.InstalledPrinters.Count > 0 Then
|
|
If srch <> "" Then
|
|
For Each i In System.Drawing.Printing.PrinterSettings.InstalledPrinters
|
|
If i.ToString.ToUpper.Contains(srch.ToUpper) Then
|
|
Return i
|
|
End If
|
|
Next
|
|
End If
|
|
If elseStandard Then
|
|
Dim srchPrinter = ""
|
|
If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD <> String.Empty Then
|
|
srchPrinter = VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD
|
|
Else
|
|
Dim oPS As New System.Drawing.Printing.PrinterSettings
|
|
srchPrinter = oPS.PrinterName
|
|
|
|
End If
|
|
For Each i In System.Drawing.Printing.PrinterSettings.InstalledPrinters
|
|
If i.ToString.ToUpper.Contains(srchPrinter.ToUpper) Then ' If i.ToString = srchPrinter Then ' Contains, weil sonst \\dc02\ stört
|
|
Return i
|
|
End If
|
|
Next
|
|
End If
|
|
End If
|
|
Return ""
|
|
End Function
|
|
|
|
|
|
Public Shared Function IsValidEMail(ByVal MailAdress As String) As Boolean
|
|
Return Regex.IsMatch(MailAdress, "^([0-9a-zA-Z]([-\.\w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-\w]*[0-9a-zA-Z]\.)+[a-zA-Z]{2,9})$")
|
|
End Function
|
|
|
|
Public Shared Function isLeerNothing(o) As Object
|
|
Return IIf(o = "", Nothing, o)
|
|
End Function
|
|
Public Shared Function isLeerNothingDbl(o, Optional returnVal = Nothing) As Object
|
|
Try
|
|
If o = "" Then Return returnVal
|
|
If IsNumeric(o) Then Return CDbl(o)
|
|
Return returnVal
|
|
|
|
Catch ex As Exception
|
|
Return returnVal
|
|
End Try
|
|
End Function
|
|
Public Shared Function isLeerNothingDblPKT(o) As Object
|
|
If o = "" Then Return Nothing
|
|
If IsNumeric(o) Then Return CDbl(o.ToString.Replace(".", ","))
|
|
Return Nothing
|
|
End Function
|
|
|
|
Public Shared Sub setInfo(f As Form, art As String, text As String, dauer As Integer)
|
|
Dim frmPopUpInfo As New frmPopUpInfo
|
|
frmPopUpInfo.ErrMessage = text
|
|
frmPopUpInfo.seconds = dauer
|
|
frmPopUpInfo.typ = art.ToUpper
|
|
frmPopUpInfo.Show(f)
|
|
End Sub
|
|
|
|
Public Shared Function grayoutForm(control As Control) As Form
|
|
Dim f As New frmGrayOut
|
|
f.Show(control)
|
|
Return f
|
|
End Function
|
|
|
|
Sub dgvCellToCbo(dgv As DataGridView, columnIndex As Integer, HeaderText As String, DataPropertyName As String, sqlstr As String, Optional conn_art As String = "SDL", Optional dropdownwidth As Integer = -1)
|
|
If dgv.Columns.Count <= columnIndex Then Exit Sub
|
|
Dim comboBoxColumn As New DataGridViewComboBoxColumn
|
|
Dim SQL As New SQL
|
|
With comboBoxColumn
|
|
.HeaderText = HeaderText : .DataPropertyName = DataPropertyName
|
|
.Name = DataPropertyName
|
|
.DataSource = SQL.loadDgvBySql(sqlstr, conn_art)
|
|
.ValueMember = .DataSource.Columns(0).ColumnName
|
|
.DisplayMember = .DataSource.Columns(1).ColumnName
|
|
.FlatStyle = FlatStyle.Flat
|
|
If dropdownwidth > 0 Then .DropDownWidth = dropdownwidth
|
|
End With
|
|
dgv.Columns.RemoveAt(columnIndex)
|
|
dgv.Columns.Insert(columnIndex, comboBoxColumn)
|
|
End Sub
|
|
Sub dgvCellToCbo2(dgv As DataGridView, columnName As String, HeaderText As String, DataPropertyName As String, sqlstr As String, Optional conn_art As String = "SDL", Optional dropdownwidth As Integer = -1, Optional simpleStyle As Boolean = False)
|
|
If dgv.Columns.Count = 0 Then Exit Sub
|
|
Dim comboBoxColumn As New DataGridViewComboBoxColumn
|
|
Dim SQL As New SQL
|
|
Dim columnIndex = dgv.Columns(columnName).Index
|
|
' MsgBox(columnIndex)
|
|
If dgv.Columns.Count <= columnIndex Then Exit Sub
|
|
With comboBoxColumn
|
|
.HeaderText = HeaderText
|
|
.DataPropertyName = DataPropertyName
|
|
.Name = columnName ' DataPropertyName
|
|
.DataSource = SQL.loadDgvBySql(sqlstr, conn_art)
|
|
.ValueMember = .DataSource.Columns(0).ColumnName
|
|
.DisplayMember = .DataSource.Columns(1).ColumnName
|
|
.FlatStyle = FlatStyle.Flat
|
|
If simpleStyle Then .DisplayStyle = DataGridViewComboBoxDisplayStyle.Nothing
|
|
If dropdownwidth > 0 Then .DropDownWidth = dropdownwidth
|
|
End With
|
|
dgv.Columns.RemoveAt(columnIndex)
|
|
|
|
Dim dt = DirectCast(dgv.DataSource, DataTable)
|
|
dt.Columns.Remove(columnName)
|
|
dgv.DataSource = dt
|
|
dgv.Columns.Insert(columnIndex, comboBoxColumn)
|
|
' dgv.Item(columnIndex, dgv.CurrentRow.Index) = comboBoxColumn
|
|
'dgv.Columns.(columnIndex) = comboBoxColumn
|
|
' dgv.Columns.RemoveAt(columnIndex)
|
|
' dgv.Columns.Remove(columnName)
|
|
' dgv.Columns.Insert(columnIndex, comboBoxColumn)
|
|
End Sub
|
|
|
|
Public Function getdgvCboCell(ColumnName As String, HeaderText As String, DataPropertyName As String, sqlstr As String, Optional conn_art As String = "SDL", Optional dropdownwidth As Integer = -1, Optional defaultNullValue As Object = Nothing) As DataGridViewComboBoxColumn
|
|
Dim d = New DataGridViewComboBoxColumn()
|
|
Dim SQL As New SQL
|
|
With d
|
|
.HeaderText = HeaderText : .DataPropertyName = DataPropertyName
|
|
.Name = ColumnName
|
|
' .DataSource = SQL.loadDgvBySql(sqlstr, conn_art)
|
|
' .ValueMember = .DataSource.Columns(0).ColumnName.ToString
|
|
'.ValueType =
|
|
Dim dt As DataTable = SQL.loadDgvBySql(sqlstr, conn_art)
|
|
|
|
.DataSource = dt
|
|
.ValueMember = .DataSource.Columns(0).ColumnName
|
|
.DisplayMember = .DataSource.Columns(1).ColumnName
|
|
'For Each r As DataRow In dt.Rows
|
|
' .Items("VALUE").Add(r(0))
|
|
' .Items("DISPLAY").Add(r(1))
|
|
'Next
|
|
' .DataSource = SQL.loadDgvBySql(sqlstr, conn_art)
|
|
|
|
' .DisplayMember = .DataSource.Columns(1).ColumnName.ToString
|
|
.FlatStyle = FlatStyle.Flat
|
|
If defaultNullValue IsNot Nothing Then .DefaultCellStyle.NullValue = CInt(defaultNullValue)
|
|
If dropdownwidth > 0 Then .DropDownWidth = dropdownwidth
|
|
End With
|
|
Return d
|
|
End Function
|
|
|
|
|
|
|
|
Public Function ShowOptionsForm() As cKundenFMZOLL
|
|
Dim options = New frmSearchKunde
|
|
' Did the user click Save?
|
|
Select Case options.ShowDialog()
|
|
' Yes, so grab the values you want from the dialog here
|
|
Case Windows.Forms.DialogResult.OK : Return options.KUNDE
|
|
Case Windows.Forms.DialogResult.Cancel : Return Nothing
|
|
End Select
|
|
Return Nothing
|
|
End Function
|
|
|
|
Public Shared Sub setAllReadOnly(o As Object)
|
|
For Each c As Control In o.Controls
|
|
If c.HasChildren Then
|
|
setAllReadOnly(c)
|
|
Else
|
|
'MsgBox(c.GetType.Name)
|
|
If TypeOf c Is TextBox Then CType(c, TextBox).ReadOnly = True
|
|
If TypeOf c Is CheckBox Then CType(c, CheckBox).Enabled = False
|
|
If TypeOf c Is DataGridView Then CType(c, DataGridView).Enabled = False : CType(c, DataGridView).ReadOnly = True
|
|
If TypeOf c Is RichTextBox Then CType(c, RichTextBox).ReadOnly = True
|
|
If TypeOf c Is VERAG_PROG_ALLGEMEIN.FlatButton Then CType(c, VERAG_PROG_ALLGEMEIN.FlatButton).Enabled = False
|
|
If TypeOf c Is VERAG_PROG_ALLGEMEIN.MyComboBox Then CType(c, VERAG_PROG_ALLGEMEIN.MyComboBox).Enabled = False
|
|
If TypeOf c Is VERAG_PROG_ALLGEMEIN.MyLinkLabelVALUE Then CType(c, VERAG_PROG_ALLGEMEIN.MyLinkLabelVALUE).Enabled = False
|
|
If TypeOf c Is VERAG_PROG_ALLGEMEIN.MyTextBox Then CType(c, VERAG_PROG_ALLGEMEIN.MyTextBox).Enabled = False
|
|
If TypeOf c Is RadioButton Then CType(c, RadioButton).Enabled = False
|
|
If TypeOf c Is LinkLabel Then CType(c, LinkLabel).Enabled = False
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
|
|
Public Shared Sub openKundenblatt(kdnr As String, f As Form, Optional closeFirst As Boolean = False)
|
|
f.Enabled = False
|
|
f.Cursor = Cursors.WaitCursor
|
|
Try
|
|
|
|
'For Each frm As Form In Application.OpenForms.Item("frmKundenUebersichtZOLL") Is Nothing
|
|
If Not Application.OpenForms.Item("frmKundenblatt") Is Nothing Then
|
|
|
|
If closeFirst Then
|
|
Application.OpenForms.Item("frmKundenblatt").Close()
|
|
Else
|
|
Select Case MessageBox.Show("Ein Kundenblatt ist bereits geöffnet. Soll ein weiteres Fenster geöffnet werden?" & vbNewLine & vbNewLine & " Ja: " & vbTab & " Neues Kundenblatt öffnen " & vbNewLine & " Nein: " & vbTab & " Im aktuellen Fenster öffnen " & vbNewLine & " Abbr.: " & vbTab & " Vorgang abbrechen ", "Bereits geöffnetes Kundenblatt schließen?", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question)
|
|
Case vbYes
|
|
Case vbNo
|
|
Application.OpenForms.Item("frmKundenblatt").Close()
|
|
Case DialogResult.Cancel
|
|
Exit Sub
|
|
End Select
|
|
|
|
End If
|
|
|
|
End If
|
|
' Next
|
|
|
|
frmKundenblatt.kdNr = kdnr
|
|
frmKundenblatt.Show()
|
|
frmKundenblatt.BringToFront()
|
|
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
End Try
|
|
f.Enabled = True
|
|
f.Cursor = Cursors.Default
|
|
|
|
Exit Sub
|
|
|
|
If closeFirst Then
|
|
f.Enabled = False
|
|
f.Cursor = Cursors.WaitCursor
|
|
frmKundenblatt.Close()
|
|
frmKundenblatt.kdNr = kdnr
|
|
frmKundenblatt.Show()
|
|
frmKundenblatt.BringToFront()
|
|
f.Enabled = True
|
|
f.Cursor = Cursors.Default
|
|
ElseIf frmKundenblatt.Visible Then
|
|
f.Enabled = False
|
|
f.Cursor = Cursors.WaitCursor
|
|
Select Case MessageBox.Show("Ein Kundenblatt ist bereits geöffnet. Soll ein weiteres Fenster geöffnet werden?" & vbNewLine & vbNewLine & " Ja: " & vbTab & " Neues Kundenblatt öffnen " & vbNewLine & " Nein: " & vbTab & " Im aktuellen Fenster öffnen " & vbNewLine & " Abbr.: " & vbTab & " Vorgang abbrechen ", "Bereits geöffnetes Kundenblatt schließen?", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question)
|
|
Case vbYes
|
|
Dim kb As New frmKundenblatt
|
|
' kb.BERECHTIGUNEN = cBerechtignungenFunctions.loadBerechtigungen(VERAG_PROG_ALLGEMEIN.cAllgemein.USRID)
|
|
kb.kdNr = kdnr
|
|
kb.Show()
|
|
kb.BringToFront()
|
|
Case vbNo
|
|
frmKundenblatt.Close()
|
|
frmKundenblatt.kdNr = kdnr
|
|
frmKundenblatt.Show()
|
|
frmKundenblatt.BringToFront()
|
|
Case vbCancel
|
|
End Select
|
|
f.Enabled = True
|
|
f.Cursor = Cursors.Default
|
|
Else
|
|
f.Enabled = False
|
|
f.Cursor = Cursors.WaitCursor
|
|
frmKundenblatt.kdNr = kdnr
|
|
frmKundenblatt.Show()
|
|
frmKundenblatt.BringToFront()
|
|
f.Enabled = True
|
|
f.Cursor = Cursors.Default
|
|
End If
|
|
End Sub
|
|
|
|
Public Function newEntry(kdNr, kfz, sdlNr) As Integer
|
|
Try
|
|
Dim kundenSQL As New kundenSQL
|
|
Dim SQL As New SQL
|
|
Dim History = SQL.getValueTxtBySql("SELECT isnull(max([History]),0)+1 as History FROM SDL where KundenNr = '" & kdNr & "' AND KfzKennzeichen='" & kfz & "' And SDLNr ='" & sdlNr & "' ", "SDL")
|
|
|
|
SQL.doSQL("INSERT INTO SDL (KundenNr,KfzKennzeichen,SDLNr,History,Bestelldatum,Erfassungsdatum,Sachbearbeiter,[Ersatzkarte],[Gesperrt],[Defekt],[Verloren],[Gestohlen]) VALUES ('" & kdNr & "','" & kfz & "','" & sdlNr & "','" & History & "','" & Now.ToShortDateString & "',GETDATE(),'" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME & "',0,0,0,0,0)")
|
|
|
|
|
|
Dim PKDNr As cPartnerKdNRFMZoll = kundenSQL.getPartnerKdNrFromFMZOLL(kdNr)
|
|
Select Case sdlNr
|
|
Case 100
|
|
Case 101
|
|
Case 200 : SQL.doSQL("UPDATE SDL SET KartenNr='" & PKDNr.ATKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 201 : SQL.doSQL("UPDATE SDL SET KartenNr='direkt', Partner='ROAD', [BenutzerNr]='" & PKDNr.MautDE_BenutzerNr & "', [FlottenPIN]='" & PKDNr.MautDE_FlottenPIN & "', [MasterPIN]='" & PKDNr.MautDE_MasterPIN & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 202 : SQL.doSQL("UPDATE SDL SET [TELEPASS-Kd-Nr]='" & PKDNr.TELEPASS_Kd_Nr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 203 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 204 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]=" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 205 ' SQL.doSQL("UPDATE SDL SET [CLIENT-Nr]=" & PKDNr.??? & " WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 206 'ALT: SQL.doSQL("UPDATE SDL SET KartenNr=" & PKDNr.XXXXX & " WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 207 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 208 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 209 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 210 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 211 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 212 : SQL.doSQL("UPDATE SDL SET [CLIENT-Nr]='" & PKDNr.UTAKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
Case 213 : SQL.doSQL("UPDATE SDL SET [MSE-Kd-Nr]='" & PKDNr.MSEKundenNr & "' WHERE KundenNr='" & kdNr & "' AND KfzKennzeichen='" & kfz & "' AND SDLNr='" & sdlNr & "' AND History='" & History & "'")
|
|
End Select
|
|
|
|
|
|
|
|
Return History
|
|
Catch ex As Exception
|
|
MsgBox("ERR03: " & ex.Message)
|
|
End Try
|
|
Return -1
|
|
End Function
|
|
|
|
|
|
Public Function newEntryVERAG_Card(ByRef kdNr, ByRef kfz, ByRef sdlNr)
|
|
Try
|
|
Dim f As New frmFindNewVeragCard(kfz, sdlNr)
|
|
If f.ShowDialog() = DialogResult.OK Then
|
|
'UPDATE
|
|
Dim kundenSQL As New kundenSQL
|
|
Dim History = kundenSQL.getValueTxtBySql("SELECT isnull(max([History]),0)+1 as History FROM SDL where KundenNr = '" & kdNr & "' AND KfzKennzeichen='" & kfz & "' And SDLNr ='" & sdlNr & "' ", "SDL")
|
|
kundenSQL.doSQL("UPDATE [SDL] set KundenNr='" & kdNr & "', KfzKennzeichen='" & kfz & "', History='" & History & "', Bestelldatum='" & Now.ToShortDateString & "', Lieferdatum='" & Now.ToShortDateString & "' WHERE KundenNr='" & f.kdNr & "' and KfzKennzeichen='" & f.KfzKennzeichen & "' and History='" & f.History & "' and SDLNr=" & sdlNr & " ", "SDL")
|
|
Return History
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
End Try
|
|
Return -1
|
|
End Function
|
|
|
|
Public Shared Function newFrmData(control As Control, ByRef KundenNr As Integer, ByRef SDLNr As Integer, ByRef KfzKennzeichen As String, ByRef History As String, Optional showDetailForm As Boolean = False) As String '
|
|
If Not VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("MDM_Leistungen_bearbeiten", "SDL") Then
|
|
MsgBox("Keine Berechtigung!")
|
|
Return "CANCEL"
|
|
End If
|
|
Dim frmGrayOut = cProgramFunctions.grayoutForm(control)
|
|
|
|
|
|
|
|
|
|
Dim frmNewData As New frmNewData
|
|
frmNewData.showDetailForm = showDetailForm
|
|
'Dim frmNewData As New frmNewData
|
|
If KundenNr > 0 Then frmNewData.kdnr = KundenNr
|
|
If SDLNr > 0 Then frmNewData.SDLLeistung = SDLNr
|
|
If KfzKennzeichen <> "" Then frmNewData.KfzKennzeichen = KfzKennzeichen
|
|
' If lkw <> "" Then frmNewData.Lkw = lkw
|
|
If frmGrayOut Is Nothing Then Return "CANCEL" '?? Manschmal nicht zugewiesen?? KA..
|
|
If frmNewData Is Nothing Then Return "CANCEL" '?? Manschmal nicht zugewiesen?? KA..
|
|
Try
|
|
|
|
Select Case frmNewData.ShowDialog(frmGrayOut)
|
|
Case DialogResult.OK
|
|
KundenNr = frmNewData.kdnr
|
|
SDLNr = frmNewData.SDLLeistung
|
|
KfzKennzeichen = frmNewData.KfzKennzeichen
|
|
History = frmNewData.history
|
|
If frmNewData.newData Then
|
|
frmGrayOut.Close()
|
|
Return "OK_NEW"
|
|
Else
|
|
frmGrayOut.Close()
|
|
Return "OK"
|
|
End If
|
|
End Select
|
|
frmGrayOut.Close()
|
|
Return "CANCEL"
|
|
|
|
|
|
Catch ex As Exception
|
|
MsgBox("als" & ex.Message & ex.StackTrace)
|
|
End Try
|
|
|
|
|
|
|
|
End Function
|
|
|
|
Public Sub addNowBtnToDate(tb As TextBox)
|
|
Dim pb As New VERAG_PROG_ALLGEMEIN.MyLinkPicBoxVALUE
|
|
tb.Parent.Controls.Add(pb)
|
|
pb.Tag = "Heute"
|
|
pb.Left = tb.Left + tb.Width + 5 : pb.Top = tb.Top
|
|
pb.Height = 18 : pb.Width = 20
|
|
pb.SizeMode = PictureBoxSizeMode.Zoom
|
|
pb.Cursor = Cursors.Hand
|
|
pb.Image = My.Resources.today
|
|
pb.linkedTextBox = tb
|
|
|
|
' ToolTip Text zuordnen
|
|
Dim tooltip As New ToolTip '
|
|
tooltip.SetToolTip(pb, "Heute")
|
|
|
|
AddHandler pb.Click, AddressOf linkclicked
|
|
End Sub
|
|
|
|
Public Sub setBindingDTPE(dat As VERAG_PROG_ALLGEMEIN.MyTextBox, sqlParam As String, bs As BindingSource)
|
|
' dat.DataBindings.Add(New Binding("Nullablevalue", bs, sqlParam, True, DataSourceUpdateMode.OnPropertyChanged, DBNull.Value))
|
|
dat._value = ""
|
|
dat.DataBindings.Add(New Binding("_value", bs, sqlParam, True, DataSourceUpdateMode.OnPropertyChanged, "")) ', ""))
|
|
dat.Text = dat._value
|
|
dat.initDatePicture()
|
|
If dat.Name = "txtGueltigkeit2" Then dat.initDatePicture2()
|
|
'Nullablevalue
|
|
'MsgBox(bs.Current(sqlParam) IsNot DBNull.Value)
|
|
' dat.Checked = (bs.Current(sqlParam) IsNot DBNull.Value)
|
|
End Sub
|
|
|
|
Public Sub initDTPE(dat As VERAG_PROG_ALLGEMEIN.MyTextBox)
|
|
dat._value = ""
|
|
dat.Text = dat._value
|
|
dat.initDatePicture()
|
|
If dat.Name = "txtGueltigkeit2" Then dat.initDatePicture2()
|
|
End Sub
|
|
|
|
|
|
Public Sub initPIN(pintxt As VERAG_PROG_ALLGEMEIN.MyTextBox)
|
|
' If pintxt.Text <> "" Then pintxt.Enabled = False : pintxt.ForeColor = Color.Black
|
|
If pintxt.Text <> "" Then pintxt.ReadOnly = True : pintxt.BackColor = Color.WhiteSmoke
|
|
pintxt.initPINSHowPic()
|
|
End Sub
|
|
|
|
Public Sub addPicToGueltigBis(tb As TextBox)
|
|
Dim pb As New VERAG_PROG_ALLGEMEIN.MyLinkPicBoxVALUE
|
|
tb.Parent.Controls.Add(pb)
|
|
pb.Tag = "Gültig Bis"
|
|
pb.Left = tb.Left + tb.Width + 5 : pb.Top = tb.Top
|
|
pb.Height = 18 : pb.Width = 20
|
|
pb.SizeMode = PictureBoxSizeMode.Zoom
|
|
pb.Name = "picGueltigBisUhr"
|
|
' pb = checkGueltigBis(pb, tb)
|
|
pb.linkedTextBox = tb
|
|
pb.linkedPictureBox = pb
|
|
pb.Image = My.Resources.uhr_notime
|
|
|
|
Dim tgb As New Label
|
|
tb.Parent.Controls.Add(tgb)
|
|
tgb.Name = "txtGueltigBisUhr"
|
|
tgb.Left = tb.Left + tb.Width + pb.Width + 5 : tgb.Top = tb.Top
|
|
' tgb.Visible = False
|
|
' tgb.Text = "abgelaufen"
|
|
tgb.ForeColor = Color.Red
|
|
|
|
AddHandler tb.TextChanged, AddressOf checkGueltigBis
|
|
|
|
' checkGueltigBis(tb, New EventArgs)
|
|
End Sub
|
|
Sub checkGueltigBis(sender As Object, e As EventArgs)
|
|
' MsgBox("änderung")
|
|
Try
|
|
Dim tb As TextBox = sender
|
|
Dim pb As VERAG_PROG_ALLGEMEIN.MyLinkPicBoxVALUE = CType(tb.FindForm.Controls.Find("picGueltigBisUhr", True)(0), VERAG_PROG_ALLGEMEIN.MyLinkPicBoxVALUE)
|
|
Dim tgb As Label = CType(tb.FindForm.Controls.Find("txtGueltigBisUhr", True)(0), Label)
|
|
' MsgBox(tgb.Name)
|
|
|
|
|
|
If tb.Text.Length = 10 And IsDate(tb.Text) Then
|
|
If CDate(tb.Text) < Now Then
|
|
pb.Image = My.Resources.uhr_red
|
|
tgb.Text = "abgelaufen"
|
|
tgb.Visible = True
|
|
tgb.ForeColor = Color.Red
|
|
ElseIf CDate(tb.Text) >= Now Then
|
|
pb.Image = My.Resources.uhr_green
|
|
tgb.Text = "gültig"
|
|
'tgb.Visible = False
|
|
tgb.ForeColor = Color.Green
|
|
End If
|
|
Else
|
|
pb.Image = My.Resources.uhr_notime
|
|
' tgb.Visible = False
|
|
tgb.Text = ""
|
|
End If
|
|
Catch ex As Exception
|
|
End Try
|
|
Return
|
|
End Sub
|
|
|
|
|
|
Sub linkclicked(sender As Object, e As EventArgs)
|
|
Try
|
|
Dim tb As TextBox = sender.linkedTextBox
|
|
tb.Text = Now.ToShortDateString
|
|
Catch ex As Exception
|
|
End Try
|
|
End Sub
|
|
|
|
|
|
Public Sub screenshot()
|
|
Dim form As New Form
|
|
form = Form.ActiveForm
|
|
Dim bounds As Rectangle
|
|
Dim screenshot As System.Drawing.Bitmap
|
|
Dim graph As Graphics
|
|
bounds = form.Bounds 'Screen.PrimaryScreen.Bounds
|
|
|
|
screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
|
|
graph = Graphics.FromImage(screenshot)
|
|
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
|
|
' PictureBox1.Image = screenshot
|
|
If Not My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\") Then
|
|
My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\")
|
|
End If
|
|
Dim cnt As Integer = 1
|
|
Dim strname As String = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\" & form.Name & "_" & Now.ToString("ddMMyyyy_HHmm_")
|
|
While System.IO.File.Exists(strname & cnt & ".bmp") : cnt += 1 : End While
|
|
screenshot.Save(strname & cnt & ".bmp")
|
|
End Sub
|
|
|
|
'Globale Variabeln deklarieren
|
|
Private WeiterGehts As Boolean = False
|
|
Private ms As Integer
|
|
'Hier wird die Wartezeit in ms umgerechnet und der Thread gestartet
|
|
Public Sub Wartezeit(ByVal Sekunden As Integer)
|
|
ms = Sekunden * 1000
|
|
WeiterGehts = False
|
|
Dim T As Thread = New Thread(AddressOf Warten)
|
|
T.Start()
|
|
Do
|
|
Application.DoEvents()
|
|
Loop Until WeiterGehts = True
|
|
End Sub
|
|
'Hier wartet das Programm
|
|
Private Sub Warten()
|
|
Thread.Sleep(ms)
|
|
WeiterGehts = True
|
|
End Sub
|
|
|
|
'Rechte
|
|
|
|
|
|
Public Function checkDbNullStr(ByVal o As Object) As String
|
|
Try : If Not o.ToString Is DBNull.Value Then Return o.ToString
|
|
Catch e As Exception : Return ""
|
|
End Try
|
|
Return ""
|
|
End Function
|
|
|
|
Public valueChanged As Boolean = False
|
|
Public closeOK As Boolean = False
|
|
|
|
'Läuft alle Elememte durch
|
|
Public Sub initChangeEvent(ByVal oContainer As Object)
|
|
If Not IsNothing(oContainer) Then
|
|
' alle Controls des Container-Objekts durchlaufen
|
|
For Each oControl As Control In oContainer.Controls
|
|
' Falls es sich um ein Container-Control handelt und die
|
|
' TextBox-Controls ebenfalls zurückgesetzt werden sollen, muss
|
|
' die Funktion ResetTextBox rekursiv erneut aufgerufen werden
|
|
If oControl.Controls.Count > 0 Then
|
|
initChangeEvent(oControl)
|
|
Else
|
|
' Sofern es sich um ein TextBox-Control handelt...
|
|
If TypeOf oControl Is TextBox Or TypeOf oControl Is RichTextBox Then
|
|
AddHandler oControl.TextChanged, AddressOf setChange
|
|
End If
|
|
If TypeOf oControl Is CheckBox Then
|
|
AddHandler DirectCast(oControl, CheckBox).CheckedChanged, AddressOf setChange
|
|
End If
|
|
If TypeOf oControl Is DateTimePicker Then
|
|
AddHandler DirectCast(oControl, DateTimePicker).ValueChanged, AddressOf setChange
|
|
End If
|
|
If TypeOf oControl Is ComboBox Then
|
|
AddHandler DirectCast(oControl, ComboBox).SelectedIndexChanged, AddressOf setChange
|
|
End If
|
|
If TypeOf oControl Is RadioButton Then
|
|
AddHandler DirectCast(oControl, RadioButton).CheckedChanged, AddressOf setChange
|
|
End If
|
|
|
|
End If
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub setChange()
|
|
valueChanged = True
|
|
closeOK = False
|
|
End Sub
|
|
|
|
Public Sub RemoveClickEvent(b As Object)
|
|
Dim f1 As FieldInfo = GetType(Control).GetField("EventClick", BindingFlags.Static Or BindingFlags.NonPublic)
|
|
Dim obj As Object = f1.GetValue(b)
|
|
Dim pi As PropertyInfo = b.GetType().GetProperty("Events", BindingFlags.NonPublic Or BindingFlags.Instance)
|
|
Dim list As EventHandlerList = DirectCast(pi.GetValue(b, Nothing), EventHandlerList)
|
|
list.RemoveHandler(obj, list(obj))
|
|
End Sub
|
|
|
|
Shared Function getValue(o As DataGridViewCell) As String
|
|
Try
|
|
If o.ValueType.ToString = "System.Boolean" Then
|
|
If o.Value Is DBNull.Value Then Return "NEIN"
|
|
Select Case o.Value
|
|
Case True : Return "JA"
|
|
Case False : Return "NEIN"
|
|
End Select
|
|
Else
|
|
Return o.Value.ToString().Replace(";", ",")
|
|
End If
|
|
Catch ex As Exception
|
|
End Try
|
|
Return ""
|
|
End Function
|
|
|
|
Public Shared Function genExcelFromDT_NEW(dt As DataTable, Optional rangeAsWaehrung() As String = Nothing, Optional ShowAutoFilter As Boolean = True, Optional HeaderTxt As String = "", Optional HeaderTxt2 As String = "", Optional waehrungsZeichen As String = "€", Optional fitCellsToContent As Boolean = False) As String
|
|
Try
|
|
|
|
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
|
|
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
|
|
My.Computer.FileSystem.CreateDirectory(sPath)
|
|
End If
|
|
|
|
Dim wb As New XLWorkbook
|
|
' Dim dt As DataTable = (dgv.DataSource)
|
|
' Dim dt As DataTable = TryCast(dgv., DataTable)
|
|
|
|
wb.Worksheets.Add(dt, "DATEN")
|
|
wb.Worksheets(0).Tables.FirstOrDefault().ShowAutoFilter = ShowAutoFilter
|
|
|
|
If rangeAsWaehrung IsNot Nothing Then
|
|
For Each r In rangeAsWaehrung
|
|
Try
|
|
wb.Worksheets(0).Range(r).Style.NumberFormat.SetFormat("###,###,##0.00 " & waehrungsZeichen)
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
End Try
|
|
Next
|
|
End If
|
|
|
|
If HeaderTxt <> "" Then
|
|
wb.Worksheets(0).FirstRow.InsertRowsAbove(2)
|
|
wb.Worksheets(0).Range("A1").Value = HeaderTxt
|
|
wb.Worksheets(0).Range("A1").Style.Font.Bold = True
|
|
If HeaderTxt2 <> "" Then
|
|
wb.Worksheets(0).Range("A2").Value = HeaderTxt2
|
|
wb.Worksheets(0).Row(2).InsertRowsBelow(1)
|
|
End If
|
|
|
|
End If
|
|
|
|
If fitCellsToContent Then
|
|
wb.Worksheets(0).Columns().AdjustToContents()
|
|
wb.Worksheets(0).Rows().AdjustToContents()
|
|
End If
|
|
|
|
|
|
|
|
Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx"
|
|
wb.SaveAs(filename)
|
|
|
|
|
|
Process.Start(filename)
|
|
|
|
Return filename
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
Return Nothing
|
|
End Try
|
|
End Function
|
|
|
|
Public Shared Sub genExcelCSVFromDT(dgv As DataTable, Optional onlyVisible As Boolean = False)
|
|
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
|
|
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
|
|
My.Computer.FileSystem.CreateDirectory(sPath)
|
|
End If
|
|
|
|
Dim fn As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".csv"
|
|
Dim outFile As System.IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(fn, False)
|
|
Dim clmns As String = ""
|
|
For i = 0 To dgv.Columns.Count - 1
|
|
' If Not onlyVisible Or (onlyVisible And dgv.Columns(i).Visible = True) Then
|
|
clmns &= dgv.Columns(i).ColumnName.ToString().Replace(";", ",") & ";"
|
|
' End If
|
|
Next
|
|
outFile.WriteLine(clmns)
|
|
For i = 0 To dgv.Rows.Count - 1
|
|
clmns = ""
|
|
For j = 0 To dgv.Columns.Count - 1
|
|
' If Not onlyVisible Or (onlyVisible And dgv.Columns(j).Visible = True) Then
|
|
'clmns &= getValue(dgv(j, i)) & ";"
|
|
clmns &= dgv.Rows(i)(j).ToString.Replace(";", ",") & ";"
|
|
' End If
|
|
Next
|
|
outFile.WriteLine(clmns)
|
|
Next
|
|
outFile.Close()
|
|
Try
|
|
|
|
p.StartInfo.FileName = "Excel.exe"
|
|
p.StartInfo.Arguments = fn
|
|
p.EnableRaisingEvents = True
|
|
p.Start()
|
|
AddHandler p.Exited, AddressOf cleartmp 'Löscht die Temp-Dateien
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Excel konnte nicht gestartet werden!" & vbNewLine & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Public Shared Sub genExcelFromDGV_NEW(dgv As DataGridView, Optional onlyVisible As Boolean = False, Optional replaceZeroDate As Boolean = False)
|
|
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
|
|
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
|
|
My.Computer.FileSystem.CreateDirectory(sPath)
|
|
End If
|
|
|
|
Dim wb As New XLWorkbook
|
|
' Dim dt As DataTable = (dgv.DataSource)
|
|
' Dim dt As DataTable = TryCast(dgv., DataTable)
|
|
|
|
wb.Worksheets.Add(dgridViewTods(dgv, replaceZeroDate), "DATEN")
|
|
Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx"
|
|
wb.SaveAs(filename)
|
|
Process.Start(filename)
|
|
|
|
Exit Sub
|
|
|
|
|
|
|
|
Dim fn As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".csv"
|
|
Dim outFile As System.IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(fn, False)
|
|
Dim clmns As String = ""
|
|
For i = 0 To dgv.ColumnCount - 1
|
|
If Not onlyVisible Or (onlyVisible And dgv.Columns(i).Visible = True) Then
|
|
clmns &= dgv.Columns(i).HeaderText.ToString().Replace(";", ",") & ";"
|
|
End If
|
|
Next
|
|
outFile.WriteLine(clmns)
|
|
For i = 0 To dgv.RowCount - 1
|
|
clmns = ""
|
|
For j = 0 To dgv.ColumnCount - 1
|
|
If Not onlyVisible Or (onlyVisible And dgv.Columns(j).Visible = True) Then
|
|
Dim valueTmp As String = getValue(dgv(j, i)) & ";"
|
|
clmns &= valueTmp
|
|
End If
|
|
Next
|
|
' MsgBox(clmns)
|
|
If replaceZeroDate Then ' DATUM Replace
|
|
outFile.WriteLine(clmns.Replace(" 00:00:00", ""))
|
|
Else
|
|
outFile.WriteLine(clmns)
|
|
End If
|
|
Next
|
|
|
|
outFile.Close()
|
|
Try
|
|
|
|
p.StartInfo.FileName = "Excel.exe"
|
|
p.StartInfo.Arguments = fn
|
|
p.EnableRaisingEvents = True
|
|
p.Start()
|
|
AddHandler p.Exited, AddressOf cleartmp 'Löscht die Temp-Dateien
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Excel konnte nicht gestartet werden!" & vbNewLine & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Public Shared Sub genExcelFromDGV(dgv As DataGridView, Optional onlyVisible As Boolean = False)
|
|
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
|
|
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
|
|
My.Computer.FileSystem.CreateDirectory(sPath)
|
|
End If
|
|
|
|
Dim fn As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".csv"
|
|
Dim outFile As System.IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(fn, False)
|
|
Dim clmns As String = ""
|
|
For i = 0 To dgv.ColumnCount - 1
|
|
If Not onlyVisible Or (onlyVisible And dgv.Columns(i).Visible = True) Then
|
|
clmns &= dgv.Columns(i).HeaderText.ToString().Replace(";", ",") & ";"
|
|
End If
|
|
Next
|
|
outFile.WriteLine(clmns)
|
|
For i = 0 To dgv.RowCount - 1
|
|
clmns = ""
|
|
For j = 0 To dgv.ColumnCount - 1
|
|
If Not onlyVisible Or (onlyVisible And dgv.Columns(j).Visible = True) Then
|
|
clmns &= getValue(dgv(j, i)) & ";"
|
|
End If
|
|
Next
|
|
outFile.WriteLine(clmns)
|
|
Next
|
|
outFile.Close()
|
|
Try
|
|
|
|
p.StartInfo.FileName = "Excel.exe"
|
|
p.StartInfo.Arguments = fn
|
|
p.EnableRaisingEvents = True
|
|
p.Start()
|
|
AddHandler p.Exited, AddressOf cleartmp 'Löscht die Temp-Dateien
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Excel konnte nicht gestartet werden!" & vbNewLine & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
Public Shared Function dgridViewTods(ByVal dgv As DataGridView, Optional replaceZeroDate As Boolean = False) As DataTable
|
|
Dim dt As New DataTable
|
|
Try
|
|
' Add Table
|
|
' ds.Tables.Add("Invoices")
|
|
|
|
' Add Columns
|
|
Dim col As DataColumn
|
|
For Each dgvCol As DataGridViewColumn In dgv.Columns
|
|
col = New DataColumn(dgvCol.Name)
|
|
dt.Columns.Add(col)
|
|
Next
|
|
|
|
'Add Rows from the datagridview
|
|
Dim row As DataRow
|
|
Dim colcount As Integer = dgv.Columns.Count - 1
|
|
For i As Integer = 0 To dgv.Rows.Count - 1
|
|
row = dt.Rows.Add
|
|
For Each column As DataGridViewColumn In dgv.Columns
|
|
Dim valueTmp As Object = dgv.Rows.Item(i).Cells(column.Index).Value
|
|
If valueTmp Is DBNull.Value Then
|
|
row.Item(column.Index) = ""
|
|
Else
|
|
If replaceZeroDate AndAlso Not IsNumeric(valueTmp) Then valueTmp = valueTmp.ToString.Replace(" 00:00:00", "")
|
|
row.Item(column.Index) = valueTmp
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
Return dt
|
|
|
|
Catch ex As Exception
|
|
|
|
MsgBox("CRITICAL ERROR : Exception caught while converting dataGridView to DataSet (dgvtods).. " & Chr(10) & ex.Message)
|
|
Return Nothing
|
|
End Try
|
|
End Function
|
|
|
|
Private Shared WithEvents p As New Process
|
|
Shared Sub cleartmp(ByVal sender As System.Object, ByVal e As System.EventArgs) 'Nach Beenden des Programmes werden alle temporären Dateien gelöscht
|
|
Dim dir = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Monitoring\tmp\"
|
|
If System.IO.Directory.Exists(dir) Then
|
|
For Each file As String In System.IO.Directory.GetFiles(dir) ' Ermittelt alle Dateien des Ordners
|
|
Try
|
|
My.Computer.FileSystem.DeleteFile(file)
|
|
Catch ex As Exception : MsgBox(ex.Message) : End Try
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Public Shared Sub _TRANSLATE_RPT(rpt As GrapeCity.ActiveReports.SectionReport, o As GrapeCity.ActiveReports.SectionReportModel.ControlCollection, lan As String, reportName As String)
|
|
If lan = "" Then Exit Sub
|
|
If lan = "DE" Then Exit Sub
|
|
'o... Form
|
|
's... SubContainer
|
|
'c... Control
|
|
Dim MEname = reportName 'rpt.Name (geht ned) '"rptRechnungDruck"
|
|
Dim TextTmp = VERAG_PROG_ALLGEMEIN.cAllgemein.TRANSLATE.list.FindAll(Function(x) x.trs_object = MEname And x.trs_sprache = lan)
|
|
|
|
If TextTmp IsNot Nothing Then
|
|
For Each TXT As VERAG_PROG_ALLGEMEIN.cTranslate In TextTmp
|
|
Dim found As GrapeCity.ActiveReports.SectionReportModel.ARControl = Nothing
|
|
For Each search As GrapeCity.ActiveReports.SectionReportModel.ARControl In o
|
|
If search.Name = TXT.trs_control Then
|
|
found = search
|
|
End If
|
|
Next
|
|
|
|
' MsgBox(TXT.trs_control)
|
|
If found IsNot Nothing Then
|
|
' MsgBox("JA")
|
|
Dim obj As GrapeCity.ActiveReports.SectionReportModel.ARControl = found
|
|
If obj IsNot Nothing Then
|
|
If (TypeOf obj Is GrapeCity.ActiveReports.SectionReportModel.Label) Then
|
|
DirectCast(obj, GrapeCity.ActiveReports.SectionReportModel.Label).Text = TXT.trs_text
|
|
End If
|
|
If (TypeOf obj Is GrapeCity.ActiveReports.SectionReportModel.TextBox) Then
|
|
DirectCast(obj, GrapeCity.ActiveReports.SectionReportModel.TextBox).Text = TXT.trs_text
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Function MessageTimeOut(sMessage As String, sTitle As String, iSeconds As Integer) As Boolean
|
|
Dim Shell
|
|
Shell = CreateObject("WScript.Shell")
|
|
Shell.Run("mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""" & sMessage & """," & iSeconds & ",""" & sTitle & """))")
|
|
MessageTimeOut = True
|
|
End Function
|
|
|
|
End Class
|
|
|
|
|
|
Public Class MyListItem_DELETE
|
|
Private mText As String
|
|
Private mValue As String
|
|
|
|
Public Sub New(ByVal pText As String, ByVal pValue As String)
|
|
mText = pText
|
|
mValue = pValue
|
|
End Sub
|
|
|
|
Public ReadOnly Property Text() As String
|
|
Get
|
|
Return mText
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property Value() As String
|
|
Get
|
|
Return mValue
|
|
End Get
|
|
End Property
|
|
|
|
Public Overrides Function ToString() As String
|
|
Return mText
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
End Class
|
|
|
|
|
|
|
|
Public Class MyListItem2_DELETE
|
|
Private mText As Object
|
|
Private mValue As Object
|
|
|
|
Public Sub New(ByVal pText As Object, ByVal pValue As Object)
|
|
mText = pText
|
|
mValue = pValue
|
|
End Sub
|
|
|
|
Public ReadOnly Property Text() As Object
|
|
Get
|
|
Return mText
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property Value() As Object
|
|
Get
|
|
Return mValue
|
|
End Get
|
|
End Property
|
|
|
|
' Public Overrides Function ToString() As Object
|
|
' Return mText
|
|
' End Function
|
|
|
|
|
|
|
|
|
|
|
|
End Class
|
|
|
|
|
|
|
|
|
|
Public Class SQLVariable_DELETE
|
|
Private TextSQLName As String
|
|
Private ValueSQLVALUE As Object
|
|
Private Scalarvariablename As String
|
|
Private primaryParam As Boolean
|
|
|
|
Public Sub New(ByVal Text As String, ByVal Value As Object, Optional Scalarvariablename As String = "", Optional primaryParam As Boolean = False)
|
|
Me.TextSQLName = Text
|
|
Me.ValueSQLVALUE = Value
|
|
Me.primaryParam = primaryParam
|
|
|
|
If Scalarvariablename <> "" Then Me.Scalarvariablename = Scalarvariablename Else Me.Scalarvariablename = Text
|
|
End Sub
|
|
|
|
Public ReadOnly Property Text() As String
|
|
Get
|
|
Return TextSQLName
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property Value() As Object
|
|
Get
|
|
Return ValueSQLVALUE
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property Scalarvariable() As Object
|
|
Get
|
|
Return Scalarvariablename
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property isPrimaryParam() As Boolean
|
|
Get
|
|
Return primaryParam
|
|
End Get
|
|
End Property
|
|
|
|
|
|
' Public Overrides Function ToString() As Object
|
|
' Return mText
|
|
' End Function
|
|
|
|
|
|
|
|
End Class
|
|
|
|
Public Class cNetworkDrive
|
|
|
|
' Benötigte API-Deklarationen
|
|
Const RESOURCETYPE_DISK = &H1
|
|
|
|
Public Structure NETRESOURCE
|
|
Public dwScope As Integer
|
|
Public dwType As Integer
|
|
Public dwDisplayType As Integer
|
|
Public dwUsage As Integer
|
|
Public lpLocalName As String
|
|
Public lpRemoteName As String
|
|
Public lpComment As String
|
|
Public lpProvider As String
|
|
End Structure
|
|
|
|
Private Declare Function WNetAddConnection2 Lib "mpr.dll" _
|
|
Alias "WNetAddConnection2A" ( _
|
|
ByRef lpNetResource As NETRESOURCE, _
|
|
ByVal lpPassword As String, _
|
|
ByVal lpUserName As String, _
|
|
ByVal dwFlags As Integer) As Integer
|
|
|
|
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" _
|
|
Alias "WNetCancelConnection2A" ( _
|
|
ByVal lpName As String, _
|
|
ByVal dwFlags As Integer, _
|
|
ByVal fForce As Integer) As Integer
|
|
|
|
''' <summary>
|
|
''' Netzlaufwerk verbinden
|
|
''' </summary>
|
|
''' <param name="buchstabe">Laufwerksbuchstabe</param>
|
|
''' <param name="freigabename">Freigabename</param>
|
|
Public Function MapDrive(ByVal buchstabe As String, _
|
|
ByVal freigabename As String) As Boolean
|
|
|
|
Dim nr As NETRESOURCE ' Netzlaufwerk-Objekt (siehe Struktur)
|
|
Dim username As String ' Username für die Netzwerkresource
|
|
Dim password As String ' Passwort für die Netzwerkresource
|
|
Dim cntresult As Integer ' Resultat des Verbindens
|
|
|
|
' nr ist das neue Netzlaufwerk der NETRESOURCE Struktur:
|
|
nr = New NETRESOURCE
|
|
|
|
' Überprüfen, ob der Laufwerkbuchstabe schon vorhanden ist,
|
|
' wenn ja dann Funktionen beenden.
|
|
If Not buchstabe.EndsWith(":") Then buchstabe = buchstabe & ":"
|
|
Dim sDrives As String = Join(System.IO.Directory.GetLogicalDrives(), "")
|
|
If sDrives.Contains(buchstabe) Then Return False
|
|
|
|
' Dem Objekt nr übergeben wir jetzt die wichtigen Eigenschaften:
|
|
With nr
|
|
' Freigabename setzt sich zusammen aus dem
|
|
' Computernamen und dem Freigabename
|
|
' Bsp: \\meincomputer\freigabe1
|
|
.lpRemoteName = freigabename
|
|
' Der gewünschte Laufwerksbuchstabe
|
|
.lpLocalName = buchstabe
|
|
End With
|
|
|
|
' Evtl. Username und Passwort, sollte die Freigabe gesichert sein.
|
|
username = "VERAGOST\Administrator"
|
|
password = "BmWr501956"
|
|
|
|
' Typdefinition des Netzlaufwerk (eben Laufwerk)
|
|
nr.dwType = RESOURCETYPE_DISK
|
|
|
|
' Die eigentliche Funktion, das Verbinden.
|
|
' Das Ergebnis wird in cntresult abgespeichert.
|
|
' Bei Erfolg kommt als Return 0
|
|
cntresult = WNetAddConnection2(nr, password, username, 0)
|
|
If cntresult = 0 Then
|
|
' Wenn null, war das Verbinden erfolgreich,
|
|
Return True
|
|
Else
|
|
' anderfalls nicht.
|
|
Return False
|
|
End If
|
|
End Function
|
|
|
|
|
|
''' <summary>
|
|
''' Netzlaufwerk trennen
|
|
''' </summary>
|
|
''' <param name="buchstabe">Netzlaufwerksbuchstabe</param>
|
|
Public Function UnMapDrive(ByVal buchstabe As String, _
|
|
Optional ByVal ForceDisconnect As Boolean = True) As Boolean
|
|
Dim unctrc As Integer ' Result des Trennes
|
|
|
|
' Die eigentliche Funktion des Netzlaufwerks trennen.
|
|
If Not buchstabe.EndsWith(":") Then buchstabe = buchstabe & ":"
|
|
unctrc = WNetCancelConnection2(buchstabe, 0, ForceDisconnect)
|
|
If unctrc = 0 Then
|
|
' Wenn null, war die Funktion erfolgreich
|
|
Return True
|
|
Else
|
|
' Andernfalls war die Funktion nicht erfolgreich.
|
|
Return False
|
|
End If
|
|
End Function
|
|
|
|
|
|
|
|
Public Function AddNetworkDrive(ByVal Drive As String, _
|
|
ByVal UncPath As String, _
|
|
Optional ByVal Username As String = "", _
|
|
Optional ByVal Password As String = "") As Boolean
|
|
|
|
Dim p As New Process()
|
|
Try
|
|
With p.StartInfo
|
|
.FileName = "net"
|
|
If Username.Length > 0 Then
|
|
' Netzlaufwerk mit Benutzername und Kennwort erstellen
|
|
.Arguments = String.Format("use {0} ""{1}"" /user:""{2}"" {3}", _
|
|
Drive, UncPath, Username, Password)
|
|
.Domain = "VERAGOST"
|
|
Else
|
|
' Netzlaufwerk ohne Benutzername und Kennwort erstellen
|
|
.Arguments = String.Format("use {0} ""{1}""", Drive, UncPath)
|
|
End If
|
|
.UseShellExecute = True
|
|
.CreateNoWindow = True
|
|
End With
|
|
p.Start()
|
|
Return True
|
|
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
''' <summary>
|
|
''' Trennt das angegebene Netzlaufwerk
|
|
''' </summary>
|
|
''' <param name="Drive">Laufwerksbuchstabe</param>
|
|
Public Sub RemoveNetworkDrive(ByVal Drive As String)
|
|
Dim p As New Process()
|
|
Try
|
|
With p.StartInfo
|
|
.FileName = "net"
|
|
.Arguments = String.Format("use " & Drive & " /DELETE")
|
|
.UseShellExecute = False
|
|
.CreateNoWindow = True
|
|
End With
|
|
p.Start()
|
|
Catch ex As Exception
|
|
End Try
|
|
End Sub
|
|
End Class
|
|
|
|
Public Class cAutoCompleteData
|
|
Private _AutoCompleteString As String
|
|
Public Property AutoCompleteString() As String
|
|
Get
|
|
Return _AutoCompleteString
|
|
End Get
|
|
Set(ByVal value As String)
|
|
_AutoCompleteString = value
|
|
End Set
|
|
End Property
|
|
Private _AutoCompleteProperty As Integer
|
|
Public Property AutoCompleteProperty() As Integer
|
|
Get
|
|
Return _AutoCompleteProperty
|
|
End Get
|
|
Set(ByVal value As Integer)
|
|
_AutoCompleteProperty = value
|
|
End Set
|
|
End Property
|
|
Public Overrides Function ToString() As String
|
|
Return AutoCompleteString
|
|
End Function
|
|
End Class
|
|
|
|
Public Interface IMyInterface
|
|
Event Click As EventHandler
|
|
End Interface
|
|
|
|
|
|
|
|
Public Class cBerechtigungen
|
|
Property id As Integer
|
|
Property text As String
|
|
Property stufe As String
|
|
Property allowed As Boolean
|
|
End Class
|