Imports System.IO Imports System.Security.Cryptography Public Class UPDATERfrm Dim CopyIncremental = True ' selbe Dateien nicht kopieren Private Sub UPDATERfrm_Load(sender As Object, e As EventArgs) Handles Me.Load End Sub Private Sub UPDATERfrm_Shown(sender As Object, e As EventArgs) Handles Me.Shown Dim trd As New Threading.Thread(AddressOf Main) trd.IsBackground = True trd.Start() End Sub Dim F As String = "F:\Programme\AVISO\" ' WDH TERM ' Dim F_PROD As String = "\\192.168.0.91\f\Programme\AVISO\" ' VERAG Dim F_PROD As String = "\\share01.verag.ost.dmn\Programme\AVISO\" ' VERAG ' Dim F As String = "\\192.168.0.90\f\Programme\AVISO\" 'DEVELOPER Dim F_ATILLA As String = "\\172.16.0.99\Daten\Programme\AVISO\" ' ATILLA Public Sub Main() 'STARTPARAMETER - DP Dim PARAM = "" Dim parameter() As String = Environment.GetCommandLineArgs().ToArray If (parameter.Count - 1) >= 1 Then 'Höher als 1 weil der index 0 der Pfad zum programm ist PARAM = parameter(1) End If If PARAM = "full" Then CopyIncremental = False End If Dim FIRMA = "VERAG" Dim pfadDatei As String = System.AppDomain.CurrentDomain.BaseDirectory & "\Standort.txt" FIRMA = "VERAG" If File.Exists(pfadDatei) Then Dim fs As New FileStream(pfadDatei, FileMode.Open, FileAccess.Read) Dim strmReader As New StreamReader(fs) FIRMA = strmReader.ReadLine fs.Dispose() strmReader.Dispose() End If If FIRMA = "ATILLA" Then F = F_ATILLA 'Sichere Verbindung If F.Contains("10.4.3.17") Then buildConnectionUNISPED() 'Falls Settings existiert, wird der Pfad daraus verwendet. ' F = System.IO.File.ReadAllLines(AppDomain.CurrentDomain.BaseDirectory & "AVISOUPDATER_Settings.txt")(0) ' F = System.IO.File.ReadAllText(AppDomain.CurrentDomain.BaseDirectory & "AVISOUPDATER_Settings.txt") If Not System.IO.Directory.Exists(F) Then F = getFByIP() writeLine(RichTextBox, "Verbinde mit '" & F & "' ...") If Not System.IO.Directory.Exists(F) Then If FIRMA = "ATILLA" Then F = F_ATILLA 'Sichere Verbindung Else F = F_PROD End If writeLine(RichTextBox, "Standard-Freigabelaufwerk nicht gefunden. Verbinde mit '" & F & "' ...") If Not System.IO.Directory.Exists(F) Then MsgBox("ERROR_UPDATE_05: Es konnte keine Verbindung mit dem Freigabe-Laufwerk hergestellt werden." & vbNewLine & "Wenn Sie eine Remote-Sitzung verwenden, melden Sie sich mit dieser erneut an.", MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) End If End If writeLine(RichTextBox, "Verbindung erfolgreich...") 'Else ' System.Console.WriteLine("UPDATEPFAD: " & F) End If writeLine(RichTextBox, "3 Sekunden warten, um sicherzustellen, dass das Programm beendet wurde...") Threading.Thread.Sleep(3000) 'Falls Programm gerade am Beenden writeLine(RichTextBox, "Starte Update...") ' If Not My.Computer.FileSystem.DirectoryExists(F) Then 'MsgBox("ERROR_UPDATE_02: Update-Daten existieren nicht.", MsgBoxStyle.Critical, "ERROR") ' Else Try For i As Integer = 1 To 3 Step 1 If Not DoesProcessExists("AVISO") Then If Not tryDelMain() Then MsgBox("ERROR_UPDATE_06: AVISO.exe konnte nicht gelöscht werden. Das Programm wird evtl. noch ausgeführt.", MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) End If '--------------------------- '--------------------------- 'Alternative: '------- 'copyAndDelFilesAndDir() '--------------------------- ' If Not cut_file(File).Contains("AVISOUPDATER") And Not cut_file(File).Contains("NOT_DEL_") Then If CopyIncremental Then cProgrammeUpdate.copyProgramLIST(F, AppDomain.CurrentDomain.BaseDirectory, {"AVISOUPDATER", "NOT_DEL_"}) Else delFiles() FileCopier() End If If Not System.IO.File.Exists(AppDomain.CurrentDomain.BaseDirectory & "AVISO.exe") Then MsgBox("ERROR_UPDATE_03: AVISO.exe konnte nicht gestartet werden.", MsgBoxStyle.Critical, "ERROR") End If If Not System.IO.File.Exists(AppDomain.CurrentDomain.BaseDirectory & "upd.tmp") Then System.IO.File.Create(AppDomain.CurrentDomain.BaseDirectory & "upd.tmp") End If writeLine(RichTextBox, "Erfolgreich abgeschlossen...") Process.Start("AVISO.exe") Environment.Exit(0) End If Threading.Thread.Sleep(1000) Next MsgBox("ERROR_UPDATE_01: Update konnte nicht durchgeführt werden. AVISO.exe nicht beendet?", MsgBoxStyle.Critical, "ERROR") Catch ex As Exception MsgBox("ERROR_UPDATE_02: Update-Daten existieren nicht.", MsgBoxStyle.Critical, "ERROR") End Try 'End If Environment.Exit(0) End Sub Function getFByIP() As String Dim default_F = "" getFByIP = "" Try Dim IPADDR As System.Net.IPAddress IPADDR = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName()).AddressList(0) 'MsgBox(IPADDR.ToString()) For Each l In System.IO.File.ReadAllLines(AppDomain.CurrentDomain.BaseDirectory & "AVISOUPDATER_Settings.txt") If l.Contains("|") Then Dim sp = l.Split("|") If IPADDR.ToString.Contains(sp(0).Replace("**", "")) Then getFByIP = sp(1) End If Else default_F = l End If Next Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try If getFByIP = "" Then If default_F <> "" Then getFByIP = default_F Else getFByIP = F End If End If End Function Sub buildConnectionUNISPED() Try writeLine(RichTextBox, "UNISPED Netzwerkzugriff einrichten...") 'Dim netuse1 As New System.Diagnostics.ProcessStartInfo() 'netuse1.FileName = "C:\Windows\system32\net" 'netuse1.Arguments = "use \\10.4.3.17 /User:VERAG 1VerSub9#" 'netuse1.CreateNoWindow = True 'netuse1.WindowStyle = ProcessWindowStyle.Hidden 'System.Diagnostics.Process.Start(netuse1) Dim netuse As New System.Diagnostics.ProcessStartInfo() netuse.FileName = "C:\Windows\system32\net" netuse.Arguments = "use \\10.4.3.17 /User:VERAG 1VerSub9#" netuse.CreateNoWindow = True netuse.WindowStyle = ProcessWindowStyle.Hidden System.Diagnostics.Process.Start(netuse) Catch ex As Exception writeLine(RichTextBox, "ERR: UNISPED Netzwerkzugriff fehlgeschlagen...") End Try End Sub Delegate Sub writeLineCallback(rtb As System.Windows.Forms.RichTextBox, text As String) Private Sub writeLine(rtb As System.Windows.Forms.RichTextBox, text As String) If Me.InvokeRequired Then Dim d As New writeLineCallback(AddressOf writeLine) Me.Invoke(d, New Object() {rtb, text}) Else rtb.Text &= text & vbNewLine End If End Sub 'Sub writeLine(richtextbox,text) ' RichTextBox.Text &= text & vbNewLine ' End Sub Private Sub FileCopier() CopyDir(F, AppDomain.CurrentDomain.BaseDirectory) Exit Sub For Each file As String In IO.Directory.GetFiles(F) ' Ermittelt alle Dateien des Ordners IO.File.Copy(file, AppDomain.CurrentDomain.BaseDirectory & cut_file(file), True) ' Kopiert die Dateien Next Next For Each file As String In IO.Directory.GetDirectories(F) ' Ermittelt alle Unterordner des Ordners My.Computer.FileSystem.CopyDirectory(file, AppDomain.CurrentDomain.BaseDirectory & cut_file(file), True) Next End Sub Private Function cut_file(ByVal file As String) As String ' Funktion zum Entfernen der Backslashs / Ordner While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function Private Function tryDelMain() As Boolean 'Dim f As String = "no" Try If System.IO.File.Exists(AppDomain.CurrentDomain.BaseDirectory & "AVISO.exe") Then My.Computer.FileSystem.DeleteFile(AppDomain.CurrentDomain.BaseDirectory & "AVISO.exe") Return True Catch ex As Exception MsgBox("ERROR_UPDATE_04: Fehler beim Löschen: " & F & vbNewLine & ex.Message, MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) Return False End Try End Function Private Sub copyAndDelFilesAndDir() 'Dim f As String = "no" Try With ProgressBar .Maximum = CInt(GetFolderSize(F) \ 1024) 'eventuell Rückgabe direkt auf 0 abfragen If .Maximum = 0 Then Exit Sub .Minimum = 0 .Value = 0 End With For Each file_source In IO.Directory.GetFiles(F) 'jedes File in F:\ Dim found = False For Each file As String In IO.Directory.GetFiles(AppDomain.CurrentDomain.BaseDirectory) ' Ermittelt alle Dateien des Ordners If Not cut_file(file).Contains("AVISOUPDATER") And Not cut_file(file).Contains("NOT_DEL_") Then 'alles außer den Updater If cut_file(file) = cut_file(file_source) Then 'Gleicher Name If CompareFiles(file, file_source) Then 'selbe Datei --> Nichts Else My.Computer.FileSystem.DeleteFile(file) Copy(New IO.FileInfo((file_source)), AppDomain.CurrentDomain.BaseDirectory) 'Kopieren End If found = True End If Else ' found = True 'damit nicht mehr kopiert End If Next If Not found Then Copy(New IO.FileInfo((file_source)), AppDomain.CurrentDomain.BaseDirectory) 'Kopieren End If Next 'Lösche wegefallende Dateien: For Each file As String In IO.Directory.GetFiles(AppDomain.CurrentDomain.BaseDirectory) ' Ermittelt alle Dateien des Ordners Dim found = False For Each file_source In IO.Directory.GetFiles(F) 'jedes File in F:\ If Not cut_file(file).Contains("AVISOUPDATER") And Not cut_file(file).Contains("NOT_DEL_") Then 'alles außer den Updater If cut_file(file) = cut_file(file_source) Then 'Gleicher Name found = True End If Else found = True End If Next If found = False Then My.Computer.FileSystem.DeleteFile(file) End If Next 'Alle Ordner überschreiben: For Each file As String In IO.Directory.GetDirectories(F) ' Ermittelt alle Unterordner des Ordners 'Copy(New IO.FileInfo(file), DestinationFolder) My.Computer.FileSystem.CopyDirectory(file, AppDomain.CurrentDomain.BaseDirectory & cut_file(file), True) Next ProgressBar.Value = 0 m_Label.Text = "0%" Catch ex As Exception MsgBox("ERROR_UPDATE_04: Fehler beim Löschen/Kopieren: " & F & vbNewLine & ex.Message & ex.StackTrace , MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) End Try End Sub Private Sub delFiles() 'Dim f As String = "no" Try For Each file As String In IO.Directory.GetFiles(AppDomain.CurrentDomain.BaseDirectory) ' Ermittelt alle Dateien des Ordners If Not cut_file(file).Contains("AVISOUPDATER") And Not cut_file(file).Contains("NOT_DEL_") Then ' f = file My.Computer.FileSystem.DeleteFile(file) 'Löscht das AVISO-Programm, außer den Updater ' IO.File.Delete(file) 'IO.Directory.Delete(file) End If Next Catch ex As Exception MsgBox("ERROR_UPDATE_04: Fehler beim Löschen: " & F & vbNewLine & ex.Message, MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) End Try End Sub Private Function DoesProcessExists(ByVal PName As String) As Boolean For Each p As Process In System.Diagnostics.Process.GetProcessesByName(PName) If p.StartInfo.UserName = Environment.UserName Then Return True End If Next Return False End Function Private Sub btnClose_Click(sender As Object, e As EventArgs) Handles btnClose.Click Me.Close() End Sub Private Sub CopyDir(ByVal SourceFolder As String, ByVal DestinationFolder As String) With ProgressBar .Maximum = CInt(GetFolderSize(SourceFolder) \ 1024) 'eventuell Rückgabe direkt auf 0 abfragen If .Maximum = 0 Then Exit Sub .Minimum = 0 .Value = 0 End With For Each file As String In IO.Directory.GetFiles(SourceFolder) Copy(New IO.FileInfo(file), DestinationFolder) Next file For Each file As String In IO.Directory.GetDirectories(F) ' Ermittelt alle Unterordner des Ordners 'Copy(New IO.FileInfo(file), DestinationFolder) My.Computer.FileSystem.CopyDirectory(file, AppDomain.CurrentDomain.BaseDirectory & cut_file(file), True) Next ProgressBar.Value = 0 m_Label.Text = "0%" End Sub Private Function GetFolderSize(ByVal Folder As String) As Long Dim l As Long For Each file As String In IO.Directory.GetFiles(Folder) l += New IO.FileInfo(file).Length Next file Return l End Function Private Sub Copy(ByVal SourceFile As IO.FileInfo, ByVal TargetDir As String) Try ' Quelle Dim fsmsource As IO.FileStream ' Zieldatei Dim fsmtarget As IO.FileStream ' Größe des bei jedem Durchlauf einzulesenden Datenpaketes Dim buffersize As Int32 = 1024 * 30 ' (30 KByte) Dim buffer(buffersize) As Byte Dim readbyte As Int32 ' Quelldatei ' Using nutzen fsmsource = New IO.FileStream(SourceFile.FullName, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read) ' Zieldatei fsmtarget = New IO.FileStream(IO.Path.Combine(TargetDir, SourceFile.Name), IO.FileMode.OpenOrCreate, IO.FileAccess.Write) ' Daten nach und nach einlesen und im Zielstream wieder ' zurückschreiben While fsmsource.Position < fsmsource.Length ' Quelle einlesen readbyte = fsmsource.Read(buffer, 0, buffersize) ' In das Ziel schreiben fsmtarget.Write(buffer, 0, readbyte) With ProgressBar Dim vl As Integer = .Value vl = Math.Min(.Maximum, readbyte \ 1024 + vl) .Value = vl m_Label.Text = CStr(CInt(100 * .Value / .Maximum)) + "%" .Refresh() m_Label.Refresh() End With End While ' Streams schließen fsmsource.Close() fsmtarget.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Error") End Try End Sub Public Function CompareFiles(ByVal FileFullPath1 As String, ByVal FileFullPath2 As String) As Boolean 'returns true if two files passed to is are identical, false 'otherwise 'does byte comparison; works for both text and binary files 'Throws exception on errors; you can change to just return 'false if you prefer Dim objMD5 As New MD5CryptoServiceProvider() Dim objEncoding As New System.Text.ASCIIEncoding() Dim aFile1() As Byte, aFile2() As Byte Dim strContents1, strContents2 As String Dim objReader As StreamReader Dim objFS As FileStream Dim bAns As Boolean If Not File.Exists(FileFullPath1) Then Return False ' Throw New Exception(FileFullPath1 & " doesn't exist") If Not File.Exists(FileFullPath2) Then Return False ' Throw New Exception(FileFullPath2 & " doesn't exist") Try objFS = New FileStream(FileFullPath1, FileMode.Open) objReader = New StreamReader(objFS) aFile1 = objEncoding.GetBytes(objReader.ReadToEnd) strContents1 = _ objEncoding.GetString(objMD5.ComputeHash(aFile1)) objReader.Close() objFS.Close() objFS = New FileStream(FileFullPath2, FileMode.Open) objReader = New StreamReader(objFS) aFile2 = objEncoding.GetBytes(objReader.ReadToEnd) strContents2 = _ objEncoding.GetString(objMD5.ComputeHash(aFile2)) bAns = strContents1 = strContents2 objReader.Close() objFS.Close() aFile1 = Nothing aFile2 = Nothing Catch ex As Exception ' Throw ex Return False End Try Return bAns End Function End Class