Imports System.IO Public Class UPDATERfrm 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\DISPO\" ' WDH TERM Dim F_PROD As String = "\\192.168.0.91\f\Programme\DISPO\" ' VERAG ' Dim F As String = "\\192.168.0.90\f\Programme\DISPO\" 'DEVELOPER ' Dim F_ATILLA As String = "\\172.16.0.99\Daten\Programme\DISPO\" ' ATILLA Public Sub Main() 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 'Falls Settings existiert, wird der Pfad daraus verwendet. F = System.IO.File.ReadAllText(AppDomain.CurrentDomain.BaseDirectory & "DISPOUPDATER_Settings.txt") 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, "F-Pfad nicht gefunden, verbinde mit '" & F & "' ...") If Not System.IO.Directory.Exists(F) Then MsgBox("ERROR_UPDATE_05: Es konnte keine Verbindung mit dem F:\ 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 writeLine(RichTextBox, "Verbindung erfolgreich...") 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("DISPO") Then If Not tryDelMain() Then MsgBox("ERROR_UPDATE_06: DISPO.exe konnte nicht gelöscht werden. Das Programm wird evtl. noch ausgeführt.", MsgBoxStyle.Critical, "ERROR") Environment.Exit(0) End If delFiles() FileCopier() If Not System.IO.File.Exists(AppDomain.CurrentDomain.BaseDirectory & "DISPO.exe") Then MsgBox("ERROR_UPDATE_03: DISPO.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("DISPO.exe") Environment.Exit(0) End If Threading.Thread.Sleep(1000) Next MsgBox("ERROR_UPDATE_01: Update konnte nicht durchgeführt werden. DISPO.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 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 & "DISPO.exe") Then My.Computer.FileSystem.DeleteFile(AppDomain.CurrentDomain.BaseDirectory & "DISPO.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 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).ToUpper.Contains("DISPOUpdater") And Not cut_file(file).Contains("NOT_DEL_") Then If Not file.Contains("DISPOUpdater") And Not file.Contains("NOT_DEL_") Then ' f = file My.Computer.FileSystem.DeleteFile(file) 'Löscht das DISPO-Programm, außer den Updater ' IO.File.Delete(file) 'IO.Directory.Delete(file) 'Else MsgBox(file) End If Next Catch ex As Exception MsgBox("ERROR_UPDATE_44: 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 End Class