Hente værdi fra nettet

1) Du downloader siden
2) Du læser de data du har downloadet
3) Du parser data'ene og finder version nummer.

På din side, indsætter du f.eks.: version=301

Du skal så finde det, der står efter "version=". Eksempel:

Test data er:

this is
version=301
of this program

og koden:

dim strData as string ' de data der downloades, smides i strData
dim v as string ' v = version
dim tmp as string ' midlertidigt data


tmp = Mid(strData, InStr(strData, "version=") + Len("version="))
tmp = Mid(tmp, InStr(tmp, "=") + 1, InStr(tmp, vbCrLf))
msgbox tmp

variablen "tmp" indeholder det, der står efter "=", og indtil "ny linie" (vbcrlf): 301

se her:
http://www.vb-helper.com/howto_read_url_without_inet.html
http://www.vb-helper.com/HowTo/howto_read_url_without_inet.zip

hmm.. lagde lige mærke til at jeg ikke brugte "v" (brugte tmp i stedet)..

Komplet (men ikke testet) eksempel:

' øverst i kode-området ("(generel)")
dim var_data as variant
dim strData as string ' de data der downloades, smides i strData
dim tmp as string ' midlertidigt data



Private Sub cmdDownload_Click()
Inet1.Execute "http://www.minside/versionfil.asp", "GET"
End Sub




Private Sub Inet1_StateChanged(ByVal State As Integer)
On Error GoTo EOS

If State = icResponseCompleted Then

  ' Get the first chunk.
  var_data = Inet1.GetChunk(1024, icString)
  str_Data = str_Data & var_data

  ' Get the rest of the chunks.
  Do
    DoEvents
    var_data = Inet1.GetChunk(1024, icString)
    If Len(var_data) = 0 Then Exit Do
    str_Data = str_Data & var_data
  Loop

tmp = Mid(strData, InStr(strData, "version=") + Len("version="))
tmp = Mid(tmp, InStr(tmp, "=") + 1, InStr(tmp, vbCrLf))
msgbox "versionen er: " & tmp


EOS:
If Err.Number <> 0 Then Msgbox Err.Number & " - " & Err.Description
end sub



Der skal bruges:
- Control: Microsoft Internet Transfer Control (f.eks. version 6.0), med navnet "Inet1".
- CommandButton: med navnet "cmdDownload"

Den ne

*thesurfer -> Den nederste virker ikke, og den øverste kan jeg ikke få til at virke!

Jeg smed lige "Option Explicit" i toppen af kode-området (den første linie), og fandt ud af, at jeg skrev "strData", hvor variablen hedder "str_Data" (med "_")!

Ny kode (testet og virker!):

Option Explicit
Dim var_data As Variant
Dim str_Data As String ' de data der downloades, smides i strData
Dim tmp As String ' midlertidigt data

Private Sub cmdDownload_Click()
Inet1.Execute "http://thesurfer.users.whitehat.dk/e/q/511521/versionfil.txt", "GET"
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
On Error GoTo EOS

If State = icResponseCompleted Then
  ' Get the first chunk.
  var_data = Inet1.GetChunk(1024, icString)
  str_Data = str_Data & var_data

  ' Get the rest of the chunks.
  Do
    DoEvents
    var_data = Inet1.GetChunk(1024, icString)
    If Len(var_data) = 0 Then Exit Do
    str_Data = str_Data & var_data
  Loop
 
tmp = Mid(str_Data, InStr(str_Data, "version=") + Len("version="))
tmp = Mid(tmp, InStr(tmp, "=") + 1, InStr(tmp, vbCrLf))
MsgBox "versionen er: " & tmp
End If

EOS:
If Err.Number <> 0 Then lstErr.AddItem Err.Number & " - " & Err.Description
End Sub

En lille rettelse:
Jeg har brugt en listbox, til at vise de fejl, der ikke er "0". Listboxen hedder "lstErr". Derfor kan du se linien:

If Err.Number <> 0 Then lstErr.AddItem Err.Number & " - " & Err.Description

Hvis du ikke har tænkt dig at gøre det samme, fjern den linie, da du ellers vil få en fejl, om at objektet/control'en ikke er defineret.

Prøve med (som jeg bruger i ASP, dvs. det er VBScript, og derfor ikke nødvendigvis helt korrekt):

Dim TekstIndhold As String
Set HTTP = CreateObject("Msxml2.serverXMLHTTP")
HTTP.Open "GET", "http://www.blabla.dk/tekstfil.asp", False, "", ""
HTTP.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"   
HTTP.Send ""
TekstIndhold= HTTP.Responsetext
Set HTTP = Nothing

ldanielsen
den er genial den kode..simple og virker som den skal.
ldanielsen skal sku have de points !!!

her er den jeg bruger nu:

Function getdata(url As String)
Dim TekstIndhold As String
Set HTTP = CreateObject("Msxml2.serverXMLHTTP")
HTTP.Open "GET", url, False, "", ""
HTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
HTTP.Send ""
getdata = HTTP.Responsetext
Set HTTP = Nothing
End Function

Tak for det.

Der er i øvrigt et andet Object, WinHttp, som jeg er bregyndt at bruge i stedet. Jeg bruger det jo i reglen ikke til at modtage XML med, så WinHttp er "nok". se denne kode, hvor jeg submitter en virtuel form (med POST, ret det til GET efter behov):

Dim objWinHttp, sUrl
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.Open "POST", "http://www.dom.ext/file.ext", False
objWinHttp.SetCredentials "Brugernavn", "Password", 0
   
on error resume next
objWinHttp.Send("Evt. text her")
if err then
    'Der er fejl
    Result = "Err = " & err.description & "<BR>" & _
        "hSend Status : " & objWinHttp.status & "<BR>"
else
    'success
    Result = objWinHttp.responseText
end if

on error goto 0   

igen er det VBScript, bruge på en ASP-side