30-08-2023

This commit is contained in:
Jonathan Jenne
2023-08-30 16:09:32 +02:00
parent ea8ed48d25
commit 5cf8636e49
34 changed files with 649 additions and 90 deletions

View File

@@ -1,66 +0,0 @@
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
'''
''' These placeholders are optional and will be replaced if they are found in the query
''' - [String1]
''' - for Sharepoint Path when Sharepoint Module is used
''' - not used in slt Module
''' </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 AddDateSubDirectory As Boolean = False
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 SharepointDatabase 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

@@ -97,35 +97,18 @@
<Import Include="System" />
</ItemGroup>
<ItemGroup>
<Compile Include="Config.vb" />
<Compile Include="Modules\BaseModule.vb" />
<Compile Include="Modules\ISync.vb" />
<Compile Include="Modules\Sharepoint\Constants.vb" />
<Compile Include="Modules\Sharepoint\Entities\SharepointDocument.vb" />
<Compile Include="Modules\Sharepoint\SharepointException.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="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="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>
@@ -161,6 +144,12 @@
<ItemGroup>
<Content Include="App.ico" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Connectors.Common\Connectors.Common.vbproj">
<Project>{8f0ac45c-c610-4432-9078-82dd26ea3e8f}</Project>
<Name>Connectors.Common</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.

View File

@@ -1,161 +0,0 @@
Imports System.IO
Imports System.Runtime.Remoting.Messaging
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 Const DIVIDER_TEXT = "-------------------------------------"
Public Enum LogLevel
Info
Warn
[Error]
End Enum
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 Tuple(Of String, LogLevel)) Implements ISync.OnLogEntry
Public Event OnFileProcessed As EventHandler(Of String) Implements ISync.OnFileProcessed
Public Event OnFileError As EventHandler(Of String) Implements ISync.OnFileError
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 ConvertFilenameToSlug(pFileName As String) As String
Dim oName = Path.GetFileNameWithoutExtension(pFileName)
Dim oExtension = Path.GetExtension(pFileName)
Return StringEx.ConvertTextToSlug(oName) & oExtension
End Function
Friend Function GetFinalFileName(pFileName As String, pId As String) As String
Dim oExtension = Path.GetExtension(pFileName)
Return pId & oExtension
End Function
Friend Function GetFinalFilePath(pFileName As String) As String
If Config.AddDateSubDirectory Then
Dim oSubPath = FileEx.CreateDateDirectory(Config.OutputDirectory)
If oSubPath Is Nothing Then
Throw New ApplicationException("Output sub path could not be created!")
End If
Logger.Debug("Subdirectory [{0}] created.", oSubPath)
Return Path.Combine(oSubPath, pFileName)
Else
Return Path.Combine(Config.OutputDirectory, pFileName)
End If
End Function
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, New Tuple(Of String, LogLevel)(String.Format(pMessage, pArgs), LogLevel.Info))
End Sub
Friend Sub AddWarnEntry(pMessage As String, ParamArray pArgs As Object())
RaiseEvent OnLogEntry(Me, New Tuple(Of String, LogLevel)(String.Format(pMessage, pArgs), LogLevel.Warn))
End Sub
Friend Sub AddErrorEntry(pMessage As String, ParamArray pArgs As Object())
RaiseEvent OnLogEntry(Me, New Tuple(Of String, LogLevel)(String.Format(pMessage, pArgs), LogLevel.Error))
End Sub
Friend Sub AddDivider()
RaiseEvent OnLogEntry(Me, New Tuple(Of String, LogLevel)(DIVIDER_TEXT, LogLevel.Info))
End Sub
Friend Sub RaiseFileProcessed(pFilePath As String)
RaiseEvent OnFileProcessed(Me, pFilePath)
End Sub
Friend Sub RaiseFileError(pFilePath As String)
RaiseEvent OnFileError(Me, pFilePath)
End Sub
End Class

View File

@@ -1,13 +0,0 @@
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 Tuple(Of String, BaseModule.LogLevel))
Event OnFileProcessed As EventHandler(Of String)
Event OnFileError As EventHandler(Of String)
End Interface

View File

@@ -1,7 +0,0 @@
Namespace Sharepoint
Public Class Constants
Public Enum ErrorType
GetDocumentError
End Enum
End Class
End Namespace

View File

@@ -1,8 +0,0 @@
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

@@ -1,12 +0,0 @@
Namespace Sharepoint
Public Class SharepointException
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

@@ -1,128 +0,0 @@
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
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)
If oDocument Is Nothing Then
Throw New SharepointException(Constants.ErrorType.GetDocumentError, "Document was not found!")
End If
Logger.Debug("Document fetched!")
AddInfoEntry("Document: [{0}]", oDocument.Name)
Logger.Info("ExtDocId: [{0}]", oDocument.Id)
Dim oFileName = ConvertFilenameToSlug(oDocument.Name)
Dim oTempFileName = GetFinalFileName(oDocument.Name, oDocument.Id)
Dim oFilePath = GetFinalFilePath(oTempFileName)
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, oFileName)
If Await Database.ExecuteNonQueryAsync(oSQL) = True Then
RaiseFileProcessed(oFilePath)
Else
Throw New ApplicationException("Database entry could not be written!")
End If
Catch ex As Exception
RaiseFileError(oDocId)
Logger.Error(ex)
AddWarnEntry("Error while running Sync: " & ex.Message)
End Try
Next
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()
If Config.SharepointConfiguration.SharepointDatabase = String.Empty Then
AddWarnEntry("Configuration for 'SharepointDatabase' is empty.")
oComplete = False
End If
Return oComplete
End Function
Private Async Function GetDocumentContent(pDocumentId As String) As Task(Of Entities.SharepointDocument)
Try
Dim oSql As String = $"SELECT T.LeafName, T.DirName, T2.Content
FROM {Config.SharepointConfiguration.SharepointDatabase}.[AllDocs] T
INNER JOIN {Config.SharepointConfiguration.SharepointDatabase}.[AllDocStreams] T2
ON T.Id = T2.Id AND T.InternalVersion = T2.InternalVersion AND T.SiteId = T2.SiteId
WHERE T.Id = '{pDocumentId}'"
Dim oTable As DataTable = Database.GetDatatable(oSql)
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

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

View File

@@ -1,10 +0,0 @@
Namespace slt.Entities
Public Class sltAvailableSystem
Public SystemId As String
Public SystemName As String
Public Description As String
Public Deactivated As Boolean
Public Priority As Integer
End Class
End Namespace

View File

@@ -1,15 +0,0 @@
Namespace slt.Entities
Public Class sltDocument
Public Property ExtDocId As String
Public Property Name As String
Public Property Description As String
Public Property DocMimeType As String
Public Property DocModifyTimestamp As String
Public Property DocOrigin As String
Public Property DocOriginalFilename As String
Public Property DocSize As Long
Public Property StorPlaceId As String
Public Property ExternalId As String
Public Property Data As Byte()
End Class
End Namespace

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,8 +0,0 @@
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

@@ -1,13 +0,0 @@
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

@@ -1,296 +0,0 @@
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 MimeEx As MimeEx
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)
MimeEx = New MimeEx(pLogConfig)
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 oDocumentName = GetFilenameWithExtension(oDocument.ExtDocId, oDocument.DocMimeType)
Dim oFileName = ConvertFilenameToSlug(oDocumentName)
Dim oTempFileName = GetFinalFileName(oFileName, oDocument.ExtDocId)
Dim oFilePath = GetFinalFilePath(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)
If Await Database.ExecuteNonQueryAsync(oSQL) = True Then
RaiseFileProcessed(oFilePath)
Else
Throw New ApplicationException("Database entry could not be written!")
End If
Catch ex As Exception
RaiseFileError(oDocId)
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 = MimeEx.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

@@ -30,19 +30,20 @@
Me.RibbonControl1 = New DevExpress.XtraBars.Ribbon.RibbonControl()
Me.btnSyncStart = New DevExpress.XtraBars.BarButtonItem()
Me.btnStopSync = New DevExpress.XtraBars.BarButtonItem()
Me.BarButtonItem1 = New DevExpress.XtraBars.BarButtonItem()
Me.btnOpenLog = New DevExpress.XtraBars.BarButtonItem()
Me.btnForceSync = New DevExpress.XtraBars.BarButtonItem()
Me.txtFilesProcessed = New DevExpress.XtraBars.BarStaticItem()
Me.txtErrorsOccurred = New DevExpress.XtraBars.BarStaticItem()
Me.btnOpenConfig = New DevExpress.XtraBars.BarButtonItem()
Me.RibbonPage1 = New DevExpress.XtraBars.Ribbon.RibbonPage()
Me.RibbonPageGroup1 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonPageGroup2 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonStatusBar1 = New DevExpress.XtraBars.Ribbon.RibbonStatusBar()
Me.SyncTimer = New System.Windows.Forms.Timer(Me.components)
Me.TrayIcon = New System.Windows.Forms.NotifyIcon(Me.components)
Me.TrayMenu = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.btnToggleWindow = New System.Windows.Forms.ToolStripMenuItem()
Me.btnExit = New System.Windows.Forms.ToolStripMenuItem()
Me.RibbonStatusBar1 = New DevExpress.XtraBars.Ribbon.RibbonStatusBar()
Me.txtFilesProcessed = New DevExpress.XtraBars.BarStaticItem()
Me.txtErrorsOccurred = New DevExpress.XtraBars.BarStaticItem()
CType(Me.ListBoxControl1, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.RibbonControl1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.TrayMenu.SuspendLayout()
@@ -60,9 +61,9 @@
'
Me.RibbonControl1.CommandLayout = DevExpress.XtraBars.Ribbon.CommandLayout.Simplified
Me.RibbonControl1.ExpandCollapseItem.Id = 0
Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.btnSyncStart, Me.btnStopSync, Me.BarButtonItem1, Me.btnForceSync, Me.txtFilesProcessed, Me.txtErrorsOccurred})
Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.btnSyncStart, Me.btnStopSync, Me.btnOpenLog, Me.btnForceSync, Me.txtFilesProcessed, Me.txtErrorsOccurred, Me.btnOpenConfig})
Me.RibbonControl1.Location = New System.Drawing.Point(0, 0)
Me.RibbonControl1.MaxItemId = 7
Me.RibbonControl1.MaxItemId = 8
Me.RibbonControl1.Name = "RibbonControl1"
Me.RibbonControl1.Pages.AddRange(New DevExpress.XtraBars.Ribbon.RibbonPage() {Me.RibbonPage1})
Me.RibbonControl1.ShowApplicationButton = DevExpress.Utils.DefaultBoolean.[False]
@@ -89,12 +90,12 @@
Me.btnStopSync.ImageOptions.SvgImage = CType(resources.GetObject("btnStopSync.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.btnStopSync.Name = "btnStopSync"
'
'BarButtonItem1
'btnOpenLog
'
Me.BarButtonItem1.Caption = "Log öffnen"
Me.BarButtonItem1.Id = 3
Me.BarButtonItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarButtonItem1.Name = "BarButtonItem1"
Me.btnOpenLog.Caption = "Log öffnen"
Me.btnOpenLog.Id = 3
Me.btnOpenLog.ImageOptions.SvgImage = CType(resources.GetObject("btnOpenLog.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.btnOpenLog.Name = "btnOpenLog"
'
'btnForceSync
'
@@ -104,6 +105,29 @@
Me.btnForceSync.ImageOptions.SvgImage = CType(resources.GetObject("btnForceSync.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.btnForceSync.Name = "btnForceSync"
'
'txtFilesProcessed
'
Me.txtFilesProcessed.Caption = "Keine Dateien"
Me.txtFilesProcessed.Id = 5
Me.txtFilesProcessed.ImageOptions.SvgImage = CType(resources.GetObject("txtFilesProcessed.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.txtFilesProcessed.Name = "txtFilesProcessed"
Me.txtFilesProcessed.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'txtErrorsOccurred
'
Me.txtErrorsOccurred.Caption = "Keine Fehler"
Me.txtErrorsOccurred.Id = 6
Me.txtErrorsOccurred.ImageOptions.SvgImage = CType(resources.GetObject("txtErrorsOccurred.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.txtErrorsOccurred.Name = "txtErrorsOccurred"
Me.txtErrorsOccurred.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'btnOpenConfig
'
Me.btnOpenConfig.Caption = "Config öffnen"
Me.btnOpenConfig.Id = 7
Me.btnOpenConfig.ImageOptions.SvgImage = CType(resources.GetObject("btnOpenConfig.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.btnOpenConfig.Name = "btnOpenConfig"
'
'RibbonPage1
'
Me.RibbonPage1.Groups.AddRange(New DevExpress.XtraBars.Ribbon.RibbonPageGroup() {Me.RibbonPageGroup1, Me.RibbonPageGroup2})
@@ -121,10 +145,20 @@
'RibbonPageGroup2
'
Me.RibbonPageGroup2.Alignment = DevExpress.XtraBars.Ribbon.RibbonPageGroupAlignment.Far
Me.RibbonPageGroup2.ItemLinks.Add(Me.BarButtonItem1)
Me.RibbonPageGroup2.ItemLinks.Add(Me.btnOpenLog)
Me.RibbonPageGroup2.ItemLinks.Add(Me.btnOpenConfig)
Me.RibbonPageGroup2.Name = "RibbonPageGroup2"
Me.RibbonPageGroup2.Text = "RibbonPageGroup2"
'
'RibbonStatusBar1
'
Me.RibbonStatusBar1.ItemLinks.Add(Me.txtFilesProcessed)
Me.RibbonStatusBar1.ItemLinks.Add(Me.txtErrorsOccurred)
Me.RibbonStatusBar1.Location = New System.Drawing.Point(0, 254)
Me.RibbonStatusBar1.Name = "RibbonStatusBar1"
Me.RibbonStatusBar1.Ribbon = Me.RibbonControl1
Me.RibbonStatusBar1.Size = New System.Drawing.Size(632, 24)
'
'SyncTimer
'
'
@@ -153,31 +187,6 @@
Me.btnExit.Size = New System.Drawing.Size(184, 22)
Me.btnExit.Text = "Beenden"
'
'RibbonStatusBar1
'
Me.RibbonStatusBar1.ItemLinks.Add(Me.txtFilesProcessed)
Me.RibbonStatusBar1.ItemLinks.Add(Me.txtErrorsOccurred)
Me.RibbonStatusBar1.Location = New System.Drawing.Point(0, 254)
Me.RibbonStatusBar1.Name = "RibbonStatusBar1"
Me.RibbonStatusBar1.Ribbon = Me.RibbonControl1
Me.RibbonStatusBar1.Size = New System.Drawing.Size(632, 24)
'
'txtFilesProcessed
'
Me.txtFilesProcessed.Caption = "Keine Dateien"
Me.txtFilesProcessed.Id = 5
Me.txtFilesProcessed.ImageOptions.SvgImage = CType(resources.GetObject("txtFilesProcessed.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.txtFilesProcessed.Name = "txtFilesProcessed"
Me.txtFilesProcessed.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'txtErrorsOccurred
'
Me.txtErrorsOccurred.Caption = "Keine Fehler"
Me.txtErrorsOccurred.Id = 6
Me.txtErrorsOccurred.ImageOptions.SvgImage = CType(resources.GetObject("txtErrorsOccurred.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.txtErrorsOccurred.Name = "txtErrorsOccurred"
Me.txtErrorsOccurred.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'frmMain
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -205,7 +214,7 @@
Friend WithEvents btnSyncStart As DevExpress.XtraBars.BarButtonItem
Friend WithEvents btnStopSync As DevExpress.XtraBars.BarButtonItem
Friend WithEvents RibbonPageGroup1 As DevExpress.XtraBars.Ribbon.RibbonPageGroup
Friend WithEvents BarButtonItem1 As DevExpress.XtraBars.BarButtonItem
Friend WithEvents btnOpenLog As DevExpress.XtraBars.BarButtonItem
Friend WithEvents RibbonPageGroup2 As DevExpress.XtraBars.Ribbon.RibbonPageGroup
Friend WithEvents SyncTimer As Timer
Friend WithEvents TrayIcon As NotifyIcon
@@ -216,6 +225,7 @@
Friend WithEvents txtFilesProcessed As DevExpress.XtraBars.BarStaticItem
Friend WithEvents txtErrorsOccurred As DevExpress.XtraBars.BarStaticItem
Friend WithEvents RibbonStatusBar1 As DevExpress.XtraBars.Ribbon.RibbonStatusBar
Friend WithEvents btnOpenConfig As DevExpress.XtraBars.BarButtonItem
#End Region

View File

@@ -155,7 +155,7 @@
TTI0LDE4SDh2LTRoMTZWMTh6IiBjbGFzcz0iUmVkIiAvPg0KICA8L2c+DQo8L3N2Zz4L
</value>
</data>
<data name="BarButtonItem1.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v21.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="btnOpenLog.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v21.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjIxLjIsIFZlcnNpb249MjEuMi40
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
@@ -224,6 +224,24 @@
LDIyLjYsMjIuNiwyOCwxNiwyOHoiIGNsYXNzPSJSZWQiIC8+DQogICAgPGNpcmNsZSBjeD0iMTYiIGN5
PSIyMiIgcj0iMiIgY2xhc3M9IlJlZCIgLz4NCiAgICA8cmVjdCB4PSIxNCIgeT0iOCIgd2lkdGg9IjQi
IGhlaWdodD0iMTAiIHJ4PSIwIiByeT0iMCIgY2xhc3M9IlJlZCIgLz4NCiAgPC9nPg0KPC9zdmc+Cw==
</value>
</data>
<data name="btnOpenConfig.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v21.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjIxLjIsIFZlcnNpb249MjEuMi40
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
dkV4cHJlc3MuVXRpbHMuU3ZnLlN2Z0ltYWdlAQAAAAREYXRhBwICAAAACQMAAAAPAwAAAJQCAAAC77u/
PD94bWwgdmVyc2lvbj0nMS4wJyBlbmNvZGluZz0nVVRGLTgnPz4NCjxzdmcgeD0iMHB4IiB5PSIwcHgi
IHZpZXdCb3g9IjAgMCAzMiAzMiIgdmVyc2lvbj0iMS4xIiB4bWxucz0iaHR0cDovL3d3dy53My5vcmcv
MjAwMC9zdmciIHhtbG5zOnhsaW5rPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5L3hsaW5rIiB4bWw6c3Bh
Y2U9InByZXNlcnZlIiBpZD0iT3BlbiIgc3R5bGU9ImVuYWJsZS1iYWNrZ3JvdW5kOm5ldyAwIDAgMzIg
MzIiPg0KICA8c3R5bGUgdHlwZT0idGV4dC9jc3MiPgoJLlllbGxvd3tmaWxsOiNGRkIxMTU7fQoJLnN0
MHtvcGFjaXR5OjAuNzU7fQo8L3N0eWxlPg0KICA8ZyBjbGFzcz0ic3QwIj4NCiAgICA8cGF0aCBkPSJN
Mi4yLDI1LjJsNS41LTEyYzAuMy0wLjcsMS0xLjIsMS44LTEuMkgyNlY5YzAtMC42LTAuNC0xLTEtMUgx
MlY1YzAtMC42LTAuNC0xLTEtMUgzQzIuNCw0LDIsNC40LDIsNXYyMCAgIGMwLDAuMiwwLDAuMywwLjEs
MC40QzIuMSwyNS4zLDIuMiwyNS4zLDIuMiwyNS4yeiIgY2xhc3M9IlllbGxvdyIgLz4NCiAgPC9nPg0K
ICA8cGF0aCBkPSJNMzEuMywxNEg5LjZMNCwyNmgyMS44YzAuNSwwLDEuMS0wLjMsMS4zLTAuN0wzMiwx
NC43QzMyLjEsMTQuMywzMS44LDE0LDMxLjMsMTR6IiBjbGFzcz0iWWVsbG93IiAvPg0KPC9zdmc+Cw==
</value>
</data>
<metadata name="SyncTimer.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">

View File

@@ -1,5 +1,6 @@
Imports System.ComponentModel
Imports System.Runtime.Remoting.Messaging
Imports Connectors.Common
Imports DevExpress.XtraEditors.ViewInfo
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
@@ -46,18 +47,23 @@ Partial Public Class frmMain
AddInfoEntry("Version: {0}", Application.ProductVersion)
AddDivider()
If ConfigManager.Config.ActiveModule = "NONE" Then
AddWarnEntry("No ActiveModule selected, check your configuration!", ConfigManager.Config.ActiveModule)
Exit Sub
End If
Database = New MSSQLServer(LogConfig, ConfigManager.Config.ConnectionString)
Sync = InitializeModule(ConfigManager.Config.ActiveModule)
' Load Form Title from Module
Text = Sync.Name
TrayIcon.Text = Sync.Name
If Sync Is Nothing Then
AddWarnEntry("ActiveModule '{0}' is not implemented!", ConfigManager.Config.ActiveModule)
Exit Sub
End If
' Load Form Title from Module
Text = Sync.Name
TrayIcon.Text = Sync.Name
If Database.DBInitialized = False Then
AddWarnEntry("Database could not be initialized. Please check connection string.")
Exit Sub
@@ -96,7 +102,6 @@ Partial Public Class frmMain
oSync = New Sharepoint.SharepointSync(LogConfig, Database, ConfigManager.Config)
Case Else
Return Nothing
End Select
@@ -207,7 +212,7 @@ Partial Public Class frmMain
})
End Sub
Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick
Private Sub btnOpenLog_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnOpenLog.ItemClick
Try
Dim oPath = LogConfig.LogDirectory
Process.Start("explorer.exe", oPath)
@@ -264,4 +269,13 @@ Partial Public Class frmMain
e.Appearance.FontStyleDelta = FontStyle.Bold
End Select
End Sub
Private Sub btnOpenConfig_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnOpenConfig.ItemClick
Try
Dim oPath = Application.StartupPath
Process.Start("explorer.exe", oPath)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
End Class