Trække nogle tal ud af et html dokument.

? Prøv at begrund lidt mere...

//>Rune

jeg vil gerne lave et script i vb som har en funktion der returnerer 66, men altså ikke altid 66. I koden jeg har indsat er der forskellige tal, disse vil jeg gerne trække ud af koden med et script, kan det lade sig gøre. Jeg forestiller mig noget med, at scriptet læser siden ind en gang imellem og finder de tal jeg skal bruge, jeg er bare ikke klar over hvordan det skal kodes.

Blev det mere klart?

Koden er altid som den der er indsat, blot varierer tallenes værdi.

Ok,jeg kigger lige på det i morgen... natnat

//>Rune

det lyder super.

Hm. Vent lige lidt... Du kan jo ikke hive noget ind fra et andet site end dit eget! -Det er umuligt...! -hvis dette var muligt, prøv så at forestille dig alle de nyheder der ville blive stjålet fra nyhedssider osv. Det ville jo blive helt ekstremt.!

//>Rune

det kan man sagtens, du kan se dette script:
' Latest news from Politiken (http://politiken.dk/VisArtikel.iasp?PageID=1)
' Written by Michael Borup (borup@email.dk)
' 2002-09-02

function news1
  news1 = getNews(1)
end function

function news2
  news2 = getNews(2)
end function

function news3
  news3 = getNews(3)
end function

function news4
  news4 = getNews(4)
end function

function news5
  news5 = getNews(5)
end function

function news6
  news6 = getNews(6)
end function

function news7
  news7 = getNews(7)
end function

function news8
  news8 = getNews(8)
end function

function news9
  news9 = getNews(9)
end function

function news10
  news10 = getNews(10)
end function

function getNews(value)
  On Error Resume Next

  ' Get page
  page = binToText(getHTMLBin("http://politiken.dk/VisArtikel.iasp?PageID=1"), 100000)
 
  ' Parse news from page
  endPos = InStr(1, page, "(PID, rubrik, tid)", 1)           
  startPos = InStrRev(page, " ", endPos, 1) + 1       
  id = Mid(page, startPos, endPos - startPos) 
  newsArray = split(page, id, -1, 1)

  ' Get news index
  if (value + 2) <= UBound(newsArray) then
    newsStr = newsArray(value + 2)   
  end if

  ' Format news string
  startPos = InStr(1, newsStr, "'", 1) + 1           
  endPos = InStr(startPos, newsStr, "'", 1)
  newsText = Mid(newsStr, startPos, endPos - startPos)
 
  endPos = InStrRev(newsStr, "'", Len(newsStr), 1)
  startPos = InStrRev(newsStr, "'", (endPos - 1), 1) + 1
  newsTime = Mid(newsStr, startPos, endPos - startPos)

  newsStr = newsText + " (" + NewsTime + ")"

  newsStr = htmlToAcsii(newsStr)   
 
  getNews = newsStr

end function

function htmlToAcsii(value)
  value = replace(value, "<br>", " ")   
  value = replace(value, vbLf, "")
  value = replace(value, vbCr, "")
  value = replace(value, "&aring;", "å")
  value = replace(value, "&aelig;", "æ")
  value = replace(value, "&oslash;", "ø")
  value = replace(value, "&Aring;", "Å")
  value = replace(value, "&Aelig;", "Æ")
  value = replace(value, "&Oslash;", "Ø")
  value = replace(value, "&aacute;", "á")
  value = replace(value, "&quot;", """")
 
  htmlToAcsii = value
end function

function getHTMLBin(strURL)
  On Error Resume Next

  Dim objXMLHTTP, strReturn
  Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")

  objXMLHTTP.Open "GET", strURL, False
  objXMLHTTP.Send Cstr(Rnd())

  getHTMLBin = objXMLHTTP.responseBody
  Set objXMLHTTP = Nothing
end function

function binToText(varBinData, intDataSizeInBytes)
  On Error Resume Next
           
  Const adFldLong = &H00000080
  Const adVarChar = 200
  Set objRS = CreateObject("ADODB.Recordset")

  objRS.Fields.Append "txt", adVarChar, intDataSizeInBytes, adFldLong
  objRS.Open

  objRS.AddNew
  objRS.Fields("txt").AppendChunk varBinData
  binToText = objRS("txt").Value

  objRS.Close
  Set objRS = Nothing
end function

Jeg kan bare ikke finde ud af, om man kan gøre det i mit tilfælde. Jeg tænker noget med at læse en linje og så skære det fra man ikke skal bruge, for koden er jo den samme hver gang pånær tallet.

Hvis du kan få alt koden til at ligge i en variabel kan du trække de forskellige data ud ved at gøre sådan her... (I dette tilfælde har jeg fx. trukket dit IP nr. ud af teksten)

<html>
<head>
    <title></title>
</head>
<body>

<script language="VBScript">
   
    strCode = "<!DOCTYPE HTML PUBLIC '-//IETF//DTD HTML//EN'><HTML><HEAD><TITLE>XXXXXXXXXX - Data Meter (version 0.7b)</TITLE></HEAD><BODY><body background='' bgcolor='#ffffff' text='#000000' link='#0000A0' vlink='#000000' alink='#000000'><center><b>Your Upload/Download stats</b><br><br><table><tr><td>IP Address:<br>Upload:<br>Download:<br>Total:<br>Limit:<br>Used:</td><td>172.16.1.38<br>2 [MB]<br>66 [MB]<br>68 [MB]<br>1000 [MB]<br>7%</td></tr> </table><br><br>Web (http) &amp; XXXXXXX E-mail (pop3) trafic notcounted in.<br><br><br><a href='XXXXXXXX'>XXXXXXXXX</a> - Data Meter (version 0.7b)</center></BODY></HTML>"
    If InStr(strCode, "[MB]") Then
        MsgBox(InStr(strCode, "[MB]"))
        MsgBox(Mid(strCode, InStr(strCode, "[MB]")-17,11))
    End If
'msgbox(strCode)
</script>

</body>
</html>

//>Rune

men er det ikke muligt, at scriptet i stedet tager adressen som parameter og derefter indlæser denne og finder de forskellige variable, for siden er jo ikke sådan som jeg har indsat hvergang, tallene varierer.

desuden havde jeg også tænkt, at det skulle indsættes som en vbs-fil, altså ikke bare som et script. Vil det betyde nogle større ændringer?

Nej, det ville ikke være de store ændringer der skulle til...

Jeg forstår ikke hvad du mener emd at indlæse og så finde variablerne for siden...! -Man kan jo ikke indlæse alt tekst fra en side... -men er det da ikke dit eget site? -Hvis det er så kan du jo bare kontakte databasen/selv lave script der gør det...

//>Rune

det er ikke mit eget site, derfor kan jeg ikke kontakte databasen. Jeg bor på et kollegie hvor vi har en download kvote, denne vises på siden. Men jeg har nu fået det til at virke med følgende kode:

function ip

  ' Get ip
  page = binToText(getHTMLBin("http://pedersen.omk.dk:8080/cgi-bin/datameter.pl"), 1000)
  ip = Mid(page, InStr(page, "[MB]")-17,11)
 

end function

function htmlToAcsii(value)
  value = replace(value, "<br>", " ")   
  value = replace(value, vbLf, "")
  value = replace(value, vbCr, "")
  value = replace(value, "&aring;", "å")
  value = replace(value, "&aelig;", "æ")
  value = replace(value, "&oslash;", "ø")
  value = replace(value, "&Aring;", "Å")
  value = replace(value, "&Aelig;", "Æ")
  value = replace(value, "&Oslash;", "Ø")
  value = replace(value, "&aacute;", "á")
  value = replace(value, "&quot;", """")
 
  htmlToAcsii = value
end function

function getHTMLBin(strURL)
  On Error Resume Next

  Dim objXMLHTTP, strReturn
  Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")

  objXMLHTTP.Open "GET", strURL, False
  objXMLHTTP.Send Cstr(Rnd())

  getHTMLBin = objXMLHTTP.responseBody
  Set objXMLHTTP = Nothing
end function

function binToText(varBinData, intDataSizeInBytes)
  On Error Resume Next
           
  Const adFldLong = &H00000080
  Const adVarChar = 200
  Set objRS = CreateObject("ADODB.Recordset")

  objRS.Fields.Append "txt", adVarChar, intDataSizeInBytes, adFldLong
  objRS.Open

  objRS.AddNew
  objRS.Fields("txt").AppendChunk varBinData
  binToText = objRS("txt").Value

  objRS.Close
  Set objRS = Nothing
end function

Som du kan se har jeg brugt koden jeg tidligere har postet og kombineret den med lidt af dit. Nu skal jeg bare lave funktioner til at trække resten ud med.

den skal lige finpudses, og jeg skal jo heller ikke indlæse kilden for hver værdi jeg vil have ud. Desuden har jeg ikke rigtigt brug for funktionen htmlToAscii, men det kan være jeg kan bruge den til noget smart så jeg lettere kan finde de forskellige værdier i koden. Men tak for hjælpen.

Anytime ;o)
Thx 4 Poinz

//>Rune

men tror du der er en smartere eller mere elegant måde at gøre det på?

Hmm nej, ik' rigtig..

//>Rune