Imports System.IO Imports System.Threading Imports System.Xml Public Class Common #Region " Deklarationen" Dim m_Config_Path As String Dim m_Config_DateiEndung As String Dim m_MitWatcherObjekt As Boolean = False Dim m_WatcherObjekt As FileSystemWatcher 'Alle XML Variabeln Dim m_param_RootName As String Dim m_param_MitNetUse As Integer Dim m_param_NetUseParameter As String Dim m_param_PfadSourceFiles As String Dim m_param_NetUseNT As Integer Dim m_param_NetUseUser As String Dim m_param_NetUsePW As String Dim m_param_DateiEndung_Org_Files As String Dim m_param_DateiEndung_OK_Files As String Dim m_param_DateiEndung_Error_Files As String Dim m_param_DateiEndung_ErrorEDKB08_Files As String Dim m_param_PdadTempSourceFiles As String Dim m_error As Boolean = False Dim m_CollConfigFiles As New Collection() Dim m_DokToInit As Boolean = False Private Enum Enum_MapTyp Mappen = 0 Loeschen = 1 End Enum Public Enum Enum_DokStatus OK = 1 Fehler = 2 FehlerEDKB08 = 3 End Enum Public Event StartVerarbeitung(ByVal InputVerzeichnis As String) Public Event LogToBMS(ByVal LogEintrag As String, ByVal iTyp As Integer) #End Region #Region " Public" #Region " Init" Public Sub Sub_Init(ByVal Config_Path As String, ByVal Config_DateiEndung As String) m_Config_Path = Config_Path m_Config_DateiEndung = Config_DateiEndung End Sub Public Sub Sub_Init(ByVal Config_Path As String, ByVal Config_DateiEndung As String, ByRef WatcherObjekt As FileSystemWatcher) m_MitWatcherObjekt = True m_WatcherObjekt = WatcherObjekt m_WatcherObjekt.EnableRaisingEvents = False m_Config_Path = Config_Path m_Config_DateiEndung = Config_DateiEndung End Sub #End Region Public Sub Start_Checking() 'Anzahl ConfigFiles holen GetConfigFiles(m_CollConfigFiles, m_Config_DateiEndung, m_Config_Path) 'Config Auslesen Dim i As Integer For i = 1 To m_CollConfigFiles.Count If ReadConfig(m_Config_Path + m_CollConfigFiles.Item(i)) = True Then CopyFilesToLocalSystem() End If Next End Sub Public Function Set_DokStatus(ByVal DokumentName As String, ByVal bStatus As Enum_DokStatus) As Boolean 'True = OK 'False = NOK Set_DokStatus = WriteDokumentStatus(bStatus, DokumentName) End Function #Region " End Sub" Public Sub Sub_End() If m_MitWatcherObjekt = True Then m_WatcherObjekt.EnableRaisingEvents = True End If End Sub #End Region #End Region #Region " Diverses " Private Sub GetConfigFiles(ByRef Col_Data As Collection, ByVal sDateiendung As String, ByVal sPfad As String) 'Dateinamen der Config Dateien auslesen Try Dim di As New IO.DirectoryInfo(sPfad) Dim diar1 As IO.FileInfo() = di.GetFiles("*." & sDateiendung) Dim dra As IO.FileInfo For Each dra In diar1 Col_Data.Add(dra.Name) Next Catch Ex As Exception RaiseEvent LogToBMS("Fehler: GetConfigFiles: " + Ex.Message, 3) End Try End Sub Private Function ReadConfig(ByVal ConfigFile As String) As Boolean Try Dim xmldoc As New XmlDocument() xmldoc.Load(ConfigFile) m_param_RootName = xmldoc.SelectSingleNode("/root/config/RootName").InnerText() m_param_MitNetUse = xmldoc.SelectSingleNode("/root/config/MitNetUse").InnerText() m_param_NetUseParameter = xmldoc.SelectSingleNode("/root/config/NetUseParameter").InnerText() m_param_PfadSourceFiles = xmldoc.SelectSingleNode("/root/config/PfadSourceFiles").InnerText() m_param_NetUseNT = Int(xmldoc.SelectSingleNode("/root/config/NetUseNT").InnerText()) m_param_NetUseUser = xmldoc.SelectSingleNode("/root/config/NetUseUser").InnerText() m_param_NetUsePW = xmldoc.SelectSingleNode("/root/config/NetUsePW").InnerText() m_param_DateiEndung_Org_Files = xmldoc.SelectSingleNode("/root/config/DateiEndung_Org_Files").InnerText() m_param_DateiEndung_OK_Files = xmldoc.SelectSingleNode("/root/config/DateiEndung_OK_Files").InnerText() m_param_DateiEndung_Error_Files = xmldoc.SelectSingleNode("/root/config/DateiEndung_Error_Files").InnerText() m_param_DateiEndung_ErrorEDKB08_Files = xmldoc.SelectSingleNode("/root/config/DateiEndung_ErrorEDKB08_Files").InnerText() m_param_PdadTempSourceFiles = xmldoc.SelectSingleNode("/root/config/PfadTempSourceFiles").InnerText() 'Config in Ordnung ReadConfig = True Catch ex As Exception ReadConfig = False End Try End Function Sub Debug_Write(ByVal text As String) FileOpen(98, "D:\edoka\vitruvdebug.txt", OpenMode.Append) WriteLine(98, text) FileClose(98) End Sub Private Sub CopyFilesToLocalSystem() 'Wenn Net Use Parametrisiert ist diesen ausführen If m_param_MitNetUse = 1 Then makeNetUse(Enum_MapTyp.Mappen) End If If m_param_RootName = "VITRUV" Then debug_write("Vitruv)") Move_Files_to_Localsystem() If m_param_MitNetUse = 1 Then makeNetUse(Enum_MapTyp.Loeschen) End If Exit Sub End If m_DokToInit = False Dim m_CollGSF As New Collection() GetConfigFiles(m_CollGSF, m_param_DateiEndung_Org_Files, m_param_PfadSourceFiles) Dim i As Integer For i = 1 To m_CollGSF.Count copySourceFiles(m_param_PfadSourceFiles, m_param_PdadTempSourceFiles, m_CollGSF.Item(i)) m_DokToInit = True Next m_CollGSF = Nothing If m_DokToInit = True Then RaiseEvent StartVerarbeitung(m_param_PdadTempSourceFiles) End If 'Wenn Net Use Parametrisiert ist diesen wieder trennen If m_param_MitNetUse = 1 Then makeNetUse(Enum_MapTyp.Loeschen) End If End Sub Private Function makeNetUse(ByVal iTyp As Enum_MapTyp) As Integer 'Net Use ausführen Dim cmdret As Integer Try If iTyp = Enum_MapTyp.Mappen Then If m_param_NetUseNT = 1 Then cmdret = Shell("Net Use " & m_param_NetUseParameter & " " & m_param_NetUsePW & " /user:" & m_param_NetUseUser, AppWinStyle.NormalFocus, True) Else cmdret = Shell("Net Use " & m_param_NetUseParameter, AppWinStyle.NormalFocus, True) End If Else 'cmdret = Shell("Net Use " & m_param_NetUseParameter & " /d /y", AppWinStyle.NormalFocus, True) cmdret = Shell("Net Use " & m_param_PfadSourceFiles & " /d /y", AppWinStyle.NormalFocus, True) End If makeNetUse = cmdret Catch ex As Exception Debug_Write("Error NetUse:" + ex.Message) RaiseEvent LogToBMS("Fehler: makeNetUse: " + ex.Message, 3) End Try End Function Private Sub copySourceFiles(ByVal sPfad As String, ByVal sZielPfad As String, ByVal sDateiname As String) Try Dim sDateiNameIND As String If FolderExist(sZielPfad) = False Then Create_Folders(sZielPfad) End If sDateiNameIND = Left(sDateiname, Len(sDateiname) - Len(m_param_DateiEndung_Org_Files) - 1) + ".IND" 'File.Copy(sPfad + sDateiname, sZielPfad + sDateiname, True) ReplaceXMLBlanks(sPfad + sDateiname, sZielPfad + sDateiNameIND) Dim m_CollSourceFiles As New Collection() Dim sUnterOrdner As String sUnterOrdner = Left(sDateiname, Len(sDateiname) - Len(m_param_DateiEndung_Org_Files) - 1) + "\" 'Alle Dateien im Unterverzeichnis auslesen GetConfigFiles(m_CollSourceFiles, "tif", m_param_PfadSourceFiles + sUnterOrdner) Dim i As Integer If m_CollSourceFiles.Count > 0 Then If FolderExist(sZielPfad) = False Then Create_Folders(sZielPfad) End If End If For i = 1 To m_CollSourceFiles.Count File.Copy(sPfad + sUnterOrdner + m_CollSourceFiles.Item(i), sZielPfad + m_CollSourceFiles.Item(i), True) Next m_CollSourceFiles = Nothing Catch ex As Exception RaiseEvent LogToBMS("Fehler: copySourceFiles: " + ex.Message, 3) End Try End Sub Sub Move_Files_to_Localsystem() Debug_Write("Move_Files") Dim di As New DirectoryInfo(m_param_PfadSourceFiles) For Each subdi As DirectoryInfo In di.GetDirectories Dim FileExists As Boolean = False For Each filename As String In IO.Directory.GetFiles(m_param_PfadSourceFiles + "\" + subdi.Name, "*.tif") If File.Exists(m_param_PdadTempSourceFiles + IO.Path.GetFileName(filename)) Then FileExists = True Next For Each filename As String In IO.Directory.GetFiles(m_param_PfadSourceFiles + "\" + subdi.Name, "*.xml") If File.Exists(m_param_PdadTempSourceFiles + subdi.Name + "_" + IO.Path.GetFileName(filename)) Then FileExists = True Next If Not FileExists Then For Each filename As String In IO.Directory.GetFiles(m_param_PfadSourceFiles + "\" + subdi.Name, "*.tif") File.Move(filename, m_param_PdadTempSourceFiles + IO.Path.GetFileName(filename)) Next For Each filename As String In IO.Directory.GetFiles(m_param_PfadSourceFiles + "\" + subdi.Name, "*.xml") File.Move(filename, m_param_PdadTempSourceFiles + subdi.Name + "_" + IO.Path.GetFileName(filename) + ".ind") Next Thread.Sleep(2000) Dim counter As Integer = 0 For Each filename As String In IO.Directory.GetFiles(m_param_PfadSourceFiles + "\" + subdi.Name, "*.*") counter = counter + 1 Next If counter = 0 Then Dim di1 As New IO.DirectoryInfo(m_param_PfadSourceFiles + "\" + subdi.Name) di1.Delete() End If End If Next End Sub Private Sub ReadXMLReplaceTextFile(ByRef change_col As Collection) Try Dim s As String = "" Dim Splitresult As String() FileOpen(1, m_Config_Path + "WordChange.txt", OpenMode.Input) While Not EOF(1) Input(1, s) If Len(s) >= 3 Then Splitresult = s.Split(";") change_col.Add(New WordChange(Splitresult(0), Splitresult(1))) End If End While Catch ex As Exception RaiseEvent LogToBMS("Fehler: ReplaceXMLBlanks: " + ex.Message, 3) Finally FileClose(1) End Try End Sub Private Sub ReplaceXMLBlanks(ByVal sOrgFile As String, ByVal sOutputFile As String) Try Dim sr As IO.StreamReader Dim sw As IO.StreamWriter Dim s As String Dim change_col As New Collection() Dim i As Integer ReadXMLReplaceTextFile(change_col) 'Inpute sr = New IO.StreamReader(sOrgFile, System.Text.Encoding.GetEncoding("ISO-8859-1")) s = sr.ReadToEnd sr.Close() 'Ersetz Dim wc As WordChange For i = 1 To change_col.Count wc = change_col(i) s = s.Replace(wc.SourceString, wc.TargetString) Next 'aubut sw = New IO.StreamWriter(sOutputFile, False, System.Text.Encoding.GetEncoding("ISO-8859-1")) sw.Write(s) sw.Flush() sw.Close() Catch ex As Exception RaiseEvent LogToBMS("Fehler: ReplaceXMLBlanks: " + ex.Message, 3) End Try End Sub Private Function WriteDokumentStatus(ByVal bStatus As Enum_DokStatus, ByVal sDokumentName As String) As Boolean WriteDokumentStatus = True Try 'Wenn Net Use Parametrisiert ist diesen ausführen If m_param_MitNetUse = 1 Then makeNetUse(Enum_MapTyp.Mappen) End If If FolderExist(m_param_PfadSourceFiles) = False Then RaiseEvent LogToBMS("Fehler: Kann Ordner nicht Finden", 3) WriteDokumentStatus = False Exit Function End If If File.Exists(m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_Org_Files) = False Then RaiseEvent LogToBMS("Fehler: Kann Datei nicht Finden", 3) WriteDokumentStatus = False Exit Function End If Select Case bStatus Case Enum_DokStatus.OK File.Move(m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_Org_Files, m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_OK_Files) Case Enum_DokStatus.Fehler File.Move(m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_Org_Files, m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_Error_Files) Case Enum_DokStatus.FehlerEDKB08 File.Move(m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_Org_Files, m_param_PfadSourceFiles + sDokumentName + "." + m_param_DateiEndung_ErrorEDKB08_Files) End Select 'Wenn Net Use Parametrisiert ist diesen wieder trennen If m_param_MitNetUse = 1 Then makeNetUse(Enum_MapTyp.Loeschen) End If Catch ex As Exception WriteDokumentStatus = False End Try End Function #End Region End Class