Как остановить программу до изменения файла, а после его изменения перейти на метку

@KVV1963 · Регистрация: 26.12.2020

Студворк — интернет-сервис помощи студентам

VB.NET
1
2
Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Сервер", "Результаты.txt")    'Определение класса обработчика событий
AddHandler fsw.Changed, AddressOf GOTO 1

На такой вариант ругается при написании!

Добавлено через 7 минут
Нужно ли для определения изменения файла закрывать запущенный поток?

VB.NET
1
2
3
Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запускаем поток
...
End Using

и если да то как его закрыть?

Добавлено через 20 минут
без ожидания программа зависает

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Main()
        'Пути к серверу и файлу log
        'Dim PathServer As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\Sam3_DedicatedServer.exe"
        'Dim PathRating As String = "C:\Сервер\Результаты.txt"   'Путь к базе
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
        'IO.File.WriteAllText(PathRating, "")   'Стираем файл log
        'Dim myProcess As Process = System.Diagnostics.Process.Start(PathServer, " +exec " & Chr(34) & "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\config.ini" & Chr(34))  'Запускаем сервер
        Dim Pos As Long = 0  'Номер позиции в потоке
        'Do While myProcess.HasExited = False   'Анализируем данные файла log пока сторонний процесс работает
1:      Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запапускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs, System.Text.Encoding.Default)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        'Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        'РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрок / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
                Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Сервер", "Результаты.txt")    'Определение класса обработчика событий
                'AddHandler fsw.Changed, AddressOf Сообщение
                'If Not (sr Is Nothing) Then sr.Close()  'Закрываем StreamReader
                GoTo 1
            End Using
        End Using
        'Loop
 
        'fs.Close()  'Закрываем FileStream
        'myProcess.WaitForExit()    'Ждём завершения процесса
    End Sub

и выдаёт ошибку "CLR не удалось перейти из COM-контекста 0xb978e0 в COM-контекст 0xb97828 за 60 секунд. Наиболее вероятно, что поток, владеющий контекстом/апартаментом назначения, находится в режиме ожидания или выполнения очень длительной операции без прокачки сообщений Windows. Обычно эта ситуация отрицательно влияет на производительность и даже может привести к зависанию приложения или чрезмерному расходованию памяти. Чтобы избежать этой проблемы, все потоки однопоточного апартамента (STA) должны использовать примитивы ожидания для прокачки (например, CoWaitForMultipleHandles) и периодически прокачивать сообщения во время длительных операций."
Как можно использовать для меня функцию CoWaitForMultipleHandles примеров не нашёл!

Uswer · 08.01.2021, 13:44

Обсуждали уже.

@KVV1963 · 08.01.2021, 15:40 **[ТС]**

Перехват понятен только в процедуру а мне нужно сразу схватить событие и перейти на метку!

@MrCrown · 08.01.2021, 17:30

Сообщение от KVV1963

мне нужно сразу схватить событие и перейти на метку!

KVV1963, совет: забудьте GOTO как страшный сон и никогда его не используйте. Перепишите код с использованием процедур или функций, а также рассмотрите варианты с генерацией собственных событий.

Uswer · 08.01.2021, 19:20

KVV1963, Вы наверное не правильно понимаете принцип работы событий. Забудьте про оператор GOTO.

Кликните здесь для просмотра всего текста

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Imports System.IO
 
Module Module1
    Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Сервер", "Результаты.txt")    'сторож файла
    Dim Pos As Long = 0  'Номер позиции в потоке
 
    Sub Main()
        AddHandler fsw.Changed, AddressOf readResult
    End Sub
 
 
    Public Sub readResult(ByVal sender As Object, ByVal e As System.IO.FileSystemEventArgs)
        'Пути к серверу и файлу log
        'Dim PathServer As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\Sam3_DedicatedServer.exe"
        'Dim PathRating As String = "C:\Сервер\Результаты.txt"   'Путь к базе
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
 
        Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запапускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs, System.Text.Encoding.Default)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрок / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
            End Using
        End Using
    End Sub
 
End Module

Добавлено через 45 секунд
Ой, про GOTO уже написали!

Добавлено через 18 минут
Да, и чтобы завесить приложение измените метод Main так

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
    Sub Main()
        fsw.NotifyFilter = NotifyFilters.LastAccess Or NotifyFilters.LastWrite
        fsw.EnableRaisingEvents = True
 
        AddHandler fsw.Changed, AddressOf readResult
        Dim endApp As Boolean = False
 
        While Not endApp
            Console.WriteLine("For quit enter 'Exit'")
            If Console.ReadLine() = "Exit" Then endApp = True
            Console.WriteLine(vbLf)
        End While
    End Sub

Сообщение ОТРЕДАКТИРОВАЛ.

@KVV1963 · 08.01.2021, 21:33 **[ТС]**

спасибо попробую как вы советуете

@KVV1963 · 09.01.2021, 14:24 **[ТС]**

Не работает ваш вариант на консоли пусто! Где то ошибка!

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
Imports System
Imports System.Diagnostics
Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Module Module1
    'Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Сервер", "Результаты.txt")    'сторож файла
    Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log", "Sam3_DedicatedServer-default-27016.All.log")    'сторож файла
    Dim Pos As Long = 0  'Номер позиции в потоке
    Sub Main()
        fsw.NotifyFilter = NotifyFilters.LastAccess Or NotifyFilters.LastWrite
        fsw.EnableRaisingEvents = True
        AddHandler fsw.Changed, AddressOf readResult
        Dim endApp As Boolean = False
        While Not endApp
            Console.WriteLine("For quit enter 'Exit'")
            If Console.ReadLine() = "Exit" Then endApp = True
            Console.WriteLine(vbLf)
        End While
    End Sub
    Public Sub readResult(ByVal sender As Object, ByVal e As System.IO.FileSystemEventArgs)
        'Пути к серверу и файлу log
        'Dim PathServer As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\Sam3_DedicatedServer.exe"
        'Dim PathRating As String = "C:\Сервер\Результаты.txt"   'Путь к базе
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
        Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запапускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs, System.Text.Encoding.Default)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрок / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
            End Using
        End Using
    End Sub
    Private Sub РейтингИгрока(Данные As String, НомерДействия As Integer)   'Расчёт рейтинга командной игры
        'Dim Подключение = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=С:\Сервер\Сервер.mdb")
        'Dim Подключение = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Сервер\Сервер.mdb")    'Подключение к базе
        Dim Подключение = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Сервер\Отладка.mdb")    'Подключение к базе
        Подключение.Open()
        Dim Команда = New OleDbCommand()
        Команда.Connection = Подключение
        Dim ФрагоРейтингУбившего As Double
        Dim СмертиУбившего As Integer
        Dim РейтингУбившего As Double
        Dim ФрагоРейтингУбитого As Double
        Dim СмертиУбитого As Integer
        Dim РейтингУбитого As Double
        Dim ArrayData(2, 16) As String  '('0 - ID игрока, 1 - Имя игрока, 2- время входа на сервер, 3 - время выхода с сервера)
        Select Case НомерДействия
            Case 1 'Определение режима игры (одиночный/командный) отключён
            Case 2 'Проверка наличия игрока в базе (если нет то запись в базу)
                Команда.CommandText = "Select [ID игрока] From [Результаты] Where [ID игрока]='" & IDИгрока(Данные) & "'"   'Ищем ID игрока в базе
                Команда.ExecuteNonQuery()
                If Команда.ExecuteScalar() = IDИгрока(Данные) Then    'Если есть запись об игроке
                    Команда.CommandText = "SELECT Результаты.Имя FROM Результаты WHERE (((Результаты.[ID игрока])='" & IDИгрока(Данные) & "'))"   'проверка смены имени
                    Команда.ExecuteNonQuery()
                    If Команда.ExecuteScalar() <> ИмяИгрока(Данные) Then    'Если есть имя игрока изменидось то меняем в базе
                        Команда.CommandText = "UPDATE Результаты SET Результаты.Имя = '" & ИмяИгрока(Данные) & "' WHERE(((Результаты.[ID игрока]) ='" & IDИгрока(Данные) & "'))"   'запись имени игрока в базу
                        Команда.ExecuteNonQuery()
                    End If
                Else    'Если нет записи об игроке 
                    Команда.CommandText = "INSERT INTO [Результаты] ([ID игрока], [Имя]) VALUES ('" & IDИгрока(Данные) & "','" & ИмяИгрока(Данные) & "')"   'запись ID игрока Steam в базу
                    Команда.ExecuteNonQuery()
                End If
            Case 4   'Занесение результатов игрока в базу
                'Занесение фрагов и смертей игрока в базу
                Команда.CommandText = "UPDATE Результаты SET Результаты.Смерти = [Результаты]![Смерти]+1 WHERE (((Результаты.[ID игрока])='" & IDУбитогоИгрока(Данные) & "'))"   'запись смертей в базу
                Команда.ExecuteNonQuery()
                If IDУбившегоИгрока(Данные) <> IDУбитогоИгрока(Данные) Then     'не самоубийство
                    Команда.CommandText = "UPDATE Результаты SET Результаты.Фраги = [Результаты]![Фраги]+1 WHERE (((Результаты.[ID игрока])='" & IDУбившегоИгрока(Данные) & "'))"   'запись фрагов в базу
                    Команда.ExecuteNonQuery()
                End If
                'Расчёт рейтинга и фрагорейтинга убившего игрока с записью в базу
                Команда.CommandText = "Select [Рейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Рейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                РейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Фрагорейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Смерти убитого игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбитого = Команда.ExecuteScalar
                If IDУбившегоИгрока(Данные) = IDУбитогоИгрока(Данные) Then GoTo 1     'самоубийство
                If РейтингУбитого = 0 And ФрагоРейтингУбитого = 0 Then
                    ФрагоРейтингУбившего = 0.5
                ElseIf ФрагоРейтингУбитого = 0 Then
                    ФрагоРейтингУбившего = 1 / (СмертиУбитого + 1)
                Else
                    ФрагоРейтингУбившего = РейтингУбитого
                End If
                ФрагоРейтингУбившего = Math.Round(ФрагоРейтингУбившего, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.ФрагоРейтинг = [Результаты]![ФрагоРейтинг]+" & ТочкаЗапятая(ФрагоРейтингУбившего) & " WHERE (((Результаты.[ID игрока])='" & IDУбившегоИгрока(Данные) & "'))"   'запись фрагорейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
                Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбившегоИгрока(Данные) & "'"   'Фрагорейтинг убившего игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбившего = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбившегоИгрока(Данные) & "'"   'Смерти убившего игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбившего = Команда.ExecuteScalar
                If СмертиУбившего = 0 Then
                    РейтингУбившего = ФрагоРейтингУбившего
                Else
                    РейтингУбившего = ФрагоРейтингУбившего / СмертиУбившего
                End If
                РейтингУбившего = Math.Round(РейтингУбившего, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.Рейтинг = " & ТочкаЗапятая(РейтингУбившего) & " WHERE(((Результаты.[ID игрока]) ='" & IDУбившегоИгрока(Данные) & "'))"   'запись рейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
                'Расчёт рейтинга и фрагорейтинга убитого игрока с записью в базу
1:              Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Фрагорейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Смерти убитого игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбитого = Команда.ExecuteScalar
                If РейтингУбитого = 0 And ФрагоРейтингУбитого = 0 Then
                    РейтингУбитого = 0.5
                ElseIf ФрагоРейтингУбитого = 0 Then
                    РейтингУбитого = 1 / (СмертиУбитого + 1)
                Else
                    РейтингУбитого = ФрагоРейтингУбитого / СмертиУбитого
                End If
                РейтингУбитого = Math.Round(РейтингУбитого, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.Рейтинг = " & ТочкаЗапятая(РейтингУбитого) & " WHERE(((Результаты.[ID игрока]) ='" & IDУбитогоИгрока(Данные) & "'))"   'запись рейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
        End Select
        Подключение.Close()
    End Sub
    Public Function IDИгрока(Данные As String) As String    'Выборка из строки ID игрока в Steam 
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStrRev(Данные, "playerid=")
        КонецСтроки = Strings.InStrRev(Данные, "/>")
        IDИгрока = Mid(Данные, НачалоСтроки + 10, ДлинаСтроки - (НачалоСтроки + 10) - (ДлинаСтроки - КонецСтроки + 1))
    End Function
    Public Function ИмяИгрока(Данные As String) As String    'Выборка из строки имени игрока в Steam
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "<playerjoined player=")
        КонецСтроки = Strings.InStr(Данные, Chr(34) & " playerid=")
        ИмяИгрока = Mid(Данные, НачалоСтроки + 22, ДлинаСтроки - (НачалоСтроки + 23) - (ДлинаСтроки - КонецСтроки - 1))
    End Function
    Public Function IDУбитогоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "playerid=")
        КонецСтроки = Strings.InStr(Данные, "killerclass=")
        IDУбитогоИгрока = Mid(Данные, НачалоСтроки + 10, ДлинаСтроки - (НачалоСтроки + 10) - (ДлинаСтроки - КонецСтроки + 2))
    End Function
    Public Function IDУбившегоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStrRev(Данные, "killerplayerid=")
        КонецСтроки = Strings.InStrRev(Данные, "/>")
        IDУбившегоИгрока = Mid(Данные, НачалоСтроки + 16, ДлинаСтроки - (НачалоСтроки + 16) - (ДлинаСтроки - КонецСтроки + 1))
    End Function
    Public Function ТочкаЗапятая(Число As Double) As String    'Преобразование запятой в точку
        Dim Строка As String
        Строка = CStr(Число)
        Строка = Строка.Replace(",", ".")
        ТочкаЗапятая = Строка
    End Function
End Module

Добавлено через 6 минут
В процедуру readResult не переходит!

Uswer · 09.01.2021, 14:54

KVV1963, я проверял, код рабочий. Вероятно сторож не генерирует событие потому, что log-файл игрушка держит открытым постоянно пока запущена сама. Система просто не видит изменения в свойствах файла. Попробуйте расширить список отслеживаемых параметров так:

VB.NET
1
fsw.NotifyFilter = NotifyFilters.LastAccess Or NotifyFilters.LastWrite Or NotifyFilters.Size

Добавлено через 4 минуты
KVV1963, у меня маленький вопрос к Вам. Почему Вы пишите консольное приложение? Я бы написал обычное "форточное" приложение, окно при старте скрывал, а в трее поместил бы иконку с контекстным меню.

@KVV1963 · 09.01.2021, 15:39 **[ТС]**

Наверно дело в том что файл постоянно открыт игровым сервером и пока сервер не закроется изменений не видно. А если открыть его в WIn то они видны, но только что есть на момент открытия! Что бы увидеть текущие изменения надо его снова закрыть и открыть! Мне кажется поэтому

VB.NET
1
AddHandler fsw.Changed, AddressOf readResult

ни чего и не ловит!

Добавлено через 1 минуту
Мой вариант в онлайне работает но виснет может нужно сделать останов по таймеру таймеру на 10 мин?

Добавлено через 2 минуты
Пробую!

Добавлено через 4 минуты
Нет не ловит(((( Помогите пожалуйста с таймером на 10 мин!

Добавлено через 2 минуты
Консольное что бы наблюдать при отладке

Добавлено через 3 минуты
Попробую закрыть и открыть сервер - должно же тогда сработать!

Добавлено через 3 минуты
да при закрытие сервера всё работает!

Добавлено через 2 минуты
Как выкрутится? Может таймер 10 мин матч как раз столько длится? Что посоветуете? Все ждут результатов в онлайне(((( Ваш код просто прелесть вообще ресурсов не жрёт но не видит изменений!

Добавлено через 4 минуты
В Win то я изменения вижу при открытие файла! Может нужно открывать и закрывать файл через определённое время?

Uswer · 09.01.2021, 16:44

Сообщение от KVV1963

Консольное что бы наблюдать при отладке

В студии есть замечательное окно куда можно делать вывод при отладке приложений WinForms. Кстати команды вывода точно такие же Console.WriteLine.

@KVV1963 · 09.01.2021, 16:51 **[ТС]**

Как это окно может мне помочь?

Добавлено через 2 минуты
Получается для онлайна выход у меня только один - останов по таймеру на 5 мин и опрос 1 мин?

Uswer · 09.01.2021, 17:09

Сообщение от KVV1963

Как выкрутится? Может таймер 10 мин

На таймере.

Кликните здесь для просмотра всего текста

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Imports System.IO
Imports System.Timers
 
Module Module1
    Dim Pos As Long = 0  'Номер позиции в потоке
    Dim AppTimer As New System.Timers.Timer
 
    Sub Main()
        AppTimer.Interval = 600000 'интервал 10 мин, при отладке можно задать меньше
        AddHandler AppTimer.Elapsed, AddressOf AppTimer_Tick
        AppTimer.Start()
 
        Dim endApp As Boolean = False
        Console.WriteLine("For quit enter 'Exit'")
        While Not endApp
            If Console.ReadLine() = "Exit" Then
                endApp = True
            End If
            Console.WriteLine(vbLf)
        End While
    End Sub
 
    Public Sub AppTimer_Tick(ByVal source As Object, ByVal e As ElapsedEventArgs)
        readResult()
    End Sub
 
    Public Sub readResult()
        'Пути к серверу и файлу log
        'Dim PathServer As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\Sam3_DedicatedServer.exe"
        'Dim PathRating As String = "C:\Сервер\Результаты.txt"   'Путь к базе
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
        Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs, System.Text.Encoding.Default)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрок / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
            End Using
        End Using
    End Sub
 
End Module

Добавлено через 1 минуту

Сообщение от KVV1963

Как это окно может мне помочь?

В это окно выводятся отладочные сообщения.

@KVV1963 · 09.01.2021, 18:49 **[ТС]**

Пробую!

Добавлено через 1 час 29 минут
Вы просто мастер работает и не сбивается! Сделал 30 секунд паузу и всё ок! Только убрал из

VB.NET
1
Using sr As New StreamReader(fs, System.Text.Encoding.Default)

System.Text.Encoding.Default иначе русский шрифт переводит в ероглифы! большое вам спасибо!!!!!!!!!!!!

Добавлено через 46 секунд
И ресурсов совсем не жрёт!

Добавлено через 2 минуты
Мой вариант был значительно хуже.

Uswer · 09.01.2021, 19:02

Сообщение от KVV1963

Вы просто мастер

"Я не волшебник, я только учусь." Из к/ф "Золушка".

@KVV1963 · 09.01.2021, 19:31 **[ТС]**

Знаю))))))

@KVV1963 · 28.01.2021, 18:59 **[ТС]**

Ну и попал я с этим таймером))) Оказывается что он считывает файл не до конца а только на сколько установишь! И тогда позиция начинает теряться! В онлайне всё ок а вот если пересчитывать длинный лог то циклиться! Поставил опрос лога до таймера - теперь он считывает его до конца и ждёт обновления! также возникала ошибка доступа к базе данных из за постоянного закрытия и открытия базы данных в процедуре расчёта и записи - теперь постоянно держу базу открытой и закрываю только после выхода из программы! Не получается копирование файлов в начале программы выдаёт ошибку! Пока в комментариях в чём проблема не понимаю((((((

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
Imports System
Imports System.Diagnostics
Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports System.Timers
Module Module1
    Dim fsw As FileSystemWatcher = New FileSystemWatcher("C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log", "Sam3_DedicatedServer-default-27016.All.log")    'Запуск потока
    Dim Pos As Long = 0  'Номер позиции в потоке
    Dim AppTimer As New System.Timers.Timer
    Dim Подключение = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Сервер\Сервер.mdb")    'Подключение к базе
    Sub Main()
        'Dim sourceFileName As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
        'Dim destFileName As String = "C:\Cервер\Log\" & Now.ToLongDateString & "_" & Now.ToLongTimeString & ".txt"
        'Dim destFileName As String = "C:\Cервер\log\10012021.log"
        'File.Copy(sourceFileName, destFileName, True)
        'File.WriteAllText(sourceFileName, "")
        Dim PathServer As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Bin\Sam3_DedicatedServer.exe"   'Путь к серверу
        Подключение.Open()
        readResult()
        AppTimer.Interval = 30000 'интервал 30 сек
        AddHandler AppTimer.Elapsed, AddressOf AppTimer_Tick
        AppTimer.Start()
        Dim endApp As Boolean = False
        Console.WriteLine("For quit enter 'Exit'")
        While Not endApp
            If Console.ReadLine() = "Exit" Then
                endApp = True
            End If
            Console.WriteLine(vbLf)
        End While
        Подключение.Close()
    End Sub
    Public Sub AppTimer_Tick(ByVal source As Object, ByVal e As ElapsedEventArgs)
        readResult()
    End Sub
    Public Sub readResult()
        'Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"   'Путь к логу сервера
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-19.01.2021.log"   'Путь к логу сервера
        Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрока / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
            End Using
        End Using
    End Sub
    Private Sub РейтингИгрока(Данные As String, НомерДействия As Integer)   'Расчёт рейтинга командной игры
        'Dim Подключение = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Сервер\Сервер.mdb")    'Подключение к базе
        'Подключение.Open()
        Dim Команда = New OleDbCommand()
        Команда.Connection = Подключение
        Dim ФрагоРейтингУбившего As Double
        Dim СмертиУбившего As Integer
        Dim РейтингУбившего As Double
        Dim ФрагоРейтингУбитого As Double
        Dim СмертиУбитого As Integer
        Dim РейтингУбитого As Double
        Dim ArrayData(2, 16) As String  '('0 - ID игрока, 1 - Имя игрока, 2- время входа на сервер, 3 - время выхода с сервера)
        Select Case НомерДействия
            Case 1 'Определение режима игры (одиночный/командный) отключён
            Case 2 'Проверка наличия игрока в базе (если нет то запись в базу)
                Команда.CommandText = "Select [ID игрока] From [Результаты] Where [ID игрока]='" & IDИгрока(Данные) & "'"   'Ищем ID игрока в базе
                Команда.ExecuteNonQuery()
                If Команда.ExecuteScalar() = IDИгрока(Данные) Then    'Если есть запись об игроке
                    Команда.CommandText = "SELECT Результаты.Имя FROM Результаты WHERE (((Результаты.[ID игрока])='" & IDИгрока(Данные) & "'))"   'проверка смены имени
                    Команда.ExecuteNonQuery()
                    If Команда.ExecuteScalar() <> ИмяИгрока(Данные) Then    'Если есть имя игрока изменидось то меняем в базе
                        Команда.CommandText = "UPDATE Результаты SET Результаты.Имя = '" & ИмяИгрока(Данные) & "' WHERE(((Результаты.[ID игрока]) ='" & IDИгрока(Данные) & "'))"   'запись имени игрока в базу
                        Команда.ExecuteNonQuery()
                    End If
                Else    'Если нет записи об игроке 
                    Команда.CommandText = "INSERT INTO [Результаты] ([ID игрока], [Имя]) VALUES ('" & IDИгрока(Данные) & "','" & ИмяИгрока(Данные) & "')"   'запись ID Steam и имени игрока в базу
                    Команда.ExecuteNonQuery()
                End If
            Case 4   'Занесение результатов игрока в базу
                'Проверка наличия убитого игрока в базе (если нет то запись в базу)
                Команда.CommandText = "Select [ID игрока] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Ищем ID игрока в базе
                Команда.ExecuteNonQuery()
                If Команда.ExecuteScalar() = IDУбитогоИгрока(Данные) Then    'Если есть запись об игроке
                    Команда.CommandText = "SELECT Результаты.Имя FROM Результаты WHERE (((Результаты.[ID игрока])='" & IDУбитогоИгрока(Данные) & "'))"   'проверка смены имени
                    Команда.ExecuteNonQuery()
                    If Команда.ExecuteScalar() <> ИмяУбитогоИгрока(Данные) Then    'Если есть имя игрока изменидось то меняем в базе
                        Команда.CommandText = "UPDATE Результаты SET Результаты.Имя = '" & ИмяУбитогоИгрока(Данные) & "' WHERE(((Результаты.[ID игрока]) ='" & IDИгрока(Данные) & "'))"   'запись имени игрока в базу
                        Команда.ExecuteNonQuery()
                    End If
                Else    'Если нет записи об игроке 
                    Команда.CommandText = "INSERT INTO [Результаты] ([ID игрока], [Имя]) VALUES ('" & IDУбитогоИгрока(Данные) & "','" & ИмяУбитогоИгрока(Данные) & "')"   'запись ID Steam и имени игрока в базу
                    Команда.ExecuteNonQuery()
                End If
                'Проверка наличия убившего игрока в базе (если нет то запись в базу)
                Команда.CommandText = "Select [ID игрока] From [Результаты] Where [ID игрока]='" & IDУбившегоИгрока(Данные) & "'"   'Ищем ID игрока в базе
                Команда.ExecuteNonQuery()
                If Команда.ExecuteScalar() = IDУбившегоИгрока(Данные) Then    'Если есть запись об игроке
                    Команда.CommandText = "SELECT Результаты.Имя FROM Результаты WHERE (((Результаты.[ID игрока])='" & IDУбившегоИгрока(Данные) & "'))"   'проверка смены имени
                    Команда.ExecuteNonQuery()
                    If Команда.ExecuteScalar() <> ИмяУбившегоИгрока(Данные) Then    'Если есть имя игрока изменидось то меняем в базе
                        Команда.CommandText = "UPDATE Результаты SET Результаты.Имя = '" & ИмяУбившегоИгрока(Данные) & "' WHERE(((Результаты.[ID игрока]) ='" & IDУбившегоИгрока(Данные) & "'))"   'запись имени игрока в базу
                        Команда.ExecuteNonQuery()
                    End If
                Else    'Если нет записи об игроке 
                    Команда.CommandText = "INSERT INTO [Результаты] ([ID игрока], [Имя]) VALUES ('" & IDУбившегоИгрока(Данные) & "','" & ИмяУбившегоИгрока(Данные) & "')"   'запись ID Steam и имени игрока в базу
                    Команда.ExecuteNonQuery()
                End If
                'Занесение фрагов и смертей игрока в базу
                Команда.CommandText = "UPDATE Результаты SET Результаты.Смерти = [Результаты]![Смерти]+1 WHERE (((Результаты.[ID игрока])='" & IDУбитогоИгрока(Данные) & "'))"   'запись смертей в базу
                Команда.ExecuteNonQuery()
                If IDУбившегоИгрока(Данные) <> IDУбитогоИгрока(Данные) Then     'не самоубийство
                    Команда.CommandText = "UPDATE Результаты SET Результаты.Фраги = [Результаты]![Фраги]+1 WHERE (((Результаты.[ID игрока])='" & IDУбившегоИгрока(Данные) & "'))"   'запись фрагов в базу
                    Команда.ExecuteNonQuery()
                End If
                'Расчёт рейтинга и фрагорейтинга убившего игрока с записью в базу
                Команда.CommandText = "Select [Рейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Рейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                РейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Фрагорейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Смерти убитого игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбитого = Команда.ExecuteScalar
                If IDУбившегоИгрока(Данные) = IDУбитогоИгрока(Данные) Then GoTo 1     'самоубийство
                If РейтингУбитого = 0 And ФрагоРейтингУбитого = 0 Then
                    ФрагоРейтингУбившего = 0.5
                ElseIf ФрагоРейтингУбитого = 0 Then
                    ФрагоРейтингУбившего = 1 / (СмертиУбитого + 1)
                Else
                    ФрагоРейтингУбившего = РейтингУбитого
                End If
                ФрагоРейтингУбившего = Math.Round(ФрагоРейтингУбившего, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.ФрагоРейтинг = [Результаты]![ФрагоРейтинг]+" & ТочкаЗапятая(ФрагоРейтингУбившего) & " WHERE (((Результаты.[ID игрока])='" & IDУбившегоИгрока(Данные) & "'))"   'запись фрагорейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
                Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбившегоИгрока(Данные) & "'"   'Фрагорейтинг убившего игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбившего = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбившегоИгрока(Данные) & "'"   'Смерти убившего игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбившего = Команда.ExecuteScalar
                If СмертиУбившего = 0 Then
                    РейтингУбившего = ФрагоРейтингУбившего
                Else
                    РейтингУбившего = ФрагоРейтингУбившего / СмертиУбившего
                End If
                РейтингУбившего = Math.Round(РейтингУбившего, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.Рейтинг = " & ТочкаЗапятая(РейтингУбившего) & " WHERE(((Результаты.[ID игрока]) ='" & IDУбившегоИгрока(Данные) & "'))"   'запись рейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
                'Расчёт рейтинга и фрагорейтинга убитого игрока с записью в базу
1:              Команда.CommandText = "Select [ФрагоРейтинг] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Фрагорейтинг убитого игрока в базе
                Команда.ExecuteNonQuery()
                ФрагоРейтингУбитого = Команда.ExecuteScalar
                Команда.CommandText = "Select [Смерти] From [Результаты] Where [ID игрока]='" & IDУбитогоИгрока(Данные) & "'"   'Смерти убитого игрока в базе
                Команда.ExecuteNonQuery()
                СмертиУбитого = Команда.ExecuteScalar
                If РейтингУбитого = 0 And ФрагоРейтингУбитого = 0 Then
                    РейтингУбитого = 0.5
                ElseIf ФрагоРейтингУбитого = 0 Then
                    РейтингУбитого = 1 / (СмертиУбитого + 1)
                Else
                    РейтингУбитого = ФрагоРейтингУбитого / СмертиУбитого
                End If
                РейтингУбитого = Math.Round(РейтингУбитого, 3)
                Команда.CommandText = "UPDATE Результаты SET Результаты.Рейтинг = " & ТочкаЗапятая(РейтингУбитого) & " WHERE(((Результаты.[ID игрока]) ='" & IDУбитогоИгрока(Данные) & "'))"   'запись рейтинга убившего игрока в базу
                Команда.ExecuteNonQuery()
        End Select
        'Подключение.Close()
    End Sub
    Public Function IDИгрока(Данные As String) As String    'Выборка из строки ID игрока в Steam 
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStrRev(Данные, "playerid=")
        КонецСтроки = Strings.InStrRev(Данные, "/>")
        IDИгрока = Mid(Данные, НачалоСтроки + 10, ДлинаСтроки - (НачалоСтроки + 10) - (ДлинаСтроки - КонецСтроки + 1))
    End Function
    Public Function ИмяИгрока(Данные As String) As String    'Выборка из строки имени игрока в Steam
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "<playerjoined player=")
        КонецСтроки = Strings.InStr(Данные, Chr(34) & " playerid=")
        ИмяИгрока = Mid(Данные, НачалоСтроки + 22, ДлинаСтроки - (НачалоСтроки + 23) - (ДлинаСтроки - КонецСтроки - 1))
    End Function
    Public Function IDУбитогоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "playerid=")
        КонецСтроки = Strings.InStr(Данные, "killerclass=")
        IDУбитогоИгрока = Mid(Данные, НачалоСтроки + 10, ДлинаСтроки - (НачалоСтроки + 10) - (ДлинаСтроки - КонецСтроки + 2))
    End Function
    Public Function IDУбившегоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStrRev(Данные, "killerplayerid=")
        КонецСтроки = Strings.InStrRev(Данные, "/>")
        IDУбившегоИгрока = Mid(Данные, НачалоСтроки + 16, ДлинаСтроки - (НачалоСтроки + 16) - (ДлинаСтроки - КонецСтроки + 1))
    End Function
    Public Function ИмяУбитогоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "<playerkilled player=")
        КонецСтроки = Strings.InStr(Данные, "playerid=")
        ИмяУбитогоИгрока = Mid(Данные, НачалоСтроки + 22, ДлинаСтроки - (НачалоСтроки + 22) - (ДлинаСтроки - КонецСтроки + 2))
    End Function
    Public Function ИмяУбившегоИгрока(Данные As String) As String    'Выборка из строки ID убитого игрока
        Dim ДлинаСтроки As Integer
        Dim НачалоСтроки As Integer
        Dim КонецСтроки As Integer
        ДлинаСтроки = Strings.Len(Данные)
        НачалоСтроки = Strings.InStr(Данные, "killerplayer=")
        КонецСтроки = Strings.InStr(Данные, "killerplayerid=")
        ИмяУбившегоИгрока = Mid(Данные, НачалоСтроки + 14, ДлинаСтроки - (НачалоСтроки + 14) - (ДлинаСтроки - КонецСтроки + 2))
    End Function
    Public Function ТочкаЗапятая(Число As Double) As String    'Преобразование запятой в точку
        Dim Строка As String
        Строка = CStr(Число)
        Строка = Строка.Replace(",", ".")
        ТочкаЗапятая = Строка
    End Function
End Module

А во остальном всем большое спасибо, очень сильно помогли мне! Без вас бы не справился точно! Очень благодарен всем! Этот рейтинг можно использовать для любого лога игры - это не тупой просчёт фрагов и смертей!, с исправлениями конечно, если кого заинтересует алгоритм - пишите и помогите пожалуйста с копированием файла и дозаписью в сохранённый лог файл!

Добавлено через 6 минут
Игроки все очень рады рейтингу и я тоже)))

Uswer · 28.01.2021, 21:19

KVV1963, а можно как-то понятней объяснить что именно не получается?

@KVV1963 · 29.01.2021, 14:16 **[ТС]**

Есть файл лога сервера "Sam3_DedicatedServer-default-27016.All.log". Перед включением сервера она должна скопировать этот файл с изменением его имени на текущая "дата_время" а затем стереть информацию из файла лога. При запуске ставит красный крест на File.Copy и выдаёт ошибку System.NotSupportedException: "Данный формат пути не поддерживается."

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Imports System
Imports System
Imports System.Diagnostics
Imports System.IO
Imports System.Data
Imports System.Data.OleDb
Imports System.Timers
Module Module1
    Sub Main()
        Dim sourceFileName As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"
        Dim destFileName As String = "C:\Cервер\Log\" & Now.ToLongDateString & "_" & Now.ToLongTimeString & ".log"
        File.Copy(sourceFileName, destFileName, True)
        File.WriteAllText(sourceFileName, "")
    End Sub
End Module

Добавлено через 44 минуты
К сожалению есть и другая проблема в коде указанном выше! Приложение через 15-30 мин переходит в режим приостановки выполнения. Помощник по отладке управляемого кода "ContextSwitchDeadlock" : "CLR не удалось перейти из COM-контекста 0xa28108 в COM-контекст 0xa28050 за 60 секунд. Наиболее вероятно, что поток, владеющий контекстом/апартаментом назначения, находится в режиме ожидания или выполнения очень длительной операции без прокачки сообщений Windows. Обычно эта ситуация отрицательно влияет на производительность и даже может привести к зависанию приложения или чрезмерному расходованию памяти. Чтобы избежать этой проблемы, все потоки однопоточного апартамента (STA) должны использовать примитивы ожидания для прокачки (например, CoWaitForMultipleHandles) и периодически прокачивать сообщения во время длительных операций." Как от этого избавиться не знаю((( Когда запускаешь кнопкой продолжить - всё нормально позицию лога помнит, а когда я скомпилирую и она перейдёт в режим приостановки выполнения, как я буду из спячки её выводить?

Добавлено через 2 минуты
Что значит прокачивать сообщения во время длительных операций?

Добавлено через 13 минут
И ещё одна проблема при таймере в 30 сек она не успевает обработать большой лог и уходит из процедуры не дойдя до Pos = fs.Position а после возвращается с Pos =0 и зацикливается. Получается что таймер через 30 сек прекращает работу процедуры и опять на 30 сек переходит в режим ожидания? Эту проблему я решил перед запуском таймера я я сначала запускаю процедуру! Но в онлайне желательно как то подстраховаться.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Public Sub readResult()
        Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-27016.All.log"   'Путь к логу сервера
        'Dim PathRating As String = "C:\Program Files (x86)\Steam\steamapps\common\Serious Sam 3\Log\Sam3_DedicatedServer-default-01.2021.log"   'Путь к логу сервера
        Using fs As New FileStream(PathRating, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) 'Запускаем поток
            fs.Position = Pos   'Текущая позиция потока
            Using sr As New StreamReader(fs)
                While Not sr.EndOfStream
                    Dim line As String = sr.ReadLine()
                    If Strings.InStr(line, "roundstart") <> 0 Then  'Начало нового раунда / определение режима игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 1)
                    ElseIf Strings.InStr(line, "playerjoined") <> 0 Then  'Игрок зашёл в игру
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 2)
                    ElseIf Strings.InStr(line, "playerleft") <> 0 Then  'Игрок вышел из игры
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 3)
                    ElseIf Strings.InStr(line, "playerkilled") <> 0 Then  'Игрок убил другого игрока / игрок убил сам себя
                        Console.WriteLine(line) 'Вывод на консоль нужной строки блока
                        РейтингИгрока(line, 4)
                    ElseIf Strings.InStr(line, "Client 0 disconnected") <> 0 Then  'Все игроки вышли из игры
                        РейтингИгрока(line, 5)
                    End If
                End While
                Pos = fs.Position
            End Using
        End Using
    End Sub

Добавлено через 1 час 32 минуты
опять остановилась в онлайне может паузу уменьшить?

Uswer · 29.01.2021, 18:40

Сообщение от KVV1963

на File.Copy и выдаёт ошибку System.NotSupportedException: "Данный формат пути не поддерживается."

Ну это проще пареной репы! Дело в том, что функция Now.ToLongTimeString возвращает строку времени с недопустимым для пути символом ":". Перед генерацией строки пути используйте преобразование времени к необходимому формату. Посмотрите здесь.
По второй проблеме опять не понял, но скорее всего надо сделать так:

VB.NET
1
2
3
4
5
Public Sub AppTimer_Tick(ByVal source As Object, ByVal e As ElapsedEventArgs)
    AppTimer.Stop()
    readResult()
    AppTimer.Start()
End Sub

Добавлено через 26 минут
Пример замены двоеточия:

VB.NET
1
2
3
4
5
Dim NowTimeString As String = DateTime.Now.ToLongTimeString '13:45:30
Dim timeSeparatorChar As String = CultureInfo.CurrentCulture.DateTimeFormat.TimeSeparator
NowTimeString = Replace(NowTimeString, timeSeparatorChar, "-") '13-45-30
 
Dim destFileName As String = "C:\Cервер\Log\" & Now.ToLongDateString & "_" & NowTimeString & ".log"

С этим куском пути "C:\Cервер\Log" тоже лучше разобраться через методы System.IO.Path.

@Sklifosofsky · 29.01.2021, 21:07

Сообщение от KVV1963

"CLR не удалось перейти из COM-контекста 0xa28108 в COM-контекст 0xa28050 за 60 секунд

Если память не подводит, то это из-за ole вылезает. Я в код особо не вглядывался, но вроде есть у вас не закрытые подключения к oleDb. Попробуйте мультипоточный режим запуска активировать. В ole есть свои потоки прокачки, а курирующая консоль в однопоточном режиме (STA) при приостановке своих цикла(ов) может помешать работе ole.

VB.NET
1
2
3
4
<MTAThread()> _
Sub Main()
'...
End Sub

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

Uswer 2282 / 1598 / 400 Регистрация: 26.06.2017 Сообщений: 4,732 Записей в блоге: 1
	08.01.2021, 13:44
	Обсуждали уже. 0

@KVV1963 0 / 0 / 0 Регистрация: 26.12.2020 Сообщений: 89
	08.01.2021, 15:40 [ТС]
	Перехват понятен только в процедуру а мне нужно сразу схватить событие и перейти на метку! 0

@KVV1963 0 / 0 / 0 Регистрация: 26.12.2020 Сообщений: 89
	08.01.2021, 21:33 [ТС]
	спасибо попробую как вы советуете 0

@KVV1963 0 / 0 / 0 Регистрация: 26.12.2020 Сообщений: 89
	09.01.2021, 16:51 [ТС]
	Как это окно может мне помочь? Добавлено через 2 минуты Получается для онлайна выход у меня только один - останов по таймеру на 5 мин и опрос 1 мин? 0

@KVV1963 0 / 0 / 0 Регистрация: 26.12.2020 Сообщений: 89
	09.01.2021, 19:31 [ТС]
	Знаю)))))) 0

Uswer 2282 / 1598 / 400 Регистрация: 26.06.2017 Сообщений: 4,732 Записей в блоге: 1
	28.01.2021, 21:19
	KVV1963, а можно как-то понятней объяснить что именно не получается? 0

Как остановить программу до изменения файла, а после его изменения перейти на метку

Решение