Form_load tager lang tid, tag det af små gange

Set en progressbar på formen og kald show i form_load inden den løkke. Så kan du opdatere den progressbar løbende.

til slut i din løkke skriver du:

progressbar1.value = progressbar1.value + "hvad du nu ønsker"

Okay den kan jeg så ikke lige finde (har den ikke ude under generel) hvor tilføjer jeg den eller hvad hedder filen (ActivX)?

Microsoft Windows Common Controls

Under komponenter

Okay fandt den. Tak.

visshow.Value = visshow.Value + 1 er til slut i min løkke. Men den bliver ikke vist. Og når formen så endelig har loadet er der kun et ud af de mange takker som lyser blot.

Spørgsmål
  Den skal vel vide hvad der er 100%? 100% er et antal linier i en Tekst fil (som jeg kløber igennem med do løkken) men den værdi kan den jo ikke få før jeg er færdig med do løkken og så er det jo vel for sent? Hvad gør jeg så? Ville det være smart at første løbe alle linier igennem tekst filen inden jeg starter på Do løkken (det kan dreje sig om 30.000)?

Kan det have noget at sige at inde i do løkken tilføjer jeg info til to list bokse om hvad den fandt ud af?

/Casper

Ja selvfølgelig, det skal du selv lige regne ud!

Det sidste kan godt have noget at sige.

I et modul tilføjer du lige følgende:

<Snip>
Public Const WM_SETREDRAW = &HB

Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
</Snip>

I form_load inden løkken tilføjer du linien

sendmessageany listbox1.hwnd, wm_setredraw, 0&, 0&

efter løkken tilføjer du

sendmessageany listbox1.hwnd, wm_setredraw, 1&, 0&

Det slår gentegning af listboksen fra, hvilket sætter skub i tingene.

Hvis du ved med dig selv, at du tilføjer over 100 linier til listboksen, så tilføjer du følgende i et modul:

Public Const LB_INITSTORAGE = &H1A8

I form_load inden løkken tilføjer du:

SendMessage Listbox1.HWnd, LB_INITSTORAGE, <Antal elementer>, ByVal <Antal elementer> * <forventet tekstlængde per element>

Dette får listboxen til at allokere den hukommelse, der skal bruges til et antal elementer. Det vil også sætte hastigheden op, da standardfremgangsmåden er at allokere hukommelse til et element ad gangen.

Det virker nu ikke rigtig godt, faktisk ingen forskel (fjende List2 pga forsøget (i koden) og så ændret navnet til List1)

----

Private Sub Form_Load()
intFilNr = FreeFile
strFilNavn = "C:\apache\htdocs\craw\dom.txt"

Open strFilNavn For Input As #intFilNr
Do
Line Input #intFilNr, strLinie

List1.AddItem strLinie
strValidKode = DownloadString("http://validator.w3.org/check?uri=http://www." & strLinie)

If Not InStr(strValidKode, "No errors found!") = 0 Then
List2.AddItem "Valid"
Else
List2.AddItem "Ikke Valid"
End If


Loop Until EOF(intFilNr)
Close #intFilNr

End Sub

---

DownloadString er fra http://www.eksperten.dk/spm/256469

Det sidste forstår jeg ikke helt ?

Hvis du forventer at tilføje 500 elementer på 100 tegn, så ser den således ud:

sendmessagaany listbox1.hwnd, lb_initstorage, 500, byval 500*100

Jeg kan ikke rigtig *forvente* noget da det er kildekoder fra forskellige sider ngoel fylder -50bytes andre +30KB :).

Jeg har godt nok ikke tænkt mig at teste 30.000 domæner for at se om de er valid kodet, men... det er bare for at se om det kan lade sig gøre. (teori)

Er der ikke andre metoder at gøre det på? Det med list boksene er bare for at vise det rent visuelt. De skal fjernes igen og resultatet af

If Not InStr(strValidKode, "No errors found!") = 0 Then
List2.AddItem "Valid"
Else
List2.AddItem "Ikke Valid"
End If

samt strLinie skal puttesi en database.

Det er nærmest en robot.

/Casper

Du kan heller ikke få tingene hurtigere end internetforbindelsen vil give dig dem (downloadstring).

nemlig men så vil jeg bruge Proccesbaren og ev. en label på en form til at vise hvor langt jeg er kommet.

Progress baren kræver, at du kender de totale antal, du skal igennem.

Hvis du ikke gør det, så ville jeg bruge en label og opdatere den med en tekst i starten af løkken (Behandler nu ........)

Okay men det kan jeg så ikke få opdateret vissiuelt på skærmen? Eller kan jeg ?

Jo, kald label1.refresh

(Hurtigere DownloadString)

set de 256 til 2048 så henter du en pakke på 2048 tegn, frem for pakke på 256 tegn. :-)

Dim sBuffer As String * 256

Det er så nok bare mig der ikke kan få det til at virke?

Private Sub Form_Load()
intFilNr = FreeFile
strFilNavn = "C:\apache\htdocs\craw\dom.txt"

Open strFilNavn For Input As #intFilNr
Do
Line Input #intFilNr, strLinie
Label1.Caption = strLinie

Label1.Refresh

' Til databasen
' List1.AddItem strLinie
strValidKode = DownloadString("http://validator.w3.org/check?uri=http://www." & strLinie)

' Til databasen
' If Not InStr(strValidKode, "No errors found!") = 0 Then
' List2.AddItem "Valid"
' Else
' List2.AddItem "Ikke Valid"
' End If


Loop Until EOF(intFilNr)
Close #intFilNr

End Sub

--------------------------------

Formen bliver først vist når den sidste linie i filen er loadet ind, det samme med Labelen selvfølgelig.

Private Sub Form_Load()
intFilNr = FreeFile
strFilNavn = "C:\apache\htdocs\craw\dom.txt"

me.show
doevents

Open strFilNavn For Input As #intFilNr
Do
Line Input #intFilNr, strLinie
Label1.Caption = strLinie

Label1.Refresh

' Til databasen
' List1.AddItem strLinie
strValidKode = DownloadString("http://validator.w3.org/check?uri=http://www." & strLinie)

' Til databasen
' If Not InStr(strValidKode, "No errors found!") = 0 Then
' List2.AddItem "Valid"
' Else
' List2.AddItem "Ikke Valid"
' End If


Loop Until EOF(intFilNr)
Close #intFilNr

End Sub

Ahhh. mange tak :)
Me.Show

Du behøver jo ikke at få en server til at tjække din url prøv:

'-------------------------- Form1 --------------------------
Option Explicit

Private Declare Function InternetOpen Lib "wininet" 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 InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nProxyPort As Integer, ByVal lpszUserName As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long

Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const HTTP_QUERY_STATUS_TEXT = 20
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0

Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_SERVICE_HTTP = 3

Private Function GetQueryInfo(ByVal lRequest As Long, TYPE_HTTP As Long) As String
Dim sBuffer As String * 1024
Dim lBufferLength As Long
lBufferLength = Len(sBuffer)
  HttpQueryInfo lRequest, TYPE_HTTP, ByVal sBuffer, lBufferLength, 0
GetQueryInfo = sBuffer
End Function

Public Function CheckURL(ByVal strUrl As String) As Variant
Dim lPos As Long
Dim lRequest As Long
Dim sServerName As String
Dim sServerPath As String
Dim lInternetSession As Long
Dim lInternetConnect As Long
  sServerName = strUrl
  If Left$(LCase(sServerName), 7) = "http://" Then
    sServerName = Right$(sServerName, Len(sServerName) - 7)
  End If
    lPos = InStr(1, sServerName, "/")
  If lPos > 0 Then
    sServerPath = Right$(sServerName, Len(sServerName) - lPos + 1)
    sServerName = Left$(sServerName, lPos - 1)
  End If
  lInternetSession = InternetOpen("HeaderInfo", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
  lInternetConnect = InternetConnect(lInternetSession, sServerName, INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
  lRequest = HttpOpenRequest(lInternetConnect, "GET", sServerPath, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    If CBool(lRequest) Then
      HttpSendRequest lRequest, vbNullString, 0, 0, 0

      'function GetQueryInfo
      'CheckURL = GetQueryInfo(lRequest, HTTP_QUERY_STATUS_CODE) '200, 403, 404....
      CheckURL = GetQueryInfo(lRequest, HTTP_QUERY_STATUS_TEXT) 'Not Found eller OK

    End If
  InternetCloseHandle lRequest
  InternetCloseHandle lInternetConnect
  InternetCloseHandle lInternetSession
End Function

Private Sub Command1_Click()
  Me.Caption = CheckURL("http://www.eksperten.dk/spm/256682")
End Sub
'-------------------------- Form1 --------------------------

Det gør jeg vel når jeg skal tjekke om det er valid kode? Jeg hverken gdder eller kan lave en validator på højde med W3C :).

Der er et eller andet rivende galt i det her spm. ?

Hvad mener du?

Accepteret svar: benny.tordrup
Point : 0
11/09-2002 15:05:22

Afvist svar: bccinlove
11/09-2002 15:08:01

(Den point delign har jeg slet ikek lavet. Den rigtig 5p til bccinlove  og 55 til dig)

Og spørgsmålet står som åbent.
P¨å accepter listen er der ikke nogle, men den er der (tom).

Mystisk

Det her er et svar

stadigvæk intet på listen

dssdsd

Exp.dk den glade giver, 60 bliver til 120points.