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.

443 lines
21 KiB

Imports System.IO
Imports System.Net
Imports System.Reflection
Imports Newtonsoft.Json
' Changelog
' 20221105 - Anpassung neuer Dokumentart 'FINAL_VALUATION_REPORT'"
' Es werden Dokumente mit dem Typ FINAL_VALUATION_REPORT oder mit Kommentar 'Final' berücksichtigt
' Sind beide "Varianten" in einem Auftrag vorhanden, wird FINAL_VALUATION_REPORT prioritär behandelt
' Ende 20221105
Module Module1
Private Enum Enum_MapTyp
Mappen = 0
Loeschen = 1
End Enum
Dim Orders
Dim Order
Dim Documents
Dim Document
Dim Attributes
Dim User
Dim clslog As New clslog
Dim Process_Step As Integer = 0
Dim haserror As Boolean = False
Dim filename As String = ""
Sub Main()
clslog.Writelog("Start Dimension-Transfer")
If Get_Finished_Orders() = False Then
clslog.Writelog("Verarbeitung mit Fehlercode " + Process_Step.ToString + " abgebrochen")
Exit Sub
End If
For i As Integer = 0 To Orders.content.count - 1
If Check_TKB_Archivierung(i) = True Then
If Get_Details(i) = False Then
clslog.Writelog("Verarbeitung mit Fehlercode " + Process_Step.ToString + " abgebrochen")
End If
Else
clslog.Writelog("Attribute TKB_Archivierung nicht gesetzt: " + Orders.content(i).id)
End If
Next
Manual_Processing()
clslog.Writelog("Ende Dimension-Transfer")
If clslog.errormailtext <> "" Then send_mail()
End Sub
Sub Manual_Processing()
If File.Exists(My.Settings.Manual_Processing_File) Then
FileOpen(2, My.Settings.Manual_Processing_File, OpenMode.Input)
While Not EOF(2)
Dim s As String
Input(2, s)
clslog.Writelog("Manuelle Verarbeitung: " + s)
Dim strArr() As String
strArr = s.Split(";")
If strArr.Length > 1 Then
s = strArr(1)
If s.IndexOf("Docname") > -1 Then
s = Right(s, Len(s) - 8)
If Get_Details(0, strArr(0), s, 0) = False Then
clslog.Writelog("Verarbeitung mit Fehlercode " + Process_Step.ToString + " abgebrochen")
End If
End If
If s.IndexOf("DocID") > -1 Then
s = Right(s, Len(s) - 6)
If Get_Details(0, strArr(0), "", s) = False Then
clslog.Writelog("Verarbeitung mit Fehlercode " + Process_Step.ToString + " abgebrochen")
End If
End If
Else
If Get_Details(0, s, "", 0) = False Then
clslog.Writelog("Verarbeitung mit Fehlercode " + Process_Step.ToString + " abgebrochen")
End If
End If
End While
FileClose(2)
FileSystem.Rename(My.Settings.Manual_Processing_File, My.Settings.Manual_Processing_File + "_" + DateTime.Now.ToString("yyyyMMdd_ HHmmss") + ".done")
End If
End Sub
Public Function Check_TKB_Archivierung(ByVal ID As Integer) As Boolean
Dim url As String
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + Orders.content(ID).id + "/attributes"
Dim request = TryCast(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest)
request.Method = "GET"
request.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
If My.Settings.HOST <> "" Then request.Host = My.Settings.HOST
Dim responseContent As String = ""
Using response = TryCast(request.GetResponse(), System.Net.HttpWebResponse)
Using reader = New System.IO.StreamReader(response.GetResponseStream())
responseContent = reader.ReadToEnd()
End Using
Attributes = JsonConvert.DeserializeObject(Of clsAttributes.Root)(responseContent)
End Using
For i As Integer = 0 To Attributes.attributes.count - 1
If Attributes.attributes(i).key = "TKB_Archivierung" And Attributes.attributes(i).value = "Ja" Then
Return True
End If
Next
Return False
End Function
Public Function get_user_data(ByVal type As String) As String
For i As Integer = 0 To Order.links.count - 1
If Order.links(i).rel = type Then
Dim url As String
url = Order.links(i).href
Dim request = TryCast(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest)
request.Method = "GET"
request.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
If My.Settings.HOST <> "" Then request.Host = My.Settings.HOST
Dim responseContent As String = ""
Using response = TryCast(request.GetResponse(), System.Net.HttpWebResponse)
Using reader = New System.IO.StreamReader(response.GetResponseStream())
responseContent = reader.ReadToEnd()
End Using
User = JsonConvert.DeserializeObject(Of clsUser.Root)(responseContent)
Dim result As String = User.firstName + " " + User.lastName
Return result
End Using
End If
Next
Return ""
End Function
Public Function Get_Finished_Orders() As Boolean
Try
Process_Step = 10
Dim FromTime As String
FileOpen(1, My.Settings.TimeParam, OpenMode.Input)
Input(1, FromTime)
FileClose(1)
FileOpen(1, My.Settings.TimeParam, OpenMode.Output)
WriteLine(1, Now.ToString("s"))
FileClose(1)
clslog.Writelog("Finished Orders seit " + FromTime)
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim Filter = My.Settings.OrderFilter.Replace("&SelectionTime&", FromTime)
Filter = My.Settings.OrderFilter.Replace("&SelectionTime&", FromTime)
Dim url As String = My.Settings.BaseURL + "/" + My.Settings.Orders + Filter
Dim request = TryCast(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest)
request.Method = "GET"
request.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
If My.Settings.HOST <> "" Then request.Host = My.Settings.HOST
Dim responseContent As String = ""
Using response = TryCast(request.GetResponse(), System.Net.HttpWebResponse)
Using reader = New System.IO.StreamReader(response.GetResponseStream())
responseContent = reader.ReadToEnd()
End Using
Orders = JsonConvert.DeserializeObject(Of clsOrders.Orders)(responseContent)
End Using
Return True
Catch ex As Exception
clslog.Writelog("Get_Finished_Orders Fehler:" + ex.Message)
haserror = True
Return False
End Try
End Function
Public Function Get_Details(id As Integer, Optional manualid As String = "", Optional docname As String = "", Optional docid As Double = 0) As Boolean
Try
Process_Step = 20
clslog.Writelog("-----------")
If manualid <> "" Then clslog.Writelog(manualid) Else clslog.Writelog(Orders.content(id).id)
'Order
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim url As String = ""
If manualid <> "" Then
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + manualid
Else
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + Orders.content(id).id
End If
Dim request = TryCast(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest)
request.Method = "GET"
request.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
If My.Settings.HOST <> "" Then request.Host = My.Settings.HOST
Dim responseContent As String = ""
Using response = TryCast(request.GetResponse(), System.Net.HttpWebResponse)
Using reader = New System.IO.StreamReader(response.GetResponseStream())
responseContent = reader.ReadToEnd()
End Using
Order = JsonConvert.DeserializeObject(Of clsOrder.Root)(responseContent)
End Using
Process_Step = 21
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id)
request = TryCast(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest)
request.Method = "GET"
request.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
responseContent = ""
Using response = TryCast(request.GetResponse(), System.Net.HttpWebResponse)
Using reader = New System.IO.StreamReader(response.GetResponseStream())
responseContent = reader.ReadToEnd()
End Using
Documents = JsonConvert.DeserializeObject(Of clsDocuments.Root)(responseContent)
End Using
filename = My.Settings.TempPath + Order.id + "_"
'' erste Prio: "FINAL_VALUATION_REPORT"
Process_Step = 22
Dim wc As New WebClient
If docname = "" And docid = 0 Then
Dim fileid_final_valuation_report As String = ""
Dim fileid_final_comment As String = ""
Dim filename_final_valuation_report As String = ""
Dim filename_final_comment As String = ""
Dim has_final_valuation_report As Boolean = False
Dim has_final_comment As Boolean = False
For i As Integer = 0 To Documents.content.count - 1
If Documents.content(i).documentType = "FINAL_VALUATION_REPORT" Then
has_final_valuation_report = True
fileid_final_valuation_report = Documents.content(i).fileid.ToString
filename_final_valuation_report = Documents.content(i).name
End If
Dim kommentar As String = ""
If Not IsNothing(Documents.content(i).comments) Then
kommentar = Documents.content(i).comments
End If
If kommentar = "Final" Then
has_final_comment = True
fileid_final_comment = Documents.content(i).fileid.ToString
filename_final_comment = Documents.content(i).name
End If
Next
If has_final_valuation_report = True Then
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + fileid_final_valuation_report
wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
filename = filename + filename_final_valuation_report + ".pdf"
wc.DownloadFile(url, filename)
If Write_EDKB08_Struktur(Order.id) = False Then
haserror = True
Return False
End If
Return True
Exit Function
End If
If has_final_comment = True Then
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + fileid_final_comment
wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
filename = filename + filename_final_comment + ".pdf"
wc.DownloadFile(url, filename)
If Write_EDKB08_Struktur(Order.id) = False Then
haserror = True
Return False
End If
Return True
Exit Function
End If
End If
For i As Integer = 0 To Documents.content.count - 1
If docname <> "" And Documents.content(i).name = docname Then
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + Documents.content(i).fileid.ToString
wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
filename = filename + Documents.content(i).name + ".pdf"
wc.DownloadFile(url, filename)
If Write_EDKB08_Struktur(manualid) = False Then
haserror = True
Return False
End If
Return True
Exit Function
End If
If docid <> 0 And Documents.content(i).fileId = docid Then
url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + Documents.content(i).fileid.ToString
wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
filename = filename + Documents.content(i).name + ".pdf"
wc.DownloadFile(url, filename)
If Write_EDKB08_Struktur(manualid) = False Then
haserror = True
Return False
End If
Return True
Exit Function
End If
'If docname = "" And docid = 0 Then
' '20221105 Neuer Dokumenttyp
' If Not IsNothing(Documents.content(i).documentType) Then
' If Documents.content(i).documentType = "FINAL_VALUATION_REPORT" Then
' url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + Documents.content(i).fileid.ToString
' wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
' filename = My.Settings.TempPath + Documents.content(i).name + ".pdf"
' wc.DownloadFile(url, filename)
' If Write_EDKB08_Struktur(Order.id) = False Then
' haserror = True
' Return False
' End If
' Return True
' Exit Function
' End If
' End If
' Dim kommentar As String = ""
' If Not IsNothing(Documents.content(i).comments) Then
' kommentar = Documents.content(i).comments
' End If
' If kommentar = "Final" Then
' url = My.Settings.BaseURL + "/" + My.Settings.Orders + "/" + My.Settings.Documents.Replace("&OrderID&", Order.id) + "/" + Documents.content(i).fileid.ToString
' wc.Headers.Add(HttpRequestHeader.Authorization, "Bearer " + My.Settings.Token)
' filename = My.Settings.TempPath + Documents.content(i).name + ".pdf"
' wc.DownloadFile(url, filename)
' If Write_EDKB08_Struktur(Order.id) = False Then
' haserror = True
' Return False
' End If
' Return True
' Exit Function
' End If
'End If
Next
Return False
Catch ex As Exception
clslog.Writelog("Get_Details Fehler:" + ex.Message)
haserror = True
Return False
End Try
End Function
Public Function Write_EDKB08_Struktur(ByVal OrderID As String) As Boolean
Try
Process_Step = 23
Dim ds As New DataSet
'ds.ReadXml(ApplicationPath() + "EDKB08struktur.xml")
ds.ReadXml(ApplicationPath() + "DIPStruktur.xml")
Dim dr As DataRow = ds.Tables(0).Rows(0)
dr("PARTNERNR") = Order.externalId
dr("dateiname") = System.IO.Path.GetFileName(filename)
dr("Dateiformat") = "PDF"
dr("Herkunftsapplikation") = "Dimensions"
dr("AUFTRAGSNR") = Order.id.ToString
If Not IsNothing(Order.valuationObject.parcelNumber) Then
dr("Kataster") = Order.valuationObject.parcelNumber
Else
dr("Kataster") = ""
End If
dr("BEWERTET_VON") = Order.valuationObject.address.addressLine1 + " " + Order.valuationObject.address.zipCode + " " + Order.valuationObject.address.place
dr("eigentuemer") = Order.details.endcustomername
dr("bewertet_von") = get_user_data("valuator")
dr("plausibilisiert_von") = get_user_data("reviewer")
dr("plausibilisiert_am") = Order.modificationdate
dr("Status_Vertraege") = "Aktiv"
Dim bezeichnung As String
Dim tmpbez As String
bezeichnung = "WD " + Order.id.ToString
If Not IsNothing(Order.valuationObject.address.addressline1) Then
tmpbez = Order.valuationObject.address.addressline1
Else
tmpbez = ""
End If
If tmpbez <> "" Then bezeichnung = bezeichnung + ", " + tmpbez
If Not IsNothing(Order.valuationObject.address.addressline2) Then
tmpbez = Order.valuationObject.address.addressline2
Else
tmpbez = ""
End If
If tmpbez <> "" Then bezeichnung = bezeichnung + ", " + tmpbez
If Not IsNothing(Order.valuationObject.address.place) Then
tmpbez = Order.valuationObject.address.place
Else
tmpbez = ""
End If
If tmpbez <> "" Then bezeichnung = bezeichnung + ", " + tmpbez
tmpbez = dr("Kataster").ToString
tmpbez = tmpbez.Replace("NULL", "")
If tmpbez <> "" Then bezeichnung = bezeichnung + ", " + tmpbez
dr("Bezeichnung") = Bezeichnung
ds.Tables(0).AcceptChanges()
If System.IO.File.Exists(My.Settings.DestPath + System.IO.Path.GetFileName(filename)) Then
System.IO.File.Delete(My.Settings.DestPath + System.IO.Path.GetFileName(filename))
End If
If System.IO.File.Exists(My.Settings.DestPath + OrderID + ".xml") Then
System.IO.File.Delete(My.Settings.DestPath + OrderID + ".xml")
End If
System.IO.File.Move(filename, My.Settings.DestPath + System.IO.Path.GetFileName(filename))
ds.WriteXml(My.Settings.DestPath + OrderID + ".xml")
clslog.Writelog("Import-Daten und Datei bereitgestellt - Order-ID :" + OrderID)
Return True
Catch ex As Exception
clslog.Writelog("Write_EDKB08_Struktur Fehler:" + ex.Message)
haserror = True
Return False
End Try
End Function
'Sub get_file()
Public Function ApplicationPath() As String
Return Path.GetDirectoryName([Assembly].GetEntryAssembly().Location) + "\"
End Function
Public Function send_mail()
Dim s As String = My.Settings.sendmail_ps
s = s.Replace("&sender&", My.Settings.sender)
s = s.Replace("&recipient&", My.Settings.recipient)
s = s.Replace("&body&", clslog.errormailtext)
Dim write As IO.StreamWriter
write = New IO.StreamWriter(My.Settings.TempPath & "" & My.Settings.sendmailfile)
write.Write(s)
write.Close()
s = My.Settings.sendmailcmd
s = s + My.Settings.TempPath + "" + My.Settings.sendmailfile
If My.Settings.sendmail = "1" Then
clslog.Writelog("Mailversand: " + s)
Process.Start("powershell.exe", s)
End If
End Function
End Module