Lire page web
detbour
Messages postés
11
Date d'inscription
jeudi 19 juin 2008
Statut
Membre
Dernière intervention
19 septembre 2009
-
8 nov. 2008 à 19:20
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 9 nov. 2008 à 16:29
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 9 nov. 2008 à 16:29
1 réponse
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
9 nov. 2008 à 16:29
9 nov. 2008 à 16:29
salut,
possible oui, après il y a une gymnastique dépendante de la page en question
1. récupérer la source de la page, avec ce code par exemple :
<hr />
' RÉCUPÉRER LA SOURCE D'UNE PAGE DANS UNE VARIABLE STRING PAR
API
' http://www.codyx.org/snippet_recuperer-source-page-dans-variable-string-api_620.aspx#1877
' Posté par [ 401740 PCPT ] le 09/06/2008
<hr />
Private Declare Function
DeleteFile
Lib
"kernel32"
Alias
"DeleteFileA"
(
ByVal
lpFileName
As String
)
As Long
Private Declare Function
URLDownloadToFile
Lib
"urlmon"
Alias
"URLDownloadToFileA"
(
ByVal
pCaller
As Long
,
ByVal
szURL
As String
,
ByVal
szFileName
As String
,
ByVal
dwReserved
As Long
,
ByVal
lpfnCB
As Long
)
As
Long
Function GetStringSourceFromOnlineFile(ByVal
sUrl As String) As String
' récupère un nom de fichier temporaire
Dim sTempDest As String
sTempDest = GetUniqueTempFileName '
http://www.codyx.org/snippet_generer-nom-fichier-temporaire-unique_619.aspx#1876
' télécharge la page
If URLDownloadToFile(0&, sUrl, sTempDest, 0&, 0&) = 0
Then
' on lit le
fichier
Dim FF As Integer
FF = FreeFile
Open sTempDest For Input As #FF
GetStringSourceFromOnlineFile = Input(LOF(FF), 1)
Close #FF
' supprime le fichier temp
Call DeleteFile(sTempDest)
End If
End Function
'----------------------------------------------------------------
'Remarques :
'Label1.AutoSize = True
'Label1.Caption = "Mon IP WAN : " &
GetStringSourceFromOnlineFile("http://www.whatismyip.org")
'
'
'
'nécessite
ce snippet :
http://www.codyx.org/snippet_generer-nom-fichier-temporaire-unique_619.aspx#1876
2. récupérer les chaînes utiles
en nettoyant les textes parasites
voir alors avec
*les fonctions INSTR, INSTRREV, MID$, LEFT$, RIGHT$, REPLACE, JOIN, SPLIT (documentées, [F1])
*ou avec ce code qui peut aider :
<hr />
' RÉCUPÉRER UNE CHAÎNE (INCONNUE) PLACÉE ENTRE DEUX CHAÎNES
(CONNUES)
' http://www.codyx.org/snippet_recuperer-chaine-inconnue-placee-entre-deux-chaines-connues_334.aspx#1043
' Posté par [ =401740 PCPT ] le 04/03/2007
<hr />
Private Function
MyMid(
ByRef
Expression
As String
, sLeft
As String
, sRight
As String
,
Optional
Start
As Long
=
1
)
As
String
Dim lPosL As Long, lPosR As Long lPosL InStr(Start, Expression, sLeft): lPosR InStr(lPosL + 1, Expression,
sRight)
If lPosL > 0 And lPosR > 0 Then
MyMid = Mid$(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
Else
MyMid = vbNullString
End If
End Function
'EXEMPLE D'UTILISATION
Private Sub Form_Load()
Dim sStr As String
MsgBox MyMid("
machin
", "'>", "</")
Unload Me
End Sub
*ou celui-ci :
<hr />
' SPLIT SUR PLUSIEURS CRITÈRES
' http://www.codyx.org/snippet_split-sur-plusieurs-criteres_233.aspx#754
' Posté par [ =401740 PCPT ] le 19/09/2006
<hr />
Function
MultiSplit(
ByVal
sStr
As String
, bKeepSepar
As Boolean
,
ParamArray
aArray())
As String
()
' sStr -> chaîne à parser
' bKeepSepar -> garder ou non les caractères de
référence
' aArray -> tableau des
références de taille variables
Dim sCol As New Collection
Dim sChar As String, sLeft As String
Dim bFound As Boolean
Dim aRes() As String
Dim i As Integer, j As Integer, NbCarac As
Integer
i = 0
While LenB(sStr) > 0
i = i + 1
bFound = False
For j = LBound(aArray) To UBound(aArray)
NbCarac = Len(aArray(j))
sChar = Mid$(sStr, i, NbCarac)
If sChar = CStr(aArray(j)) Then bFound = True: Exit
For
Next j
If bFound Then
sLeft = Left$(sStr, i - 1)
If LenB(sLeft) > 0 Then sCol.Add sLeft
If bKeepSepar Then sCol.Add sChar
sStr = Right$(sStr, Len(sStr) - (NbCarac + (i - 1)))
i = 0
ElseIf sChar = vbNullString Then
sCol.Add sStr
sStr = vbNullString
End If
Wend
ReDim aRes(sCol.Count - 1)
For i = 1 To sCol.Count
aRes(i - 1) = sCol.Item(i)
Next i
MultiSplit = aRes
Set sCol = Nothing
Erase aRes
End Function
' EXEMPLE D'UTILISATION
Private Sub Form_Load()
Dim a$(), i%
a = MultiSplit( _
"Function MultiSplit(ByVal sStr As String, bKeepSepar As Boolean,
ParamArray aArray()) As String()", _
False, "(", ")", ",", "String", " ")
For i = 0 To UBound(a)
Debug.Print "_" & a(i) & "_"
Next i
End Sub
'----------------------------------------------------------------
'Remarques :
'mis à jour : supporte les paramètres de différentes
tailles
'(au lieu de 1 seul caractère)
*ou passer par les EXpressions REGulières
http://regex.codes-sources.com/
bon courage
<hr size ="2" width="100%" />
Prenez un instant pour répondre à [forum/sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
possible oui, après il y a une gymnastique dépendante de la page en question
1. récupérer la source de la page, avec ce code par exemple :
<hr />
' RÉCUPÉRER LA SOURCE D'UNE PAGE DANS UNE VARIABLE STRING PAR
API
' http://www.codyx.org/snippet_recuperer-source-page-dans-variable-string-api_620.aspx#1877
' Posté par [ 401740 PCPT ] le 09/06/2008
<hr />
Private Declare Function
DeleteFile
Lib
"kernel32"
Alias
"DeleteFileA"
(
ByVal
lpFileName
As String
)
As Long
Private Declare Function
URLDownloadToFile
Lib
"urlmon"
Alias
"URLDownloadToFileA"
(
ByVal
pCaller
As Long
,
ByVal
szURL
As String
,
ByVal
szFileName
As String
,
ByVal
dwReserved
As Long
,
ByVal
lpfnCB
As Long
)
As
Long
Function GetStringSourceFromOnlineFile(ByVal
sUrl As String) As String
' récupère un nom de fichier temporaire
Dim sTempDest As String
sTempDest = GetUniqueTempFileName '
http://www.codyx.org/snippet_generer-nom-fichier-temporaire-unique_619.aspx#1876
' télécharge la page
If URLDownloadToFile(0&, sUrl, sTempDest, 0&, 0&) = 0
Then
' on lit le
fichier
Dim FF As Integer
FF = FreeFile
Open sTempDest For Input As #FF
GetStringSourceFromOnlineFile = Input(LOF(FF), 1)
Close #FF
' supprime le fichier temp
Call DeleteFile(sTempDest)
End If
End Function
'----------------------------------------------------------------
'Remarques :
'Label1.AutoSize = True
'Label1.Caption = "Mon IP WAN : " &
GetStringSourceFromOnlineFile("http://www.whatismyip.org")
'
'
'
'nécessite
ce snippet :
http://www.codyx.org/snippet_generer-nom-fichier-temporaire-unique_619.aspx#1876
2. récupérer les chaînes utiles
en nettoyant les textes parasites
voir alors avec
*les fonctions INSTR, INSTRREV, MID$, LEFT$, RIGHT$, REPLACE, JOIN, SPLIT (documentées, [F1])
*ou avec ce code qui peut aider :
<hr />
' RÉCUPÉRER UNE CHAÎNE (INCONNUE) PLACÉE ENTRE DEUX CHAÎNES
(CONNUES)
' http://www.codyx.org/snippet_recuperer-chaine-inconnue-placee-entre-deux-chaines-connues_334.aspx#1043
' Posté par [ =401740 PCPT ] le 04/03/2007
<hr />
Private Function
MyMid(
ByRef
Expression
As String
, sLeft
As String
, sRight
As String
,
Optional
Start
As Long
=
1
)
As
String
Dim lPosL As Long, lPosR As Long lPosL InStr(Start, Expression, sLeft): lPosR InStr(lPosL + 1, Expression,
sRight)
If lPosL > 0 And lPosR > 0 Then
MyMid = Mid$(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
Else
MyMid = vbNullString
End If
End Function
'EXEMPLE D'UTILISATION
Private Sub Form_Load()
Dim sStr As String
MsgBox MyMid("
machin
", "'>", "</")
Unload Me
End Sub
*ou celui-ci :
<hr />
' SPLIT SUR PLUSIEURS CRITÈRES
' http://www.codyx.org/snippet_split-sur-plusieurs-criteres_233.aspx#754
' Posté par [ =401740 PCPT ] le 19/09/2006
<hr />
Function
MultiSplit(
ByVal
sStr
As String
, bKeepSepar
As Boolean
,
ParamArray
aArray())
As String
()
' sStr -> chaîne à parser
' bKeepSepar -> garder ou non les caractères de
référence
' aArray -> tableau des
références de taille variables
Dim sCol As New Collection
Dim sChar As String, sLeft As String
Dim bFound As Boolean
Dim aRes() As String
Dim i As Integer, j As Integer, NbCarac As
Integer
i = 0
While LenB(sStr) > 0
i = i + 1
bFound = False
For j = LBound(aArray) To UBound(aArray)
NbCarac = Len(aArray(j))
sChar = Mid$(sStr, i, NbCarac)
If sChar = CStr(aArray(j)) Then bFound = True: Exit
For
Next j
If bFound Then
sLeft = Left$(sStr, i - 1)
If LenB(sLeft) > 0 Then sCol.Add sLeft
If bKeepSepar Then sCol.Add sChar
sStr = Right$(sStr, Len(sStr) - (NbCarac + (i - 1)))
i = 0
ElseIf sChar = vbNullString Then
sCol.Add sStr
sStr = vbNullString
End If
Wend
ReDim aRes(sCol.Count - 1)
For i = 1 To sCol.Count
aRes(i - 1) = sCol.Item(i)
Next i
MultiSplit = aRes
Set sCol = Nothing
Erase aRes
End Function
' EXEMPLE D'UTILISATION
Private Sub Form_Load()
Dim a$(), i%
a = MultiSplit( _
"Function MultiSplit(ByVal sStr As String, bKeepSepar As Boolean,
ParamArray aArray()) As String()", _
False, "(", ")", ",", "String", " ")
For i = 0 To UBound(a)
Debug.Print "_" & a(i) & "_"
Next i
End Sub
'----------------------------------------------------------------
'Remarques :
'mis à jour : supporte les paramètres de différentes
tailles
'(au lieu de 1 seul caractère)
*ou passer par les EXpressions REGulières
http://regex.codes-sources.com/
bon courage
<hr size ="2" width="100%" />
Prenez un instant pour répondre à [forum/sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
