09-08-2023

This commit is contained in:
Jonathan Jenne 2023-08-09 09:10:03 +02:00
parent c7f4885078
commit 3e41e5b469
44 changed files with 1024 additions and 638 deletions

View File

Before

Width:  |  Height:  |  Size: 4.2 KiB

After

Width:  |  Height:  |  Size: 4.2 KiB

59
Connectors.Form/Config.vb Normal file
View File

@ -0,0 +1,59 @@
Public Class Config
Public Property ActiveModule As String = "slt"
''' <summary>
''' This connection string needs to point to the database where the document data will be written to
''' </summary>
''' <returns></returns>
Public Property ConnectionString As String = ""
''' <summary>
''' This query must contain two placeholders:
'''
''' - {0} for ExtDocId
''' - {1} for Filename
''' </summary>
Public Property SQLQueryExport As String = ""
''' <summary>
''' This query needs to return a table with exactly one column, which represents the ExtDocId
''' </summary>
Public Property SQLQueryFetch As String = ""
Public Property OutputDirectory As String = ""
Public Property TimerIntervalMin As Integer = 0
Public Property Debug As Boolean = False
Public Property Autostart As Boolean = True
Public Property sltConfiguration As New sltConfig
Public Property SharepointConfiguration As New SharepointConfig
Public Class SharepointConfig
''' <summary>
''' The connection string of the sharepoint database. Should contain the tables AllDocs and AllDocStreams
''' </summary>
Public Property SharepointConnectionString As String = ""
End Class
Public Class sltConfig
''' <summary>
''' Hostname of the slt Server
''' </summary>
Public Property Hostname As String = ""
''' <summary>
''' Post of the slt Server
''' </summary>
Public Property Port As String = ""
''' <summary>
''' Username for authenticating with the slt Server
''' </summary>
Public Property Username As String = ""
''' <summary>
''' Password for authenticating with the slt Server
''' </summary>
Public Property Password As String = ""
''' <summary>
''' System or Mandator to use in slt
''' </summary>
Public Property SystemId As String = ""
End Class
End Class

View File

@ -6,8 +6,8 @@
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{A439775B-FF9C-4C46-9395-79356A8FC601}</ProjectGuid>
<OutputType>WinExe</OutputType>
<RootNamespace>sltSync</RootNamespace>
<AssemblyName>sltSync</AssemblyName>
<RootNamespace>Connectors.Form</RootNamespace>
<AssemblyName>Connectors.Form</AssemblyName>
<TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
<FileAlignment>512</FileAlignment>
<OptionExplicit>On</OptionExplicit>
@ -38,7 +38,7 @@
<MyType>WindowsForms</MyType>
</PropertyGroup>
<PropertyGroup>
<StartupObject>sltSync.My.MyApplication</StartupObject>
<StartupObject>Connectors.Form.My.MyApplication</StartupObject>
</PropertyGroup>
<ItemGroup>
<Reference Include="DevExpress.BonusSkins.v21.2" />
@ -95,26 +95,32 @@
</ItemGroup>
<ItemGroup>
<Compile Include="Config.vb" />
<Compile Include="Entities\sltDocument.vb" />
<Compile Include="Modules\BaseModule.vb" />
<Compile Include="Modules\ISync.vb" />
<Compile Include="Modules\Sharepoint\Entities\SharepointDocument.vb" />
<Compile Include="Modules\Sharepoint\SharepointSync.vb" />
<Compile Include="Modules\slt\Constants.vb" />
<Compile Include="Modules\slt\Entities\sltDocument.vb" />
<Compile Include="frmMain.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="frmMain.Designer.vb">
<DependentUpon>frmMain.vb</DependentUpon>
</Compile>
<Compile Include="Entities\sltAvailableSystem.vb" />
<Compile Include="Modules\slt\Entities\sltAvailableSystem.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="Responses\sltDocumentResponse.vb" />
<Compile Include="sltException.vb" />
<Compile Include="Responses\sltLoginResponse.vb" />
<Compile Include="Responses\sltLogoutResponse.vb" />
<Compile Include="Responses\sltMandatorResponse.vb" />
<Compile Include="Responses\sltResponse.vb" />
<Compile Include="sltSync.vb" />
<Compile Include="Modules\slt\Responses\sltDocumentResponse.vb" />
<Compile Include="Modules\slt\sltException.vb" />
<Compile Include="Modules\slt\Responses\sltLoginResponse.vb" />
<Compile Include="Modules\slt\Responses\sltLogoutResponse.vb" />
<Compile Include="Modules\slt\Responses\sltMandatorResponse.vb" />
<Compile Include="Modules\slt\Responses\sltResponse.vb" />
<Compile Include="Modules\slt\sltSync.vb" />
<EmbeddedResource Include="frmMain.resx">
<DependentUpon>frmMain.vb</DependentUpon>
</EmbeddedResource>
@ -128,6 +134,7 @@
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Resources.resx</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>

View File

@ -0,0 +1,114 @@
Imports System.IO
Imports System.Threading.Tasks
Imports DevExpress.DocumentView
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Public MustInherit Class BaseModule
Inherits BaseClass
Implements ISync
Friend ReadOnly Config As Config
Friend ReadOnly Database As MSSQLServer
Public MustOverride Property Name As String Implements ISync.Name
Public MustOverride Property IsLoggedIn As Boolean Implements ISync.IsLoggedIn
Public MustOverride Async Function Run() As Task Implements ISync.Run
Public MustOverride Function Cleanup() As Task Implements ISync.Cleanup
Public MustOverride Function TestConfigIsComplete() As Boolean Implements ISync.TestConfigIsComplete
Public Event OnLogEntry As EventHandler(Of String) Implements ISync.OnLogEntry
Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer, pConfig As Config)
MyBase.New(pLogConfig)
Database = pDatabase
Config = pConfig
End Sub
Friend Async Function FetchDocIds() As Task(Of List(Of String))
If Config.SQLQueryFetch = "" Then
Logger.Warn("Fetch Query is not configured. Exiting.")
Return Nothing
End If
Dim oTable As DataTable = Await Database.GetDatatableAsync(Config.SQLQueryFetch)
If oTable Is Nothing Then
Logger.Warn("Error while fetching DocIds. Exiting")
Return Nothing
End If
Dim oDocIds = oTable.Rows.
Cast(Of DataRow).
Select(Function(r) r.Item(0).ToString()).
ToList()
AddInfoEntry("Found [{0}] files.", oDocIds.Count)
Return oDocIds
End Function
Friend Sub EnsureOutputDirectoryExists()
Dim oOutputDirectory As String = Config.OutputDirectory
If Directory.Exists(oOutputDirectory) = False Then
Throw New DirectoryNotFoundException($"Directory '{oOutputDirectory}' does not exist.")
End If
End Sub
Friend Function CopyFileToOutputPath(pFileContents As Byte(), pFilePath As String) As Boolean
Try
Using oStream As New MemoryStream(pFileContents)
Using oWriter As New FileStream(pFilePath, FileMode.Create)
oStream.CopyTo(oWriter)
Logger.Debug("File copied to document path [{0}]", pFilePath)
End Using
End Using
Return True
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
Public Function TestConfigIsCompleteBase() As Boolean
Dim oComplete = True
If Config.ConnectionString = String.Empty Then
AddWarnEntry("Configuration for 'ConnectionString' is empty.")
oComplete = False
End If
If Config.SQLQueryFetch = String.Empty Then
AddWarnEntry("Configuration for 'SQLQueryFetch' is empty.")
oComplete = False
End If
If Config.SQLQueryExport = String.Empty Then
AddWarnEntry("Configuration for 'SQLQueryExport' is empty.")
oComplete = False
End If
If Config.OutputDirectory = String.Empty Then
AddWarnEntry("Configuration for 'OutputDirectory' is empty.")
oComplete = False
End If
Return oComplete
End Function
Friend Sub AddInfoEntry(pMessage As String, ParamArray pArgs As Object())
RaiseEvent OnLogEntry(Me, String.Format(pMessage, pArgs))
End Sub
Friend Sub AddWarnEntry(pMessage As String, ParamArray pArgs As Object())
RaiseEvent OnLogEntry(Me, String.Format(pMessage, pArgs))
End Sub
Friend Sub AddDivider()
RaiseEvent OnLogEntry(Me, "---")
End Sub
End Class

View File

@ -0,0 +1,11 @@
Imports System.Threading.Tasks
Public Interface ISync
Property Name As String
Property IsLoggedIn() As Boolean
Function Run() As Task
Function Cleanup() As Task
Function TestConfigIsComplete() As Boolean
Event OnLogEntry As EventHandler(Of String)
End Interface

View File

@ -0,0 +1,8 @@
Namespace Sharepoint.Entities
Public Class SharepointDocument
Public Property Id As String
Public Property Name As String
Public Property Path As String
Public Property Data As Byte()
End Class
End Namespace

View File

@ -0,0 +1,132 @@
Imports System.ComponentModel
Imports System.IO
Imports System.Threading.Tasks
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Namespace Sharepoint
Public Class SharepointSync
Inherits BaseModule
Implements ISync
Public Overrides Property Name As String = "Sharepoint Sync"
Public Overrides Property IsLoggedIn As Boolean
Private ReadOnly AllowedExtensions As New List(Of String) From {
"xls", "xlsx", "pdf", "dxf", "dwg", "doc", "docx", "ppt", "pptx", "jpg", "bmp", "msg", "eml", "png"
}
Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer, pConfig As Config)
MyBase.New(pLogConfig, pDatabase, pConfig)
End Sub
Public Overrides Async Function Run() As Task
Try
AddInfoEntry("Starting SharepointSync.")
AddDivider()
EnsureOutputDirectoryExists()
Dim oExtDocIds = Await FetchDocIds()
If oExtDocIds Is Nothing Then
Throw New ApplicationException($"Document Ids could not be fetched!")
End If
For Each oDocId As String In oExtDocIds
Try
Logger.Debug("Fetching document from Database..")
Dim oDocument = Await GetDocumentContent(oDocId)
Logger.Debug("Document fetched!")
AddInfoEntry("Document: [{0}]", oDocument.Name)
Logger.Info("ExtDocId: [{0}]", oDocument.Id)
' TODO: split path and build final sub path
' Beispiel Pfad:
' Netze/Betrieb/Baumassnahmen/Zählerwechsel 2012/Wasserzähler und Ausbauscheine/2012-06-25
Logger.Debug("Original Document Path: [{0}]", oDocument.Path)
Dim oSplitPaths = oDocument.Path.Split("/"c).
Select(Function(folder) StringEx.ConvertTextToSlug(folder)).
ToArray()
Dim oDocumentPath = String.Join("\", oSplitPaths)
Logger.Debug("Normalized Document Path: [{0}]", oDocument.Path)
Dim oDirectoryPath = Path.Combine(Config.OutputDirectory, oDocument.Path.Replace("/", "\"))
Dim oFilePath = Path.Combine(oDirectoryPath, oDocument.Name)
Logger.Debug("Final Document Path: [{0}]", oFilePath)
If CopyFileToOutputPath(oDocument.Data, oFilePath) = False Then
Throw New ApplicationException("File could not be created in output path!")
End If
Dim oSQL = String.Format(Config.SQLQueryExport, oDocument.Id, oDocument.Name)
Await Database.ExecuteNonQueryAsync(oSQL)
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Next
'TODO
AddInfoEntry("Finished Sync.")
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
End Function
Public Overrides Function Cleanup() As Task
Return Task.CompletedTask
End Function
Public Overrides Function TestConfigIsComplete() As Boolean
Dim oComplete = TestConfigIsCompleteBase()
Return oComplete
End Function
Private Async Function GetDocumentContent(pDocumentId As String) As Task(Of Entities.SharepointDocument)
Try
Dim oExtensionList = AllowedExtensions.
Select(Function(ext) $"'{ext}'").
ToList()
Dim oSql As String = $"SELECT T.*, T2.Content, T2.InternalVersion
FROM [AllDocs] T
INNER JOIN [AllDocStreams] T2
ON T.Id = T2.Id AND T.InternalVersion = T2.InternalVersion AND T.SiteId = T2.SiteId
WHERE T.Extension in ({String.Join(",", oExtensionList)})
T.Id = '{pDocumentId}'"
Dim oTable As DataTable = Database.GetDatatableWithConnection(oSql, Config.SharepointConfiguration.SharepointConnectionString)
If oTable Is Nothing OrElse oTable.Rows.Count = 0 Then
Logger.Warn("Document with Id [{0}] was not found in SharePoint Database!", pDocumentId)
Return Nothing
End If
Dim oRow = oTable.Rows.Item(0)
Dim oFilename As String = oRow.ItemEx("LeafName", "")
Dim oPath As String = oRow.ItemEx("DirName", "")
Dim oContent As Byte() = CType(oRow.Item("Content"), Byte())
Return New Entities.SharepointDocument() With {
.Id = pDocumentId,
.Name = oFilename,
.Path = oPath,
.Data = oContent
}
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
End Class
End Namespace

View File

@ -0,0 +1,11 @@
Namespace slt
Public Class Constants
Public Enum ErrorType
LoginError
LogoutError
AvailableSystemError
NotLoggedInError
GetDocumentError
End Enum
End Class
End Namespace

View File

@ -1,4 +1,4 @@
Namespace Entities
Namespace slt.Entities
Public Class sltAvailableSystem
Public SystemId As String
Public SystemName As String

View File

@ -1,4 +1,4 @@
Namespace Entities
Namespace slt.Entities
Public Class sltDocument
Public Property ExtDocId As String
Public Property Name As String

View File

@ -0,0 +1,7 @@
Namespace slt.Responses
Public Class sltDocumentResponse
Inherits sltResponse
Public Property Value As Entities.sltDocument
End Class
End Namespace

View File

@ -0,0 +1,8 @@
Namespace slt.Responses
Public Class sltLoginResponse
Inherits sltResponse
Public Property Value As String
End Class
End Namespace

View File

@ -0,0 +1,6 @@
Namespace slt.Responses
Public Class sltLogoutResponse
Inherits sltResponse
End Class
End Namespace

View File

@ -0,0 +1,8 @@
Namespace slt.Responses
Public Class sltAvailableSystemResponse
Inherits sltResponse
Public Property Value As List(Of slt.Entities.sltAvailableSystem)
End Class
End Namespace

View File

@ -0,0 +1,8 @@
Namespace slt.Responses
Public MustInherit Class sltResponse
Public Property Message As String
Public Property State As Boolean
Public Property Type As Integer
End Class
End Namespace

View File

@ -0,0 +1,13 @@
Namespace slt
Public Class sltException
Inherits ApplicationException
Public ReadOnly ErrorType As Constants.ErrorType
Public Sub New(pErrorType As Constants.ErrorType, pMessage As String)
MyBase.New(pMessage)
ErrorType = pErrorType
End Sub
End Class
End Namespace

View File

@ -0,0 +1,288 @@
Imports System.IO
Imports System.Net.Http
Imports Newtonsoft.Json
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Base.ModuleExtensions
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports Connectors.Form.slt.Constants
Imports Connectors.Form.slt.Responses
Imports Connectors.Form.slt.Entities
Imports System.Threading.Tasks
Imports DigitalData.Modules.Config
Namespace slt
Public Class sltSync
Inherits BaseModule
Implements ISync
Private ReadOnly FileEx As FileEx
Public Overrides Property Name As String = "slt Sync"
Public Overrides Property IsLoggedIn As Boolean = False
Public SessionId As String = Nothing
Public AvailableSystems As New List(Of sltAvailableSystem)
Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer, pConfig As Config)
MyBase.New(pLogConfig, pDatabase, pConfig)
FileEx = New FileEx()
End Sub
Public Overrides Async Function Run() As Threading.Tasks.Task Implements ISync.Run
Try
AddInfoEntry("Starting sltSync.")
AddDivider()
EnsureOutputDirectoryExists()
Dim oExtDocIds = Await FetchDocIds()
If oExtDocIds Is Nothing Then
Throw New ApplicationException($"Document Ids could not be fetched!")
End If
AddInfoEntry("Logging in..")
Await GetAvailableSystems()
Await Login(Config.sltConfiguration.SystemId)
For Each oDocId As String In oExtDocIds
Try
Logger.Debug("Fetching document from API..")
Dim oDocument = Await GetDocumentContent(oDocId)
Logger.Debug("Document fetched!")
AddInfoEntry("Document: [{0}]", oDocument.Name)
Logger.Info("ExtDocId: [{0}]", oDocument.ExtDocId)
Dim oFileName = GetFilenameWithExtension(oDocument.Name, oDocument.DocMimeType)
Dim oFilePath = Path.Combine(Config.OutputDirectory, oFileName)
If CopyFileToOutputPath(oDocument.Data, oFilePath) = False Then
Throw New ApplicationException("File could not be created in output path!")
End If
Dim oSQL = String.Format(Config.SQLQueryExport, oDocument.ExtDocId, oFileName)
Await Database.ExecuteNonQueryAsync(oSQL)
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Next
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Try
AddInfoEntry("Finished Sync.")
AddInfoEntry("Logging Out..")
Await Logout()
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while logging out: " & ex.Message)
Finally
AddDivider()
End Try
End Function
Public Overrides Async Function Cleanup() As Task Implements ISync.Cleanup
Await Logout()
End Function
Public Overrides Function TestConfigIsComplete() As Boolean Implements ISync.TestConfigIsComplete
Dim oComplete = TestConfigIsCompleteBase()
If Config.sltConfiguration.Hostname = String.Empty Then
AddWarnEntry("Configuration for 'Hostname' is empty.")
oComplete = False
End If
If Config.sltConfiguration.Port = String.Empty Then
AddWarnEntry("Configuration for 'Port' is empty.")
oComplete = False
End If
If Config.sltConfiguration.Username = String.Empty Then
AddWarnEntry("Configuration for 'Username' is empty.")
oComplete = False
End If
If Config.sltConfiguration.Password = String.Empty Then
AddWarnEntry("Configuration for 'Password' is empty.")
oComplete = False
End If
Return oComplete
End Function
Private Function GetFilenameWithExtension(pFilename As String, pMimetype As String) As String
Try
If pMimetype = "application/outlook" Then
pMimetype = "application/vnd.ms-outlook"
End If
Dim oExtension = FileEx.GetExtension(pMimetype)
Return StringEx.ConvertTextToSlug(pFilename) & oExtension
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("File [{0}] does not have a valid mimetype [{1}]. Returning original filename.", pFilename, pMimetype)
Return pFilename
End Try
End Function
Private Async Function GetAvailableSystems() As Threading.Tasks.Task
Try
Logger.Debug("Fetching available systems..")
Dim oUrl = "/slt/External/System/Authentication/Json/AvailableSystems"
Dim oJson As String = Await SendRequest(oUrl)
Dim oResponse = JsonConvert.DeserializeObject(Of sltAvailableSystemResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.AvailableSystemError)
AvailableSystems = oResponse.Value
Logger.Debug("Fetched [{0}] available systems!", oResponse.Value.Count)
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.AvailableSystemError, ex.Message)
End Try
End Function
Private Async Function Login(pSystemId As String) As Threading.Tasks.Task
Try
Logger.Debug("Logging in..")
If AvailableSystems.Any(Function(s) s.SystemId = pSystemId) = False Then
Dim oMessage = String.Format("SystemId [{0}] does not match any System returned from API.", pSystemId)
Logger.Warn(oMessage)
Throw New sltException(ErrorType.LoginError, oMessage)
End If
Dim oUrl = "/slt/External/System/Authentication/Json/Login"
Dim oParams = New Dictionary(Of String, String) From {
{"systemid", pSystemId},
{"user", Config.sltConfiguration.Username},
{"password", Config.sltConfiguration.Password}
}
Logger.Debug("Username: [{0}]", Config.sltConfiguration.Username)
Logger.Debug("SystemId: [{0}]", pSystemId)
Dim oJson As String = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltLoginResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.LoginError)
SessionId = oResponse.Value
IsLoggedIn = True
Logger.Debug("Login successful!")
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.LoginError, ex.Message)
End Try
End Function
Private Async Function Logout() As Threading.Tasks.Task
If Not IsLoggedIn Then
Throw New sltException(ErrorType.NotLoggedInError, "No session found")
End If
Logger.Debug("Logging out..")
Try
Dim oUrl = "/slt/External/System/Authentication/Json/Logout"
Dim oParams = New Dictionary(Of String, String) From {
{"SessionId", SessionId}
}
Dim oJson As String = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltLogoutResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.LogoutError)
SessionId = Nothing
IsLoggedIn = False
Logger.Debug("Login successful!")
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.LogoutError, ex.Message)
End Try
End Function
Private Async Function GetDocumentContent(pExternalDocumentId As String) As Threading.Tasks.Task(Of slt.Entities.sltDocument)
If Not IsLoggedIn Then
Throw New sltException(ErrorType.NotLoggedInError, "No session found")
End If
Try
Logger.Debug("Fetching document with ExtDocId [{0}]", pExternalDocumentId)
Dim oUrl = "/slt/External/Services/Allgemein/ExtDocs/JSon/GetDocument"
Dim oParams As New Dictionary(Of String, String) From {
{"extdocid", pExternalDocumentId},
{"sessionid", SessionId}
}
Dim oJson = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltDocumentResponse)(oJson)
Logger.Debug("Document Fetched!")
Return oResponse.Value
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.GetDocumentError, ex.Message)
End Try
End Function
Private Async Function SendRequest(pUrl As String) As Threading.Tasks.Task(Of String)
Return Await SendRequest(pUrl, New Dictionary(Of String, String))
End Function
Private Async Function SendRequest(pUrl As String, pQueryParams As Dictionary(Of String, String)) As Threading.Tasks.Task(Of String)
Try
Dim oUrl = GetUrl(pUrl, pQueryParams)
Logger.Debug("Preparing request to: [{0}]", oUrl)
Using oClient As New HttpClient()
oClient.DefaultRequestHeaders.Accept.Clear()
oClient.DefaultRequestHeaders.Accept.Add(New Headers.MediaTypeWithQualityHeaderValue("application/json"))
oClient.DefaultRequestHeaders.Add("User-Agent", "Digital Data sltSync")
Logger.Debug("Sending request.")
Return Await oClient.GetStringAsync(oUrl)
End Using
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Private Function GetUrl(pPath As String, pQueryParams As Dictionary(Of String, String)) As String
Dim oUrl As String = $"http://{Config.sltConfiguration.Hostname}:{Config.sltConfiguration.Port}"
If Not pPath.StartsWith("/") Then pPath &= "/"
Dim queryString = pQueryParams.ToURLQueryString()
Return $"{oUrl}{pPath}?{queryString}"
End Function
Private Sub TestRequestSuccessful(pUrl As String, pResponse As Responses.sltResponse, pErrorType As Constants.ErrorType)
If pResponse.State = False Then
Logger.Warn("Request to Url [{0}] returned error.", pUrl)
Logger.Error(pResponse.Message)
Throw New sltException(pErrorType, pResponse.Message)
End If
End Sub
End Class
End Namespace

View File

@ -1,10 +1,10 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
@ -14,10 +14,10 @@ Option Explicit On
Namespace My
'NOTE: This file is auto-generated; do not modify it directly. To make changes,
' or if you encounter build errors in this file, go to the Project Designer
' (go to Project Properties or double-click the My Project node in
' Solution Explorer), and make changes on the Application tab.
'HINWEIS: Diese Datei wird automatisch generiert und darf nicht direkt bearbeitet werden. Wenn Sie Änderungen vornehmen möchten
' oder in dieser Datei Buildfehler auftreten, wechseln Sie zum Projekt-Designer.
' (Wechseln Sie dazu zu den Projekteigenschaften, oder doppelklicken Sie auf den Knoten "Mein Projekt" im
' Projektmappen-Explorer). Nehmen Sie auf der Registerkarte "Anwendung" entsprechende Änderungen vor.
'
Partial Friend Class MyApplication
@ -32,7 +32,7 @@ Namespace My
<Global.System.Diagnostics.DebuggerStepThroughAttribute()> _
Protected Overrides Sub OnCreateMainForm()
Me.MainForm = Global.sltSync.frmMain
Me.MainForm = Global.Connectors.Form.frmMain
End Sub
End Class
End Namespace

View File

@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "17.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Connectors.Form.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.5.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class Settings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As Settings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New Settings()),Settings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Default.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As Settings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.Connectors.Form.My.Settings
Get
Return Global.Connectors.Form.My.Settings.Default
End Get
End Property
End Module
End Namespace

View File

@ -63,6 +63,7 @@
Me.RibbonControl1.Pages.AddRange(New DevExpress.XtraBars.Ribbon.RibbonPage() {Me.RibbonPage1})
Me.RibbonControl1.ShowApplicationButton = DevExpress.Utils.DefaultBoolean.[False]
Me.RibbonControl1.ShowDisplayOptionsMenuButton = DevExpress.Utils.DefaultBoolean.[False]
Me.RibbonControl1.ShowExpandCollapseButton = DevExpress.Utils.DefaultBoolean.[False]
Me.RibbonControl1.ShowPageHeadersMode = DevExpress.XtraBars.Ribbon.ShowPageHeadersMode.Hide
Me.RibbonControl1.ShowToolbarCustomizeItem = False
Me.RibbonControl1.Size = New System.Drawing.Size(632, 63)
@ -148,7 +149,7 @@
Me.IconOptions.SvgImage = CType(resources.GetObject("frmMain.IconOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.Name = "frmMain"
Me.Ribbon = Me.RibbonControl1
Me.Text = "sltSync"
Me.Text = "Sync"
CType(Me.ListBoxControl1, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.RibbonControl1, System.ComponentModel.ISupportInitialize).EndInit()
Me.TrayMenu.ResumeLayout(False)

173
Connectors.Form/frmMain.vb Normal file
View File

@ -0,0 +1,173 @@
Imports System.ComponentModel
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Partial Public Class frmMain
Private LogConfig As LogConfig
Private Logger As Logger
Private ConfigManager As ConfigManager(Of Config)
Private Database As MSSQLServer
Private Sync As ISync
Public Sub New()
InitializeComponent()
End Sub
Private Async Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
LogConfig = New LogConfig(LogConfig.PathType.CustomPath, IO.Path.Combine(Application.StartupPath, "Log"))
ConfigManager = New ConfigManager(Of Config)(LogConfig, Application.StartupPath)
LogConfig.Debug = ConfigManager.Config.Debug
Logger = LogConfig.GetLogger()
SyncTimer.Interval = ConfigManager.Config.TimerIntervalMin * 60 * 1_000
AddInfoEntry("Application started.")
AddInfoEntry("Version: {0}", Application.ProductVersion)
AddInfoEntry("Timer Interval: {0} min", ConfigManager.Config.TimerIntervalMin.ToString)
AddDivider()
Database = New MSSQLServer(LogConfig, ConfigManager.Config.ConnectionString)
Sync = InitializeModule(ConfigManager.Config.ActiveModule)
' Load Form Title from Module
Text = Sync.Name
If Sync Is Nothing Then
AddWarnEntry("ActiveModule '{0}' is not implemented!", ConfigManager.Config.ActiveModule)
Exit Sub
End If
If Database.DBInitialized = False Then
AddWarnEntry("Database could not be initialized. Please check connection string.")
Exit Sub
End If
If ConfigManager.Config.Autostart And Sync.TestConfigIsComplete() Then
Await Sync.Run()
End If
If ConfigManager.Config.TimerIntervalMin > 0 Then
StartTimer()
End If
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry($"Error while loading the application: {ex.Message}")
End Try
End Sub
Private Function InitializeModule(pActiveModule As String) As ISync
Dim oSync As ISync
Select Case pActiveModule
Case "slt"
oSync = New slt.sltSync(LogConfig, Database, ConfigManager.Config)
AddHandler oSync.OnLogEntry, AddressOf Sync_OnLogEntry
Case "Sharepoint"
oSync = New Sharepoint.SharepointSync(LogConfig, Database, ConfigManager.Config)
AddHandler oSync.OnLogEntry, AddressOf Sync_OnLogEntry
Case Else
Return Nothing
End Select
Return oSync
End Function
Private Sub Sync_OnLogEntry(sender As Object, e As String)
AddInfoEntry(e)
End Sub
Private Async Function frmMain_Closing(sender As Object, e As CancelEventArgs) As Threading.Tasks.Task Handles Me.Closing
Try
If Sync IsNot Nothing AndAlso Sync.IsLoggedIn Then
AddInfoEntry("Logging out..")
Await Sync.Cleanup()
End If
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry($"Error while closing the application: {ex.Message}")
End Try
End Function
Private Sub StartTimer()
If Sync.TestConfigIsComplete() = False Then
AddInfoEntry("Configuration is incomplete. Stopping.")
AddDivider()
Else
AddInfoEntry("Starting timer..")
btnStopSync.Enabled = True
btnSyncStart.Enabled = False
SyncTimer.Enabled = True
End If
End Sub
Private Sub StopTimer()
AddInfoEntry("Stopping timer..")
btnStopSync.Enabled = False
btnSyncStart.Enabled = True
SyncTimer.Enabled = False
End Sub
Private Async Function Timer_Elapsed(sender As Object, e As System.EventArgs) As Threading.Tasks.Task Handles SyncTimer.Tick
Await Sync.Run()
End Function
Private Sub AddInfoEntry(pMessage As String, ParamArray pArgs As Object())
Logger.Info(pMessage, pArgs)
ListBoxControl1.Items.Add(Now & " " & String.Format(pMessage, pArgs))
End Sub
Private Sub AddWarnEntry(pMessage As String, ParamArray pArgs As Object())
Logger.Info(pMessage, pArgs)
ListBoxControl1.Items.Add(String.Format(pMessage, pArgs))
End Sub
Private Sub AddDivider()
ListBoxControl1.Items.Add("=====================================")
End Sub
Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick
Try
Dim oPath = LogConfig.LogDirectory
Process.Start("explorer.exe", oPath)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
Private Sub btnSyncStart_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSyncStart.ItemClick
StartTimer()
End Sub
Private Sub btnStopSync_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnStopSync.ItemClick
StopTimer()
End Sub
Private Sub btnToggleWindow_Click(sender As Object, e As EventArgs) Handles btnToggleWindow.Click
ToggleWindow()
End Sub
Private Sub btnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
Close()
End Sub
Private Sub TrayIcon_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles TrayIcon.MouseDoubleClick
ToggleWindow()
End Sub
Private Sub ToggleWindow()
If Visible = True Then
Hide()
Else
WindowState = FormWindowState.Minimized
Show()
WindowState = FormWindowState.Normal
End If
End Sub
End Class

View File

@ -1,8 +1,8 @@
Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports Newtonsoft.Json
Imports sltSync
Imports Connectors.Form.slt.Responses
Namespace sltSync.Test
Namespace Connectors.Test
<TestClass>
Public Class AuthTest
ReadOnly oAvailableSystemsResponse As String = "{""Message"":null,""State"":true,""Type"":40,""Value"":[{""Deactivated"":false,""Description"":"""",""Priority"":1,""SystemID"":""764f0168-0005-43ca-bfe7-267b5fe254f4"",""SystemName"":""Prod: e.wa riss Netze GmbH""}]}"

View File

@ -16,7 +16,7 @@
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\sltSync\sltSync.vbproj" />
<ProjectReference Include="..\Connectors.Form\Connectors.Form.vbproj" />
</ItemGroup>
</Project>

View File

@ -3,9 +3,9 @@ Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.5.33516.290
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "sltSync", "sltSync\sltSync.vbproj", "{A439775B-FF9C-4C46-9395-79356A8FC601}"
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Connectors.Form", "Connectors.Form\Connectors.Form.vbproj", "{A439775B-FF9C-4C46-9395-79356A8FC601}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "sltSync.Test", "sltSync.Test\sltSync.Test.vbproj", "{71398AA2-8017-4CE2-8E29-187D38324FE7}"
Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "Connectors.Test", "Connectors.Test\Connectors.Test.vbproj", "{71398AA2-8017-4CE2-8E29-187D38324FE7}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution

View File

@ -1,27 +0,0 @@
Public Class Config
Public Property Hostname As String = ""
Public Property Port As String = ""
Public Property Username As String = ""
Public Property Password As String = ""
Public Property ConnectionString As String = ""
''' <summary>
''' This query must contain two placeholders:
'''
''' - {0} for ExtDocId
''' - {1} for Filename
''' </summary>
Public Property SQLQueryExport As String = ""
''' <summary>
''' This query needs to return a table with exactly one column, which represents the ExtDocId
''' </summary>
Public Property SQLQueryFetch As String = ""
Public Property OutputDirectory As String = ""
Public Property TimerIntervalMin As Integer = 10
Public Property SystemId As String = ""
Public Property Debug As Boolean = False
Public Property Autostart As Boolean = True
End Class

View File

@ -1,61 +0,0 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.18034
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Namespace My.Resources
''' <summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
''' </summary>
' This class was auto-generated by the StronglyTypedResourceBuilder
' class via a tool like ResGen or Visual Studio.
' To add or remove a member, edit your .ResX file then rerun ResGen
' with the /str option, or rebuild your VS project.
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "4.0.0.0"), Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()>
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
' internal Resources()
' {
' }
''' <summary>
''' Returns the cached ResourceManager instance used by this class.
''' </summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)>
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If (resourceMan Is Nothing) Then
Dim temp As New Global.System.Resources.ResourceManager("Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
''' <summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
''' </summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)>
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set(ByVal value As System.Globalization.CultureInfo)
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@ -1,26 +0,0 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.18034
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "10.0.0.0")>
Friend NotInheritable Partial Class Settings
Inherits System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As Settings = (CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New Settings()), Settings))
Public Shared ReadOnly Property [Default]() As Settings
Get
Return defaultInstance
End Get
End Property
End Class
End Namespace

View File

@ -1,5 +0,0 @@
Public Class sltDocumentResponse
Inherits sltResponse
Public Property Value As Entities.sltDocument
End Class

View File

@ -1,5 +0,0 @@
Public Class sltLoginResponse
Inherits sltResponse
Public Property Value As String
End Class

View File

@ -1,3 +0,0 @@
Public Class sltLogoutResponse
Inherits sltResponse
End Class

View File

@ -1,5 +0,0 @@
Public Class sltAvailableSystemResponse
Inherits sltResponse
Public Property Value As List(Of Entities.sltAvailableSystem)
End Class

View File

@ -1,5 +0,0 @@
Public MustInherit Class sltResponse
Public Property Message As String
Public Property State As Boolean
Public Property Type As Integer
End Class

View File

@ -1,273 +0,0 @@
Imports System.ComponentModel
Imports System.Configuration
Imports System.Data.SqlClient
Imports System.IO
Imports System.Text
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Base.IDB
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports Microsoft.Win32
Partial Public Class frmMain
Private LogConfig As LogConfig
Private Logger As Logger
Private ConfigManager As ConfigManager(Of Config)
Private Database As MSSQLServer
Private Sync As sltSync
Private FileEx As FileEx
Public Sub New()
InitializeComponent()
End Sub
Private Async Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Application.LocalUserAppDataPath, CompanyName:="Digital Data", ProductName:="sltSync")
Logger = LogConfig.GetLogger()
ConfigManager = New ConfigManager(Of Config)(LogConfig, Application.UserAppDataPath)
FileEx = New FileEx()
LogConfig.Debug = ConfigManager.Config.Debug
SyncTimer.Interval = ConfigManager.Config.TimerIntervalMin * 60 * 1_000
AddInfoEntry("Application started.")
AddInfoEntry("Version: {0}", Application.ProductVersion)
AddInfoEntry("Timer Interval: {0} min", ConfigManager.Config.TimerIntervalMin.ToString)
AddDivider()
Database = New MSSQLServer(LogConfig, ConfigManager.Config.ConnectionString)
Sync = New sltSync(LogConfig, ConfigManager.Config)
If Database.DBInitialized = False Then
AddWarnEntry("Database could not be initialized. Please check connection string.")
Else
If ConfigManager.Config.Autostart Then
Await RunSync()
End If
StartTimer()
End If
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry($"Error while loading the application: {ex.Message}")
End Try
End Sub
Private Async Function frmMain_Closing(sender As Object, e As CancelEventArgs) As Threading.Tasks.Task Handles Me.Closing
Try
If Sync IsNot Nothing AndAlso Sync.IsLoggedIn Then
AddInfoEntry("Logging out..")
Await Sync.Logout()
End If
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry($"Error while closing the application: {ex.Message}")
End Try
End Function
Private Sub StartTimer()
If TestConfigurationIsComplete() = False Then
AddInfoEntry("Configuration is incomplete. Stopping.")
AddDivider()
Else
AddInfoEntry("Starting timer..")
btnStopSync.Enabled = True
btnSyncStart.Enabled = False
SyncTimer.Enabled = True
End If
End Sub
Private Sub StopTimer()
AddInfoEntry("Stopping timer..")
btnStopSync.Enabled = False
btnSyncStart.Enabled = True
SyncTimer.Enabled = False
End Sub
Private Async Function Timer_Elapsed(sender As Object, e As System.EventArgs) As Threading.Tasks.Task Handles SyncTimer.Tick
Await RunSync()
End Function
Private Async Function RunSync() As Threading.Tasks.Task
Try
AddInfoEntry("Starting Sync.")
AddDivider()
Dim oOutputDirectory As String = ConfigManager.Config.OutputDirectory
If Directory.Exists(oOutputDirectory) = False Then
Throw New DirectoryNotFoundException($"Directory '{oOutputDirectory}' does not exist.")
End If
Dim oTable As DataTable = Await Database.GetDatatableAsync(ConfigManager.Config.SQLQueryFetch)
Dim oExtDocIds = oTable.Rows.Cast(Of DataRow).Select(Function(r) r.Item(0).ToString()).ToList()
AddInfoEntry("Found [{0}] files.", oExtDocIds.Count.ToString)
AddInfoEntry("Logging in..")
Await Sync.GetAvailableSystems()
Await Sync.Login(ConfigManager.Config.SystemId)
For Each oDocId As String In oExtDocIds
Try
Logger.Debug("Fetching document from API..")
Dim oDocument = Await Sync.GetDocumentContent(oDocId)
Logger.Debug("Document fetched!")
AddInfoEntry("Document: [{0}]", oDocument.Name)
Logger.Info("ExtDocId: [{0}]", oDocument.ExtDocId)
Dim oFileName = GetFilenameWithExtension(oDocument.Name, oDocument.DocMimeType)
Dim oFilePath = Path.Combine(oOutputDirectory, oFileName)
Using oStream As New MemoryStream(oDocument.Data)
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oStream.CopyTo(oWriter)
End Using
End Using
Dim oSQL = String.Format(ConfigManager.Config.SQLQueryExport, oDocument.ExtDocId, oFileName)
Await Database.ExecuteNonQueryAsync(oSQL)
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Next
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Try
AddInfoEntry("Finished Sync.")
AddInfoEntry("Logging Out..")
AddDivider()
Await Sync.Logout()
Catch ex As Exception
Logger.Error(ex)
AddWarnEntry("Error while logging out: " & ex.Message)
End Try
End Function
Private Function GetFilenameWithExtension(pFilename As String, pMimetype As String) As String
Try
If pMimetype = "application/outlook" Then
pMimetype = "application/vnd.ms-outlook"
End If
Dim oExtension = FileEx.GetExtension(pMimetype)
Return StringEx.ConvertTextToSlug(pFilename) & oExtension
Catch ex As Exception
AddWarnEntry("File [{0}] does not have a valid mimetype [{1}]. Returning original filename.", pFilename, pMimetype)
Return pFilename
End Try
End Function
Private Sub AddInfoEntry(pMessage As String, ParamArray pArgs As Object())
Logger.Info(pMessage, pArgs)
ListBoxControl1.Items.Add(Now & " " & String.Format(pMessage, pArgs))
End Sub
Private Sub AddWarnEntry(pMessage As String, ParamArray pArgs As Object())
Logger.Info(pMessage, pArgs)
ListBoxControl1.Items.Add(String.Format(pMessage, pArgs))
End Sub
Private Sub AddDivider()
ListBoxControl1.Items.Add("=====================================")
End Sub
Private Function TestConfigurationIsComplete() As Boolean
Dim oComplete = True
If ConfigManager.Config.Hostname = String.Empty Then
AddWarnEntry("Configuration for 'Hostname' is empty.")
oComplete = False
End If
If ConfigManager.Config.Port = String.Empty Then
AddWarnEntry("Configuration for 'Port' is empty.")
oComplete = False
End If
If ConfigManager.Config.Username = String.Empty Then
AddWarnEntry("Configuration for 'Username' is empty.")
oComplete = False
End If
If ConfigManager.Config.Password = String.Empty Then
AddWarnEntry("Configuration for 'Password' is empty.")
oComplete = False
End If
If ConfigManager.Config.ConnectionString = String.Empty Then
AddWarnEntry("Configuration for 'ConnectionString' is empty.")
oComplete = False
End If
If ConfigManager.Config.SQLQueryFetch = String.Empty Then
AddWarnEntry("Configuration for 'SQLQueryFetch' is empty.")
oComplete = False
End If
If ConfigManager.Config.SQLQueryExport = String.Empty Then
AddWarnEntry("Configuration for 'SQLQueryExport' is empty.")
oComplete = False
End If
If ConfigManager.Config.OutputDirectory = String.Empty Then
AddWarnEntry("Configuration for 'OutputDirectory' is empty.")
oComplete = False
End If
Return oComplete
End Function
Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick
Try
Dim oPath = LogConfig.LogDirectory
Process.Start("explorer.exe", oPath)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
Private Sub btnSyncStart_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSyncStart.ItemClick
StartTimer()
End Sub
Private Sub btnStopSync_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnStopSync.ItemClick
StopTimer()
End Sub
Private Sub btnToggleWindow_Click(sender As Object, e As EventArgs) Handles btnToggleWindow.Click
ToggleWindow()
End Sub
Private Sub btnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
Close()
End Sub
Private Sub TrayIcon_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles TrayIcon.MouseDoubleClick
ToggleWindow()
End Sub
Private Sub ToggleWindow()
If Visible = True Then
Hide()
Else
WindowState = FormWindowState.Minimized
Show()
WindowState = FormWindowState.Normal
End If
End Sub
End Class

View File

@ -1,10 +0,0 @@
Public Class sltException
Inherits ApplicationException
Public ReadOnly ErrorType As sltSync.ErrorType
Public Sub New(pErrorType As sltSync.ErrorType, pMessage As String)
MyBase.New(pMessage)
ErrorType = pErrorType
End Sub
End Class

View File

@ -1,184 +0,0 @@
Imports System.Net.Http
Imports DevExpress.XtraPrinting.Export.Pdf.PdfImageCache
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Base.ModuleExtensions
Imports DigitalData.Modules.Logging
Imports Newtonsoft.Json
Imports sltSync.Entities
Partial Public Class sltSync
Inherits BaseClass
Private ReadOnly Config As Config
Public IsLoggedIn As Boolean = False
Public SessionId As String = Nothing
Public AvailableSystems As New List(Of sltAvailableSystem)
Public Enum ErrorType
LoginError
LogoutError
AvailableSystemError
NotLoggedInError
GetDocumentError
End Enum
Public Sub New(pLogConfig As LogConfig, pConfig As Config)
MyBase.New(pLogConfig)
Config = pConfig
End Sub
Public Async Function GetAvailableSystems() As Threading.Tasks.Task
Try
Logger.Debug("Fetching available systems..")
Dim oUrl = "/slt/External/System/Authentication/Json/AvailableSystems"
Dim oJson As String = Await SendRequest(oUrl)
Dim oResponse = JsonConvert.DeserializeObject(Of sltAvailableSystemResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.AvailableSystemError)
AvailableSystems = oResponse.Value
Logger.Debug("Fetched [{0}] available systems!", oResponse.Value.Count)
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.AvailableSystemError, ex.Message)
End Try
End Function
Public Async Function Login(pSystemId As String) As Threading.Tasks.Task
Try
Logger.Debug("Logging in..")
If AvailableSystems.Any(Function(s) s.SystemId = pSystemId) = False Then
Dim oMessage = String.Format("SystemId [{0}] does not match any System returned from API.", pSystemId)
Logger.Warn(oMessage)
Throw New sltException(ErrorType.LoginError, oMessage)
End If
Dim oUrl = "/slt/External/System/Authentication/Json/Login"
Dim oParams = New Dictionary(Of String, String) From {
{"systemid", pSystemId},
{"user", Config.Username},
{"password", Config.Password}
}
Logger.Debug("Username: [{0}]", Config.Username)
Logger.Debug("SystemId: [{0}]", pSystemId)
Dim oJson As String = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltLoginResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.LoginError)
SessionId = oResponse.Value
IsLoggedIn = True
Logger.Debug("Login successful!")
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.LoginError, ex.Message)
End Try
End Function
Public Async Function Logout() As Threading.Tasks.Task
If Not IsLoggedIn Then
Throw New sltException(ErrorType.NotLoggedInError, "No session found")
End If
Logger.Debug("Logging out..")
Try
Dim oUrl = "/slt/External/System/Authentication/Json/Logout"
Dim oParams = New Dictionary(Of String, String) From {
{"SessionId", SessionId}
}
Dim oJson As String = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltLogoutResponse)(oJson)
TestRequestSuccessful(oUrl, oResponse, ErrorType.LogoutError)
SessionId = Nothing
IsLoggedIn = False
Logger.Debug("Login successful!")
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.LogoutError, ex.Message)
End Try
End Function
Public Async Function GetDocumentContent(pExternalDocumentId As String) As Threading.Tasks.Task(Of sltDocument)
If Not IsLoggedIn Then
Throw New sltException(ErrorType.NotLoggedInError, "No session found")
End If
Try
Logger.Debug("Fetching document with ExtDocId [{0}]", pExternalDocumentId)
Dim oUrl = "/slt/External/Services/Allgemein/ExtDocs/JSon/GetDocument"
Dim oParams As New Dictionary(Of String, String) From {
{"extdocid", pExternalDocumentId},
{"sessionid", SessionId}
}
Dim oJson = Await SendRequest(oUrl, oParams)
Dim oResponse = JsonConvert.DeserializeObject(Of sltDocumentResponse)(oJson)
Logger.Debug("Document Fetched!")
Return oResponse.Value
Catch ex As Exception
Logger.Error(ex)
Throw New sltException(ErrorType.GetDocumentError, ex.Message)
End Try
End Function
Private Async Function SendRequest(pUrl As String) As Threading.Tasks.Task(Of String)
Return Await SendRequest(pUrl, New Dictionary(Of String, String))
End Function
Private Async Function SendRequest(pUrl As String, pQueryParams As Dictionary(Of String, String)) As Threading.Tasks.Task(Of String)
Try
Dim oUrl = GetUrl(pUrl, pQueryParams)
Logger.Debug("Preparing request to: [{0}]", oUrl)
Using oClient As New HttpClient()
oClient.DefaultRequestHeaders.Accept.Clear()
oClient.DefaultRequestHeaders.Accept.Add(New Headers.MediaTypeWithQualityHeaderValue("application/json"))
oClient.DefaultRequestHeaders.Add("User-Agent", "Digital Data sltSync")
Logger.Debug("Sending request.")
Return Await oClient.GetStringAsync(oUrl)
End Using
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Private Function GetUrl(pPath As String, pQueryParams As Dictionary(Of String, String)) As String
Dim oUrl As String = $"http://{Config.Hostname}:{Config.Port}"
If Not pPath.StartsWith("/") Then pPath &= "/"
Dim queryString = pQueryParams.ToURLQueryString()
Return $"{oUrl}{pPath}?{queryString}"
End Function
Private Sub TestRequestSuccessful(pUrl As String, pResponse As sltResponse, pErrorType As ErrorType)
If pResponse.State = False Then
Logger.Warn("Request to Url [{0}] returned error.", pUrl)
Logger.Error(pResponse.Message)
Throw New sltException(pErrorType, pResponse.Message)
End If
End Sub
End Class