Jump to content

Recommended Posts

Posted (edited)

Um Bem Aja 

Tenho uma rotina com a finalidade do assunto em titulo que não consigo pôr a funcionar corretamente.

A mesma rotina com as devidas alterações funciona para a chave do Totoloto

Agradeço uma ajuda, Junto código

Private Sub butChaveMilhao_Click(sender As Object, e As EventArgs) Handles butChaveMilhao.Click


        Dim oWebRequest As WebRequest
        Dim oWebResponse As WebResponse = Nothing
        Dim strBuffer As String = ""
        Dim objSR As StreamReader = Nothing
        Dim leitor As Object
        Dim ler As Boolean = False
        Dim valores As String = String.Empty
        Dim i As Integer = 0

        Dim num_final As String = String.Empty
        Dim estrela_final As String = String.Empty

        'conecta com o website
        Try
            oWebRequest = HttpWebRequest.Create("https://www.jogossantacasa.pt/web/SCCartazResult/m1lhao")
            oWebResponse = oWebRequest.GetResponse()
            'Le a resposta do web site e armazena em uma stream
            objSR = New StreamReader(oWebResponse.GetResponseStream)
            strBuffer = objSR.ReadToEnd
            leitor = Split(strBuffer, vbNewLine)

            For Each linha In leitor
                If ler = True Then
                    valores += linha.ToString + vbNewLine
                    i += 1
                End If

                'If linha.Contains("Ordem Saída:") Then
                '    ler = True
                'End If

                If linha.Contains("CÓDIGO") Then
                    ler = True
                End If


                'Altera o formato da data do sorteio para verificar se corresponde a data do sorteio que o Site apresenta 
                Dim TestString As String = String.Format("{0:dd/MM/yyyy}", DateTimePicker1.Value)
                ' Returns "Shipping List".
                aString = Replace(TestString, "-", "/")
               
                If linha.Contains("Data do Sorteio") Then

                    If Not linha.Contains(aString) Then
                        MsgBox("DATA NÃO CORRESPONDE AO SORTEIO", MsgBoxStyle.Information, "Data do Sorteio Incorreta")
                        Exit Sub
                    End If

                    'Obtem o valor da linha Retira caracteres a string
                    Label5.Text = Trim(linha.ToString) 'ove(0, 58))

                    ' Label15.Text = linha.ToString
                End If
  
               If i > 10 Then
                    ler = False
               End If
            Next

        Catch ex As Exception
            MsgBox(ex.ToString)
        Finally
            objSR.Close()
            oWebResponse.Close()
        End Try

        'Retira caracteres a string
        Label6.Text = Label5.Text.Remove(80, 9)

        'Obter dados do Site da Santa Casa
        Dim WC1 As New Net.WebClient

        Dim Rsp1 As String = WC1.DownloadString("https://www.jogossantacasa.pt/web/SCCartazResult/m1lhao")

        Dim m As Match = Regex.Match(Rsp1, "<li>(?<resultado>(?<num1>\d+) (?<num2>\d+) (?<num3>\d+) (?<num4>\d+) (?<num5>\d+) (?<num6>\d+) (?<num7>\d+) (?<num8>\d+) (?<num9>\d+))</li>", RegexOptions.IgnoreCase)


        MsgBox("Data do Sorteio: " & aString & vbNewLine & vbNewLine & "Chave: " & m.Groups("resultado").ToString(), MsgBoxStyle.Information, "Obter Chave do Totoloto da Santa Casa")

        ' MsgBox("CÓDIGO: " & m.Groups("resultado").ToString(), MsgBoxStyle.Information, "Obter Chave Totoloto da Santa Casa")

        'Transfere on numeros para as caixas de texto
        TextBox1.Text = m.Groups("num1").ToString()
        TextBox2.Text = m.Groups("num2").ToString()
        TextBox3.Text = m.Groups("num3").ToString()
        TextBox4.Text = m.Groups("num4").ToString()
        TextBox5.Text = m.Groups("num5").ToString()
        TextBox6.Text = m.Groups("NUM6").ToString()
        TextBox7.Text = m.Groups("NUM7").ToString()
        TextBox8.Text = m.Groups("NUM8").ToString()
        TextBox9.Text = m.Groups("NUM9").ToString()

 

Edited by Chamuanza
Posted

O que significa "não consigo pôr a funcionar corretamente"?

Algum erro? Os named capture groups não trazem o que é suposto?

Sérgio Ribeiro


"Great coders aren't born. They're compiled and released"
"Expert coders do not need a keyboard. They just throw magnets at the RAM chips"

Posted
Quote

' Returns "Shipping List".

Copiaste isto de outro sítio? 😀

Não tenho forma de testar o código no local onde me encontro, mas quando se copia o código de outro sítio tende-se, assumo, a não olhar para o detalhe, porque na nossa cabeça o bloco todo já deveria estar a funcionar.

Sugiro que apagues tudo e que recomeces linha por linha, validando cada passo do resultado. Muitas vezes até descobres maneiras melhores de fazer o mesmo.

Se mesmo assim não dás com a coisa, quando puder verifico. 

Sérgio Ribeiro


"Great coders aren't born. They're compiled and released"
"Expert coders do not need a keyboard. They just throw magnets at the RAM chips"

  • 2 weeks later...
Posted

Olá ribeiro55

Tenho rabiado com o problema mas não consigo que a rotina leia a linha correspondente do site que assinalo em baixo

31. 1.� Pr�mio

32. MTK33215

a numeração foi atribuida no Word depois de copiar os dados do site da respectiva página. 

no código acima alterei 

' If linha.Contains("CÓDIGO") Then

por

If linha.Contains(" 1.� Pr�mio") Then

Ler = True

End If

e assim faz Ler=True

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.