[es] - Pregled linkova web stranice

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Pregled linkova web stranice

^{26.06.2008. u 20:18 - pre 193 meseci}

za to postoje dva nacina: prvi (bolji ali mnog mnogo tezi i komplikovaniji) je da napises HTML parser i da iscupas sve <a> elemente, drugi (nesto jednostavniji) je da "iscupas" href atribut svakog <a> elementa pomocu regularnih izraza, recimo:

Code:

Sub ExtractUrls(source As String)

  Dim oRegExp As RegExp
  Dim oMatches As MatchCollection
  Dim oMatch As Match

  Set oRegExp = New RegExp

  oRegEXp.Pattern = "<a href=""([^""]+)"""
  oRegExp.Global = TRue
  oRegExp.IgnoreCase = True

  Set oMatches = oRegExp.Execute(source)

  For Each oMatch in oMatches

     Debug.Print oMatch.Value

  Next

End Sub

sto se tice regularnih izraza pogeldaj ovo: http://www.elitesecurity.org/t300319-0#1860144

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

Shadowed
Vojvodina

Član broj: 649
Poruke: 12851

+4785 Profil

Re: Pregled linkova web stranice

^{26.06.2008. u 20:33 - pre 193 meseci}

Ako ta html strana postuje xhtml standarde mozes proci kroz nju i nekim xml parserom, mislim da ih i u shestici ima.

Nebojsa Milanovic: Što se tiče Trumpa, smatram ga vrhunskim predsednikom i voleo bih da živim u državi na čijem je on čelu.
Nebojsa Milanovic: Rusija ne laže, ne vodi osvajačke ratove
Nebojsa Milanovic: Trump je svetla tačka u USA blatu.

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Pregled linkova web stranice

^{26.06.2008. u 21:31 - pre 193 meseci}

ima ih ali je mnogo jednostavnije koristiti regularne izraze upravo zbog toga sto veliki broj sajtova nije xhtml (ima nemali broj i onih koji imaju xhtml doctype a opet ne postuju xhtml standarde), mada ni ovaj regexp nije idealan (recimo ukoliko je neko naveo neki drugi atribut pre href onda ga ovaj regexp nece pokupiti, mada to moze da se sredi malo komplikovanijim izrazom...)

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

milan90
Banja Luka

Član broj: 171753
Poruke: 26
*.broadband.blic.net.

Sajt: www.scalpeczematreatment...

Profil

Re: Pregled linkova web stranice

^{27.06.2008. u 13:21 - pre 193 meseci}

Hvala, mislim da cu uspjeti prilagoditi ovo.

.
.
scalp eczema treatment
treatments with home remedies and
herbs

Odgovor na temu

Eurora3D Team
Nebojsa - Programer & Vodja tima
Beograd

Član broj: 120376
Poruke: 900
91.148.114.*

+7 Profil

Re: Pregled linkova web stranice

^{27.06.2008. u 15:20 - pre 193 meseci}

Evo ti kod sa parsiranjem, ... nije savrsen ali radi
Podesen je da parsira ovu stranu

Code:

Option Explicit

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal pub_lngInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Dim fso, fs

Public Function DownloadFile(URL As String) As String
On Error GoTo Err
Dim hInternetSession       As Long
Dim hUrlFile               As Long
Dim sReadBuffer            As String * 4096     ' 4k odjednom
Dim sBuffer                As String
Dim lNumberOfBytesRead     As Long
Dim bDoLoop                As Boolean
hInternetSession = InternetOpen("FileDownload", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hInternetSession = 0 Then GoTo Err
hUrlFile = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
If hUrlFile = 0 Then GoTo Err
bDoLoop = True
While bDoLoop
   sReadBuffer = ""
      bDoLoop = InternetReadFile(hUrlFile, sReadBuffer, _
                  Len(sReadBuffer), lNumberOfBytesRead)
      sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
InternetCloseHandle (hUrlFile)
InternetCloseHandle (hInternetSession)
If sBuffer = "" Then GoTo Err
DownloadFile = sBuffer
Exit Function
Err:
DownloadFile = ""
End Function

Sub ParseURLs(HTML As String)
If HTML = "" Then Exit Sub
Dim st As Long, en As Long
st = InStr(1, HTML, "href=" & Chr(34))
While st
st = st + 6
en = InStr(st, HTML, Chr(34))
If en = 0 Then Exit Sub
fs.WriteLine Mid(HTML, st, en - st)
st = InStr(en, HTML, "href=" & Chr(34))
Wend
End Sub

Private Sub Form_Load()
On Error GoTo Err
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs = fso.CreateTextFile("C:\urls.txt", 2) ' tekst fajl
Dim buffer As String
buffer = DownloadFile("http://www.elitesecurity.org/t328044-Pregled-linkova-web-stranice") ' url
ParseURLs (buffer)
fs.Close
Set fs = Nothing
Set fso = Nothing
Err:
End
End Sub

HomePage http://www.eurora3d.com

Odgovor na temu

milan90
Banja Luka

Član broj: 171753
Poruke: 26
*.broadband.blic.net.

Sajt: www.scalpeczematreatment...

Profil

Re: Pregled linkova web stranice

^{28.06.2008. u 08:14 - pre 193 meseci}

Ne znam kako, ali meni javlja par gresaka, ove nikako da skontam.

Code:

Public Function DownloadFile(URL As String) As String
On Error GoTo Err
Dim hInternetSession       As Long
Dim hUrlFile               As Long
Dim sReadBuffer            As String * 4096     ' 4k odjednom
Dim sBuffer                As String
Dim lNumberOfBytesRead     As Long
Dim bDoLoop                As Boolean
hInternetSession = InternetOpen("FileDownload", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hInternetSession = 0 Then GoTo Err
hUrlFile = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
If hUrlFile = 0 Then GoTo Err
bDoLoop = True
While bDoLoop
   sReadBuffer = ""
      bDoLoop = InternetReadFile(hUrlFile, sReadBuffer, _
                  Len(sReadBuffer), lNumberOfBytesRead)
      sBuffer = sBuffer & [blue]Left$[/blue] (sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
InternetCloseHandle (hUrlFile)
InternetCloseHandle (hInternetSession)
If sBuffer = "" Then GoTo Err
DownloadFile = sBuffer
Exit Function
Err:
DownloadFile = ""
End Function

Sub ParseURLs(HTML As String)
If HTML = "" Then Exit Sub
Dim st As Long, en As Long
st = InStr(1, HTML, "href=" & Chr(34))
While st
st = st + 6
en = InStr(st, HTML, Chr(34))
If en = 0 Then Exit Sub
fs.WriteLine Mid(HTML, st, en - st)
st = [blue]InStr(en, HTML, "href=" & Chr(34))[/blue]
Wend
End Sub

1.'Public Property Left() As Integer' has no parameters and its return type cannot be indexed.
2. Type character '$' does not match declared data type 'Integer'.
3.Overload resolution failed because no accessible 'InStr' can be called without a narrowing conversion:

'Public Function InStr(Start As Integer, String1 As String, String2 As String, [Compare As Microsoft.VisualBasic.CompareMethod = Microsoft.VisualBasic.CompareMethod.Binary]) As Integer': Argument matching parameter 'Start' narrows from 'Long' to 'Integer'.

'Public Function InStr(String1 As String, String2 As String, [Compare As Microsoft.VisualBasic.CompareMethod = Microsoft.VisualBasic.CompareMethod.Binary]) As Integer': Argument matching parameter 'String1' narrows from 'Long' to 'String'.

'Public Function InStr(String1 As String, String2 As String, [Compare As Microsoft.VisualBasic.CompareMethod = Microsoft.VisualBasic.CompareMethod.Binary]) As Integer': Argument matching parameter 'Compare' narrows from 'String' to 'Microsoft.VisualBasic.CompareMethod'.

_{[Ovu poruku je menjao Aleksandar Ružičić dana 28.06.2008. u 12:12 GMT+1]}

.
.
scalp eczema treatment
treatments with home remedies and
herbs

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Pregled linkova web stranice

^{28.06.2008. u 11:14 - pre 193 meseci}

pa sto ne rece da radis u vb.net? :)

ovo je forum za Visual Basic 6

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

milan90
Banja Luka

Član broj: 171753
Poruke: 26
*.broadband.blic.net.

Sajt: www.scalpeczematreatment...

Profil

Re: Pregled linkova web stranice

^{28.06.2008. u 16:10 - pre 193 meseci}

Pa zapravo mi je svejedno! Prvo sam i mislio da bude u VB6, ali eto..

.
.
scalp eczema treatment
treatments with home remedies and
herbs

Odgovor na temu

Eurora3D Team
Nebojsa - Programer & Vodja tima
Beograd

Član broj: 120376
Poruke: 900
91.148.112.*

+7 Profil

Re: Pregled linkova web stranice

^{29.06.2008. u 03:25 - pre 193 meseci}

Radi to i u NETu, Samo ga snimis iz VB6, otvoris NET i uradis Upgade
Procitaj malo dokumentaciju ...

Code:

Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Form1
    Inherits System.Windows.Forms.Form

    Private Const INTERNET_OPEN_TYPE_PRECONFIG As Short = 0
    Private Const INTERNET_FLAG_RELOAD As Integer = &H80000000

    Private Declare Function InternetOpen Lib "wininet.dll"  Alias "InternetOpenA"(ByVal sAgent As String, ByVal lAccessType As Integer, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Integer) As Integer
    Private Declare Function InternetOpenUrl Lib "wininet.dll"  Alias "InternetOpenUrlA"(ByVal pub_lngInternetSession As Integer, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Integer, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Integer
    Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Integer, ByVal sBuffer As String, ByVal lNumBytesToRead As Integer, ByRef lNumberOfBytesRead As Integer) As Short
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Integer) As Short
    Dim fso, fs As Object

    Public Function DownloadFile(ByRef URL As String) As String
        On Error GoTo Err_Renamed
        Dim hInternetSession As Integer
        Dim hUrlFile As Integer
        Dim sReadBuffer As New VB6.FixedLengthString(4096) ' 4k odjednom
        Dim sBuffer As String
        Dim lNumberOfBytesRead As Integer
        Dim bDoLoop As Boolean
        hInternetSession = InternetOpen("FileDownload", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
        If hInternetSession = 0 Then GoTo Err_Renamed
        hUrlFile = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        If hUrlFile = 0 Then GoTo Err_Renamed
        bDoLoop = True
        While bDoLoop
            sReadBuffer.Value = ""
            bDoLoop = InternetReadFile(hUrlFile, sReadBuffer.Value, Len(sReadBuffer.Value), lNumberOfBytesRead)
            sBuffer = sBuffer & VB.Left(sReadBuffer.Value, lNumberOfBytesRead)
            If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
        End While
        InternetCloseHandle(hUrlFile)
        InternetCloseHandle(hInternetSession)
        If sBuffer = "" Then GoTo Err_Renamed
        DownloadFile = sBuffer
        Exit Function
Err_Renamed:
        DownloadFile = ""
    End Function

    Sub ParseURLs(ByRef HTML As String)
        If HTML = "" Then Exit Sub
        Dim st, en As Integer
        st = InStr(1, HTML, "href=" & Chr(34))
        While st
            st = st + 6
            en = InStr(st, HTML, Chr(34))
            If en = 0 Then Exit Sub
            fs.WriteLine(Mid(HTML, st, en - st))
            st = InStr(en, HTML, "href=" & Chr(34))
        End While
    End Sub

    Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        On Error GoTo Err_Renamed
        fso = CreateObject("Scripting.FileSystemObject")
        fs = fso.CreateTextFile("C:\urls.txt", 2) ' tekst fajl
        Dim buffer As String
        buffer = DownloadFile("http://www.elitesecurity.org/t328044-Pregled-linkova-web-stranice") ' url
        ParseURLs((buffer))
        fs.Close()
        fs = Nothing
        fso = Nothing
Err_Renamed:
        End
    End Sub
End Class

HomePage http://www.eurora3d.com

Odgovor na temu