Парсер Delux_plus
-
Наверно большинство знакомо с этим парсером. С сегодняшнего дня он перестал парсить таблицы чемпов в связи с обновлением всех лайвскор сайтов.
Может есть умельцы которые смогли бы его починить, не думаю что там сильно поменялся код.
Или есть к кому обратиться? Нужен знающий человек. Алгоритмы нафиг не нужны, они не работают, нужна только статистика по играм.Sub getGame(id As String) Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False Application.StatusBar = False timezone = Sheets("Старт").Range("T2").Value - 1 sourcer = Sheets("Старт").Range("X2").Value If sourcer = 1 Then sourcer = "flashscore.com/" suffix = "_en_1_" ElseIf sourcer = 2 Then sourcer = "soccerstand.com/" suffix = "_en_1_" ElseIf sourcer = 3 Then sourcer = "soccerstand.com/ru/" suffix = "_ru_1" ElseIf sourcer = 4 Then sourcer = "myscore.ru/" suffix = "_ru_1" ElseIf sourcer = 5 Then sourcer = "myscore.com.ua/" suffix = "_ru_1" End If clearParsed 'Get Teams ID Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://www." & sourcer & "match/" & id & "/", False http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "participantEncodedIds = [\'(.*)\',\'(.*)\']" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) ActiveCell.Offset(, -2).Value = objMatches.Item(0).submatches(0) ActiveCell.Offset(, -1).Value = objMatches.Item(0).submatches(1) home_id = objMatches.Item(0).submatches(0) away_id = objMatches.Item(0).submatches(1) country_id = ActiveCell.Offset(, -3).Value End If objRegExp.Pattern = "tournamentStageEncodedId = \'(.*?)\'" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) tournament_stage_id = objMatches.Item(0).submatches(0) End If objRegExp.Pattern = "tournamentEncodedId = \'(.*?)\'" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) tournament_id = objMatches.Item(0).submatches(0) End If a = 2 'Get H2H Sheets("Очные").Range("A1").Value = ActiveCell.Offset(, -6).Value Sheets("Очные").Range("B1").Value = ActiveCell.Offset(, -5).Value Sheets("ОчныеДГ").Range("A1").Value = ActiveCell.Offset(, -6).Value Sheets("ОчныеДГ").Range("B1").Value = ActiveCell.Offset(, -5).Value Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/d_hh_" & id & suffix, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = "<table class=" & Chr(34) & "head_to_head h2h_mutual" & Chr(34) & ">(.*?)<\/table>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) fs_input = objMatches.Item(0).submatches(0) objRegExp.Pattern = "<span class=" & Chr(34) & "date" & Chr(34) & ">(.*?)<\/span>(.*?)title=" & Chr(34) & "(.*?)" & Chr(34) & "(.*?)class=" & Chr(34) & "name" & Chr(34) & "><span>(.*?)<\/span><\/td><td class=" & Chr(34) & "name" & Chr(34) & "><span>(.*?)<\/span>(.*?)<strong>(.*?) : (.*?)<\/strong>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка очных...") For Each m In objMatches If bShowBar Then Call MyProgresBar objRegExp.Pattern = "<strong>" m_home = objRegExp.Replace(m.submatches(4), "") m_away = objRegExp.Replace(m.submatches(5), "") objRegExp.Pattern = "<\/strong>" m_home = objRegExp.Replace(m_home, "") m_away = objRegExp.Replace(m_away, "") m_date = DateAdd("s", m.submatches(0), "01/01/1970") date_match = DateAdd("h", timezone, date_match) m_date = Format(m_date, "yyyy.mm.dd") If m_date = Format(Now, "yyyy.mm.dd") Or m_date = Format(Now - 1, "yyyy.mm.dd") Then Else Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "\s\(...\)" m_home = objRegExp.Replace(m_home, "") m_away = objRegExp.Replace(m_away, "") Sheets("Очные").Range("A" & a).Value = m.submatches(2) Sheets("Очные").Range("B" & a).Value = Format(m_date, "yyyy.mm.dd hh:mm") Sheets("Очные").Range("C" & a).Value = m_home Sheets("Очные").Range("D" & a).Value = m_away Sheets("Очные").Range("E" & a).Value = m.submatches(7) Sheets("Очные").Range("F" & a).Value = m.submatches(8) If m_home = Sheets("Очные").Range("A1").Value Then Sheets("ОчныеДГ").Range("A" & a).Value = m.submatches(2) m_date = DateAdd("s", m.submatches(0), "01/01/1970") Sheets("ОчныеДГ").Range("B" & a).Value = Format(m_date, "yyyy.mm.dd hh:mm") Sheets("ОчныеДГ").Range("C" & a).Value = m_home Sheets("ОчныеДГ").Range("D" & a).Value = m_away Sheets("ОчныеДГ").Range("E" & a).Value = m.submatches(7) Sheets("ОчныеДГ").Range("F" & a).Value = m.submatches(8) End If a = a + 1 End If Next If bShowBar Then Unload frmStatusBar End If End If Sheets("Очные").Range("A:F").Sort Key1:=Sheets("Очные").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("ОчныеДГ").Range("A:F").Sort Key1:=Sheets("ОчныеДГ").Columns("B"), Header:=xlYes, Order1:=xlDescending a = 2 'Get Home Matches Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/pr_1_" & country_id & "_" & home_id & "_0_0_ru_1", False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText fs_rows = Split(fs_input, "~") fs_rows_length = UBound(fs_rows) - LBound(fs_rows) Call Show_PrBar_Or_No(fs_rows_length, "Загрузка домашних...") For i = 0 To fs_rows_length - 4 If bShowBar Then Call MyProgresBar fs_row = Split(fs_rows(i), "¬") fs_row_length = UBound(fs_row) - LBound(fs_row) fs_index = Split(fs_row(0), ChrW(&HF7)) If IsArray(fs_index) Then fs_index_name = fs_index(0) fs_index_value = fs_index(1) End If If fs_index_name = "SA" Then sport_id = fs_index_value ElseIf fs_index_name = "ZA" Then tour_name = "" home_name = "" For j = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(j), ChrW(&HF7)) If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1) If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1) Next j ElseIf fs_index_name = "AA" Then home_name = "" For j = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(j), ChrW(&HF7)) If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1) If fs_row_parts(0) = "AD" Then date_match = DateAdd("s", fs_row_parts(1), "01/01/1970") date_match = DateAdd("h", timezone, date_match) date_match = Format(date_match, "yyyy.mm.dd hh:mm") End If If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1) If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1) If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1) If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1) If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1) If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1) If fs_row_parts(0) = "PX" Then home_id2 = fs_row_parts(1) Next j If fs_index_value = id Then home_name = "" End If If tour_name = "" Or home_name = "" Then Else Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "\s\(...\)" home_name = objRegExp.Replace(home_name, "") away_name = objRegExp.Replace(away_name, "") Sheets("Дома").Range("A" & a).Value = tour_name Sheets("Дома").Range("B" & a).Value = date_match Sheets("Дома").Range("C" & a).Value = home_name Sheets("Дома").Range("D" & a).Value = away_name Sheets("Дома").Range("E" & a).Value = home_first Sheets("Дома").Range("F" & a).Value = away_first Sheets("Дома").Range("G" & a).Value = home_second Sheets("Дома").Range("H" & a).Value = away_second If home_id2 = home_id Then Sheets("Дома").Range("I" & a).Value = "Дома" Sheets("ДомаДома").Range("A" & a).Value = tour_name Sheets("ДомаДома").Range("B" & a).Value = date_match Sheets("ДомаДома").Range("C" & a).Value = home_name Sheets("ДомаДома").Range("D" & a).Value = away_name Sheets("ДомаДома").Range("E" & a).Value = home_first Sheets("ДомаДома").Range("F" & a).Value = away_first Sheets("ДомаДома").Range("G" & a).Value = home_second Sheets("ДомаДома").Range("H" & a).Value = away_second Sheets("ДомаДома").Range("I" & a).Value = "Дома" Else Sheets("Дома").Range("I" & a).Value = "Гости" Sheets("ДомаГости").Range("A" & a).Value = tour_name Sheets("ДомаГости").Range("B" & a).Value = date_match Sheets("ДомаГости").Range("C" & a).Value = home_name Sheets("ДомаГости").Range("D" & a).Value = away_name Sheets("ДомаГости").Range("E" & a).Value = home_first Sheets("ДомаГости").Range("F" & a).Value = away_first Sheets("ДомаГости").Range("G" & a).Value = home_second Sheets("ДомаГости").Range("H" & a).Value = away_second Sheets("ДомаГости").Range("I" & a).Value = "Гости" End If a = a + 1 End If Next i If bShowBar Then Unload frmStatusBar Sheets("Дома").Range("A:I").Sort Key1:=Sheets("Дома").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("ДомаДома").Range("A:I").Sort Key1:=Sheets("ДомаДома").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("ДомаГости").Range("A:I").Sort Key1:=Sheets("ДомаГости").Columns("B"), Header:=xlYes, Order1:=xlDescending a = 2 'Get Away Macthes Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/pr_1_" & country_id & "_" & away_id & "_0_0_ru_1", False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText fs_rows = Split(fs_input, "~") fs_rows_length = UBound(fs_rows) - LBound(fs_rows) Call Show_PrBar_Or_No(fs_rows_length, "Загрузка гостевых...") For i = 0 To fs_rows_length - 4 If bShowBar Then Call MyProgresBar fs_row = Split(fs_rows(i), "¬") fs_row_length = UBound(fs_row) - LBound(fs_row) fs_index = Split(fs_row(0), ChrW(&HF7)) If IsArray(fs_index) Then fs_index_name = fs_index(0) fs_index_value = fs_index(1) End If If fs_index_name = "SA" Then sport_id = fs_index_value ElseIf fs_index_name = "ZA" Then tour_name = "" home_name = "" For j = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(j), ChrW(&HF7)) If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1) If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1) Next j ElseIf fs_index_name = "AA" Then home_name = "" For j = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(j), ChrW(&HF7)) If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1) If fs_row_parts(0) = "AD" Then date_match = DateAdd("s", fs_row_parts(1), "01/01/1970") date_match = DateAdd("h", timezone, date_match) date_match = Format(date_match, "yyyy.mm.dd hh:mm") End If If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1) If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1) If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1) If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1) If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1) If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1) If fs_row_parts(0) = "PY" Then away_id2 = fs_row_parts(1) Next j If fs_index_value = id Then home_name = "" End If If tour_name = "" Or home_name = "" Then Else Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Pattern = "\s\(...\)" home_name = objRegExp.Replace(home_name, "") away_name = objRegExp.Replace(away_name, "") Sheets("Гости").Range("A" & a).Value = tour_name Sheets("Гости").Range("B" & a).Value = date_match Sheets("Гости").Range("C" & a).Value = home_name Sheets("Гости").Range("D" & a).Value = away_name Sheets("Гости").Range("E" & a).Value = home_first Sheets("Гости").Range("F" & a).Value = away_first Sheets("Гости").Range("G" & a).Value = home_second Sheets("Гости").Range("H" & a).Value = away_second If away_id2 = away_id Then Sheets("Гости").Range("I" & a).Value = "Гости" Sheets("ГостиГости").Range("A" & a).Value = tour_name Sheets("ГостиГости").Range("B" & a).Value = date_match Sheets("ГостиГости").Range("C" & a).Value = home_name Sheets("ГостиГости").Range("D" & a).Value = away_name Sheets("ГостиГости").Range("E" & a).Value = home_first Sheets("ГостиГости").Range("F" & a).Value = away_first Sheets("ГостиГости").Range("G" & a).Value = home_second Sheets("ГостиГости").Range("H" & a).Value = away_second Sheets("ГостиГости").Range("I" & a).Value = "Гости" Else Sheets("Гости").Range("I" & a).Value = "Дома" Sheets("ГостиДома").Range("A" & a).Value = tour_name Sheets("ГостиДома").Range("B" & a).Value = date_match Sheets("ГостиДома").Range("C" & a).Value = home_name Sheets("ГостиДома").Range("D" & a).Value = away_name Sheets("ГостиДома").Range("E" & a).Value = home_first Sheets("ГостиДома").Range("F" & a).Value = away_first Sheets("ГостиДома").Range("G" & a).Value = home_second Sheets("ГостиДома").Range("H" & a).Value = away_second Sheets("ГостиДома").Range("I" & a).Value = "Дома" End If a = a + 1 End If Next i If bShowBar Then Unload frmStatusBar Sheets("Гости").Range("A:I").Sort Key1:=Sheets("Гости").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("ГостиДома").Range("A:I").Sort Key1:=Sheets("ГостиДома").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("ГостиГости").Range("A:I").Sort Key1:=Sheets("ГостиГости").Columns("B"), Header:=xlYes, Order1:=xlDescending a = 2 'Get Table Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_overall?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText 'MsgBox fs_input Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Общая...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Таблица").Range("A" & a).Value = m.submatches(1) Sheets("Таблица").Range("B" & a).Value = m.submatches(6) Sheets("Таблица").Range("C" & a).Value = m.submatches(9) Sheets("Таблица").Range("D" & a).Value = m.submatches(12) Sheets("Таблица").Range("E" & a).Value = m.submatches(15) Sheets("Таблица").Range("F" & a).Value = m.submatches(18) Sheets("Таблица").Range("G" & a).Value = m.submatches(21) Sheets("Таблица").Range("H" & a).Value = m.submatches(22) Sheets("Таблица").Range("I" & a).Value = m.submatches(25) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If a = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_home?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Дома...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Таблица").Range("K" & a).Value = m.submatches(1) Sheets("Таблица").Range("L" & a).Value = m.submatches(6) Sheets("Таблица").Range("M" & a).Value = m.submatches(9) Sheets("Таблица").Range("N" & a).Value = m.submatches(12) Sheets("Таблица").Range("O" & a).Value = m.submatches(15) Sheets("Таблица").Range("P" & a).Value = m.submatches(18) Sheets("Таблица").Range("Q" & a).Value = m.submatches(21) Sheets("Таблица").Range("R" & a).Value = m.submatches(22) Sheets("Таблица").Range("S" & a).Value = m.submatches(25) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If a = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_table_away?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка таблицы Гости...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Таблица").Range("U" & a).Value = m.submatches(1) Sheets("Таблица").Range("V" & a).Value = m.submatches(6) Sheets("Таблица").Range("W" & a).Value = m.submatches(9) Sheets("Таблица").Range("X" & a).Value = m.submatches(12) Sheets("Таблица").Range("Y" & a).Value = m.submatches(15) Sheets("Таблица").Range("Z" & a).Value = m.submatches(18) Sheets("Таблица").Range("AA" & a).Value = m.submatches(21) Sheets("Таблица").Range("AB" & a).Value = m.submatches(22) Sheets("Таблица").Range("AC" & a).Value = m.submatches(25) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If a = 2 'Get Form Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_overall?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка формы Общая...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Форма").Range("A" & a).Value = m.submatches(1) Sheets("Форма").Range("B" & a).Value = m.submatches(6) Sheets("Форма").Range("C" & a).Value = m.submatches(9) Sheets("Форма").Range("D" & a).Value = m.submatches(12) Sheets("Форма").Range("E" & a).Value = m.submatches(15) Sheets("Форма").Range("F" & a).Value = m.submatches(18) Sheets("Форма").Range("G" & a).Value = m.submatches(21) Sheets("Форма").Range("H" & a).Value = m.submatches(22) Sheets("Форма").Range("I" & a).Value = m.submatches(25) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If a = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_home?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка формы Дома...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Форма").Range("K" & a).Value = m.submatches(1) Sheets("Форма").Range("L" & a).Value = m.submatches(6) Sheets("Форма").Range("M" & a).Value = m.submatches(9) Sheets("Форма").Range("N" & a).Value = m.submatches(12) Sheets("Форма").Range("O" & a).Value = m.submatches(15) Sheets("Форма").Range("P" & a).Value = m.submatches(18) Sheets("Форма").Range("Q" & a).Value = m.submatches(21) Sheets("Форма").Range("R" & a).Value = m.submatches(22) Sheets("Форма").Range("S" & a).Value = m.submatches(25) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If a = 2 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", "https://d." & sourcer & "x/feed/ss_1_" & tournament_id & "_" & tournament_stage_id & "_form_away?hp1=" & home_id & "&hp2=" & away_id & "&e=" & id, False http.setRequestHeader "X-Fsign", "SW9D1eZo" http.Send fs_input = http.ResponseText Set objRegExp = CreateObject("VBScript.RegExp") objRegExp.Global = True objRegExp.MultiLine = False objRegExp.Pattern = Chr(9) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(10) fs_input = objRegExp.Replace(fs_input, "") objRegExp.Pattern = Chr(13) fs_input = objRegExp.Replace(fs_input, "") If InStr(1, fs_input, "col_wins_pen") = 0 And InStr(1, fs_input, "col_wins_ot") = 0 Then objRegExp.Pattern = "<tr(.*?)>([0-9]+)\.<(.*?)>(.*?)team_name_span(.*?)>(.*?)>(.*?)<(.*?)col_matches_played(.*?)>(.*?)<(.*?)wins(.*?)>(.*?)<(.*?)draws(.*?)>(.*?)<(.*?)losses(.*?)>(.*?)<(.*?)goals(.*?)>(.*?):(.*?)<(.*?)points(.*?)>(.*?)<\/td>" If objRegExp.test(fs_input) = True Then Set objMatches = objRegExp.Execute(fs_input) cntx = objMatches.Count Call Show_PrBar_Or_No(cntx, "Загрузка формы Гости...") For Each m In objMatches If bShowBar Then Call MyProgresBar Sheets("Форма").Range("U" & a).Value = m.submatches(1) Sheets("Форма").Range("V" & a).Value = m.submatches(6) Sheets("Форма").Range("W" & a).Value = m.submatches(9) Sheets("Форма").Range("X" & a).Value = m.submatches(12) Sheets("Форма").Range("Y" & a).Value = m.submatches(15) Sheets("Форма").Range("Z" & a).Value = m.submatches(18) Sheets("Форма").Range("AA" & a).Value = m.submatches(21) Sheets("Форма").Range("AB" & a).Value = m.submatches(22) Sheets("Форма").Range("AC" & a).Value = m.submatches(15) a = a + 1 Next If bShowBar Then Unload frmStatusBar End If End If getOdds (id) Sheets("Расчеты").Range("A1").Value = id Sheets("Анализ").Select Application.ScreenUpdating = True Application.Calculation = xlAutomatic Application.EnableEvents = True Application.StatusBar = True End Sub -
Вот ссылка
-
Ну где-то регулярка сломалась, что уж тут, но в чужих регулярках разбираться - чёрт ногу сломит.
Вообще я в шоке, такой программный комплекс на базе экселя реализовывать - чего только люди не сделают, лишь бы не делать нормально. -
ура, починили! можно удалять
-
Этим парсером можно поделиться? Был бы благодарен.
-
Oddsportal тоже обновился?
-
-
@paradox вроде нет
-
@dimok этот самый простой, есть реально монстры)) у меня есть один: парсит одспортал(какие хочешь бк и виды ставок можно задать), тащит xg c другого сайта + составы. всё эксель) но долго.
-
Ну можно сделать простейшую программку, которая будет нормально всё парсить и тащить и выводить в красивом интерфейсе.
Это намного проще, чем извращаться с экселем. -
Вы не боитесь что через подобные программы вы можете предоставить доступ к своему ПК.
Может в этом ответ почему какой то EXCEL а не вполне себе работоспособные программы на каком нибудь Python? -
Подобные программы надо на удалённых серверах запускать и оставлять там постоянно работать, тогда и данные будут свежие и доступ откуда угодно.
-
@cool что мешает если страшно запустить на другом компе и просмотреть макросы.
программы конечно разные бывают, именно за этот файл не ручаюсь, попросили скинуть - скинул. у меня на базе этого парсер, но алгоритмы свои, и я там знаю всё вдоль и поперёк.Ну и конечно когда пользуетесь софтом непонятного происхождения, то лучше не держать там парольные фразы от крипты)
-
@cool если вы считаете эксель "каким-то", то вы просто ничего о нём не знаете
-
Hi i have a file similar in code but structure is a bit different ,it calculates probabilities as it goes through each match.But the problem is the same because of changes it can not get the leagues aswellBetFile.rar
-
File uploaded with my previous post
-
this piece of code has recently stopped working hope someone can fix.
этот фрагмент кода недавно перестал работать, надеюсь, кто-нибудь сможет исправить.'Get Home Matches
rowindx = 2 Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") oXMLHTTP.Open "GET", "https://d." & Sourcer & "x/feed/pr_1_" & country_id & "_" & participantEncodedIds1 & "_0_0_ru_1", False oXMLHTTP.setRequestHeader "X-Fsign", "SW9D1eZo" oXMLHTTP.Send response = oXMLHTTP.ResponseText fs_rows = Split(response, "~") fs_rows_length = UBound(fs_rows) - LBound(fs_rows) Call Show_PrBar_Or_No(fs_rows_length, "Loading home ...") For i = 0 To fs_rows_length - 4 If bShowBar Then Call MyProgresBar fs_row = Split(fs_rows(i), "¬") fs_row_length = UBound(fs_row) - LBound(fs_row) fs_index = Split(fs_row(0), ChrW(&HF7)) If IsArray(fs_index) Then fs_index_name = fs_index(0) fs_index_value = fs_index(1) End If If fs_index_name = "SA" Then sport_id = fs_index_value ElseIf fs_index_name = "ZA" Then tour_name = "" home_name = "" For J = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(J), ChrW(&HF7)) If fs_row_parts(0) = "ZA" Then tour_name = fs_row_parts(1) If fs_row_parts(0) = "ZB" Then country_id = fs_row_parts(1) If fs_row_parts(0) = "ZC" Then tour_id = fs_row_parts(1) Next J ElseIf fs_index_name = "AA" Then home_name = "" For J = 0 To fs_row_length - 1 fs_row_parts = Split(fs_row(J), ChrW(&HF7)) If fs_row_parts(0) = "AA" Then match_id = fs_row_parts(1) If fs_row_parts(0) = "AD" Then date_match = DateAdd("s", fs_row_parts(1), "01/01/1970") date_match = DateAdd("h", timezone, date_match) date_match = Format(date_match, "yyyy.mm.dd hh:mm") End If If fs_row_parts(0) = "AA" Then idios = fs_row_parts(1) If fs_row_parts(0) = "AE" Then home_name = fs_row_parts(1) If fs_row_parts(0) = "AF" Then away_name = fs_row_parts(1) If fs_row_parts(0) = "BA" Then home_first = fs_row_parts(1) If fs_row_parts(0) = "BB" Then away_first = fs_row_parts(1) If fs_row_parts(0) = "BC" Then home_second = fs_row_parts(1) If fs_row_parts(0) = "BD" Then away_second = fs_row_parts(1) If fs_row_parts(0) = "PX" Then participantEncodedIds12 = fs_row_parts(1) Set oRegExp = CreateObject("VBScript.RegExp") oRegExp.Pattern = "\s\(...\)" home_name = oRegExp.Replace(home_name, "") away_name = oRegExp.Replace(away_name, "") Next J 'If fs_index_value = id Then home_name = "" End If If tour_name = "" Or home_name = "" Then Else Sheets("Athome").Range("A" & rowindx).Value = tour_name Sheets("Athome").Range("B" & rowindx).Value = date_match Sheets("Athome").Range("C" & rowindx).Value = home_name Sheets("Athome").Range("D" & rowindx).Value = away_name Sheets("Athome").Range("E" & rowindx).Value = home_first Sheets("Athome").Range("F" & rowindx).Value = away_first Sheets("Athome").Range("G" & rowindx).Value = home_second Sheets("Athome").Range("H" & rowindx).Value = away_second If participantEncodedIds12 = participantEncodedIds1 Then Sheets("Athome").Range("I" & rowindx).Value = "Athome" Sheets("Athome2").Range("A" & rowindx).Value = tour_name Sheets("Athome2").Range("B" & rowindx).Value = date_match Sheets("Athome2").Range("C" & rowindx).Value = home_name Sheets("Athome2").Range("D" & rowindx).Value = away_name Sheets("Athome2").Range("E" & rowindx).Value = home_first Sheets("Athome2").Range("F" & rowindx).Value = away_first Sheets("Athome2").Range("G" & rowindx).Value = home_second Sheets("Athome2").Range("H" & rowindx).Value = away_second Sheets("Athome2").Range("I" & rowindx).Value = "Athome" Else Sheets("Athome").Range("I" & rowindx).Value = "Guests" Sheets("Athome3").Range("A" & rowindx).Value = tour_name Sheets("Athome3").Range("B" & rowindx).Value = date_match Sheets("Athome3").Range("C" & rowindx).Value = home_name Sheets("Athome3").Range("D" & rowindx).Value = away_name Sheets("Athome3").Range("E" & rowindx).Value = home_first Sheets("Athome3").Range("F" & rowindx).Value = away_first Sheets("Athome3").Range("G" & rowindx).Value = home_second Sheets("Athome3").Range("H" & rowindx).Value = away_second Sheets("Athome3").Range("I" & rowindx).Value = "Guests" End If rowindx = rowindx + 1 End If Next i If bShowBar Then Unload frmStatusBar Sheets("Athome").Range("A:I").Sort Key1:=Sheets("Athome").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("Athome2").Range("A:I").Sort Key1:=Sheets("Athome2").Columns("B"), Header:=xlYes, Order1:=xlDescending Sheets("Athome3").Range("A:I").Sort Key1:=Sheets("Athome3").Columns("B"), Header:=xlYes, Order1:=xlDescending
