• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

David Pintassilgo

box.net search

64 mensagens neste tópico

EDIT:

Versão mais recente:

aqui:

_____________________________________________________________________________

Boas. Aqui há uns dias vi um post do colega pedrotuga e fiquei com o bichinho a roer :D E uma vez que já tinha saudades do VB decidi meter mão á obra.

Desde já os agradecimentos em especial ao NuGunN e ao Pebat que me teem aturado nas ultimas 48Horas (e não só! :D houve mais,.. muitos mais!! :D é que eu não se pode dizer que perceba muito disto )

Tal como o titulo do tópico indica, é um programa que faz pesquisas com a ajuda do google nas partilhas do box.net. Possivelmente não será a forma mais indicada para o fazer, mas para mim está muito bom!  :P Pelo mesmo estou muito contente com isto eheheheh

Os 1º's testes estão feitos e agora se continuar com a pica logo avanço com mais novidade, mas para já podem sacar o código para verem isso a bombar! :D

Código:  http://www.box.net/public/9sm0t6kj2d

EXE:  http://www.box.net/public/92sx6ih2bv

Instalação: http://www.box.net/public/dg5int8hsq (versão beta 0.00000000001)  :D

Private Sub Command1_Click()
Dim errcode As Long
Dim url As String
Dim localFileName As String
Dim paginas As Integer
List1.Clear
localFileName = "teste.html"

For paginas = 0 To 20
pbar1 = paginas
url = "http://www.google.pt/search?q=box.net/public+" & Text1 & "&hl=pt-PT&start=" & paginas * 10 & "&sa=N"

errcode = URLDownloadToFile(0, url, localFileName, 0, 0)

If errcode = 0 Then
    procurar
Else
    MsgBox "Erro durante o download."
    End
End If
Next
pbar1 = 0
End Sub

Function procurar()
Dim html, temp, posicao, codigo As String
Dim tamanho As Integer
Open "teste.html" For Input As #1
Do While Not EOF(1)
    Line Input #1, temp
    html = html & vbCrLf & temp
Loop
tamanho = Len(html)

voltar:
    
    posicao = InStr(html, "<b>box.net/public</b>/")
    If codigo = Mid(html, posicao + 22, 10) Then
    ''nao faz nada
    Else
        codigo = Mid(html, posicao + 22, 10)
        List1.AddItem "www.box.net/public/" & codigo
    End If
    
    html = Mid(html, posicao + 22, tamanho - posicao + 22)
   

   If posicao = "0" Then
   Close #1
    
Else
GoTo voltar
End If


End Function

edit:

Antes disto tinha também feito um teste que á partida eu próprio já estava convencido que não ia obter resultados positivos, mas mesmo assim 'só mesmo naquela' fi-lo na mesma, a ideia seria descobrir url's validos no box.net por força bruta e/ou aleatório. Não funcionou, está claro... :-[

Mas aqui fica o código disso também, poderá interessar a alguém para tirar ideias para outro tipo de coisas que possam sim, ser uteis.

Aqui fica o código do inutilitário!  :cheesygrin:

http://www.box.net/public/tlibvzzyk7

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Cool!

Eheheh, e mais um camarada que entrou no admirável mundo do web-spidering. Yummie yummie mais scripts. :D

Epa... tentei testar isto no windows mas falta uma dependencia :P

COMCTL32.OCX

Nem sei o que é isso.

Já agora... há forma de compilar _VB_ em linux?

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

É pá,.. isso para dar sem erros em todos tenho de criar o pack para instalação que ai leva logo os files todos que é preciso, eu não cheguei a cria-lo porque isso ainda está muito basico mesmo.

Se não conseguirem ver mesmo com o file que o nungun apresentou avisem.

Isso para correr em linux eu já ouvi dizer que há forma de o fazer, no fim talvez me dedique a isso, é uma coisa que tambem gostava de aprender.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Antes disto tinha tambem feito um teste que á partida eu proprio já estava convencido que não ia obter resultados positivos, mas mesmo assim 'só mesmo naquela' fi-lo na mesma, a ideia seria descubrir url's validos no box.net por força bruta e/ou aleatorio. Não funcionou, está claro... :-[

Mas aqui fica o codigo disso tambem, poderá interecar a alguem para tirar ideias para outo tipo de coisas que possam sim, ser uteis.

Aqui fica o codigo do inutilitário!  :cheesygrin:

http://www.box.net/public/tlibvzzyk7

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

ups..... os "senhores do google" não axam piada ao meu programa:

Dizem que tenho algum virus no pc que está a tentar ligar-se de forma automatica .... não é bem um virus,.. sou mesmo eu...:)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

:) já não precebo nada disto,...  já reeiniciei a minha ligação para trocar o ip, e aparentemente esse problema passa temporariamente,.. mas isto já não trabalha mesmo assim. :P Não consigo fazer o donwload da pagina.... que porra...:P

Aqui ficam os files todos "da coisa" até á data. Desisto. 

Mas foi giro ver isto a bombar enquanto dava! eheh

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Isso é que é rapidez.. Pareces eu: começo um projecto hoje, amanhã já nem me lembro dele :)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Isso é que é rapidez.. Pareces eu: começo um projecto hoje, amanhã já nem me lembro dele :)

É que eu até estava cheio da fezada, mas neste momento não consigo fazer NADA com isto. O google corta-me o acesso.

Ver se me lembro de outra coisa qualquer mais fixe para fazer dentro do 'mesmo ramo' :P

edit:

Tenho estado a pensar e axo que tenho uma forma de dar utilidade a isto...  :hmm:

Até amanham!!! :P

(ps: já tou outra vez com a pica toda eheh)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Menos mal,.. talvez só bloquei quando a malta se estica á bruta. (que era o meu caso, cheguei a fazer o download de 2000 paginas nun instantihno....

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

experimenta mudar então.

Já agora afixa aí uns screenshots para o pessoal ver como isso é :cheesygrin:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

é pá,.. eu ontem passei-me logo com isto  :mad: :-[ Mas já me passou :)

Para quem não chegou a ver isto a trabalhar fica aqui o packege (ou lá como é que isso se escreve) para fazer instalação (foi feito á pressa nem testei mas axo que é só instalar isso e tá a andar de mota)

Ficam tb 2 imagens.

http://www.box.net/public/dg5int8hsq

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Epa...não devia falar assim até porque sou moderador aqui n p@p, mas...

iaux.. david, isto é um programa do C...! Brutal!

Tens k mudar isso para a pesquisa que te mostrei senao o google arma-se em carapau de corrida. Muda tambem a user-agent para "MSIE".

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Pessoal,.. o nosso amigo pedrotuga já me deu aqui umas lições de google (este gajo é ma maquina! eheh) e assim do pé pra mão o rendimento do programa cresceu qq coisa como 950%.

Logo Dou novidades! :cheesygrin:

Agora falta-me arranjar maneira de implementar um algoritmo para anular os resuldados não validos, que ainda são bastantes...

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Agora falta fazeres isso numa linguagem multi-plataforma e ficas com um grande programa :cheesygrin:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Isto com calma vai lá! :P é preciso é eu não desmotivar :cheesygrin:

Agora ovu ver se crio um filtro para eliminar alguns resultado 'ranhosos' que me aparecem lá...

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Ora aqui está o procedimento de verificação: :cheesygrin:


Function verificar_codigo(x) As String  '' agradecimento ao "marceluh" pela ajuda neste algoritmo de verificação
    Dim i As Integer
    Dim c As String
    For i = 1 To 10
        c = Mid(x, i, 1)
            Select Case c
                Case "<", ">", "/", "\", ",", "=", "?", "«", "»", "|", "[", "]", "(", ")", "}", "*", "-", "_", "+", "!", "#", "£", "$", "§", "%", "&", ",", "€", ".": verificar = 0
                GoTo fim
            End Select
    Next
    verificar = 1
fim:
End Function

Já elimina praticamente todos os link's errados que apareciam :P

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora