【 以下文字转载自 sysop 讨论区 】
发信人: aotian (aotian), 信区: sysop
标 题: Re: 大声吼一句,求滚动复制方法
发信站: 水木社区 (Tue Nov 13 12:28:03 2012), 站内
把下面复制下来存成vbs,用fterm154执行
搜索完毕后,将光标停在第一篇,然后开始执行
最后会复制到剪贴板里
Option Explicit
Dim oldScreen, chrs1, chrs2, buffer
Dim i,j,k
Dim rltStr
Dim lineStr
Dim pageNum
Dim form, textBox
oldScreen = getScreen
Fterm.CurrentWindow.SendConvertedData("$")
judgeScreen
lineStr = Trim(Mid(oldScreen(3),2))
pageNum = (Mid(lineStr, 1, InStr(lineStr, " ")) - 1) / 20 - 1
Fterm.CurrentWindow.SendConvertedData("1^M")
judgeScreen
rltStr = arrJoin2(oldScreen, 3, 22)
For i = 0 to pageNum
Fterm.CurrentWindow.SendConvertedData(" ")
judgeScreen
rltStr = rltStr & arrJoin2(oldScreen, 3,22)
Next
Set form = CreateObject("Forms.Form.1")
Set textBox = form.Controls.Add("Forms.TextBox.1").Object
textBox.MultiLine = True
textBox.Text = rltStr
textBox.SelStart = 0
textBox.SelLength = textBox.TextLength
textBox.Copy
Set textBox = nothing
Set form = nothing
MsgBox("复制成功")
Function getScreen()
Dim i
Dim myStr(23)
For i = 0 to 23
myStr(i) = Fterm.CurrentWindow.GetBuffer(i)
Next
getScreen = myStr
End Function
Function arrJoin(arr(), x, y)
Dim i
arrJoin = ""
For i = x to y
arrJoin = arrJoin & arr(i)
Next
End Function
Function arrJoin2(arr(), x, y)
Dim i
arrJoin2 = ""
For i = x to y
arrJoin2 = arrJoin2 & arr(i) & vbcrlf
Next
End Function
Function judgeScreen()
Dim nowScreen, oldScreenStr, nowScreenStr, diff
diff = 100
While diff > 12
Fterm.Delay(1000)
nowScreen = getScreen
oldScreenStr = arrJoin(oldScreen, 1, 22)
nowScreenStr = arrJoin(nowScreen, 1, 22)
diff = compareRight(oldScreenStr, nowScreenStr)
oldScreen = nowScreen
Wend
End Function
Function compareRight(str1, str2)
Dim buffer1, buffer2, i
str1 = RTrim(str1)
str2 = RTrim(str2)
If Len(str1) <> Len(str2) Then
compareRight = -1
Else
For i = 1 to Len(str1)
If Right(str1, i) = Right(str2, i) Then
compareRight = i
Else
Exit Function
End If
Next
End If
End Function
【 在 oxx (搜索) 的大作中提到: 】
: 超级搜索
--
修改:aotian FROM 118.186.202.*
FROM 118.186.202.*