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.

1443 lines
64 KiB

Imports System.IO
Imports System.Xml
Imports System.Xml.Schema
Imports System.Data.SqlClient
Imports System.Data.SqlTypes
Public Class xmlHandling
#Region "Properties"
Dim m_result As Boolean
Property Result As Boolean
Get
Return m_result
End Get
Set(value As Boolean)
m_result = value
End Set
End Property
#End Region
#Region "Deklarationen"
Dim Partner_Typ As String
Dim Partner_Art As String
Dim Resultvalue As String
Dim PersonBeziehung As New DataTable
Dim AddrBeziehung As New DataTable
Dim sAction As String = ""
Dim doc As New XmlDocument
Dim partnernr As Integer
Dim vvr As New DataTable
Dim pnr As Integer = 0
Dim Angestelltenart As String = ""
Dim vipCode As String = ""
Dim OriginalXml As String = ""
#End Region
Sub New(ByVal strdata As String)
Try
Me.Result = True
Me.OriginalXml = strdata
Dim ds As New DataSet
If Result Then
doc.LoadXml(strdata)
Dim XMLType As String = XmlHelper.GetItemValueByTagName(doc, "resultName")
Select Case XMLType
Case "Partner Stammdaten"
Partner_Typ = XmlHelper.GetItemValueByTagName(doc, "typ")
Partner_Art = XmlHelper.GetItemValueByTagName(doc, "art")
PersonBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "personbeziehung")
AddrBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "adresse")
Angestelltenart = XmlHelper.GetItemValueByTagName(doc, "angestelltenArt")
vipCode = XmlHelper.GetItemValueByTagName(doc, "vipCode")
Result = Update_Partner()
If Result Then
Result = Update_Angestelltenart(Angestelltenart)
If Result Then
Result = Update_VIP(vipCode)
End If
End If
Case "Adresse Stammdaten"
Dim Adresstype As String
' Version mit E-Mail-Adressen
Adresstype = XmlHelper.GetItemValueByTagName(doc, "medium")
If Adresstype = "email" Then
Update_Email()
Else
Result = update_Adresse()
End If
Case "Container Stammdaten"
AddrBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "adresse")
Result = update_vv()
Case "Document Stammdaten"
If XmlHelper.GetItemValueByTagName(doc, "partnerNummer") <> "" Then
Result = update_vv()
End If
Case "Konto Stammdaten"
AddrBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "adresse")
Result = update_vv()
Case "Loan Stammdaten"
AddrBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "adresse")
Result = update_vv()
Case "Mitarbeiter Stammdaten"
Case "Verfuegungsrechte"
vvr = XmlHelper.ConvertXmlNodeListToDataTable(doc, "Verfuegungsrecht")
pnr = XmlHelper.GetItemValueByTagName(doc, "BpKey")
Result = Update_Verfuegungsrechte()
Case "Schrankfach Stammdaten"
AddrBeziehung = XmlHelper.ConvertXmlNodeListToDataTable(doc, "adresse")
Result = update_vv()
Case "EDK-Dokument Referenz"
Dim dokumentid As String = XmlHelper.GetItemValueByTagName(doc, "objektRef")
Dim Ref1 As String = XmlHelper.GetItemValueByTagName(doc, "externeNr")
Dim Ref2 As String = XmlHelper.GetItemValueByTagName(doc, "formatierteNr")
Result = Update_Dokumentreferenz(dokumentid, Ref1, Ref2)
Case "LSV Stammdaten"
Result = update_lsv()
Case Else
m_log.log("EDKB04: Error bei XML->Obj: xmltype:" & XMLType, Common.Common.JournalEntryType.Error)
Result = False
End Select
End If
Catch ex As Exception
m_log.log("EDKB04: Fehler beim Einlesen des XML", Common.Common.JournalEntryType.Error)
Result = False
End Try
End Sub
#Region "LSV"
Private Function update_lsv() As Boolean
Dim ret As Boolean = True
Dim canceledDocuments As LsvBe.CanceledDocuments = New LsvBe.CanceledDocuments()
canceledDocuments.ConnectionString = Globals.sConnectionString_edoka
canceledDocuments.Contract = doc
ret = canceledDocuments.Render()
For Each result As Result In canceledDocuments.Results
m_log.log(String.Format("EDKB04: {0}", result.Text), result.Type)
Next
If Not ret Then
LsvSendMail()
End If
Return ret
End Function
Sub LsvSendMail()
Dim edokaSqlDb As New EdokaSqlDb(Globals.sConnectionString_edoka)
edokaSqlDb.SendMail(
"TGGZVInlandAusland@tkb.ch",
"Zur Abklärung: Für die aufgehobene LSV-Belastungsermächtigung wurde im Archiv kein zutreffendes Dokument für die Aufhebung gefunden.",
Me.OriginalXml)
End Sub
#End Region
#Region "Partner"
#Region "PartnerUpdate"
Private Sub UpdateStringRow(ByVal XmlElement As String, ByRef DbRow As DataRow, ByVal ColumnName As String)
Dim xmlValue As String
xmlValue = XmlHelper.GetItemValueByTagName(doc, XmlElement)
If xmlValue <> "" Then
DbRow(ColumnName) = xmlValue
Else
DbRow(ColumnName) = DBNull.Value
End If
End Sub
Private Sub UpdateIntRow(ByVal XmlElement As String, ByRef DbRow As DataRow, ByVal ColumnName As String)
Dim xmlValue As String
xmlValue = XmlHelper.GetItemValueByTagName(doc, XmlElement)
If xmlValue <> "" Then
DbRow(ColumnName) = Convert.ToInt32(xmlValue)
Else
DbRow(ColumnName) = DBNull.Value
End If
End Sub
Private Sub UpdateDateRow(ByVal XmlElement As String, ByRef DbRow As DataRow, ByVal ColumnName As String)
Dim xmlValue As String
xmlValue = XmlHelper.GetItemValueByTagName(doc, XmlElement)
If xmlValue <> "" Then
Dim d As Date = DateTime.ParseExact(xmlValue, "yyyyMMdd", System.Globalization.CultureInfo.InvariantCulture)
DbRow(ColumnName) = d
Else
DbRow(ColumnName) = DBNull.Value
End If
End Sub
Private Sub UpdatePartnerBoersenkotiert(ByRef DbRow As DataRow)
Const columnName = "boersenkotiert"
Const xmlElement = "is_boeko"
Dim xmlValue As String
xmlValue = XmlHelper.GetItemValueByTagName(doc, xmlElement)
If xmlValue.ToUpper() = "Y" Then
DbRow(columnName) = 1
Else
DbRow(columnName) = 0
End If
End Sub
''' <summary>
''' Teil von Update_Partner()
''' Aktualisiert alle berechtigte Email Adressen eines Parnters
''' Die Daten (siehe Parameter) kommen alle aus der XML Message
''' </summary>
''' <param name="partnerNr">aus XML Message</param>
Private Sub UpdatePartnerBerechtigteEmail(partnerNr As Integer)
' Das Try/Catch Konstrukt braucht es nur für Debug Zwecke
Try
' cn = ColumnName
Const cnId = "id"
Const cnPartnerNr = "partner_nr"
Const cnEmailAdresse = "email_adresse"
' so = Size of
Const soEmailAdresse = 100
Const tableName = "partner_berechtigte_email_adresse"
' select id, partner_nr, email_adresse from dbo.partner_berechtigte_email_adresse
Dim selectCmdText As String = String.Format("select {0}, {1}, {2} from dbo.{3}", cnId, cnPartnerNr, cnEmailAdresse,
tableName)
' select id, partner_nr, email_adresse from dbo.partner_berechtigte_email_adresse where partner_nr = @partner_nr
Dim selectByPartnerCmdText As String = String.Format("{0} where {1} = @{1}", selectCmdText, cnPartnerNr)
' select id, partner_nr, email_adresse from dbo.partner_berechtigte_email_adresse where id = scope_identity()
Dim selectByScopeIdentityCmdText As String = String.Format("{0} where {1} = scope_identity()", selectCmdText, cnId)
' insert into dbo.partner_berechtigte_email_adresse (partner_nr, email_adresse) values (@partner_nr, @email_adresse)
Dim insertCmdText As String = String.Format("insert into dbo.{0} ({1}, {2}) values (@{1}, @{2})",
tableName, cnPartnerNr, cnEmailAdresse, cnPartnerNr, cnEmailAdresse)
' insert into dbo.partner_berechtigte_email_adresse (partner_nr, email_adresse) values (@partner_nr, @email_adresse);
' Select Case id, partner_nr, email_adresse from dbo.partner_berechtigte_email_adresse where id = scope_identity();
Dim insertBatchText As String = String.Format("{0}; {1};", insertCmdText, selectByScopeIdentityCmdText)
' delete partner_berechtigte_email_adresse where id = @id
Dim deleteByIdCmdText As String = String.Format("delete {0} where {1} = @{1}", tableName, cnId)
Dim connectionString As String = Globals.sConnectionString_edoka
Const xmlElement = "berechtigteEmailAdressen"
Dim berechtigteEmailAdressen As String
berechtigteEmailAdressen = XmlHelper.GetItemValueByTagName(doc, xmlElement)
Dim emailsFromXml As Dictionary(Of String, String) = New Dictionary(Of String, String)
Dim rowsToDeleteInDatabase As List(Of DataRow) = New List(Of DataRow)
Dim emails As [String]() = "".Split("")
' Emails aus berechtigteEmailAdressen in emailsFromXml speichern
If Not String.IsNullOrEmpty(berechtigteEmailAdressen) Then
emails = berechtigteEmailAdressen.Split(";")
End If
For Each email As String In emails
Dim trimmedEmail = email.Trim()
Dim emailKey = email.ToLower()
If trimmedEmail.Length > 0 Then
Dim dummy As String = ""
If Not emailsFromXml.TryGetValue(emailKey, dummy) Then
emailsFromXml(emailKey) = trimmedEmail
End If
End If
Next
' DB Adapter aufbauen (bis und mit Zeile 223)
Using connection As New SqlConnection(connectionString),
dtEmail As New DataTable,
daEmail As New SqlDataAdapter(selectByPartnerCmdText, connection),
insertCommand As New SqlCommand(insertBatchText, connection),
deleteCommand As New SqlCommand(deleteByIdCmdText, connection)
daEmail.SelectCommand.Parameters.Add(New SqlParameter("@" + cnPartnerNr, partnerNr))
daEmail.InsertCommand = insertCommand
daEmail.InsertCommand.Parameters.Add(New SqlParameter("@" + cnPartnerNr, SqlDbType.Int, 4, cnPartnerNr))
daEmail.InsertCommand.Parameters.Add(New SqlParameter("@" + cnEmailAdresse, SqlDbType.NVarChar, soEmailAdresse, cnEmailAdresse))
daEmail.DeleteCommand = deleteCommand
daEmail.DeleteCommand.Parameters.Add(New SqlParameter("@" + cnId, SqlDbType.Int, 4, cnId))
' Mit DB Adapter Email Adressen des Partners aktualisieren
daEmail.MissingSchemaAction = MissingSchemaAction.AddWithKey
daEmail.Fill(dtEmail)
For Each row As DataRow In dtEmail.Rows
Dim dummy As String = ""
Dim emailFromDb As String = row(cnEmailAdresse)
Dim emailFromDbKey As String = emailFromDb.ToLower()
If emailsFromXml.TryGetValue(emailFromDbKey, dummy) Then
emailsFromXml.Remove(emailFromDbKey)
Else
rowsToDeleteInDatabase.Add(row)
End If
Next
For Each row As DataRow In rowsToDeleteInDatabase
row.Delete()
Next
For Each email As String In emailsFromXml.Values
Dim dataRow As DataRow = dtEmail.NewRow()
dataRow(cnEmailAdresse) = email
dataRow(cnPartnerNr) = partnerNr
' HINWEIS: Add eröffnet eine Transaction
dtEmail.Rows.Add(dataRow)
Next
' HINWEIS: Mit Update wird die Transaktion beendet
daEmail.Update(dtEmail)
End Using
Catch ex As Exception
Dim message As String = ex.Message
Throw ex
End Try
End Sub
Private Function Update_Partner() As Boolean
Try
Dim dbRow As DataRow
partnernr = XmlHelper.GetItemValueByTagName(doc, "avqObjKey")
Dim dsPartner As New DataSet
Dim daPartner As New SqlDataAdapter("select * from partner where nrpar00 = " & partnernr.ToString, Globals.sConnectionString_edoka)
daPartner.SelectCommand.CommandTimeout = Params.SqlTimeout
'Saldierung: Status = 7 oder Ablaufdatum <=now
If hlp_Check_Saldierung(XmlHelper.GetItemValueByTagName(doc, "ablaufDatum"), XmlHelper.GetItemValueByTagName(doc, "status")) = True Then
Try
'-------------------------------------------------------------------------------
'- Saldierung
'-------------------------------------------------------------------------------
Dim scpartsald As New SqlCommand
Dim copartsald As New SqlConnection
scpartsald.CommandText = "dbo.sp_saldierter_partner"
scpartsald.CommandTimeout = Params.SqlTimeout
scpartsald.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.Int, 36, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, partnernr))
scpartsald.CommandType = CommandType.StoredProcedure
copartsald.ConnectionString = Globals.sConnectionString_edoka
copartsald.Open()
scpartsald.Connection = copartsald
scpartsald.ExecuteNonQuery()
copartsald.Close()
scpartsald.Dispose()
copartsald.Dispose()
sAction = " Saldierung"
m_log.log("EDKB04: Partner : " & partnernr.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Catch ex As Exception
m_log.log("EDKB04: Partner-Saldierung error (sp_saldierter_partner): PNR=" & partnernr.ToString & ", Msg:" & Err.Description, Common.Common.JournalEntryType.Error)
Return False
End Try
Return True
End If
'-------------------------------------------------------------------------------
'- Partner insert / update
'-------------------------------------------------------------------------------
Dim neuer_partner As Boolean
daPartner.Fill(dsPartner, "partner")
Dim dtPartner As DataTable = dsPartner.Tables(0)
If dsPartner.Tables(0).Rows.Count < 1 Then
neuer_partner = True
sAction = " insert"
dbRow = dtPartner.NewRow()
Else
neuer_partner = False
sAction = " update"
dbRow = dsPartner.Tables(0).Rows(0)
End If
If XmlHelper.GetItemValueByTagName(doc, "kundenSegment") = "WEBP" Then
dbRow("IDMSG00") = XmlHelper.GetItemValueByTagName(doc, "kundenSegment")
dbRow("bkpar00") = XmlHelper.GetItemValueByTagName(doc, "vorname") + " " + XmlHelper.GetItemValueByTagName(doc, "name")
End If
dbRow("nrpar00") = partnernr
dbRow("validto") = System.DBNull.Value
If XmlHelper.GetItemValueByTagName(doc, "ablaufDatum") <> "" Then
dbRow("validto") = hlp_Transformdate(XmlHelper.GetItemValueByTagName(doc, "ablaufDatum"))
End If
dbRow("saldiert") = hlp_Check_Saldierung(XmlHelper.GetItemValueByTagName(doc, "ablaufDatum"), XmlHelper.GetItemValueByTagName(doc, "status"))
dbRow("cdvsa00") = 0
dbRow("azepl00") = 1
dbRow("nrparad") = "00" & partnernr.ToString
dbRow("TXADZ012") = ""
dbRow("TXADZ022") = ""
dbRow("TXADZ032") = ""
dbRow("TXADZ042") = ""
dbRow("TXADZ052") = ""
dbRow("TXADZ062") = ""
dbRow("TXADZ072") = ""
dbRow("TXADZ011") = ""
dbRow("TXADZ021") = ""
dbRow("TXADZ031") = ""
dbRow("TXADZ041") = ""
dbRow("TXADZ051") = ""
dbRow("TXADZ061") = ""
dbRow("TXADZ071") = ""
dbRow("TSMUT00") = hlp_MutDatum("1")
dbRow("VDMUTER") = Params.CDMuter
If XmlHelper.GetItemValueByTagName(doc, "betreuerId") <> "" Then
dbRow("nrbeu01") = XmlHelper.GetItemValueByTagName(doc, "betreuerId")
Else
If Not IsNumeric(dbRow("nrbeu01")) Then
dbRow("nrbeu01") = Params.DefaultBetreuerID
End If
End If
Dim kn As String = XmlHelper.GetItemValueByTagName(doc, "kurzName")
'20140921 - gem. DRO
'Kurzname ist ggf. ein Alias und wird nicht berücksichtigt
kn = ""
Select Case Partner_Art
Case "NAT"
dbRow("cdpaw00") = "N"
dbRow("nrnat01") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "nationalitaet"))
dbRow("nrdom00") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "domizilCode"))
Dim s As String = hlp_Transformdate(XmlHelper.GetItemValueByTagName(doc, "geburtsDatum"))
If s <> "" Then dbRow("GebGruendDat") = s
If kn <> "" Then
dbRow("bkpar00") = kn
dbRow("Kurzname_Stamm") = XmlHelper.GetItemValueByTagName(doc, "name")
Else
dbRow("bkpar00") = XmlHelper.GetItemValueByTagName(doc, "vorname") + " " + XmlHelper.GetItemValueByTagName(doc, "name")
dbRow("kurzname_stamm") = dbRow("bkpar00")
End If
Case "JUR"
dbRow("cdpaw00") = "J"
dbRow("nrnat01") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "domizilCode"))
If kn <> "" Then
dbRow("bkpar00") = kn
dbRow("Kurzname_Stamm") = XmlHelper.GetItemValueByTagName(doc, "name")
Else
dbRow("bkpar00") = XmlHelper.GetItemValueByTagName(doc, "vorname") + " " + XmlHelper.GetItemValueByTagName(doc, "name")
dbRow("kurzname_stamm") = dbRow("bkpar00")
End If
Case Else
dbRow("cdpaw00") = "U"
dbRow("nrnat01") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "domizilCode"))
If kn <> "" Then
dbRow("bkpar00") = kn
dbRow("Kurzname_Stamm") = XmlHelper.GetItemValueByTagName(doc, "name")
Else
dbRow("bkpar00") = XmlHelper.GetItemValueByTagName(doc, "vorname") + " " + XmlHelper.GetItemValueByTagName(doc, "name")
dbRow("kurzname_stamm") = dbRow("bkpar00")
End If
End Select
UpdateStringRow("nameFormatiert", dbRow, "name_formated")
'20240916
UpdateStringRow("steuerIdentAHV", dbRow, "steuerIdentAHV")
UpdateStringRow("zivilstand", dbRow, "zivilstand")
'ende 20240916
UpdateIntRow("sectorId", dbRow, "sector_id")
UpdateIntRow("rechtsFormId", dbRow, "legal_form_id")
UpdateIntRow("personRatingId", dbRow, "rate_intl_id")
UpdateDateRow("creditRatingDatum", dbRow, "rate_intl_date")
'Wird noch nicht gebraucht
'Const nationalitaet_2ff = "nationalitaet_2ff"
'UpdateStringRow(nationalitaet_2ff, dbRow, nationalitaet_2ff)
'Const uid = "uid"
'UpdateStringRow(uid, dbRow, uid)
UpdatePartnerBoersenkotiert(dbRow)
UpdatePartnerBerechtigteEmail(partnernr)
If neuer_partner Then
dtPartner.Rows.Add(dbRow)
End If
Dim cb As New SqlCommandBuilder(daPartner)
daPartner.Update(dsPartner, "partner")
kn = ""
kn = Update_BKPAR00(dbRow("Nrpar00"))
If kn <> "" Then
dbRow("BKPAR00") = Trim(dbRow("BKPAR00")) + ", " + kn
dbRow("kurzname_stamm") = dbRow("BKPAR00")
daPartner.Update(dsPartner, "partner")
End If
daPartner.Dispose()
dsPartner.Clear()
Update_Adressbeziehungen()
Update_PersonBeziehung()
'MsgBox(partnernr)
m_log.log("EDKB04: Partner : " & partnernr.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.log("EDKB04: DBHandling.Partner, Tabelle partner: " & partnernr.ToString & ex.Message, Common.Common.JournalEntryType.Error)
Return False
End Try
End Function
Private Function Update_BKPAR00(ByVal pnr As Integer) As String
Dim dsAddr As New DataSet
Dim tempkn As String = ""
Try
Dim sql As String = "SELECT dbo.PartnerAdresse.Partnernr, dbo.Partner_Adresse.ORT FROM dbo.Partner_Adresse INNER JOIN "
sql = sql + "dbo.PartnerAdresse ON dbo.Partner_Adresse.ADDR_OBJ_ID = dbo.PartnerAdresse.ADDR_OBJ_ID "
sql = sql + "WHERE (dbo.PartnerAdresse.Partnernr = " + pnr.ToString + ")"
sql = sql + " and (dbo.PartnerAdresse.aktiv = 1) order by adresstype"
Dim daAddr As New SqlDataAdapter(sql, Globals.sConnectionString_edoka)
daAddr.SelectCommand.CommandTimeout = Params.SqlTimeout
daAddr.Fill(dsAddr, "Adressen")
If dsAddr.Tables(0).Rows.Count > 0 Then
tempkn = dsAddr.Tables(0).Rows(0).Item("Ort").ToString
End If
Return tempkn
Catch
Return ""
Finally
dsAddr.Dispose()
End Try
End Function
Private Function Update_Angestelltenart(ByVal aart As String) As Boolean
Dim dsaart As New DataSet
Dim daaart As New SqlDataAdapter("select * from edoka_etmia0_data where nrpar00=" + partnernr.ToString, Globals.sConnectionString_edoka)
Try
daaart.SelectCommand.CommandTimeout = Params.SqlTimeout
daaart.Fill(dsaart, "Mitarbeiter")
If aart = "" And dsaart.Tables(0).Rows.Count > 0 Then
For Each dbrow As DataRow In dsaart.Tables(0).Rows
If dbrow("sarec00") = 2 Then
dbrow("sarec00") = 7
dbrow("tsmut00") = Now()
End If
Next
sAction = " Update "
Else
If dsaart.Tables(0).Rows.Count > 0 Then
dsaart.Tables(0).Rows(0).Item("sarec00") = 2
dsaart.Tables(0).Rows(0).Item("tsmut00") = Now
sAction = " Update "
Else
If aart <> "" Then
Dim dbRow As DataRow
dbRow = dsaart.Tables(0).NewRow
dbRow("NRPAR00") = partnernr
dbRow("NRVRN00") = 9999
dbRow("CDIDF00") = "EDKB04"
dbRow("NRSPA00") = 1
dbRow("BKMIA00") = "EDKB04"
dbRow("NRBTI00") = 0
dbRow("NRTEL00") = ""
dbRow("NRTFX00") = ""
dbRow("SABEU00") = "N"
dbRow("BEEML00") = ""
dbRow("CDMUTER") = 1
dbRow("TSMUT00") = Now
dbRow("DMERF00") = Now
dbRow("SAREC00") = "2"
dsaart.Tables(0).Rows.Add(dbRow)
sAction = " Insert "
End If
End If
End If
Dim cb As New SqlCommandBuilder(daaart)
daaart.Update(dsaart, "Mitarbeiter")
m_log.log("EDKB04: Mitarbeiter : " & partnernr.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.log("EDKB04: DBHandling.Mitarbeiter, Tabelle etmia0_data: " & partnernr.ToString & ex.Message, Common.Common.JournalEntryType.Error)
Return False
Finally
dsaart.Dispose()
daaart.Dispose()
End Try
End Function
Private Function Update_VIP(ByVal VIPCode As String) As Boolean
Dim dsaart As New DataSet
Dim daaart As New SqlDataAdapter("select * from edoka_ETVIP0_data where nrpar00=" + partnernr.ToString, Globals.sConnectionString_edoka)
Try
daaart.SelectCommand.CommandTimeout = Params.SqlTimeout
daaart.Fill(dsaart, "VIP")
If VIPCode = "N" And dsaart.Tables(0).Rows.Count > 0 Then
For Each dbrow As DataRow In dsaart.Tables(0).Rows
If dbrow("sarec00") = 2 Then
dbrow("sarec00") = 7
dbrow("tsmut00") = Now()
End If
Next
sAction = " update "
Else
If dsaart.Tables(0).Rows.Count > 0 Then
dsaart.Tables(0).Rows(0).Item("sarec00") = 2
dsaart.Tables(0).Rows(0).Item("tsmut00") = Now
sAction = " update "
Else
If VIPCode <> "N" Then
Dim dbRow As DataRow
dbRow = dsaart.Tables(0).NewRow
dbRow("NRPAR00") = partnernr
dbRow("NRVRN00") = 9999
dbRow("NRVIP00") = 1
dbRow("DSMUT00") = Now
dbRow("SAREC00") = "2"
dsaart.Tables(0).Rows.Add(dbRow)
sAction = " Insert "
End If
End If
End If
Dim cb As New SqlCommandBuilder(daaart)
daaart.Update(dsaart, "VIP")
m_log.log("EDKB04: VIP : " & partnernr.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.log("EDKB04: DBHandling.Mitarbeiter, Tabelle etvip0_data: " & partnernr.ToString & ex.Message, Common.Common.JournalEntryType.Error)
Return False
Finally
dsaart.Dispose()
daaart.Dispose()
End Try
End Function
#End Region
#Region "Adressbeziehungen"
Function Update_Adressbeziehungen()
Dim Domiziladresse_fuer_Kurznamenupdate As Integer = 0
Dim ts As DateTime = Now
Dim found As Boolean = False
Dim dsAddr As New DataSet
Dim daAddr As New SqlDataAdapter("select * from partneradresse where aktiv=1 and partnernr=" + partnernr.ToString, Globals.sConnectionString_edoka)
daAddr.SelectCommand.CommandTimeout = Params.SqlTimeout
daAddr.Fill(dsAddr, "Adressen")
For Each r As DataRow In AddrBeziehung.Rows
For Each r1 As DataRow In dsAddr.Tables(0).Rows
found = False
If r1("ADDR_Obj_ID") = r("avqObjId") Then
If r1("Adresstype") = 1 And r("Typ") = "D" Then
Domiziladresse_fuer_Kurznamenupdate = r1("Addr_obj_id")
r1("mutiert_am") = ts
found = True
Exit For
End If
If r1("Adresstype") = 2 And r("Typ") = "H" Then
r1("mutiert_am") = ts
found = True
Exit For
End If
If r1("Adresstype") = 9 And r("Typ") = "A" Then
r1("mutiert_am") = ts
found = True
Exit For
End If
End If
Next
'-- Neue Adressbeziehung einfügen
If found = False Then
Dim rn As DataRow = dsAddr.Tables(0).NewRow
rn("Partnernr") = partnernr
'rn("Adressnr") = ""
rn("Addr_obj_id") = r("avqobjid")
Select Case r("Typ")
Case "D"
rn("Adresstype") = 1
Domiziladresse_fuer_Kurznamenupdate = rn("Addr_obj_id")
Case "H"
rn("Adresstype") = 2
Case Else
rn("Adresstype") = 9
End Select
rn("erstellt_am") = ts
rn("mutiert_am") = ts
rn("aktiv") = 1
rn("mutierer") = 1
dsAddr.Tables(0).Rows.Add(rn)
End If
Next
For Each r As DataRow In dsAddr.Tables(0).Rows
If r("mutiert_am") <> ts Then
r("aktiv") = 0
r("mutiert_am") = ts
r("mutierer") = 1
End If
Next
Dim cb As New SqlCommandBuilder(daAddr)
daAddr.Update(dsAddr, "Adressen")
daAddr.Dispose()
dsAddr.Dispose()
If Domiziladresse_fuer_Kurznamenupdate <> 0 Then Update_Kurzname(Domiziladresse_fuer_Kurznamenupdate)
End Function
#End Region
#Region "E-Mail"
Function Update_Email()
Dim AddrObjID As Integer
Try
Dim sql As String
Dim neue_Adrese As Boolean
Dim dbrow As DataRow
AddrObjID = XmlHelper.GetItemValueByTagName(doc, "AvqObjId")
sql = "SELECT * FROM Partneremail_data where Addr_Obj_ID = " + AddrObjID.ToString
Dim dsAddr As New DataSet
Dim daAddr As New SqlDataAdapter(sql, Globals.sConnectionString_edoka)
daAddr.SelectCommand.CommandTimeout = Params.SqlTimeout
daAddr.Fill(dsAddr, "Addr")
If dsAddr.Tables(0).Rows.Count < 1 Then
neue_Adrese = True
sAction = " insert"
dbrow = dsAddr.Tables(0).NewRow()
dbrow("Addr_obj_id") = AddrObjID
Else
neue_Adrese = False
sAction = " update"
dbrow = dsAddr.Tables(0).Rows(0)
End If
dbrow("email") = XmlHelper.GetItemValueByTagName(doc, "zeile1")
dbrow("erstellt_am") = Now
dbrow("erstellt_von") = 1
dbrow("mutiert_am") = Now
dbrow("mutiert_von") = 1
dbrow("aktiv") = 1
'dbrow("aktiv") = 1
dbrow("ablaufdatum") = ""
If XmlHelper.GetItemValueByTagName(doc, "ablaufDatumAdresse") <> "" Then
Dim s As String = XmlHelper.GetItemValueByTagName(doc, "ablaufDatumAdresse")
dbrow("ablaufdatum") = hlp_Convert_Date(s, 1)
'If dbrow("ablaufdatum") < Now Then dbrow("aktiv") = 0
End If
If neue_Adrese Then
dsAddr.Tables(0).Rows.Add(dbrow)
End If
Dim cb As New SqlCommandBuilder(daAddr)
daAddr.Update(dsAddr, "Addr")
daAddr.Dispose()
dsAddr.Clear()
'Update_Kurzname(AddrObjID)
m_log.log("EDKB04: E-Mail Adresse Addr_Obj_IDr: " & AddrObjID.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.log("EDKB04: E-Mail DBHandling.Adresse" + AddrObjID.ToString + " : " & ex.Message, Common.Common.JournalEntryType.Error)
Return False
End Try
End Function
#End Region
#Region "Personbeziehungen"
Function Update_PersonBeziehung()
Dim sql As String
If Partner_Typ = "BP" Then
sql = "Select * from partner_rel where aktiv=1 and bp_nr=" + partnernr.ToString
Else
sql = "Select * from partner_rel where aktiv=1 and person_nummer=" + partnernr.ToString
End If
Dim ts As DateTime = Now
Dim found As Boolean = False
Dim dsPBez As New DataSet
Dim daPBez As New SqlDataAdapter(sql, Globals.sConnectionString_edoka)
daPBez.SelectCommand.CommandTimeout = Params.SqlTimeout
daPBez.Fill(dsPBez, "Beziehung")
If Partner_Typ = "BP" Then
For Each r As DataRow In PersonBeziehung.Rows
For Each r1 As DataRow In dsPBez.Tables(0).Rows
found = False
If r1("Person_Nummer").ToString = r("key_to").ToString Then
If r("reltyp") = "reg_owner" And r1("BP_Person_Rel_Typ") = 2 Then
r1("mutiert_am") = ts
found = True
Exit For
End If
If r("reltyp") = "acc_owner_lim" And r1("BP_Person_Rel_Typ") = 6 Then
r1("mutiert_am") = ts
found = True
Exit For
End If
End If
Next
If Not found And (r("reltyp") = "reg_owner" Or r("reltyp") = "acc_owner_lim") Then
Dim rn As DataRow = dsPBez.Tables(0).NewRow
rn("Person_Nummer") = r("key_to")
rn("Person_Obj_ID") = 0
If r("reltyp") = "reg_owner" Then rn("BP_Person_Rel_Typ") = 6
If r("reltyp") = "acc_owner_lim" Then rn("BP_Person_Rel_Typ") = 2
If r("reltyp") = "acc_owner" Then rn("BP_Person_Rel_Typ") = 1
rn("bp_nr") = partnernr
rn("erstellt_am") = ts
rn("mutiert_am") = ts
rn("Mutierer") = 1
rn("Gueltig_bis") = hlp_Convert_Date(r("end_date"), 1)
If rn("gueltig_bis") < Now Then rn("Aktiv") = 0 Else rn("aktiv") = 1
dsPBez.Tables(0).Rows.Add(rn)
End If
Next
For Each r As DataRow In dsPBez.Tables(0).Rows
If r("mutiert_am") <> ts Then
r("aktiv") = 0
r("mutiert_am") = ts
r("mutierer") = 1
End If
Next
Dim cb As New SqlCommandBuilder(daPBez)
daPBez.Update(dsPBez, "Beziehung")
daPBez.Dispose()
daPBez.Dispose()
Else
For Each r As DataRow In PersonBeziehung.Rows
For Each r1 As DataRow In dsPBez.Tables(0).Rows
found = False
If r1("BP_Nr").ToString = r("key_to").ToString Then
If r("reltyp") = "reg_owner" And r1("BP_Person_Rel_Typ") = 2 Then
r1("mutiert_am") = ts
found = True
Exit For
End If
If r("reltyp") = "acc_owner_lim" And r1("BP_Person_Rel_Typ") = 6 Then
found = True
r1("mutiert_am") = ts
Exit For
End If
End If
Next
If Not found And (r("reltyp") = "reg_owner" Or r("reltyp") = "acc_owner_lim") Then
Dim rn As DataRow = dsPBez.Tables(0).NewRow
rn("Person_Nummer") = partnernr
rn("Person_Obj_ID") = 0
If r("reltyp") = "reg_owner" Then rn("BP_Person_Rel_Typ") = 6
If r("reltyp") = "acc_owner_lim" Then rn("BP_Person_Rel_Typ") = 2
If r("reltyp") = "acc_owner" Then rn("BP_Person_Rel_Typ") = 1
rn("bp_nr") = r("key_to")
rn("erstellt_am") = ts
rn("mutiert_am") = ts
rn("Mutierer") = 1
rn("Gueltig_bis") = hlp_Convert_Date(r("end_date"), 1)
If rn("gueltig_bis") < Now Then rn("Aktiv") = 0 Else rn("aktiv") = 1
dsPBez.Tables(0).Rows.Add(rn)
End If
Next
For Each r As DataRow In dsPBez.Tables(0).Rows
If r("mutiert_am") <> ts Then
r("aktiv") = 0
r("mutiert_am") = ts
r("mutierer") = 1
End If
Next
Dim cb As New SqlCommandBuilder(daPBez)
daPBez.Update(dsPBez, "Beziehung")
daPBez.Dispose()
daPBez.Dispose()
End If
End Function
#End Region
#End Region
#Region "Adresse"
Public Function update_Adresse()
Dim AddrObjID As Integer
Try
Dim sql As String
Dim neue_Adrese As Boolean
Dim dbrow As DataRow
AddrObjID = XmlHelper.GetItemValueByTagName(doc, "AvqObjId")
sql = "SELECT * FROM Partner_Adresse where Addr_Obj_ID = " + AddrObjID.ToString
Dim dsAddr As New DataSet
Dim daAddr As New SqlDataAdapter(sql, Globals.sConnectionString_edoka)
daAddr.SelectCommand.CommandTimeout = Params.SqlTimeout
daAddr.Fill(dsAddr, "Addr")
If dsAddr.Tables(0).Rows.Count < 1 Then
neue_Adrese = True
sAction = " insert"
dbrow = dsAddr.Tables(0).NewRow()
dbrow("Addr_obj_id") = AddrObjID
Else
neue_Adrese = False
sAction = " update"
dbrow = dsAddr.Tables(0).Rows(0)
End If
dbrow("Zeile1") = XmlHelper.GetItemValueByTagName(doc, "zeile1")
dbrow("Zeile2") = XmlHelper.GetItemValueByTagName(doc, "zeile2")
dbrow("Zeile3") = XmlHelper.GetItemValueByTagName(doc, "zeile3")
dbrow("Zeile4") = XmlHelper.GetItemValueByTagName(doc, "zeile4")
dbrow("Zeile5") = XmlHelper.GetItemValueByTagName(doc, "zeile5")
dbrow("Zeile6") = XmlHelper.GetItemValueByTagName(doc, "zeile6")
dbrow("Zeile7") = XmlHelper.GetItemValueByTagName(doc, "zeile7")
dbrow("Titel_Vorgestellt") = XmlHelper.GetItemValueByTagName(doc, "titelVorgestellt")
dbrow("Vorname_1") = XmlHelper.GetItemValueByTagName(doc, "vorname1")
dbrow("Vorname_2") = XmlHelper.GetItemValueByTagName(doc, "vorname2")
dbrow("Vorname_3") = XmlHelper.GetItemValueByTagName(doc, "vorname3")
dbrow("Vorname_4") = XmlHelper.GetItemValueByTagName(doc, "vorname4")
dbrow("Nachname") = XmlHelper.GetItemValueByTagName(doc, "nachname")
dbrow("Firma") = XmlHelper.GetItemValueByTagName(doc, "firma")
dbrow("namenzusatz") = XmlHelper.GetItemValueByTagName(doc, "namenZusatz")
dbrow("ortzusatz") = XmlHelper.GetItemValueByTagName(doc, "ortZusatz")
Const co = "co"
UpdateStringRow(co, dbrow, co)
dbrow("Weiler") = XmlHelper.GetItemValueByTagName(doc, "weiler")
dbrow("strasse") = XmlHelper.GetItemValueByTagName(doc, "strasse")
dbrow("hausnr") = XmlHelper.GetItemValueByTagName(doc, "hausNr")
dbrow("briefanrede1code") = ""
dbrow("briefanrede1") = XmlHelper.GetItemValueByTagName(doc, "briefanrede1")
dbrow("briefanrede2zeile1") = XmlHelper.GetItemValueByTagName(doc, "briefanrede2Zeile1")
dbrow("briefanrede2zeile2") = XmlHelper.GetItemValueByTagName(doc, "briefanrede2Zeile2")
dbrow("plz") = XmlHelper.GetItemValueByTagName(doc, "plz")
dbrow("Ort") = XmlHelper.GetItemValueByTagName(doc, "ort")
dbrow("Land") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "land"))
dbrow("Laendercode") = hlp_TransformLand(XmlHelper.GetItemValueByTagName(doc, "laenderCode"))
dbrow("banklagernd") = XmlHelper.GetItemValueByTagName(doc, "banklagernd")
dbrow("versandart") = XmlHelper.GetItemValueByTagName(doc, "versandart")
dbrow("beban01") = hlp_transform_Briefanrede(XmlHelper.GetItemValueByTagName(doc, "briefanrede2Zeile1"))
dbrow("beban02") = XmlHelper.GetItemValueByTagName(doc, "briefanrede2Zeile2")
'dbrow("aktiv") = 1
dbrow("ablaufdatum") = ""
If XmlHelper.GetItemValueByTagName(doc, "ablaufDatumAdresse") <> "" Then
Dim s As String = XmlHelper.GetItemValueByTagName(doc, "ablaufDatumAdresse")
dbrow("ablaufdatum") = hlp_Convert_Date(s, 1)
'If dbrow("ablaufdatum") < Now Then dbrow("aktiv") = 0
End If
If neue_Adrese Then
dsAddr.Tables(0).Rows.Add(dbrow)
End If
Dim cb As New SqlCommandBuilder(daAddr)
daAddr.Update(dsAddr, "Addr")
daAddr.Dispose()
dsAddr.Clear()
Update_Kurzname(AddrObjID)
m_log.log("EDKB04: Adresse Addr_Obj_IDr: " & AddrObjID.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.log("EDKB04: DBHandling.Adresse" + AddrObjID.ToString + " : " & ex.Message, Common.Common.JournalEntryType.Error)
Return False
End Try
End Function
Private Sub Update_Kurzname(ByVal addrobjid As Integer)
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_edkb04_update_kurzname"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@addrobjid", SqlDbType.VarChar, 16, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, addrobjid))
Try
conn_edoka.OpenConnection()
scmCmdToExecute.ExecuteNonQuery()
Catch exi As Exception
m_log.log("EDKB04: Update Kurzname " & exi.Message & " - Addrobjid: " & addrobjid.ToString, Common.Common.JournalEntryType.Error)
Finally
conn_edoka.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Sub
#End Region
#Region "VV"
Public Function update_vv()
Try
Dim sql As String
Dim vv As String
Dim neue_vv As Boolean
Dim nrvvg00 As Integer
Dim dbrow As DataRow
Dim s As String
If XmlHelper.GetItemValueByTagName(doc, "externeNr") <> "" Then
sql = "SELECT * FROM vv WHERE NEVVG00 = '" + hlp_vv_format("NEVVG00", XmlHelper.GetItemValueByTagName(doc, "externeNr")) + "'"
Else
sql = "SELECT * FROM vv WHERE NAVVG00 = '" + XmlHelper.GetItemValueByTagName(doc, "formatierteNr") + "'"
End If
Dim dsVV As New DataSet
Dim daVV As New SqlDataAdapter(sql, Globals.sConnectionString_edoka)
daVV.SelectCommand.CommandTimeout = Params.SqlTimeout
daVV.Fill(dsVV, "VV")
If dsVV.Tables(0).Rows.Count < 1 Then
neue_vv = True
sAction = " insert"
dbrow = dsVV.Tables(0).NewRow()
dbrow("nrvvg00") = hlp_GetNewKey_vv()
Else
neue_vv = False
sAction = " update"
dbrow = dsVV.Tables(0).Rows(0)
End If
dbrow("validto") = System.DBNull.Value
If XmlHelper.GetItemValueByTagName(doc, "ablaufDatum") <> "" Then
dbrow("validto") = hlp_Convert_Date(XmlHelper.GetItemValueByTagName(doc, "ablaufDatum"), 1)
End If
dbrow("NAVVG00") = hlp_vv_format("NAVVG00", XmlHelper.GetItemValueByTagName(doc, "formatierteNr"))
'dbrow("NAVVG00") = XmlHelper.GetItemValueByTagName(doc, "formatierteNr")
vv = dbrow("NAVVG00")
If XmlHelper.GetItemValueByTagName(doc, "externeNr") = "" Then
s = hlp_TransformVVExtern(dbrow("NAVVG00"))
dbrow("NEVVG00") = hlp_vv_format("NEVVG00", s)
Else
dbrow("NEVVG00") = hlp_vv_format("NEVVG00", XmlHelper.GetItemValueByTagName(doc, "externeNr"))
End If
'dbrow("NEVVG00") = XmlHelper.GetItemValueByTagName(doc, "externeNr")
'If dbrow("NEVVG00") = "" Then dbrow("NEVVG00") = hlp_TransformVVExtern(dbrow("NAVVG00"))
'dbrow("NAVVG00") = XmlHelper.GetItemValueByTagName(doc, "formatierteNr")
If IsNumeric(XmlHelper.GetItemValueByTagName(doc, "produkt")) Then
dbrow("NRPRD00") = XmlHelper.GetItemValueByTagName(doc, "produkt")
Else
dbrow("NRPRD00") = 0
End If
dbrow("BEPRDLG") = XmlHelper.GetItemValueByTagName(doc, "kontoBezeichnung")
dbrow("SAREC00") = XmlHelper.GetItemValueByTagName(doc, "status")
If XmlHelper.GetItemValueByTagName(doc, "ablaufDatum") <> "" Then
If dbrow("validto") < Now Then
dbrow("SAREC00") = 7
End If
End If
dbrow("TXRBK00") = hlp_vv_format("TXRBK00", XmlHelper.GetItemValueByTagName(doc, "rubrik")) 'von "text" auf "rubrik" abgeändert
dbrow("NRPAR00") = XmlHelper.GetItemValueByTagName(doc, "partnerNummer")
If neue_vv Then
dsVV.Tables(0).Rows.Add(dbrow)
End If
nrvvg00 = dbrow("nrvvg00")
Dim cb As New SqlCommandBuilder(daVV)
daVV.Update(dsVV, "VV")
daVV.Dispose()
dsVV.Clear()
Update_VVAdressbeziehungen(nrvvg00)
m_log.Log("EDKB04: VV : " & vv.ToString & sAction & " erfolgreich", Common.Common.JournalEntryType.Information)
Return True
Catch ex As Exception
m_log.Log("EDKB04: DBHandling.VV, Tabelle VV: " & ex.Message, Common.Common.JournalEntryType.Error)
Return False
End Try
End Function
Function hlp_vv_format(ByVal typ As String, ByVal istring As String) As String
Dim s As String
s = istring
Select Case typ
Case "NAVVG00"
If Len(s) > 16 Then s = Left(s, 16)
Case "NEVVG00"
If Len(s) > 16 Then s = Left(s, 16)
If Not (InStr(s, "EBANK.", CompareMethod.Text)) Then
Do While Len(s) < 12
s = "0" & s
Loop
End If
Case "BEPRDLG"
If Len(s) > 35 Then s = Left(s, 35)
Case "TXRBK00"
If Len(s) > 255 Then s = Left(s, 255)
End Select
Return s
End Function
#Region "Adressbeziehungen"
Function Update_VVAdressbeziehungen(ByVal nrvvg00 As Integer)
Dim ts As DateTime = Now
Dim found As Boolean = False
Dim dsAddr As New DataSet
Dim daAddr As New SqlDataAdapter("select * from vvadresse where aktiv=1 and nrvvg00=" + nrvvg00.ToString, Globals.sConnectionString_edoka)
daAddr.SelectCommand.CommandTimeout = Params.SqlTimeout
daAddr.Fill(dsAddr, "Adressen")
For Each r As DataRow In AddrBeziehung.Rows
For Each r1 As DataRow In dsAddr.Tables(0).Rows
found = False
If r1("ADDR_Obj_ID") = r("avqObjId") Then
If r1("Adresstype") = 4 And r("Typ") = "A" Then
r1("mutiert_am") = ts
found = True
Exit For
End If
If r1("Adresstype") = 2 And r("Typ") = "H" Then
r1("mutiert_am") = ts
found = True
Exit For
End If
If r1("Adresstype") = 1 And r("Typ") = "D" Then
r1("mutiert_am") = ts
found = True
Exit For
End If
End If
Next
'-- Neue Adressbeziehung einfügen
If found = False Then
Dim rn As DataRow = dsAddr.Tables(0).NewRow
rn("nrvvg00") = nrvvg00
'rn("Adressnr") = ""
rn("Addr_obj_id") = r("avqobjid")
Select Case r("Typ")
Case "D"
rn("Adresstype") = 1
Case "H"
rn("Adresstype") = 2
Case Else
rn("Adresstype") = 4
End Select
rn("erstellt_am") = ts
rn("mutiert_am") = ts
rn("aktiv") = 1
rn("mutierer") = 1
dsAddr.Tables(0).Rows.Add(rn)
End If
Next
For Each r As DataRow In dsAddr.Tables(0).Rows
If r("mutiert_am") <> ts Then
r("aktiv") = 0
r("mutiert_am") = ts
r("mutierer") = 1
End If
Next
Dim cb As New SqlCommandBuilder(daAddr)
daAddr.Update(dsAddr, "Adressen")
daAddr.Dispose()
dsAddr.Dispose()
End Function
#End Region
#End Region
#Region "Verfuegungsrechte"
''' <summary>
'''
''' </summary>
''' <returns>True: Alles OK, False: nicht alles OK</returns>
Public Function Update_Verfuegungsrechte() As Boolean
Dim ret As Boolean = True 'bei einer Exception wird ret einfach auf False gesetzt
Try
Dim ts As DateTime = Now
Dim found As Boolean = False
Dim dtToReturn As DataTable = New DataTable()
Try
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_get_verfuegungsrechte_pro_partner"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, pnr))
sdaAdapter.Fill(dtToReturn)
Catch
ret = False
End Try
If ret Then
For Each r As DataRow In vvr.Rows
For Each rr As DataRow In dtToReturn.Rows
found = False
If r.Item("avq_auth_extl_ref") = rr.Item("avq_auth_extl_ref") Then
found = True
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.sp_update_verfuegungsrecht"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
conn_edoka.OpenConnection()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@avq_auth_extl_ref", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, rr.Item("avq_auth_extl_ref")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@Gueltigbis", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, r.Item("end_date")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.ExecuteNonQuery()
m_log.log("EDKB04: DBHandling.Verfuegungsrecht aktualisiert" + rr.Item(1).ToString + " erfolgreich ", Common.Common.JournalEntryType.Information)
Catch ex As Exception
ret = False
m_log.log("EDKB04: DBHandling.Verfuegungsrecht aktualisiert" + rr.Item(1).ToString + " nicht erfolgreich : " + ex.Message, Common.Common.JournalEntryType.Error)
Finally
scmCmdToExecute.Dispose()
conn_edoka.CloseConnection(True)
End Try
Exit For
End If
Next
If Not found Then
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.sp_update_verfuegungsrecht"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
conn_edoka.OpenConnection()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@avq_auth_extl_ref", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, r.Item("avq_auth_extl_ref")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@Gueltigbis", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now.ToShortDateString))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
m_log.log("EDKB04: DBHandling.Verfuegungsrecht Delete" + r.Item(1).ToString + " erfolgreich ", Common.Common.JournalEntryType.Information)
Catch ex As Exception
ret = False
m_log.log("EDKB04: DBHandling.Verfuegungsrecht Delete" + r.Item(1).ToString + " nicht erfolgreich : " + ex.Message, Common.Common.JournalEntryType.Error)
Finally
scmCmdToExecute.Dispose()
conn_edoka.CloseConnection(True)
End Try
End If
Next
End If
Catch ex As Exception
ret = False
End Try
Return ret
End Function
Public Function Update_Dokumentreferenz(Docid As String, Ref1 As String, Ref2 As String)
Try
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.sp_update_verfuegungsrecht_dokumentid"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
conn_edoka.OpenConnection()
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@Dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Docid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@avq_auth_extl_ref", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Ref1))
scmCmdToExecute.Parameters.Add(New SqlParameter("@avq_auth_extl_ref1", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Ref2))
scmCmdToExecute.ExecuteNonQuery()
m_log.log("EDKB04: DBHandling.Verfuegungsrecht Update EDOKA-Dokument" + Docid + " " + Ref1 + " " + Ref2 + " erfolgreich ", Common.Common.JournalEntryType.Information)
Catch ex As Exception
m_log.log("EDKB04: DBHandling.Verfuegungsrecht Update EDOKA-Dokument" + Docid + " " + Ref1 + " " + Ref2 + " nicht erfolgreich : " + ex.Message, Common.Common.JournalEntryType.Error)
Finally
scmCmdToExecute.Dispose()
conn_edoka.CloseConnection(True)
End Try
Catch ex As Exception
End Try
End Function
#End Region
#Region "Helper"
Private Function hlp_GetNewKey_vv() As Integer
hlp_GetNewKey_vv = 0
Dim ssql As String
ssql = "SELECT TOP 1 NRVVG00 + 1 AS NewRow FROM vv Order By NRVVG00 DESC"
Dim connection As New SqlConnection()
Dim daTemp As New SqlDataAdapter(ssql, connection)
Dim dsTemp As New DataSet()
Try
connection.ConnectionString = Globals.sConnectionString_edoka
connection.Open()
daTemp.Fill(dsTemp)
hlp_GetNewKey_vv = dsTemp.Tables(0).Rows(0).Item(0)
Catch ex As Exception
Return False
Finally
dsTemp = Nothing
daTemp = Nothing
connection.Close()
connection = Nothing
End Try
End Function
Function hlp_Convert_Date(ByVal iDatum As String, fnkt As Integer) As String
Try
If iDatum = "" Then Return "2712-12-31"
Select Case fnkt
Case 1
Return iDatum.Substring(0, 4) + "-" + iDatum.Substring(4, 2) + "-" + iDatum.Substring(6, 2)
End Select
Catch ex As Exception
Return ""
End Try
End Function
Private Function hlp_Check_Saldierung(ByVal instr As String, ByVal Status As String) As Boolean
'Kein Validto-Datum und Status=7 Saldierung durchfüren
If Len(instr) = 0 Then
If Status = "7" Then Return True
End If
'Validto Datum vorhandên und kleiner oder gleich heute, dann Saldierung druchführen
If Len(instr) <> 0 Then
Dim d As String = hlp_Transformdate(instr)
If IsDate(d) And CDate(d) <= Now And Status = "7" Then Return True
If IsDate(d) And CDate(d) > Now And Status = "7" Then Return False
End If
Return False
End Function
Private Function hlp_MutDatum(ByVal sformat As String) As String
Dim result As String = ""
Dim sMonth As String = Month(Now())
If Len(sMonth) = 1 Then sMonth = "0" + sMonth
Dim sDay As String = Day(Now())
If Len(sDay) = 1 Then sDay = "0" & sDay
Dim sHour As String = Hour(Now())
If Len(sHour) = 1 Then sHour = "0" & sHour
Dim sMinute As String = Minute(Now())
If Len(sMinute) = 1 Then sMinute = "0" & sMinute
Dim sSecond As String = Second(Now())
If Len(sSecond) = 1 Then sSecond = "0" & sSecond
Select Case sformat
Case "1"
'Partner.tsmut00
result = Year(Now()) & "-" & sMonth & "-" & sDay & "-" & sHour & "." & sMinute & "." & sSecond & ".000000"
Case "2"
'etparn.TSMUT00
result = sDay & "." & sMonth & "." & Year(Now()) & " " & sHour & ":" & sMinute & ":" & sSecond
Case "3"
'etparn.DMERF00
result = sDay & "." & sMonth & "." & Year(Now())
End Select
Return result
End Function
Function hlp_TransformLand(ByVal inland As String) As String
Dim result As String = "756"
'MNK 24.08.2009 Version 1.7 - Anpassung Landaufbereitung
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
scmCmdToExecute.CommandText = "dbo.sp_edkb04_get_nationalitaet"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn_edoka.scoDBConnection
scmCmdToExecute.Parameters.Add(New SqlParameter("@code", SqlDbType.VarChar, 16, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, inland))
scmCmdToExecute.Parameters.Add(New SqlParameter("@land", SqlDbType.VarChar, 16, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
Try
conn_edoka.OpenConnection()
scmCmdToExecute.ExecuteNonQuery()
result = scmCmdToExecute.Parameters("@land").Value
Return result
Catch exi As Exception
m_log.log("EDKB04: Fehler TransformLand " & exi.Message & " - Code: " & inland, Common.Common.JournalEntryType.Error)
Return "756"
Finally
conn_edoka.CloseConnection(True)
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
Function hlp_Transformdate(ByVal Datum As String) As String
Try
Dim s As String
s = Datum.Substring(0, 4) + "-" + Datum.Substring(4, 2) + "-" + Datum.Substring(6, 2)
Try
Dim dd As DateTime
dd = s
Catch ex As Exception
s = System.DBNull.Value.ToString
End Try
Return s
Catch ex As Exception
Return ""
End Try
End Function
Private Function hlp_GetBetreuerID_Substitute(ByVal strPnr As String) As String
Dim result As String = Params.DefaultBetreuerID
'Prüfen ob bereit ein Betreuer eingetragen ist
Dim ssql As String
ssql = "SELECT TOP 1 NRBEU01 FROM edoka_etbez0 WHERE nrpar00 = " & strPnr
Dim connection As New SqlConnection()
Dim daTemp As New SqlDataAdapter(ssql, connection)
Dim dsTemp As New DataSet()
Try
connection.ConnectionString = Globals.sConnectionString_edoka
connection.Open()
daTemp.Fill(dsTemp)
If dsTemp.Tables(0).Rows.Count > 0 Then
If CStr(dsTemp.Tables(0).Rows(0).Item(0)) <> "0" Then
result = CStr(dsTemp.Tables(0).Rows(0).Item(0))
m_log.log("EDKB04: Fehler in Partner, keine BetreuerID es wird der vorhandene Betreuer weiterverwendet, PartnerNr: " & strPnr, Common.Common.JournalEntryType.Error)
Else
m_log.log("EDKB04: Fehler in Partner, keine BetreuerID es wurde der Defaultbetreuer eingesetzt, PartnerNr: " & strPnr, Common.Common.JournalEntryType.Error)
End If
Else
m_log.log("EDKB04: Fehler in Partner, keine BetreuerID es wurde der Defaultbetreuer eingesetzt, PartnerNr: " & strPnr, Common.Common.JournalEntryType.Error)
End If
Catch ex As Exception
m_log.log("EDKB04: Fehler in hlp_GetBetreuerID_Substitute, PartnerNr: " & strPnr & ", Error" & ex.Message, Common.Common.JournalEntryType.Error)
Finally
dsTemp = Nothing
daTemp = Nothing
connection.Close()
connection = Nothing
End Try
Return result
End Function
Private Function hlp_TransformVVExtern(ByVal instr As String) As String
Dim result As String = ""
Dim i As Integer = 1
Do While i <= Len(instr)
If Char.IsDigit(Mid(instr, i, 1).Chars(0)) Then
result = result + Mid(instr, i, 1)
End If
i = i + 1
Loop
Return result
End Function
Private Function hlp_transform_Briefanrede(ByVal Anrede As String) As String
Dim s As String
s = Anrede
s = s.Replace("Sehr geehrter ", "")
s = s.Replace("Sehr geehrte ", "")
Return s
End Function
#End Region
End Class