Pour mon programme d'anagrammes, j'ai récupéré les définitions du dico Larousse en ligne à l'aide du programme qui suit (une variante d'un prog que Dobro avait posté pour récupérer une page internet).
Ca a prit 2 jours et une nuit environ pour les + de 132000 mots.
Je n'ai pas été black listé, ce qui était ma crainte. (ouf !)
Plusieurs semaines plus tard, mon code ne fonctionne plus. "Réessayez plus tard le serveur ne répond pas", pourtant, quand je fais la même recherche avec mon Browser, pas de problème. ( http://www.larousse.fr/dictionnaires/francais/test )
Pouvez vous lancer ce code et me confirmer si vous avez la définition du mot "test" qui s'affiche ou pas ?
Si non, comment peuvent ils me blacklister sans que browser le soit ? J'ai essayé en passant par un VPn même résultat...
Merci.
Code : Tout sélectionner
Structure dico
base.s
def.s
mot.s
EndStructure
Global NewList basedef.dico()
Global Site.s="http://www.larousse.fr/dictionnaires/francais/"
ProcedureDLL.s Url2Text2(Url.s, OpenType.b,ProxyAndPort.s)
; 1 INTERNET_OPEN_TYPE_DIRECT Resolves all host names locally.
; 0 INTERNET_OPEN_TYPE_PRECONFIG Retrieves the proxy Or direct configuration from the registry.
; 4 INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY Retrieves the proxy Or direct configuration from the registry And prevents the use of a startup Microsoft JScript Or Internet Setup (INS) file.
; 3 INTERNET_OPEN_TYPE_PROXY Passes requests To the proxy unless a proxy bypass list is supplied And the name To be resolved bypasses the proxy. In this Case, the function uses INTERNET_OPEN_TYPE_DIRECT.
isLoop.b=1
INET_RELOAD.l = $80000000
hInet.l=0
hURL.l=0
Bytes.l=0
Buffer.s=Space(2048)
RES.s=""
hInet = InternetOpen_("", OpenType, ProxyAndPort, "", 0)
hURL = InternetOpenUrl_(hInet, Url, #Null, 0, INET_RELOAD, 0)
Repeat
InternetReadFile_(hURL,@Buffer, Len(Buffer), @Bytes)
If Bytes = 0
isLoop=0
Else
RES = RES + Left(Buffer, Bytes)
EndIf
Until isLoop=0
InternetCloseHandle_(hURL)
InternetCloseHandle_(hInet)
ProcedureReturn RES
EndProcedure
ProcedureDLL.s Url2Text(Url.s)
ProcedureReturn Url2Text2(Url,1,"")
EndProcedure
Procedure recherchemot(mot$)
a$=url2text(site+mot$)
;base
basen1.i=FindString(a$,"CatgramDefinition")
base.s=Right(a$,Len(a$)-(basen1+18))
basen.i=FindString(base,"</p>")-1
base=Left(base,basen)
If basen1=0
base="definition a rajouter"
EndIf ;problème !!
;End
;definition
defn1=FindString(a$,"ul class="+Chr(34)+"Definitions")
def.s=Right(a$,Len(a$)-(defn1+22))
defn=FindString(def,"</ul>")-1
def.s=Left(def,defn)
If defn1=0
base="definition a rajouter"
def=""
EndIf ;problème !!
If FindString(a$,"par le correcteur")
base="definition absente du dictionnaire"
def=""
EndIf
If Len(base)>0
*membase=AllocateMemory(Len(base)*4)
PokeS(*membase,base,-1,#PB_Ascii)
base=PeekS(*membase,-1,#PB_UTF8)
FreeMemory(*membase)
EndIf
If Len(def)>0
*memdef=AllocateMemory(Len(def)*4)
PokeS(*memdef,def,-1,#PB_Ascii)
def=PeekS(*memdef,-1,#PB_UTF8)
FreeMemory(*memdef)
EndIf
If FindString(base,"<a class="+Chr(34)+"lienconj"+Chr(34)+" href="+Chr(34)+"/conjugaison/francais/")
base=ReplaceString(base,"<a class="+Chr(34)+"lienconj"+Chr(34)+" href="+Chr(34)+"/conjugaison/francais/","")
n=FindString(base,"/")-1
base=Left(base,n)
EndIf
defn=0
While FindString(def,"<li class="+Chr(34)+"DivisionDefinition"+Chr(34)+">",1,#PB_String_NoCase)
defn+1
def=ReplaceString(def,"<li class="+Chr(34)+"DivisionDefinition"+Chr(34)+">","§"+Str(defn)+" ",#PB_String_NoCase,1,1)
Wend
def=ReplaceString(def,"</li>","",1,#PB_String_NoCase)
def=ReplaceString(def,"<span class="+Chr(34)+"ExempleDefinition"+Chr(34)+">"," Ex: ",#PB_String_NoCase)
def=ReplaceString(def,"</span>","",1,#PB_String_NoCase)
def=ReplaceString(def,"<span class="+Chr(34)+"Renvois"+Chr(34)+">","",#PB_String_NoCase)
While FindString(def,"<")
For t=1 To Len(def)
If Mid(def,t,1)="<"
deb=t-1
EndIf
If Mid(def,t,1)=">"
def=Left(def,deb)+Right(def,Len(def)-t)
Break
EndIf
Next t
Wend
While FindString(base,"<")
For t=1 To Len(base)
If Mid(base,t,1)="<"
deb=t-1
EndIf
If Mid(base,t,1)=">"
base=Left(base,deb)+Right(base,Len(base)-t)
Break
EndIf
Next t
Wend
;def
def=ReplaceString(def," :"," ")
def=ReplaceString(def,Chr(9),"")
def=ReplaceString(def," ","")
def=ReplaceString(def,Chr(13),"")
;base
base=ReplaceString(base," :"," ")
base=ReplaceString(base,Chr(9),"")
AddElement(basedef())
basedef()\base=base
basedef()\def=def
basedef()\mot=mot$
EndProcedure
recherchemot("test")
Debug basedef()\mot
Debug basedef()\base
Debug basedef()\def
