【 以下文字转载自 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.*

哈哈
【 在 tssnake (爱，勇气，希望@@马瘦毛长) 的大作中提到: 】
: 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: 发信站: 水木社区 (Tue Nov 13 14:51:36 2012), 站内
:
: 好吧
: 换更新版本吧
: 【 在 sevarsti (E.T.~缥缈过客) 的大作中提到: 】
: :         失败，loading之后unsupported...
:
:
: --
: 一声霹雳一把剑 一群猛虎钢七连！                                  ____
: _____       ____ _____ ____        _____ ____       ____ ____  ╱￣￣╲
:   ___   _          _ _        \                               /   ☆   \
: ___         _  _   _   _  _    \     _          _   _    _  _▕ ⌒￣⌒ ︳
:                                                                ╲_罒_╱
:                              钢七连的第5610个兵·tssnake          ￣
:
:
: ※ 来源:·水木社区 newsmth.net·[FROM: 166.111.72.12]
--
FROM 123.124.80.*

用的是64位win7
怎么换成写入文件？
【 在 aotian (aotian) 的大作中提到: 】
: 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: 发信站: 水木社区 (Sat Jan 11 23:53:41 2014), 站内
:
: 应该是操作系统不兼容吧我猜
: 把这一段放入剪贴板的代码换成写入文件的应该就行了
:
: 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
:
:
:
: 【 在 haning (寒宇) 的大作中提到: 】
: : @aotian
: : 是我打开的方式不对吗？运行后都提示
: : “
: : ...................
:
: --
:
: ※ 来源:·水木社区 newsmth.net·[FROM: 42.81.235.*]
--
FROM 119.57.112.*

没生成这个文件

btw：对于这个脚本的路径没啥特殊要求吧

【 在 aotian (aotian) 的大作中提到: 】
: 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: 发信站: 水木社区 (Sun Jan 12 00:01:40 2014), 站内
:
: dim myFile, fso
: Set fso = CreateObject("Scripting.FileSystemObject")
: Set myFile = fso.OpenTextFile("buffer.txt", 2, true)
: myFile.write rltStr
: myFile.close
: Set myFile = nothing
: Set fso = nothing
:
: 用这一段试试看，然后看是否在Fterm安装目录下会生成buffer.txt文件并写入文章列表了
:
:
:
: 【 在 haning (寒宇) 的大作中提到: 】
: : 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: : 发信站: 水木社区 (Sat Jan 11 23:56:38 2014), 站内
: :
: : 用的是64位win7
: : 怎么换成写入文件？
: : 【 在 aotian (aotian) 的大作中提到: 】
: : : 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: : : 发信站: 水木社区 (Sat Jan 11 23:53:41 2014), 站内
: : :
: : : 应该是操作系统不兼容吧我猜
: : : 把这一段放入剪贴板的代码换成写入文件的应该就行了
: : :
: : : 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
: : :
: : :
: : :
: : : 【 在 haning (寒宇) 的大作中提到: 】
: : : : @aotian
: : : : 是我打开的方式不对吗？运行后都提示
: : : : “
: : : : ...................
: : :
: : : --
: : :
: : : ※ 来源:·水木社区 newsmth.net·[FROM: 42.81.235.*]
: :
: :
: : --
: :
: : ※ 来源:·水木社区 newsmth.net·[FROM: 119.57.112.*]
:
:
: --
:
: ※ 来源:·水木社区 newsmth.net·[FROM: 42.81.235.*]
--
FROM 119.57.112.*

确实
【 在 aotian (aotian) 的大作中提到: 】
: 标  题: Re: 大声吼一句，求滚动复制方法 (转载)
: 发信站: 水木社区 (Sun Jan 12 00:18:11 2014), 站内
:
: 那可能是你把msgbox "复制成功"那一行也去掉了，那一行最好还是留着，可以知道什么时候运行完了
:
: 【 在 haning (寒宇) 的大作中提到: 】
: : 运行完没提示
: : 在脚本所在的目录下找到这个buffer.txt文件了，里面的内容是帖子列表
: : 3ks
: : ...................
:
: --
:
: ※ 来源:·水木社区 newsmth.net·[FROM: 42.81.235.*]
--
FROM 119.57.112.*