Heippa!
käyttäjätunnus Axuu tässä taannoin kyseli tällaista, enkä malttanut olla puuttumatta aiheeseen...
<HTML>
<HEAD>
<TITLE></TITLE>
<META http-equiv=Content-Type content="text/html; charset=UTF-8">
<script language="vbscript">
Sub getSomeAction Dim xhttp, url, xurl, str Dim xref, xcss, xsrc 'huom! putka käyttää EDIT: näemmä iso-8859-1, 'eikä UTF-7 koodausta, kuten virheellisesti luulin... 'joten esimerkistä putoilee ääkköset/siä url = "https://www.ohjelmointiputka.net/" xurl = url + "index.php" Set xhttp = createObject("msxml2.XMLHTTP") xhttp.open "GET", xurl, false xhttp.send() xhttp.getAllResponseHeaders str = xhttp.responseText Set xhttp = nothing xref = "href=" + chr(34) xcss = "css/" xsrc = "src=" + chr(34) ' parsitaan linkit str = Replace(str, xref, xref + url) ' parsitaan tyyli-osoitteet str = Replace(str, xcss, url + xcss) ' parsitaan sorsa-osoitteet str = Replace(str, xsrc, xsrc + url) ' parsitaan mahd. tuplat pois linkeistä str = Replace(str, url + url, url) ' joko Document.Write(str) ' tai jos halutaan esim. vain <body> - </body> osuus ' niin parsitaan vielä hieman lisää... 'If instr(str, LCase("<body")) > 0 And instr(str, LCase("</body")) > 0 Then 'Dim xs, xe 'xs = Cint(instr(str, LCase("<body"))) 'xe = Cint(instr(str, LCase("</body"))) 'str = mid(str, xs, xe-xs) 'Huom! <BODY id 'xbody.innerHTML=str 'End if End Sub
</script>
</HEAD>
<BODY id="xbody">
<INPUT type="button" id="nappi" onclick="getSomeAction()" value="nappi">
</BODY>
</HTML>
neau33 kirjoitti:
'huom! putka käyttää UTF-7 koodausta
No ei kyllä varmasti käytä vaan iso-8859-1:tä.
Heippa taas!
Tässä vielä ASP.NET versio samaisesta aiheesta
<%@ Page Language="VB"%> <%@ import Namespace="Microsoft.VisualBasic" %> <%@ import Namespace="System.IO" %> <%@ import Namespace="System.Text" %> <%@ import Namespace="System.Net" %> "xbody" runat="server"> <form runat="server"> </form>
Encoding.UTF7 näemmä toimii myös putkan kohdalla...
Heippa taas!
Yahoon & Googlen naimakauppa.htm...
<HTML>
<HEAD>
<TITLE></TITLE>
<script language="vbscript">
Sub getSomeAction Dim xhttp, url(), str(), pagestr Dim xref, xcss, xsrc, xvrt For i = 0 to 1 ReDim Preserve str(i) ReDim Preserve url(i) Select Case i Case 0 url(i) = "http://fi.search.yahoo.com/" Case 1 url(i) = "http://www.google.fi/" End Select Set xhttp = createObject("msxml2.XMLHTTP") xhttp.open "GET", url(i), false xhttp.send() xhttp.getAllResponseHeaders str(i) = xhttp.responseText Set xhttp = nothing xref = "href=" + chr(34) xcss = "css/" xsrc = "src=" + chr(34) xvrt = "virtual=" + chr(34) str(i) = Replace(str(i), xref, xref + url(i)) str(i) = Replace(str(i), xcss, url(i) + xcss) str(i) = Replace(str(i), xsrc, xsrc + url(i)) str(i) = Replace(str(i), url(i) + url(i), url(i)) str(i) = Replace(str(i), url(i) + "mailto:", "mailto:") str(i) = Replace(str(i), xvrt, xvrt + url(i)) str(i) = Replace(str(i), url(i) + "http:", "http:") If instr(str(i), LCase("<body")) > 0 And instr(str(i), LCase("</body")) > 0 Then Dim xs, xe xs = Clng(instr(str(i), LCase("<body"))) xe = Clng(instr(str(i), LCase("</body"))) str(i) = mid(str(i), xs, xe-xs) pagestr = pagestr + str(i) End if Next xbody.innerHTML = pagestr End Sub
</script>
</HEAD>
<BODY onload="getSomeAction()" id="xbody">
</BODY>
</HTML>
melkein tekis mieli lätätä tohon vielä combo johon iskeä suosikeista osoitteita + OK-nappi...
Heippa taas!
leikkaa ja liimaa tästä itsellesi kiva hakusivu (MetaHaku.htm)...
<HTML> <HEAD> <TITLE>MetaHaku</TITLE> <script language="vbscript"> Sub getSomeAction Dim xhttp, url(), str(), pagestr Dim xref, xcss, xsrc, xvrl, xact For i = 0 to 3 ReDim Preserve str(i) ReDim Preserve url(i) Select Case i Case 0 url(i) = "http://fi.search.yahoo.com/" Case 1 url(i) = "http://www.google.fi/" Case 2 url(i) = "http://www.fi/" Case 3 url(i) = "http://www.metacrawler.com/" End Select Set xhttp = createObject("msxml2.XMLHTTP") xhttp.open "GET", url(i), false xhttp.send() xhttp.getAllResponseHeaders str(i) = xhttp.responseText Set xhttp = nothing xref = "href=" + chr(34) xcss = "css/" xsrc = "src=" + chr(34) xact = "action=" + chr(34) xvrl = "virtual=" + chr(34) str(i) = Replace(str(i), xref, xref + url(i)) str(i) = Replace(str(i), xcss, url(i) + xcss) str(i) = Replace(str(i), xsrc, xsrc + url(i)) str(i) = Replace(str(i), url(i) + url(i), url(i)) str(i) = Replace(str(i), xact , xact + url(i)) str(i) = Replace(str(i), xvrl, xvrl + url(i)) str(i) = Replace(str(i), "=/", "=" + url(i)) str(i) = Replace(str(i), url(i) + "mailto:", "mailto:") str(i) = Replace(str(i), url(i) + "http:", "http:") str(i) = Replace(str(i), url(i) + "https:", "https:") If instr(str(i), LCase("<body")) > 0 And instr(str(i), LCase("</body")) > 0 Then Dim xs, xe xs = Clng(instr(str(i), LCase("<body"))) xe = Clng(instr(str(i), LCase("</body>"))) + 7 str(i) = mid(str(i), xs, xe-xs) pagestr = pagestr + str(i) End if Next If Len(pagestr) > 0 Then xbody.innerHTML = pagestr End If End Sub </script> </HEAD> <BODY id="xbody" onload="getSomeAction()"> </BODY> </HTML>
Hei haloo!
eipäs nyt mennä ja unohdeta mielenkiintoista aihetta...
<HTML> <HEAD><TITLE>PutkaHaku</TITLE> <script language="vbscript"> Sub getSomeAction Dim xhttp, url, bstr, str, slen Dim xref, xsrc, xact, xvrl url = "https://www.ohjelmointiputka.net/" xref = "href=" + chr(34) xsrc = "src=" + chr(34) xact = "action=" + chr(34) xvrl = "virtual=" + chr(34) Set xhttp = CreateObject("msxml2.XMLHTTP") xhttp.open "POST", url, false xhttp.send() xhttp.getAllResponseHeaders bstr = xhttp.responseBody '* <-- huomaa binaariputken... For i = 1 to LenB(bstr) str = str & Chr(AscB(MidB(bstr,i , 1))) '*<-- ...konversio stringiksi '(ilman mitään API-paskaa) Next Set xhttp = Nothing slen = Len(str) For i = 1 to slen If LCase(mid(str, i, Len(xref))) = xref Then If Not mid(str, i + Len(xref), 1) = "/" _ And Not mid(str, i + Len(xref), Len("http://")) = "http://" _ And Not mid(str, i + Len(xref), Len("https://")) = "https://" _ And Not mid(str, i + Len(xref), Len("mailto:")) = "mailto:" Then str = left(str, i + Len(xref) - 1) & url & right(str, Len(str) - i - Len(xref) + 1) slen = Len(str) ElseIf mid(str, i + Len(xref), 1) = "/" Then str = left(str, i + Len(xref) - 1) & url & right(str, Len(str) - i + 1) slen = Len(str) End If End If If LCase(mid(str, i, Len(xsrc))) = xsrc Then If Not mid(str, i + Len(xsrc), 1) = "/" _ and And Not mid(str, i + Len(xsrc), Len("http://")) = "http://" _ and And Not mid(str, i + Len(xsrc), Len("https://")) = "https://" Then str = left(str, i + Len(xsrc) - 1) & url & right(str, Len(str) - i - Len(xsrc) + 1) slen = Len(str) ElseIf mid(str, i + Len(xsrc), 1) = "/" Then str = left(str, i + Len(xsrc) - 1) & url & right(str, Len(str) - i + 1) slen = Len(str) End If End If If LCase(mid(str, i, Len(xact))) = xact Then If Not mid(str, i + Len(xact), 1) = "/" _ And Not mid(str, i + Len(xact), Len("http://")) = "http://" _ And Not mid(str, i + Len(xact), Len("https://")) = "https://" Then str = left(str, i + Len(xact) - 1) & url & right(str, Len(str) - i - Len(xact) + 1) slen = Len(str) ElseIf mid(str, i + Len(xact), 1) = "/" Then str = left(str, i + Len(xact) - 1) & url & right(str, Len(str) - i + 1) slen = Len(str) End If End If If LCase(mid(str, i, Len(xvrl))) = xvrl Then If Not mid(str, i + Len(xvrl), 1) = "/" _ And Not mid(str, i + Len(xvrl), Len("http://")) = "http://" _ And Not mid(str, i + Len(xvrl), Len("https://")) = "https://" Then str = left(str, i + Len(xvrl) - 1) & url & right(str, Len(str) - i - Len(xvrl) + 1) slen = Len(str) ElseIf mid(str, i + Len(xvrl), 1) = "/" Then str = left(str, i + Len(xvrl) - 1) & url & right(str, Len(str) - i + 1) slen = Len(str) End if End if Next If Len(str) > 0 Then Document.Write(str) End If End Sub </script></HEAD> <BODY id="xbody" onload="getSomeAction()"> </BODY> </HTML>
19:18 <+Leivinjauhe (NIMI SENSUROITU HUOM)> https://www.ohjelmointiputka.net/keskustelu/
Itsekin mietin usein samaa... Alkomaholia tuo taisi viimeksi syyttää.
Aihe on jo aika vanha, joten et voi enää vastata siihen.