Public Class FormAblaufsteuerung
' =============================
' Vorlauf Tagesordner erstellen
' =============================
Public Structure arOutline
Public arDatum As String
Public arSchuetze As String
Public arZeit As String
Public arLine As String
Public arDatei As String
End Structure
Public IndexList As New List(Of arOutline)
Dim nameTeamPlayer As String
Public Sub FormAblaufsteuerung_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'TODO: Diese Codezeile lädt Daten in die Tabelle "Esa_ErgebnisseDataSet.Ergebnisse". Sie können sie bei Bedarf verschieben oder entfernen.
' Me.ErgebnisseTableAdapter.Fill(Me.Esa_ErgebnisseDataSet.Ergebnisse)
' Löschen Liste der Tagesordner je Stand
If My.Computer.FileSystem.FileExists(toDaten & toStand1 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand1 & "all.dat")
End If
If My.Computer.FileSystem.FileExists(toDaten & toStand2 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand2 & "all.dat")
End If
If My.Computer.FileSystem.FileExists(toDaten & toStand3 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand3 & "all.dat")
End If
' Leere Tagesordner auf Server entfernen
ReorgServer()
' Variable für Tagesordner aufbereiten
TextBoxDatum.Text = Date.Now.Year & "-" & Format((Date.Now.Month()), "00")
' Tagesordner je Stand erstellen
If My.Computer.FileSystem.FileExists(toDaten & toStand1 & ErgFolder) Then
msg = ErgFolder & " Tagesordner Stand 1 ist vorhanden."
ListBoxMeldungView(title, msg)
Else
My.Computer.FileSystem.CreateDirectory(toDaten & toStand1 & ErgFolder)
msg = ErgFolder & " Tagesordner Stand 1 wurde erstellt."
ListBoxMeldungView(title, msg)
End If
If My.Computer.FileSystem.FileExists(toDaten & toStand2 & ErgFolder) Then
msg = ErgFolder & " Tagesordner Stand 2 ist vorhanden."
ListBoxMeldungView(title, msg)
Else
My.Computer.FileSystem.CreateDirectory(toDaten & toStand2 & ErgFolder)
msg = ErgFolder & " Tagesordner Stand 2 wurde erstellt."
ListBoxMeldungView(title, msg)
End If
If My.Computer.FileSystem.FileExists(toDaten & toStand3 & ErgFolder) Then
msg = ErgFolder & " Tagesordner Stand 3 ist vorhanden."
ListBoxMeldungView(title, msg)
Else
My.Computer.FileSystem.CreateDirectory(toDaten & toStand3 & ErgFolder)
msg = ErgFolder & " Tagesordner Stand 3 wurde erstellt."
ListBoxMeldungView(title, msg)
End If
msg = " Einen Moment Geduld bitte, ich räume den Server auf."
ListBoxMeldungView(title, msg)
End Sub
Public Sub TabStand1_Click(sender As System.Object, e As System.EventArgs) Handles TabStand1.Click
' ==========================================================
' Sammeldatei all.dat enthält alle Ordner mit Schießtagen.
' ==========================================================
path = "c:\Daten\Stand1\all.dat"
ListBoxStand1.Items.Clear()
msg = " Laden Stand 1 läuft."
ListBoxMeldungView(title, msg)
ListBoxStand1.Refresh()
Using sr = New IO.StreamReader(path, System.Text.Encoding.Default)
Do While sr.Peek() >= 0
srLine = sr.ReadLine()
Select Case srLine.Contains(TextBoxDatum.Text)
Case True
ListBoxStand1.Items.Add(sr.ReadLine())
nameOrdner = Pfad + "\Stand1\" + srLine
StandUserNames1(nameOrdner)
Case False
Console.WriteLine(srLine)
End Select
Loop
End Using
' ========================================================
' Liste Sortieren, anzeigen und Statusmeldung ausgeben
' ========================================================
'StandUserNames1(nameOrdner)
SortBox1()
ListBoxStand1.Show()
' ListBoxStand1.Refresh()
msg = " Laden Stand 1 ist beendet."
ListBoxMeldungView(title, msg)
End Sub
Public Sub StandUserNames1(nameOrdner)
' =============================
' Dateien Stand 1 ab Jahr nach Auswahl suchen
' =============================
' ListBoxStand1.Items.Clear()
If System.IO.Directory.Exists(nameOrdner) Then
For Each nameDatei As String In
System.IO.Directory.GetFiles(nameOrdner)
testPos = InStr(1, nameDatei, "2", CompareMethod.Text)
nameFile = Strings.Mid(nameDatei, testPos, 10)
nameDateiEx = Strings.Right(nameDatei, 4)
word = Chr(34) & Chr(40)
recNr = 0
recNrResult = 0
Select Case nameDateiEx
Case Is = ".xml"
word = "ListBoxStand1"
XMLReader(nameDatei, word, Outline)
Case Is = ".dat"
'getFileContent1(nameDatei, word, Outline)
End Select
Next nameDatei
SortBox1()
ListBoxStand1.Show()
ListBoxStand1.Refresh()
msg = " Laden Stand 1 Datei " & nameFile & " ist beendet."
ListBoxMeldungView(title, msg)
Else
msg = " Zu dieser Auswahl existieren keine Schießdaten"
ListBoxMeldungView(title, msg)
End If
End Sub
Public Sub TabControl1_change(sender As System.Object, e As System.EventArgs) Handles TabControl1.Click
TabPart = Me.TabControl1.SelectedIndex
Select Case Me.TabControl1.SelectedIndex
Case 0 ' Stand 1
TabStand1_Click(TabControl1, e)
ListBoxStand1_SelectedIndexChanged(TabControl1, e)
Case 1 ' Stand 2
TabStand2_Click(TabControl1, e)
ListBoxStand2_SelectedIndexChanged(TabControl1, e)
Case 2 ' Stand 3
TabStand3_Click(TabControl1, e)
ListBoxStand3_SelectedIndexChanged(TabControl1, e)
End Select
End Sub
Public Sub ListBoxStand1_SelectedIndexChanged(sender As Object, e As System.EventArgs) Handles ListBoxStand1.SelectedIndexChanged
posBox = Me.ListBoxStand1.IndexFromPoint(Me.ListBoxStand1.PointToClient(MousePosition))
If posBox > -1 Then
nameValue = Me.ListBoxStand1.SelectedItem.ToString
nameHerg = Strings.Right(nameValue, 11)
nameWork = Strings.Left(nameValue, 10)
nameOrdner = Strings.Replace(nameOrdner, nameFile, nameWork, 1, -1)
ListBoxStand1_SelectedIndexClick(nameOrdner & "\" & nameHerg, toEsa & nameHerg)
Else
'MessageBox.Show("Eintrag nicht mit der Maus getroffen, nochmal versuchen!")
End If
ListBoxStand1.Refresh()
ListBoxStand1.Show()
End Sub
Public Function ListBoxStand1_SelectedIndexClick(nameFile, toEsa)
Select Case My.Computer.FileSystem.FileExists(toEsa)
Case True
My.Computer.FileSystem.DeleteFile(toEsa)
My.Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
Case False
Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
End Select
End Function
Public Sub TabStand2_Click(sender As System.Object, e As System.EventArgs) Handles TabStand2.Click
' ==========================================================
' Sammeldatei all.dat enthält alle Ordner mit Schießtagen.
' ==========================================================
path = "c:\Daten\Stand2\all.dat"
ListBoxStand2.Items.Clear()
msg = " Laden Stand 2 läuft."
ListBoxMeldungView(title, msg)
ListBoxStand2.Refresh()
Using sr = New IO.StreamReader(path, System.Text.Encoding.Default)
Do While sr.Peek() >= 0
srLine = sr.ReadLine()
Select Case srLine.Contains(TextBoxDatum.Text)
Case True
ListBoxStand2.Items.Add(sr.ReadLine())
nameOrdner = Pfad + "\Stand2\" + srLine
StandUserNames2(nameOrdner)
Case False
Console.WriteLine(sr.ReadLine())
End Select
Loop
End Using
' ========================================================
' Liste Sortieren, anzeigen und Statusmeldung ausgeben
' ========================================================
'StandUserNames2(nameOrdner)
SortBox2()
ListBoxStand2.Show()
msg = " Laden Stand 2 ist beendet."
ListBoxMeldungView(title, msg)
End Sub
Public Sub StandUserNames2(nameOrdner)
' =============================
' Dateien Stand 2 ab Jahr nach Auswahl suchen
' =============================
On Error Resume Next
'ListBoxStand2.Items.Clear()
If System.IO.Directory.Exists(nameOrdner) Then
For Each nameDatei As String In
System.IO.Directory.GetFiles(nameOrdner)
testPos = InStr(1, nameDatei, "2", CompareMethod.Text)
nameFile = Strings.Mid(nameDatei, testPos, 12)
nameDateiEx = Strings.Right(nameDatei, 4)
word = Chr(34) & Chr(40)
recNr = 0
recNrResult = 0
Select Case nameDateiEx
Case Is = ".xml"
word = "ListBoxStand2"
XMLReader(nameDatei, word, Outline)
Case Is = ".dat"
'getFileContent2(nameDatei, word, Outline)
End Select
Next nameDatei
SortBox2()
ListBoxStand2.Show()
'ListBoxStand2.Refresh()
msg = " Laden Stand 2 Datei " & nameFile & " ist beendet."
ListBoxMeldungView(title, msg)
Else
msg = " Zu dieser Auswahl existieren keine Schießdaten"
ListBoxMeldungView(title, msg)
End If
End Sub
Public Sub getFileContent2(nameDatei, word, Outline)
' ==================================================
' Ergebnisdatei Stand 2 lesen und zur Anzeige aufbereiten
' ==================================================
Dim found As Boolean = False
On Error Resume Next
For Each line As String In System.IO.File.ReadLines(nameDatei, System.Text.Encoding.Default)
recNr = recNr + 1
lineTest = line
Console.WriteLine(lineTest)
Select Case line.Contains(word)
Case True
'lineTest = line
Outline = line
Outline = Strings.Mid(Outline, 10) ' Name
Outline = Outline.Replace(Chr(34), "") ' Name ohne Hochkomma
nameDatum = Strings.Right(nameOrdner, 10)
nameJahr = Strings.Left(nameDatum, 4)
nameTag = Strings.Right(nameDatum, 2)
nameMonat = Strings.Mid(nameDatum, 6, 2)
nameDatum = nameTag & "." & nameMonat & "." & nameJahr
posStart = InStr(1, Outline, ":", CompareMethod.Text)
posStart = posStart - 17
posZeit = InStr(1, Outline, ":", CompareMethod.Text)
posZeit = posZeit - 3
' dataGridViewStand2 colZeit-----------------------
colZeitStart = CObj(Strings.Mid(Outline, posZeit, 9))
' dataGridViewStand2 colName-----------------------
colPlayer = CObj(Strings.Mid(Outline, 1, posStart))
'--------------------------------------------------
Outline = Strings.Replace(Outline, nameDatum, "")
colDatum = CObj(nameDatum)
'--------------------------------------------------
Outline = StrConv(Outline, vbLowerCase)
Outline = StrConv(Outline, vbProperCase)
Outline = Outline.Replace(", , ", "-")
Outline = Trim(Outline)
End Select
'-------------------------
' ungültige überspringen
'-------------------------
Select Case line.Contains(wordResult) 'Match
Case True
recNrResult = recNr + 6 ' Ergebnis Gesamt
recNrAnzahl = recNr + 5 ' Anzahl Schüsse
recNrZeitMatchStart = recNr + 3 ' Match Startzeit
recNrDatumMatch = recNr + 2
End Select
Select Case line.Contains("Linie")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") , ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 3, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 3, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") #, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case recNr
Case Is = recNrAnzahl
colAnzahlSchuesse = line
Case Is = recNrResult
nameHerg = Strings.Right(nameDatei, 11)
colDateiErgebnis = CObj(nameHerg)
colErgebisGesamt = CObj(line)
'--------------------------------------------------
Select Case posStart
Case Is 8 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 8 ' 1 Tabs
Outline = Outline & "_________" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 9 ' 1 Tabs
Outline = Outline & "_________" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 20 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 19 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 18 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 17 ' 1 Tab
Outline = Outline & "___" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 16 ' 1 Tab
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 14 ' 1 Tab
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 15 ' 1 Tab
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is 16 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is 15 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Else
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
End Select
ListBoxStand2.Items.Add(nameFile & " " & Outline)
colRows = colRows + 1
colCells = colCells + 1
GoTo BreakPoint
End Select
Next
BreakPoint:
End Sub
Public Sub ListBoxStand2_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ListBoxStand2.SelectedIndexChanged
posBox = Me.ListBoxStand1.IndexFromPoint(Me.ListBoxStand2.PointToClient(MousePosition))
If posBox > -1 Then
nameValue = Me.ListBoxStand2.SelectedItem.ToString
nameHerg = Strings.Right(nameValue, 11)
nameWork = Strings.Left(nameValue, 10)
nameOrdner = Strings.Replace(nameOrdner, nameFile, nameWork, 1, -1)
ListBoxStand2_SelectedIndexClick(nameOrdner & "\" & nameHerg, toEsa & nameHerg)
Else
' MessageBox.Show("Eintrag nicht mit der Maus getroffen, nochmal versuchen!")
End If
ListBoxStand2.Refresh()
ListBoxStand2.Show()
End Sub
Public Function ListBoxStand2_SelectedIndexClick(nameFile, toEsa)
Select Case My.Computer.FileSystem.FileExists(toEsa)
Case True
My.Computer.FileSystem.DeleteFile(toEsa)
My.Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
Case False
My.Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
End Select
End Function
Public Sub TabStand3_Click(sender As System.Object, e As System.EventArgs) Handles TabStand3.Click
path = "c:\Daten\Stand3\all.dat"
ListBoxStand3.Items.Clear()
msg = " Laden Stand 3 läuft."
ListBoxMeldungView(title, msg)
ListBoxStand3.Refresh()
Using sr = New IO.StreamReader(path, System.Text.ASCIIEncoding.Default)
Do While sr.Peek() > -1
srLine = sr.ReadLine()
Select Case srLine.Contains(TextBoxDatum.Text)
Case True
ListBoxStand3.Items.Add(sr.ReadLine())
nameOrdner = Pfad + "\Stand3\" + srLine
StandUserNames3(nameOrdner)
Case False
Console.WriteLine(sr.ReadLine())
Case Else
Console.WriteLine(sr.ReadLine())
End Select
Loop
End Using
' ========================================================
' Liste Sortieren, anzeigen und Statusmeldung ausgeben
' ========================================================
StandUserNames3(nameOrdner)
SortBox3()
ListBoxStand3.Show()
msg = " Laden Stand 3 ist beendet."
ListBoxMeldungView(title, msg)
End Sub
Public Sub StandUserNames3(nameOrdner)
' =============================
' Dateien Stand 3 ab Jahr nach Auswahl suchen
' =============================
'ListBoxStand3.Items.Clear()
On Error Resume Next
If System.IO.Directory.Exists(nameOrdner) Then
For Each nameDatei As String In
System.IO.Directory.GetFiles(nameOrdner)
testPos = InStr(1, nameDatei, "2", CompareMethod.Text)
nameFile = Strings.Mid(nameDatei, testPos, 10)
nameDateiEx = Strings.Right(nameDatei, 4)
word = Chr(34) & Chr(40)
recNr = 0
recNrResult = 0
Select Case nameDateiEx
Case Is = ".xml"
word = "ListBoxStand3"
XMLReader(nameDatei, word, Outline)
Case Is = ".dat"
'getFileContent2(nameDatei, word, Outline)
End Select
Next nameDatei
SortBox3()
ListBoxStand3.Show()
ListBoxStand3.Refresh()
msg = " Laden Stand 3 Datei " & nameFile & " ist beendet."
ListBoxMeldungView(title, msg)
Else
msg = " Zu dieser Auswahl existieren keine Schießdaten"
ListBoxMeldungView(title, msg)
End If
End Sub
Public Sub getFileContent3(nameDatei, word, Outline)
' ==================================================
' Ergebnisdatei Stand 3 lesen und zur Anzeige aufbereiten
' ==================================================
Dim found As Boolean = False
On Error Resume Next
For Each line As String In System.IO.File.ReadLines(nameDatei, System.Text.Encoding.Default)
recNr = recNr + 1
lineTest = line
Console.WriteLine(lineTest)
Select Case line.Contains(word)
Case True
'lineTest = line
Outline = line
Outline = Strings.Mid(Outline, 10) ' Name
Outline = Outline.Replace(Chr(34), "") ' Name ohne Hochkomma
nameDatum = Strings.Right(nameOrdner, 10)
nameJahr = Strings.Left(nameDatum, 4)
nameTag = Strings.Right(nameDatum, 2)
nameMonat = Strings.Mid(nameDatum, 6, 2)
nameDatum = nameTag & "." & nameMonat & "." & nameJahr
posStart = InStr(1, Outline, ":", CompareMethod.Text)
posStart = posStart - 17
posZeit = InStr(1, Outline, ":", CompareMethod.Text)
posZeit = posZeit - 3
' dataGridViewStand3 colZeit-----------------------
colZeitStart = CObj(Strings.Mid(Outline, posZeit, 9))
' dataGridViewStand3 colName-----------------------
colPlayer = CObj(Strings.Mid(Outline, 1, posStart))
'--------------------------------------------------
Outline = Strings.Replace(Outline, nameDatum, "")
colDatum = CObj(nameDatum)
'--------------------------------------------------
Outline = StrConv(Outline, vbLowerCase)
Outline = StrConv(Outline, vbProperCase)
Outline = Outline.Replace(", , ", "-")
Outline = Trim(Outline)
End Select
'-------------------------
' ungültige überspringen
'-------------------------
Select Case line.Contains(wordResult) 'Match
Case True
recNrResult = recNr + 6 ' Ergebnis Gesamt
recNrAnzahl = recNr + 5 ' Anzahl Schüsse
recNrZeitMatchStart = recNr + 3 ' Match Startzeit
recNrDatumMatch = recNr + 2
End Select
Select Case line.Contains("Linie")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") , ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 3, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 3, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") #, ")
Case True
GoTo BreakPoint
End Select
Select Case line.Contains(") 1, ")
Case True
GoTo BreakPoint
End Select
Select Case recNr
Case Is = recNrAnzahl
colAnzahlSchuesse = line
Case Is = recNrResult
nameHerg = Strings.Right(nameDatei, 11)
colDateiErgebnis = CObj(nameHerg)
colErgebisGesamt = CObj(line)
'--------------------------------------------------
Select Case posStart
Case Is 8 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 8 ' 1 Tabs
Outline = Outline & "_________" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 9 ' 1 Tabs
Outline = Outline & "_________" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 20 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 19 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 18 ' 1 Tab
Outline = Outline & "____" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 17 ' 1 Tab
Outline = Outline & "___" & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 16 ' 1 Tab
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 14 ' 1 Tab
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is = 15 ' 1 Tab
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is 16 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Is 15 ' 2 Tabs
Outline = Outline & Chr(9) & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
Case Else
Outline = Outline & Chr(9) & "Erg.: " & colErgebisGesamt & "_" & "_" & nameHerg
End Select
ListBoxStand3.Items.Add(nameFile & " " & Outline)
colRows = colRows + 1
colCells = colCells + 1
GoTo BreakPoint
End Select
Next
BreakPoint:
End Sub
Public Sub ListBoxStand3_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ListBoxStand3.SelectedIndexChanged
posBox = Me.ListBoxStand1.IndexFromPoint(Me.ListBoxStand3.PointToClient(MousePosition))
If posBox > -1 Then
nameValue = Me.ListBoxStand3.SelectedItem.ToString
nameHerg = Strings.Right(nameValue, 11)
nameWork = Strings.Left(nameValue, 11)
nameOrdner = Strings.Replace(nameOrdner, nameFile, nameWork, 1, -1)
ListBoxStand3_SelectedIndexClick(nameOrdner & "\" & nameHerg, toEsa & nameHerg)
Else
' MessageBox.Show("Eintrag nicht mit der Maus getroffen, nochmal versuchen!")
End If
ListBoxStand3.Refresh()
ListBoxStand3.Show()
End Sub
Public Function ListBoxStand3_SelectedIndexClick(nameFile, toEsa)
Select Case My.Computer.FileSystem.FileExists(toEsa)
Case True
My.Computer.FileSystem.DeleteFile(toEsa)
My.Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
Case False
My.Computer.FileSystem.CopyFile(nameFile, toEsa)
msg = " Kopieren Datei " & toEsa & " erfolgreich, kann jetzt mit Esa-Server bearbeitet werden."
ListBoxMeldungView(title, msg)
End Select
End Function
Public Function GetFolderFile(toEsa, nameValue, nameHerg)
End Function
Private Sub ButtonReorgStand1_Click(sender As System.Object, e As System.EventArgs) Handles ButtonReorgStand1.Click
'Stand 1 reorganisieren
IPAkt = IPSt1
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand1-Technik prüfen (Sicherung 4, Stand1, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand1 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter1
strNetworkShare = strNetworkShare1
strUsername = strUsername1
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
Pfad = "x:\Daten"
msg = " Reorganisation Stand 1 läuft, bitte warten."
ListBoxMeldungView(title, msg)
SearchAndDestroyStand1(Pfad)
End Select
End Sub
Private Sub ButtonReorgStand2_Click(sender As System.Object, e As System.EventArgs) Handles ButtonReorgStand2.Click
'Stand 2 prüfen
IPAkt = IPSt2
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand2-Technik prüfen (Sicherung 4, Stand2, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand2 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter2
strNetworkShare = strNetworkShare2
strUsername = strUsername2
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
Pfad = "y:\Daten"
msg = " Reorganisation Stand 2 läuft, bitte warten."
ListBoxMeldungView(title, msg)
SearchAndDestroyStand2(Pfad)
End Select
End Sub
Private Sub ButtonReorgStand3_Click(sender As System.Object, e As System.EventArgs) Handles ButtonReorgStand3.Click
'Stand 3 prüfen
IPAkt = IPSt3
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand3-Technik prüfen (Sicherung 4, Stand3, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand3 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter3
strNetworkShare = strNetworkShare3
strUsername = strUsername3
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
Pfad = "z:\Daten"
msg = " Reorganisation Stand 3 läuft, bitte warten."
ListBoxMeldungView(title, msg)
SearchAndDestroyStand3(Pfad)
End Select
End Sub
Public Sub ButtonReorgServer_Click(sender As System.Object, e As System.EventArgs) Handles ButtonReorgServer.Click
Pfad = "c:\Daten"
msg = " Reorganisation " & toDaten & " " & toStand1 & " läuft, bitte warten."
ListBoxMeldungView(title, msg)
If My.Computer.FileSystem.FileExists(toDaten & toStand1 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand1 & "all.dat")
End If
msg = " Reorganisation " & toDaten & " " & toStand2 & " läuft, bitte warten."
ListBoxMeldungView(title, msg)
If My.Computer.FileSystem.FileExists(toDaten & toStand2 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand2 & "all.dat")
End If
msg = " Reorganisation " & toDaten & " " & toStand3 & " läuft, bitte warten."
ListBoxMeldungView(title, msg)
If My.Computer.FileSystem.FileExists(toDaten & toStand3 & "all.dat") Then
My.Computer.FileSystem.DeleteFile(toDaten & toStand3 & "all.dat")
End If
SearchAndDestroyServer(Pfad)
End Sub
Public Sub ReorgServer()
Pfad = "c:\Daten"
msg = " Reorganisation läuft, bitte warten."
ListBoxMeldungView(title, msg)
SearchAndDestroyServer(Pfad)
End Sub
'--------------------------------
' Tooltips
'--------------------------------
'================================Tooltips Ende====================================================
Public Sub ListBoxMeldungView(title As String, msg As String)
TextMsg = title & msg
m = m + 1
Select Case m
Case Is > 3
ListBoxMeldung1.Items.Clear()
ListBoxMeldung1.Refresh()
m = 0
End Select
ListBoxMeldung1.Items.Add(TextMsg)
ListBoxMeldung1.Refresh()
End Sub
Public Sub SearchAndDestroyStand1(ByVal Pfad As String)
'Weitere Ordner durchsuchen
For Each Ordner As String In IO.Directory.GetDirectories(Pfad)
SearchAndDestroyStand1(Ordner)
Next Ordner
'Falls keine Dateien und Unterordner existieren // Ordner löschen
If IO.Directory.GetFiles(Pfad).Length = 0 And IO.Directory.GetDirectories(Pfad).Length = 0 Then
IO.Directory.Delete(Pfad)
msg = Pfad & " Ordner ist ungültig, leer und wird übersprungen und gelösch."
ListBoxMeldungView(title, msg)
Else
DatText = Strings.Right(Pfad, 10)
Ergebnis = InStr(1, Pfad, "Stand", vbTextCompare)
Select Case Ergebnis
Case Is > 0
Stand = Strings.Mid(Pfad, Ergebnis, 6)
Case Is = 0
Stand = Strings.Left(Pfad, 1)
End Select
Select Case Microsoft.VisualBasic.Left(DatText, 1)
Case "1"
msg = DatText & " gültigen Ergebnis-Ordner > 1900 gefunden."
ListBoxMeldungView(title, msg)
Case "2"
msg = DatText & " gültigen Ergebnis-Ordner > 2000 gefunden."
ListBoxMeldungView(title, msg)
End Select
End If
msg = " Hinzufügen " & DatText & " erfolgreich."
ListBoxMeldungView(title, msg)
' close all.dat
End Sub 'Alle Ordner suchen und ggf. löschen
Public Sub SearchAndDestroyStand2(ByVal Pfad As String)
'Weitere Ordner durchsuchen
For Each Ordner As String In IO.Directory.GetDirectories(Pfad)
SearchAndDestroyStand2(Ordner)
Next Ordner
'Falls keine Dateien und Unterordner existieren // Ordner löschen
If IO.Directory.GetFiles(Pfad).Length = 0 And IO.Directory.GetDirectories(Pfad).Length = 0 Then
IO.Directory.Delete(Pfad)
msg = Pfad & " Ordner ist ungültig, leer und wird übersprungen und gelösch."
ListBoxMeldungView(title, msg)
Else
DatText = Strings.Right(Pfad, 10)
Ergebnis = InStr(1, Pfad, "Stand", vbTextCompare)
Select Case Ergebnis
Case Is > 0
Stand = Strings.Mid(Pfad, Ergebnis, 6)
Case Is = 0
Stand = Strings.Left(Pfad, 1)
End Select
Select Case Microsoft.VisualBasic.Left(DatText, 1)
Case "1"
msg = DatText & " gültigen Ergebnis-Ordner > 1900 gefunden."
ListBoxMeldungView(title, msg)
Case "2"
msg = DatText & " gültigen Ergebnis-Ordner > 2000 gefunden."
ListBoxMeldungView(title, msg)
End Select
End If
msg = " Hinzufügen " & DatText & " erfolgreich."
ListBoxMeldungView(title, msg)
' close all.dat
End Sub 'Alle Ordner suchen und ggf. löschen
Public Sub SearchAndDestroyStand3(ByVal Pfad As String)
'Weitere Ordner durchsuchen
For Each Ordner As String In IO.Directory.GetDirectories(Pfad)
SearchAndDestroyStand3(Ordner)
Next Ordner
'Falls keine Dateien und Unterordner existieren // Ordner löschen
If IO.Directory.GetFiles(Pfad).Length = 0 And IO.Directory.GetDirectories(Pfad).Length = 0 Then
dirName = Pfad
dSecurity = IO.Directory.GetAccessControl(dirName)
dSecurity.AddAccessRule(ac_rule3)
IO.Directory.SetAccessControl(dirName, dSecurity)
System.IO.Directory.Delete(dirName)
msg = Pfad & " Ordner ist ungültig, leer und wird übersprungen und gelösch."
ListBoxMeldungView(title, msg)
Else
DatText = Strings.Right(Pfad, 10)
Ergebnis = InStr(1, Pfad, "Stand", vbTextCompare)
Select Case Ergebnis
Case Is > 0
Stand = Strings.Mid(Pfad, Ergebnis, 6)
Case Is = 0
Stand = Strings.Left(Pfad, 1)
End Select
Select Case Microsoft.VisualBasic.Left(DatText, 1)
Case "1"
msg = DatText & " gültigen Ergebnis-Ordner > 1900 gefunden."
ListBoxMeldungView(title, msg)
Case "2"
msg = DatText & " gültigen Ergebnis-Ordner > 2000 gefunden."
ListBoxMeldungView(title, msg)
End Select
End If
msg = " Hinzufügen " & DatText & " erfolgreich."
ListBoxMeldungView(title, msg)
End Sub 'Alle Ordner suchen und ggf. löschen
Public Sub SearchAndDestroyServer(ByVal Pfad As String)
'Weitere Ordner durchsuchen
For Each Ordner As String In IO.Directory.GetDirectories(Pfad)
SearchAndDestroyServer(Ordner)
Next Ordner
'Falls keine Dateien und Unterordner existieren // Ordner löschen
If IO.Directory.GetFiles(Pfad).Length = 0 And IO.Directory.GetDirectories(Pfad).Length = 0 Then
' aber nicht den aktuellen Tagesordner
DatText = Strings.Right(Pfad, 10)
Select Case DatText
Case Is > tagesDatum
IO.Directory.Delete(Pfad)
msg = Pfad & " Ordner ist ungültig, leer und wird übersprungen und gelösch."
ListBoxMeldungView(title, msg)
End Select
Else
DatText = Strings.Right(Pfad, 10)
Ergebnis = InStr(1, Pfad, "Stand", vbTextCompare)
Select Case Ergebnis
Case Is > 0
Stand = Strings.Mid(Pfad, Ergebnis, 6)
Case Is = 0
Stand = Strings.Left(Pfad, 1)
End Select
Select Case Microsoft.VisualBasic.Left(DatText, 1)
Case "1"
msg = DatText & " Ergebnis-Ordner wird der Auswahl hinzugefügt"
ListBoxMeldungView(title, msg)
AllDat(DatText, Pfad, Stand) ' write pfad to all.dat or at end
Case "2"
msg = DatText & " Ergebnis-Ordner wird der Auswahl hinzugefügt"
ListBoxMeldungView(title, msg)
AllDat(DatText, Pfad, Stand) ' write pfad to all.dat or at end
End Select
End If
msg = " Hinzufügen " & DatText & " erfolgreich."
ListBoxMeldungView(title, msg)
' close all.dat
End Sub 'Alle Ordner suchen und ggf. löschen
Public Sub NewListBox(i, sr, BoxName)
Me.Controls.AddRange(New Control() {ListBoxStand1, ListBoxStand2, ListBoxStand3})
BoxItems.Add(New BoxItem(sr.ReadLine()))
'BoxName.DataSource = BoxItem
BoxName.ValueMember.Insert(i, (sr.ReadLine()))
Select Case BoxName
Case Is = "ListBoxStand1"
AddHandler ListBoxStand1.SelectedValueChanged, AddressOf ListBoxStand1_SelectedValueChanged
Case Is = "ListBoxStand2"
AddHandler ListBoxStand2.SelectedValueChanged, AddressOf ListBoxStand2_SelectedValueChanged
Case Is = "ListBoxStand3"
AddHandler ListBoxStand3.SelectedValueChanged, AddressOf ListBoxStand3_SelectedValueChanged
End Select
End Sub
Public Sub ListBoxStand1_SelectedValueChanged(ByVal sender As Object, ByVal e As EventArgs)
If ListBoxStand1.SelectedIndex > -1 Then
ListBoxStand1.Text = ListBoxStand1.SelectedValue.ToString()
End If
End Sub 'ListBoxStand1_SelectedValueChanged
Public Sub ListBoxStand2_SelectedValueChanged(ByVal sender As Object, ByVal e As EventArgs)
If ListBoxStand2.SelectedIndex > -1 Then
ListBoxStand2.Text = ListBoxStand2.SelectedValue.ToString()
End If
End Sub 'ListBoxStand2_SelectedValueChanged
Public Sub ListBoxStand3_SelectedValueChanged(ByVal sender As Object, ByVal e As EventArgs)
If ListBoxStand3.SelectedIndex > -1 Then
ListBoxStand3.Text = ListBoxStand3.SelectedValue.ToString()
End If
End Sub 'ListBoxStand3_SelectedValueChanged
Private Function vbModeless() As Object
Throw New NotImplementedException
End Function
Public Sub SortBox1()
ListBoxStand1.Sorted = True 'Sortieren
ListBoxStand1.Sorted = False 'Sortierung aufheben
anzahl_Items = ListBoxStand1.Items.Count - 1
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand1.Items.Add(ListBoxStand1.Items.Item(i))
Console.WriteLine("Box1: " & ListBoxStand1.Items.Item(i))
Next
'Jetzt noch die alten Einträge entfernen
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand1.Items.RemoveAt(i)
Next
End Sub
Public Sub SortBox2()
ListBoxStand2.Sorted = True 'Sortieren
ListBoxStand2.Sorted = False 'Sortierung aufheben
anzahl_Items = ListBoxStand2.Items.Count - 1
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand2.Items.Add(ListBoxStand2.Items.Item(i))
Console.WriteLine("Box2: " & ListBoxStand2.Items.Item(i))
Next
'Jetzt noch die alten Einträge entfernen
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand2.Items.RemoveAt(i)
Console.WriteLine("Box2: " & ListBoxStand2.Items.Item(i))
Next
End Sub
Public Sub SortBox3()
ListBoxStand3.Sorted = True 'Sortieren
ListBoxStand3.Sorted = False 'Sortierung aufheben
anzahl_Items = ListBoxStand3.Items.Count - 1
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand3.Items.Add(ListBoxStand3.Items.Item(i))
Console.WriteLine("Box3: " & ListBoxStand3.Items.Item(i))
Next
'Jetzt noch die alten Einträge entfernen
For i As Integer = anzahl_Items To 0 Step -1
ListBoxStand3.Items.RemoveAt(i)
Next
End Sub
Public Sub AllDat(DatText, Pfad, Stand)
Select Case Stand
Case "Stand1"
path = "c:\Daten\" & Stand & "\all.dat"
Case "Stand2"
path = "c:\Daten\" & Stand & "\all.dat"
Case "Stand3"
path = "c:\Daten\" & Stand & "\all.dat"
Case "x"
path = "x:\Daten\all.dat"
Case "y"
path = "y:\Daten\all.dat"
Case "z"
path = "z:\Daten\all.dat"
Case Is > "stand1, stand2, stand3, x, y, z"
path = "c:\Daten\all.dat"
End Select
' This text is added only once to the file.
If Not IO.File.Exists(path) Then
' Create a file to write to.
Using sw As IO.StreamWriter = IO.File.CreateText(path)
sw.WriteLine(DatText)
End Using
Else
' This text is always added, making the file longer over time
' if it is not deleted.
Using sw As IO.StreamWriter = IO.File.AppendText(path)
sw.WriteLine(DatText)
End Using
End If
' ====================================
' Testausgabe auf der Console
' ====================================
' Open the file to read from.
' Using sr As StreamReader = File.OpenText(path)
' Do While sr.Peek() >= 0
' Console.WriteLine(sr.ReadLine())
' Loop
' End Using
End Sub
'=========================================
' Netzverbindung mit Ping Prüfungen
'=========================================
Public Function TestIP(ByVal url As String, ByVal maxwait As Integer) As Boolean
Try
Dim result As System.Net.NetworkInformation.PingReply = pinger.Send(IPAkt, maxwait)
If result.Status = Net.NetworkInformation.IPStatus.Success Then
Return True
Else
Return False
End If
Catch
Return False
End Try
End Function
Public Sub ButtonStaendeOnline_Click(sender As System.Object, e As System.EventArgs) Handles ButtonStaendeOnline.Click
' ==============
' Server prüfen
' ==============
IPAkt = IPSvr
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Server-Technik prüfen (Kabel zum Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Case Is = True
msg = IPAkt & " Server ist OK"
ListBoxMeldungView(title, msg)
End Select
' ==================
' Router prüfen
' ==================
IPAkt = IPRtr
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Router-Technik prüfen (Sicherung 4, Kabel, Router)"
ListBoxMeldungView(title, msg)
Case Is = True
msg = IPAkt & " Router ist OK"
ListBoxMeldungView(title, msg)
End Select
' =================
' Stand 1 prüfen
' =================
IPAkt = IPSt1
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand1-Technik prüfen (Sicherung 4, Stand1, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Case Is = True
msg = IPAkt & " Stand1 ist OK"
ListBoxMeldungView(title, msg)
End Select
If Not My.Computer.FileSystem.DirectoryExists("X:\") Then
msg = IPAkt & " Laufwerk X Stand1 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter1
strNetworkShare = strNetworkShare1
strUsername = strUsername1
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End If
Try
Catch ex As System.IO.DirectoryNotFoundException
Select Case IO.Directory.GetDirectories("x:").Length
Case Is > 0
msg = IPAkt & " Laufwerk X Stand1 ist verbunden"
ListBoxMeldungView(title, msg)
Case Is = 0
msg = IPAkt & " Laufwerk X Stand1 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter1
strNetworkShare = strNetworkShare1
strUsername = strUsername1
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End Select
End Try
' ==================
' Stand 2 prüfen
' ==================
IPAkt = IPSt2
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand2-Technik prüfen (Sicherung 4, Stand2, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Case Is = True
msg = IPAkt & " Stand2 ist OK"
ListBoxMeldungView(title, msg)
End Select
If Not My.Computer.FileSystem.DirectoryExists("Y:\") Then
msg = IPAkt & " Laufwerk Y Stand2 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter2
strNetworkShare = strNetworkShare2
strUsername = strUsername2
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End If
Try
Catch ex As System.IO.DirectoryNotFoundException
Select Case IO.Directory.GetDirectories("y:").Length
Case Is > 0
msg = IPAkt & " Laufwerk Y Stand2 ist verbunden"
ListBoxMeldungView(title, msg)
Case Is = 0
msg = IPAkt & " Laufwerk Y Stand2 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter2
strNetworkShare = strNetworkShare2
strUsername = strUsername2
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End Select
End Try
' =================
' Stand 3 prüfen
' =================
IPAkt = IPSt3
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand3-Technik prüfen (Sicherung 4, Stand3, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Case Is = True
msg = IPAkt & " Stand3 ist OK"
ListBoxMeldungView(title, msg)
End Select
If Not My.Computer.FileSystem.DirectoryExists("Z:\") Then
msg = IPAkt & " Laufwerk Z Stand3 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter3
strNetworkShare = strNetworkShare3
strUsername = strUsername3
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End If
Try
Catch ex As System.IO.DirectoryNotFoundException
Select Case IO.Directory.GetDirectories("z:").Length
Case Is > 0
msg = IPAkt & " Laufwerk Z Stand3 ist verbunden"
ListBoxMeldungView(title, msg)
Case Is = 0
msg = IPAkt & " Laufwerk Z Stand3 ist NICHT verbunden, Reparaturversuch läuft"
ListBoxMeldungView(title, msg)
strDriveLetter = strDriveLetter3
strNetworkShare = strNetworkShare3
strUsername = strUsername3
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
End Select
End Try
End Sub
' ==================================================
' Netzwerkfreigaben prüfen und bei Bedarf erstellen
' ==================================================
Public Sub CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
Select Case IO.DriveInfo.GetDrives.Length.ToString(strDriveLetter)
Case Is > ""
msg = IPAkt & " Laufwerk " & strDriveLetter & "ist verbunden"
ListBoxMeldungView(title, msg)
Case Is = ""
msg = IPAkt & " Laufwerk " & strDriveLetter & " ist NICHT verbunden." & vbCr &
"Das System versucht das zu reparieren"
ListBoxMeldungView(title, msg)
System.Diagnostics.Process.Start("net.exe", "use " & strDriveLetter & " " & strNetworkShare & " /user:" & strUsername & " " & strPassword)
End Select
End Sub
Private Sub ButtonHolAktDatStand1_Click(sender As System.Object, e As System.EventArgs) Handles ButtonHolAktDatStand1.Click
'Stand 1 prüfen
IPAkt = IPSt1
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand1-Technik prüfen (Sicherung 4, Stand1, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand1 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"c:\esa",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
My.Computer.FileSystem.DeleteFile(foundFile)
Next
strDriveLetter = strDriveLetter1
strNetworkShare = strNetworkShare1
strUsername = strUsername1
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"x:\intarso\esa2015",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
nameFile = Microsoft.VisualBasic.Right(foundFile, 10)
FileCopy(foundFile, toEsa & nameFile)
FileCopy(foundFile, toDaten & toStand1 & ErgFolder & "\" & nameFile)
msg = IPAkt & " Daten " & nameFile & "von Stand 1 wurden zum Server erfolgreich übertragen. "
ListBoxMeldungView(title, msg)
Next
msg = IPAkt & " Alle Daten Stand 1 können jetzt mit ESA aufgerufen werden."
ListBoxMeldungView(title, msg)
End Select
End Sub
Private Sub ButtonHolAktDatStand2_Click(sender As System.Object, e As System.EventArgs) Handles ButtonHolAktDatStand2.Click
'Stand 2 prüfen
IPAkt = IPSt2
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand2-Technik prüfen (Sicherung 4, Stand2, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand2 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"c:\esa",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
My.Computer.FileSystem.DeleteFile(foundFile)
Next
strDriveLetter = strDriveLetter2
strNetworkShare = strNetworkShare2
strUsername = strUsername2
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"y:\intarso\esa2015",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
nameFile = Microsoft.VisualBasic.Right(foundFile, 10)
FileCopy(foundFile, toEsa & nameFile)
FileCopy(foundFile, toDaten & toStand2 & ErgFolder & "\" & nameFile)
msg = IPAkt & " Daten " & nameFile & "von Stand 2 wurden zum Server erfolgreich übertragen. "
ListBoxMeldungView(title, msg)
Next
msg = IPAkt & " Alle Daten Stand 2 können jetzt mit ESA aufgerufen werden."
ListBoxMeldungView(title, msg)
End Select
End Sub
Private Sub ButtonHolAktDatStand3_Click(sender As System.Object, e As System.EventArgs) Handles ButtonHolAktDatStand3.Click
'Stand 3 prüfen
IPAkt = IPSt3
Select Case TestIP(IPAkt, maxwait)
Case Is = False
msg = IPAkt & " Stand3-Technik prüfen (Sicherung 4, Stand3, Kabel, Router, IP-Adresse)"
ListBoxMeldungView(title, msg)
Return
Case Is = True
msg = IPAkt & " Stand3 ist OK, Verarbeitung geht weiter"
ListBoxMeldungView(title, msg)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"c:\esa",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
My.Computer.FileSystem.DeleteFile(foundFile)
Next
strDriveLetter = strDriveLetter3
strNetworkShare = strNetworkShare3
strUsername = strUsername3
CheckNetDrive(strDriveLetter, strNetworkShare, strUsername, strPassword)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(
"z:\intarso\esa2015",
Microsoft.VisualBasic.FileIO.SearchOption.SearchAllSubDirectories, "herg*.*")
nameFile = Microsoft.VisualBasic.Right(foundFile, 10)
FileCopy(foundFile, toEsa & nameFile)
FileCopy(foundFile, toDaten & toStand3 & ErgFolder & "\" & nameFile)
msg = IPAkt & " Daten " & nameFile & " von Stand 3 wurden zum Server erfolgreich übertragen. "
ListBoxMeldungView(title, msg)
Next
msg = IPAkt & " Alle Daten Stand 3 können jetzt mit ESA aufgerufen werden."
ListBoxMeldungView(title, msg)
End Select
End Sub
Private Sub TextBoxDatum_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBoxDatum.TextChanged
End Sub
Private Sub ButtonExit_Click(sender As System.Object, e As System.EventArgs) Handles ButtonExit.Click
Application.Exit()
End Sub
Private Function StreamReader() As Object
Throw New NotImplementedException
End Function
Private Sub ToolTip1_Popup(sender As System.Object, e As System.Windows.Forms.PopupEventArgs) Handles ToolTip1.Popup
End Sub
Private Sub Filter(p1 As String, p2 As String, p3 As Boolean)
Throw New NotImplementedException
End Sub
Private Sub DataGridViewStand3_CellContentClick(sender As System.Object, e As System.Windows.Forms.DataGridViewCellEventArgs)
End Sub
' ==================================================
' XML Reader
' ==================================================
Public Sub XMLReader(nameDatei, word, Outline)
' ==================================================
' Ergebnisdatei Stand 1 lesen und zur Anzeige aufbereiten
' ==================================================
' Wir benötigen einen XmlReader für das Auslesen der XML-Datei
xmlFile = nameDatei
xmlCounter = 0
xmlGesamt = 0
Dim XMLReader As Xml.XmlReader = New Xml.XmlTextReader(xmlFile)
' Es folgt das Auslesen der XML-Datei
With XMLReader
Do While .Read ' Es sind noch Daten vorhanden
' Welche Art von Daten liegt an?
testParm = .NodeType
Select Case .NodeType
' Ein Element
Case Xml.XmlNodeType.Element
xmlChk = .Name
xmlDepht = .Depth
If xmlChk > "Bezeichnung" AndAlso xmlChk > "TitelName" AndAlso xmlChk > "Gesamt" Then
GoTo Weiter
End If
Console.WriteLine("Es folgt ein Element vom Typ " & .Name)
' Alle Attribute (Name-Wert-Paare) abarbeiten
If .AttributeCount > 0 Then
' Es sind noch weitere Attribute vorhanden
While .MoveToNextAttribute ' nächstes
Console.WriteLine("Feldname: " & .Name &
" -> " &
"Feldwert: " & .Value)
End While
End If
' Ein Text
Case Xml.XmlNodeType.Text
Console.WriteLine("Es folgt ein Text: " & .Value)
' Bzeicnung von Wettbewerb
If .Depth = 2 AndAlso xmlChk = "Bezeichnung" AndAlso xmlCounter 1 Then
Outline = Outline & " " & .Value
xmlCounter = xmlCounter + 1
End If
' TitelName
If .Depth = 4 AndAlso xmlChk = "TitelName" Then
Outline = Outline & " " & .Value
End If
' Gesamt von Probe überspringen
If .Depth = 4 AndAlso xmlChk = "Gesamt" Then
xmlGesamt = xmlGesamt + 1
End If
If .Depth = 6 AndAlso xmlChk = "Gesamt" Then
xmlGesamt = xmlGesamt + 1
End If
' Gesamt von Match übernehmen
If .Depth = 4 AndAlso xmlChk = "Gesamt" AndAlso xmlGesamt > 1 Then
Outline = Outline & " " & .Value
If word = "ListBoxStand1" Then
ListBoxStand1.Items.Add(nameFile & " " & Outline)
End If
If word = "ListBoxStand2" Then
ListBoxStand2.Items.Add(nameFile & " " & Outline)
End If
If word = "ListBoxStand3" Then
ListBoxStand3.Items.Add(nameFile & " " & Outline)
End If
End If
If .Depth = 6 AndAlso xmlChk = "Gesamt" AndAlso xmlGesamt > 1 Then
Outline = Outline & " " & .Value
If word = "ListBoxStand1" Then
ListBoxStand1.Items.Add(nameFile & " " & Outline)
End If
If word = "ListBoxStand2" Then
ListBoxStand2.Items.Add(nameFile & " " & Outline)
End If
If word = "ListBoxStand3" Then
ListBoxStand3.Items.Add(nameFile & " " & Outline)
End If
End If
' Ein Kommentar
Case Xml.XmlNodeType.Comment
Console.WriteLine("Es folgt ein Kommentar: " & .Value)
End Select
Weiter:
Loop ' Weiter nach Daten schauen
.Close() ' XMLTextReader schließen
End With
End Sub
Private Sub XMLReader()
' Wir benötigen einen XmlReader für das Auslesen der XML-Datei
Dim XMLReader As Xml.XmlReader _
= New Xml.XmlTextReader("quickie.xml")
' Es folgt das Auslesen der XML-Datei
With XMLReader
Do While .Read ' Es sind noch Daten vorhanden
' Welche Art von Daten liegt an?
Select Case .NodeType
' Ein Element
Case Xml.XmlNodeType.Element
Console.WriteLine("Es folgt ein Element vom Typ " & .Name)
' Alle Attribute (Name-Wert-Paare) abarbeiten
If .AttributeCount > 0 Then
' Es sind noch weitere Attribute vorhanden
While .MoveToNextAttribute ' nächstes
Console.WriteLine("Feldname: " & .Name &
" -> " &
"Feldwert: " & .Value)
End While
End If
' Ein Text
Case Xml.XmlNodeType.Text
Console.WriteLine("Es folgt ein Text: " & .Value)
' Ein Kommentar
Case Xml.XmlNodeType.Comment
Console.WriteLine("Es folgt ein Kommentar: " & .Value)
End Select
Loop ' Weiter nach Daten schauen
.Close() ' XMLTextReader schließen
End With
' Und so sieht das Ergebnis der Ausgabe aus:
' ------------------------------------------
'Es folgt ein Element vom Typ Personen
'Es folgt ein Element vom Typ Person
'Feldname: Titel -> Feldwert: Dr.
'Feldname: Name -> Feldwert: Meyer
'Feldname: Vorname -> Feldwert: Hans
'Es folgt ein Element vom Typ Person
'Feldname: Titel -> Feldwert:
'Feldname: Name -> Feldwert: Schmidt
'Feldname: Vorname -> Feldwert: Carlos
End Sub
' ==================================================
' Fortschrittsbalken
' ==================================================
Sub ShowProgress(Status As Control, AktDat As Long, AnzDat As Long)
Dim Proz As Integer
Proz = Int((AktDat / AnzDat * 60) + 0.5)
Select Case AktDat
Case 15
Item3 = ""
Case 30
Item3 = ""
Case 45
Item3 = ""
Case 60
Item3 = ""
Case 75
Item3 = ""
Case 90
Item3 = ""
End Select
If Proz 0 Then Proz = 0
If Proz > 100 Then Proz = 100
Dim newStruct As NewStruct = New NewStruct(item1:=Int((Val(Status.Tag) / 100 * Proz) + 0.5), item2:="J")
Status.Text = Item3
Label1.Refresh()
System.Threading.Thread.Sleep(1000)
End Sub
Private Sub TabStand3_ClientSizeChanged(sender As Object, e As EventArgs) Handles TabStand3.ClientSizeChanged
End Sub
End Class
Friend Structure NewStruct
Public Item1 As Double
Public Item2 As String
Public Sub New(item1 As Double, item2 As String)
Me.Item1 = item1
Item3 = item2 + Item3
Me.Item2 = item2 + Item3
End Sub
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is NewStruct) Then
Return False
End If
Dim other = DirectCast(obj, NewStruct)
Return Item1 = other.Item1 AndAlso
Item2 = other.Item2
End Function
Public Overrides Function GetHashCode() As Integer
Return (Item1, Item2).GetHashCode()
End Function
Public Sub Deconstruct(ByRef item1 As Double, ByRef item2 As String)
item1 = Me.Item1
item2 = Me.Item2
End Sub
Public Shared Widening Operator CType(value As NewStruct) As (Double, String)
Return (value.Item1, value.Item2)
End Operator
Public Shared Widening Operator CType(value As (Double, String)) As NewStruct
Return New NewStruct(value.Item1, value.Item2)
End Operator
End Structure
Friend Structure NewStruct
Public Item1 As Double
Public Item2 As String
Public Sub New(item1 As Double, item2 As String)
Me.Item1 = item1
Item3 = item2 + Item3
Me.Item2 = item2 + Item3
End Sub
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is NewStruct) Then
Return False
End If
Dim other = DirectCast(obj, NewStruct)
Return Item1 = other.Item1 AndAlso
Item2 = other.Item2
End Function
Public Overrides Function GetHashCode() As Integer
Return (Item1, Item2).GetHashCode()
End Function
Public Sub Deconstruct(ByRef item1 As Double, ByRef item2 As String)
item1 = Me.Item1
item2 = Me.Item2
End Sub
Public Shared Widening Operator CType(value As NewStruct) As (Double, String)
Return (value.Item1, value.Item2)
End Operator
Public Shared Widening Operator CType(value As (Double, String)) As NewStruct
Return New NewStruct(value.Item1, value.Item2)
End Operator
End Structure
Gruß, Mullit