Toon posts:

[vb]loop in text extractie tool maken

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hallo allemaal,

Ik ben bezig met een programma die bepaalde data uit een webpagina haalt en dan de gegevens in een text box stopt. nou heb ik het al voor elkaar dat hij de gegevens zegmaar uit de source haalt.

Ik geef een begin en een eindpunt aan ( stel ik heb de text "hallo ik ben jantje" en ik geef hallo en jantje aan als begin en eindpunt dan kopieerd hij "ik ben" naar die textbox.) en alles wat ertussen staat kopieert hij in de textbox.

maar nu zit ik dus met het probleem dat er niet alleen

hallo ik ben jantje op die pagina staat maar ook
hallo ik was jantje

2 verschillende zinnen maar wel met dezelfde begin en eindwoorden
nou wil ik dus dat hij EN "ik ben" EN "ik was" in die textbox stopt.

dus een loopje maken in dat script. nou snap ik alleen niet helemaal hoe ik die loop in dit script moet maken. Kan iemand mij hiermee helpen?

code staat hieronder:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Dim tijd, onderwerp As String

Private Sub Command1_Click()
tijd = Extract(Text1.Text, "txt2>", "</A>", False)
onderwerp = Extract(Text1.Text, "target=_blank>", "</A>", False)
Text2.Text = tijd & " " & onderwerp
End Sub

Public Function Extract(ByVal TextIN As String, Optional StartTag As String = " ",
 Optional ByVal EndTag As String = " ", Optional ByVal CheckCase As Boolean) As String
    On Error GoTo LocalError
    Dim lArray As Variant
    Extract = ""
    lArray = Split(TextIN, StartTag)
    If IsArray(lArray) Then
        Extract = lArray(1)
        lArray = Split(Extract, EndTag)
        If IsArray(lArray) Then
            Extract = lArray(0)
        Else
            Extract = ""
        End If
    End If
    Exit Function
LocalError:
    Extract = ""
End Function


hij moet dus de hele text die in text1 staat controleren op het tijd en onderwerp gedeelte

Alvast bedankt!

[ Voor 16% gewijzigd door Verwijderd op 12-01-2004 19:37 . Reden: de code vernield de layout ]


Verwijderd

Ik zou het doen met reguliere expressies...

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
' Dit voorbeeldje haalt email addressen uit een string
Dim RegExp As New RegExp ' Microsoft VBScript Regular Expressions 5.5
RegExp.Pattern = "[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,4}"
RegExp.Global = True

Dim Matches As MatchCollection
Dim Match As Match

Set Matches = RegExp.Execute("test ab@cd.ef test gh@ij.kl")

For Each Match In Matches
    MsgBox Match.Value
Next


Nu moet je alleen nog ff de regexp faq erop naslaan. Dit is veel sneller dan zelf in VB wat aanklooien want die is bagger traag met strings ed. (alle andere data typen ook, maargoed >:) )

[ Voor 4% gewijzigd door Verwijderd op 12-01-2004 22:17 ]


Verwijderd

Verwijderd schreef op 12 januari 2004 @ 22:17:
Ik zou het doen met reguliere expressies...

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
' Dit voorbeeldje haalt email addressen uit een string
Dim RegExp As New RegExp ' Microsoft VBScript Regular Expressions 5.5
RegExp.Pattern = "[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,4}"
RegExp.Global = True

Dim Matches As MatchCollection
Dim Match As Match

Set Matches = RegExp.Execute("test ab@cd.ef test gh@ij.kl")

For Each Match In Matches
    MsgBox Match.Value
Next


Nu moet je alleen nog ff de regexp faq erop naslaan. Dit is veel sneller dan zelf in VB wat aanklooien want die is bagger traag met strings ed. (alle andere data typen ook, maargoed >:) )
Ja regexen kan zeker ook en is sneller maar zo kan het ook:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Dim tijd, onderwerp As String

Private Sub Command1_Click()
tijd = Extract(Text1.Text, "txt2>", "</A>", False)
onderwerp = Extract(Text1.Text, "target=_blank>", "</A>", False)
Text2.Text = tijd & " " & onderwerp
End Sub

Public Function Extract(ByVal TextIn As String, _
                        Optional StartTag As String = " ", _
                        Optional ByVal EndTag As String = " ", _
                        Optional ByVal CheckCase As Boolean) As String

On Error GoTo LocalError
Dim StartTagArray As Variant
Dim EndTagArray As Variant

Extract = ""

'Splits string in totaal aantal gevonden instances van de zoek string
StartTagArray = Split(TextIn, StartTag, -1, vbTextCompare)

'Controleer of de string gevonden is
If IsArray(StartTagArray) Then

    For x = 1 To UBound(StartTagArray)
    'Start bij de 2e (1) array instance zodat de eerste (0) lege string wordt overgeslagen
    
        If IsArray(Split(StartTagArray(x), EndTag)) Then
            'Kijk voor elke gevonden instance of de eind tag er in zit
            EndTagArray = Split(StartTagArray(x), EndTag)
            
            'Geef de gevonden waarde terug aan de functie
            Extract = Extract + " " + EndTagArray(0)
        Else
            'Deze array instance bevat niet de eindtag
            Extract = ""
        End If
    Next x
End If

'Tags niet gevonden

Exit Function

LocalError:
    Extract = ""
End Function


Nog een kleine opmerking. De topic titel is een beetje misleidend. Je begint namelijk met [VB]. Dat had wat mij betreft [VBScript] mogen zijn! :*)

Verwijderd

Topicstarter
het principe werkt nu prima,

dus hij controleert netjes het hele bestand hij zit nu alleen met de layout te kloten

dus het moet ongeveer wezen:

12-01 / 2:01 Keyboard modding kits
12-01 / 0:11 Het Grote LOL topic (Deel 3)

en hij doet het nu zo:

12-01 / 2:01 12-01 / 0:11 Keyboard modding kits Het Grote LOL topic (Deel 3)

iemand daar ook een oplossing voor? |:(

Verwijderd

Verwijderd schreef op 12 januari 2004 @ 23:19:
[...]


het principe werkt nu prima,

dus hij controleert netjes het hele bestand hij zit nu alleen met de layout te kloten

dus het moet ongeveer wezen:

12-01 / 2:01 Keyboard modding kits
12-01 / 0:11 Het Grote LOL topic (Deel 3)

en hij doet het nu zo:

12-01 / 2:01 12-01 / 0:11 Keyboard modding kits Het Grote LOL topic (Deel 3)

iemand daar ook een oplossing voor? |:(
Ff eerst een vraagje aan jou. Heb je eigenlijk wel een idee waarom het nu wel werkt? :?

Verwijderd

Verwijderd schreef op 13 januari 2004 @ 09:59:
[...]

Ff eerst een vraagje aan jou. Heb je eigenlijk wel een idee waarom het nu wel werkt? :?
Ja bedankt voor de respons enzo..... :(
Pagina: 1