You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

984 lines
50 KiB

Imports UtilityLibrary
Imports System.IO
Imports C1.Win.C1TrueDBGrid
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.ComponentModel
Imports UtilityLibrary.Win32
Imports System.Text
Namespace EDOKA
#Region "Deklarationen"
#End Region
Public Class clsDivFnkt
Dim m_erstellungsdatum As String
Property Erstellungsdatum() As String
Get
Return m_erstellungsdatum
End Get
Set(ByVal Value As String)
If Value = "" Then
m_erstellungsdatum = ""
Else
Dim dd As String
Dim mm As String
Dim yy As String
dd = Right(Value, 2)
mm = Mid(Value, 5, 2)
yy = Mid(Value, 3, 2)
If Len(dd) < 2 Then dd = "0" + dd
If Len(mm) < 2 Then mm = "0" + mm
m_erstellungsdatum = dd + "." + mm + "." + yy
End If
End Set
End Property
Dim m_found As Boolean
Dim m_tn As TreeNode
Property found() As Boolean
Get
Return m_found
End Get
Set(ByVal Value As Boolean)
m_found = Value
End Set
End Property
Property FoundNode() As TreeNode
Get
Return m_tn
End Get
Set(ByVal Value As TreeNode)
m_tn = Value
End Set
End Property
Public Function Searchnode(ByVal tv As TreeView, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
'Imageindex: Bei 0 keine Änderungen, ansonsten node-selectedimage auf Imageindex setzen
Searchnode = False
found = False
Dim nodeX As TreeNode
For Each nodeX In tv.Nodes
If TranverseNodes(tv, nodeX, SearchObject, imageindex) Then
Exit Function
End If
Next
End Function
Private Function TranverseNodes(ByVal tv As TreeView, ByVal selectedNode As TreeNode, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
Dim nodeX As TreeNode
For Each nodeX In selectedNode.Nodes
nodeX.Text = nodeX.Text
If nodeX.Tag = SearchObject Then
nodeX.Expand()
tv.SelectedNode = nodeX
Me.FoundNode = tv.SelectedNode
If imageindex <> 0 Then
tv.SelectedNode.SelectedImageIndex = imageindex
tv.SelectedNode.Toggle()
End If
found = True
TranverseNodes = True
Exit Function
End If
TranverseNodes(tv, nodeX, SearchObject, imageindex)
Next
End Function
Public Function Searchnode1(ByVal tv As TreeView, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
'Imageindex: Bei 0 keine Änderungen, ansonsten node-selectedimage auf Imageindex setzen
Searchnode1 = False
found = False
Dim nodeX As TreeNode
For Each nodeX In tv.Nodes
If TranverseNodes1(tv, nodeX, SearchObject, imageindex) Then
Exit Function
End If
Next
End Function
Private Function TranverseNodes1(ByVal tv As TreeView, ByVal selectedNode As TreeNode, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
Dim nodeX As TreeNode
For Each nodeX In selectedNode.Nodes
Try
If nodeX.Tag = SearchObject Then
nodeX.Expand()
Me.FoundNode = nodeX
found = True
TranverseNodes1 = True
Exit Function
Else
TranverseNodes1(tv, nodeX, SearchObject, imageindex)
End If
Catch
If nodeX.Tag = SearchObject Then
nodeX.Expand()
Me.FoundNode = nodeX
found = True
TranverseNodes1 = True
Exit Function
End If
End Try
Next
End Function
Public Function Searchnode2(ByVal tv As TreeView, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
'Imageindex: Bei 0 keine Änderungen, ansonsten node-selectedimage auf Imageindex setzen
Searchnode2 = False
found = False
Dim nodeX As TreeNode
For Each nodeX In tv.Nodes
If TranverseNodes2(tv, nodeX, SearchObject, imageindex) Then
Exit Function
End If
Next
End Function
Private Function TranverseNodes2(ByVal tv As TreeView, ByVal selectedNode As TreeNode, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
Dim nodeX As TreeNode
For Each nodeX In selectedNode.Nodes
If nodeX.ImageIndex = 1 Then
nodeX.Expand()
Me.FoundNode = nodeX
found = True
TranverseNodes2 = True
Exit Function
Else
TranverseNodes2(tv, nodeX, SearchObject, imageindex)
End If
Next
End Function
Public Function Searchnode3(ByVal tv As TreeView, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
'Imageindex: Bei 0 keine Änderungen, ansonsten node-selectedimage auf Imageindex setzen
Searchnode3 = False
found = False
Dim nodeX As TreeNode
For Each nodeX In tv.Nodes
If TranverseNodes3(tv, nodeX, SearchObject, imageindex) Then
Exit Function
End If
Next
End Function
Private Function TranverseNodes3(ByVal tv As TreeView, ByVal selectedNode As TreeNode, ByVal SearchObject As Object, ByVal imageindex As Integer) As Boolean
Dim nodeX As TreeNode
For Each nodeX In selectedNode.Nodes
If nodeX.Nodes.Count > 0 Then
nodeX.Expand()
Me.FoundNode = nodeX
found = True
TranverseNodes3 = True
Exit Function
Else
TranverseNodes3(tv, nodeX, SearchObject, imageindex)
End If
Next
End Function
Public Function Check_Dir(ByVal Partnernr As Long) As String
If Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("net_use") = True Then
End If
End Function
Public Function Ist_Berechtigt(ByVal dokumenttyp As Integer, ByVal Mitarbeiternr As Integer, _
ByVal partnernr As Integer, ByVal dokumentid As String, _
ByVal berechtigung As Integer, ByVal mitarbeiterdok As Integer, _
ByVal vipdok As Integer, ByVal vertraulichdok As Integer) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.SP_Dokumentberechtigung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttyp))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Mitarbeiternr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@partnernr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partnernr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@berechtigung", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, berechtigung))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiterdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, mitarbeiterdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vipdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vipdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vertraulichdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vertraulichdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@currentmitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionen", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionsliste", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
sdaAdapter.Fill(dtToReturn)
If dtToReturn.Rows.Count = 0 Then
If berechtigung = 2 Then
If Berechtigt_als_stv(Mitarbeiternr, partnernr, dokumenttyp) = True Then
Return True
Else
Return False
End If
Else
Return False
End If
Else
Return True
End If
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function Berechtigt_als_stv(ByVal mitarbeiternr As Integer, ByVal partnernr As Integer, ByVal DOKUMENTTYPNR As Integer) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.sp_dokumentberechtigung_erstellungstv"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, mitarbeiternr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@partnernr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partnernr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, DOKUMENTTYPNR))
sdaAdapter.Fill(dtToReturn)
If dtToReturn.Rows.Count = 0 Then
Return False
Else
Return True
End If
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function Berechtigte_Mitarbeiter(ByVal dokumenttyp As Integer, ByVal Mitarbeiternr As Integer, _
ByVal partnernr As Integer, ByVal dokumentid As String, _
ByVal berechtigung As Integer, ByVal mitarbeiterdok As Integer, _
ByVal vipdok As Integer, ByVal vertraulichdok As Integer, _
ByVal Funktionsliste As String) As DataTable
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.SP_Dokumentberechtigung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttyp))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Mitarbeiternr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@partnernr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partnernr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@berechtigung", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, berechtigung))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiterdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, mitarbeiterdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vipdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vipdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vertraulichdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vertraulichdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@currentmitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionen", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionsliste", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Funktionsliste))
scmCmdToExecute.Parameters.Add(New SqlParameter("@stv", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
Globals.stv = scmCmdToExecute.Parameters("@stv").Value
Return dtToReturn
Catch ex As Exception
MsgBox(ex.Message)
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function Berechtigte_Funktionen(ByVal dokumenttyp As Integer, ByVal Mitarbeiternr As Integer, _
ByVal partnernr As Integer, ByVal dokumentid As String, _
ByVal berechtigung As Integer, ByVal mitarbeiterdok As Integer, _
ByVal vipdok As Integer, ByVal vertraulichdok As Integer) As DataTable
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.SP_Dokumentberechtigung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttyp))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Mitarbeiternr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@partnernr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partnernr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@berechtigung", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, berechtigung))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiterdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, mitarbeiterdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vipdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vipdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@vertraulichdok", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, vertraulichdok))
scmCmdToExecute.Parameters.Add(New SqlParameter("@currentmitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionen", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.Parameters.Add(New SqlParameter("@funktionsliste", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
sdaAdapter.Fill(dtToReturn)
Return dtToReturn
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function Generate_Berechtigungen()
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.sp_dokumentberechtigung_Generate"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.CommandTimeout = 50000
conn.OpenConnection()
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
'Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
conn.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function MA_Is_Sysadmin(ByVal mitarbeiternr As Integer) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim i As Integer
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_check_sysadmin"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@issysadmin", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
i = scmCmdToExecute.Parameters.Item("@issysadmin").Value
If i > 0 Then MA_Is_Sysadmin = True Else MA_Is_Sysadmin = False
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
#Region "Spalten"
Public Sub SpaltenTitel_Aktualisieren(ByVal tdb As C1TrueDBGrid, ByVal inptable As DataTable, ByVal tablename As String)
'Spaltentitel setzen
Dim titel As New EDOKA.MySpaltenTitel()
Dim ts As New EDOKA.Tabellenspalte()
Dim i As Integer
Dim t As New DataTable()
Dim dc As C1.Win.C1TrueDBGrid.C1DisplayColumn
Dim s As String
t = inptable
ts.Tabelle = tablename
For i = 0 To tdb.Columns.Count - 1
s = tdb.Columns(i).DataField
ts.Feld = s
ts.getspalte()
tdb.Columns(i).Caption = ts.spaltenname
If tdb.Columns(i).Caption = "" Then
tdb.Splits(0).DisplayColumns(i).Width = 0
tdb.Splits(0).DisplayColumns(i).Visible = False
Else
tdb.Splits(0).DisplayColumns(i).Width = ts.ColWith
End If
' If tdb.Columns(i).Caption = "" Then tdb.Splits(0).DisplayColumns(i).Width = 0
If ts.locked Then
tdb.Splits(0).DisplayColumns(i).Locked = True
End If
If ts.AlsHacken Then
tdb.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
End If
'Präsentation von aktiv
If tdb.Columns(i).DataField = "aktiv" Then
tdb.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
tdb.Columns(i).ValueItems.DefaultItem = True
tdb.Columns(i).DefaultValue = True
tdb.Columns(i).FilterText = True
End If
If tdb.Columns(i).DataField = "erstellt_am" Then
tdb.Columns(i).DefaultValue = Now
End If
'tdb.Splits(0).DisplayColumns.Insert(ts.Order, tdb.Splits(0).DisplayColumns(i))
'tdb.Splits(0).DisplayColumns.RemoveAt(i)
Next
End Sub
#End Region
#Region "FileHandling"
Public Function Get_Filename(ByVal fi As String, ByVal partnernr As String) As String
Dim s As String
Get_Filename = ""
If Not Open_Directory() Then Exit Function
s = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("logisches_Laufwerk") & Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_dokumente") + "\"
Get_Filename = s + fi
End Function
Public Function Open_Directory() As Boolean
Open_Directory = True
End Function
Public Function Create_Folders(ByVal s As String) As Boolean
Dim xt(10) As String
Dim xti As Integer
Dim po As Integer
Dim x As String
Dim xti1 As Integer
Dim i As Long
po = InStr(s, "\")
xti = 0
While po <> 0
xt(xti) = Left(s, po - 1)
xti = xti + 1
s = Right(s, Len(s) - (po))
po = InStr(s, "\")
End While
xt(xti) = s
For xti1 = 0 To xti
If x <> "" Then x = x & "\"
x = x & xt(xti1)
If Not FolderExist(x) Then Create_Folder(x)
Next
Create_Folders = True
End Function
Public Function FolderExist(ByVal dn As String) As Boolean
Try
If System.IO.Directory.Exists(dn) Then FolderExist = True Else FolderExist = False
Catch
FolderExist = False
End Try
End Function
Public Function Create_Folder(ByVal dn As String) As Boolean
Try
System.IO.Directory.CreateDirectory(dn)
Catch
Create_Folder = False
End Try
End Function
Public Function ExtractFilename(ByVal x As String) As String
Dim splitter
Dim i As Integer
Dim Y As String
splitter = Microsoft.VisualBasic.Split(x, "\")
On Error Resume Next
Err.Clear()
i = -1
While Err.Number = 0
i = i + 1
Y = splitter(i)
End While
ExtractFilename = Y
End Function
#End Region
#Region "Dokumentbearbeitung"
Public Function Status_Dokumentbearbeitung(ByVal fnkt As Integer, ByVal dokumentid As String, ByVal erstellung As Boolean, ByVal dokumentname As String) As Boolean
'Prüfung, Eintragung, Löschung der Tabelle DokInBearbeitung'
'Fnkt:
' 1=Eintragen
' 2=Löschen
' 3=Prüfen
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.sp_Dokument_in_Bearbeitung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@erstellung", SqlDbType.Bit, 1, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, erstellung))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentname", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentname))
scmCmdToExecute.Parameters.Add(New SqlParameter("@stationsname", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Environ("Computername")))
sdaAdapter.Fill(dtToReturn)
Status_Dokumentbearbeitung = True
If fnkt = 3 Then
If dtToReturn.Rows.Count > 0 Then
MyMsg.show_standardmessage(31, MsgBoxStyle.Critical)
Status_Dokumentbearbeitung = False
End If
End If
Catch ex As Exception
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
dtToReturn.Dispose()
End Try
End Function
#End Region
#Region "ShowDoc"
Public Sub ShowDoc(ByVal dokumentid As String, ByVal formx As Form)
Try
Dim colddokumentid As String
colddokumentid = get_colddokumentid(dokumentid, 0)
If colddokumentid = "Office" Then
show_office(dokumentid, formx)
Exit Sub
End If
If Not ShowColdDoc(dokumentid, formx, colddokumentid) Then
colddokumentid = get_colddokumentid(dokumentid, 1)
If Not ShowColdDoc(dokumentid, formx, colddokumentid) Then
colddokumentid = get_colddokumentid(dokumentid, 2)
If Not ShowColdDoc(dokumentid, formx, colddokumentid) Then
show_office(dokumentid, formx)
End If
End If
End If
Catch
End Try
End Sub
Public Function ShowColdDoc(ByVal dokumentid As String, ByVal formx As Form, ByVal cold_dokumentid As String) As Boolean
Dim f As New frmcoldview()
f.erstellungsdatum = Me.Erstellungsdatum
f.colddokumentid = cold_dokumentid
f.dokumentid = dokumentid
f.MdiParent = formx.MdiParent
'Dim docnotfound As Boolean
'f.DocNotFound = False
' f.Show()
If f.docnotfound = True Then
ShowColdDoc = False
f.Dispose()
Else
ShowColdDoc = True
f.Show()
End If
End Function
Public Function printcolddoc(ByVal dokumentid As String, ByVal formx As Form, ByVal cold_dokumentid As String) As Boolean
Try
Dim f As New frmcoldview()
f.erstellungsdatum = Me.Erstellungsdatum
f.colddokumentid = cold_dokumentid
f.dokumentid = dokumentid
f.MdiParent = formx.MdiParent
'Dim docnotfound As Boolean
'f.DocNotFound = False
f.Height = 1
f.Width = 1
f.Show()
If f.docnotfound = True Then
MyMsg.show_standardmessage(92, MsgBoxStyle.Critical)
Else
f.printdoc()
MyMsg.show_standardmessage(91, MsgBoxStyle.Information)
f.Close()
f.Dispose()
End If
Catch
MyMsg.show_standardmessage(92, MsgBoxStyle.Critical)
End Try
End Function
Public Sub show_office(ByVal dokumentid As String, ByVal formx As Form)
Dim doc As New edokadb.clsDokument()
Dim Dokument As String
Dim FileReader As New DocMgmt()
doc.cpMainConnectionProvider = conn
doc.sDokumentid = New SqlString(CType(dokumentid, String))
doc.SelectOne()
Try
Dokument = DivFnkt.Get_Filename("View_" + Format(Now, "yyyyMMddHHmmss") + "_" + doc.sDokumentname.Value, "")
' Dokument = DivFnkt.Get_Filename(doc.sDokumentname.Value, "")
If FileReader.Get_From_DB(doc.sDokumentid.Value, Dokument) = False Then
If isbck(dokumentid) Then
MyMsg.show_standardmessage(39, MsgBoxStyle.Information)
End If
doc.Dispose()
FileReader = Nothing
Exit Sub
End If
doc.Dispose()
FileReader = Nothing
Dim f As New frmWordViewer()
'hutter
'f.dokument = Dokument
f.addressBar.Text = Dokument
'f.MdiParent = formx
f.Show()
Catch ex As Exception
MsgBox(ex.Message)
MyMsg.show_standardmessage(99, MsgBoxStyle.Information)
End Try
End Sub
Public Function isbck(ByVal dokumentid As String) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "sp_check_bck"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@isbck", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@bcknr", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
If scmCmdToExecute.Parameters("@isbck").Value = 1 Then
isbck = True
Else
isbck = False
End If
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("CheckBCK:" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
dtToReturn.Dispose()
End Try
End Function
Public Sub print_office(ByVal dokumentid As String, ByVal formx As Form)
Try
Dim doc As New edokadb.clsDokument()
Dim Dokument As String
Dim FileReader As New DocMgmt()
doc.cpMainConnectionProvider = conn
doc.sDokumentid = New SqlString(CType(dokumentid, String))
doc.SelectOne()
Dokument = DivFnkt.Get_Filename(doc.sDokumentname.Value, "")
If FileReader.Get_From_DB(doc.sDokumentid.Value, Dokument) = False Then
MyMsg.show_standardmessage(39, MsgBoxStyle.Information)
doc.Dispose()
FileReader = Nothing
Exit Sub
End If
doc.Dispose()
FileReader = Nothing
Dim f As New frmWordViewer()
'hutter
f.addressBar.Text = Dokument
'f.dokument = Dokument
f.MdiParent = formx.MdiParent
f.Width = 1
f.Height = 1
f.Show()
Application.DoEvents()
'hutter
f.Print_Doc()
'f.PrintDoc()
f.Close()
f.Dispose()
MyMsg.show_standardmessage(91, MsgBoxStyle.Information)
Catch
MyMsg.show_standardmessage(92, MsgBoxStyle.Critical)
End Try
End Sub
Public Function get_colddokumentid(ByVal dokumentid As String, ByVal fnkt As Integer) As String
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.sp_get_colddokumentid"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
scmCmdToExecute.Parameters.Add(New SqlParameter("@colddokumentid", SqlDbType.VarChar, 255, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, ""))
sdaAdapter.Fill(dtToReturn)
get_colddokumentid = scmCmdToExecute.Parameters("@colddokumentid").Value
Catch ex As Exception
MsgBox("Status Dokumentbearbeitung::" & scmCmdToExecute.CommandText + "::" + ex.Message)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
dtToReturn.Dispose()
End Try
End Function
#End Region
#Region "Generate Dokumentid"
Public Function Generate_Key() As String
Dim dbkey As New edokadb.clsMyKey_Tabelle()
Dim dokart As New edokadb.clsDokumentart()
Dim key As Long
Dim skey As String
Dim s As String
dbkey.cpMainConnectionProvider = conn
conn.OpenConnection()
key = dbkey.get_dbkey("dokument")
conn.CloseConnection(False)
skey = "OFFEDK000"
s = Str(Year(Now))
While Microsoft.VisualBasic.Left(s, 1) = " "
s = Microsoft.VisualBasic.Right(s, Len(s) - 1)
End While
skey = skey + s
s = Str(key)
While Microsoft.VisualBasic.Left(s, 1) = " "
s = Microsoft.VisualBasic.Right(s, Len(s) - 1)
End While
While Len(s) < 8
s = "0" + s
End While
skey = skey + s
s = Pruefziffer(Microsoft.VisualBasic.Right(skey, 15))
While Microsoft.VisualBasic.Left(s, 1) = " "
s = Microsoft.VisualBasic.Right(s, Len(s) - 1)
End While
skey = skey + s
Generate_Key = skey
End Function
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
#End Region
#Region "MainBerechtigungen"
Public Function BarcodeEtiketten_Berechtigt() As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.sp_berechtigung_labels"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@berechtigt", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
If scmCmdToExecute.Parameters("@berechtigt").Value = 1 Then
BarcodeEtiketten_Berechtigt = True
Else
BarcodeEtiketten_Berechtigt = False
End If
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function EDOKA_Partner_Berechtigt() As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
Try
scmCmdToExecute.CommandText = "dbo.sp_berechtigung_edokapartner"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@berechtigt", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
If scmCmdToExecute.Parameters("@berechtigt").Value = 1 Then
EDOKA_Partner_Berechtigt = True
Else
EDOKA_Partner_Berechtigt = False
End If
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
#End Region
#Region "Timer"
Public Function Check_MessageTimer() As Integer
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_message_getmessage"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@typ", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
sdaAdapter.Fill(dtToReturn)
Check_MessageTimer = False
Check_MessageTimer = dtToReturn.Rows.Count
Catch ex As Exception
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
#End Region
Public Sub check_doc2()
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim i As Integer
Dim s As String
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_check_doc"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
sdaAdapter.Fill(dtToReturn)
For i = 0 To dtToReturn.Rows.Count - 1
Dim f As New frmHinweismeldung1()
s = "Das nachfolgende Dokumente wurde von Ihnen erstellt, konnte aber aufgrund eines"
s = s + vbCrLf + "Systemfehlers nicht korrekt auf der Datenbank gespeichert werden. Der Dokumenteintrag im"
s = s + vbCrLf + "EDOKA ist fehlerhaft, da sich das Dokument im EDOKA nicht anzeigen lässt."
s = s + vbCrLf + vbCrLf
s = s + "Partner: " + Chr(9) + Str(dtToReturn.Rows(i).Item("nrpar00")) + " - " + dtToReturn.Rows(i).Item("bkpar00")
s = s + vbCrLf
s = s + "DokumentID: " + Chr(9) + dtToReturn.Rows(i).Item("dokumentid")
s = s + vbCrLf
s = s + "Dokumenttyp: " + Chr(9) + dtToReturn.Rows(i).Item("bezeichnung")
s = s + vbCrLf
s = s + "Erstellt am: " + Chr(9) + dtToReturn.Rows(i).Item("erstelltam")
s = s + vbCrLf + vbCrLf
s = s + "Bitte gehen Sie wie folgt vor:"
s = s + vbCrLf + "- Vernichten des allfällig ausgedrucken Dokumentes"
s = s + vbCrLf + "- Löschen des fehlerhaften Dokumenteintrages im EDOKA"
s = s + vbCrLf + "- Neu erstellen des Dokumentes"
f.Label1.Text = s
f.MsgBoxStyle = 1
f.ShowDialog()
f.Dispose()
Globals.PerfMon.force_insert_entry("Dokument nicht korrekt auf der Datenbank - " + dtToReturn.Rows(i).Item("dokumentid"))
Next
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
'Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Sub
Public Sub TraceLog(ByVal stext As String)
'Dim sw As New StreamWriter("c:\tracelog.txt", True)
'sw.WriteLine(stext)
'sw.Flush()
'sw.Close()
End Sub
Public Function leererstellung(ByVal fnkt As Integer, ByVal dokumenttypnr As Integer) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim i As Integer
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_dokument_leererstellung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttypnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@leererstellung", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
i = scmCmdToExecute.Parameters("@leererstellung").Value
If i > 0 Then leererstellung = True Else leererstellung = False
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Public Function EDOKA_Partner_Dokument(ByVal fnkt As Integer, ByVal dokumenttypnr As Integer) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim i As Integer
Dim dtToReturn As DataTable = New DataTable()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_dokument_edokapartnererstellung"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttypnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumenttypnr))
scmCmdToExecute.Parameters.Add(New SqlParameter("@leererstellung", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
sdaAdapter.Fill(dtToReturn)
i = scmCmdToExecute.Parameters("@leererstellung").Value
If i > 0 Then EDOKA_Partner_Dokument = True Else EDOKA_Partner_Dokument = False
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
End Class
End Namespace