精华区文章阅读

发信人: joyfree (白龙●忙得像死狗), 信区: Test
标 题: 下载整个版面脚本
发信站: 哈工大紫丁香 (2003年11月13日19:49:03 星期四), 站内信件

Option Explicit

#include "const.inc"

Dim m_nWindowNumber
Dim m_VariantObjArray()
Dim n, m_FSO

'Copy Article const
Const CA_STATUS_IDLE = 0
Const CA_STATUS_COPYNEXT = 1
Const strSpr = "=================================================="

'Group Copy Article const
Const GCA_STATUS_IDLE = 0
Const GCA_STATUS_START = 1
Const GCA_STATUS_GETARTICLE_NUM = 2
Const GCA_STATUS_MOVE_TO_NEXT = 3
Const GCA_STATUS_MOVE_TO_NEXT_ARTICLE = 4
Const GCA_STATUS_COPY_ARTICLE = 5
Const GCA_STATUS_COPY_SINGLE_ARTICLE = 100

Class STermVariantObj
 Public ID
 Public strLastMsg, bIsMsgCome, strLastMsgCome
 Public strSLine(), strSLineOld()
 Public Sub RedimLines(n)
 ReDim strSLine(n), strSLineOld(n)
 End Sub
 Public nScreenHeight, nCAStatus
 Public nGroupCopyStatus
 Public strArticleSegment
 Public bCopySingleArticleEnd
 Public nSingleArticlePercent
 Public nTotalArticleNum
 Public nCurrentArticle
 Public strArticlePath
 Public strArticleTitle
 Public IndexTextStream
 Public TextStream
End Class

Sub STerm_OnAutoReply(ByVal ID, ByVal nMsgType)
 Dim strMsg, strLine, l, i
 Dim obj, varobj
 Set varobj = GetVariantObjByID(ID)
 Set obj = STermControlScript.GetWindowObj(ID)

 strMsg = obj.GetBuffer(0)
 If RegExpMatch("\(\^", strMsg) > 0 Then
 l = InStr(strMsg, ")")
 If (l > 0) Then
 strMsg = Trim(Mid(strMsg, l + 2))
 End If
 Else
 strMsg = ""
 varobj.nScreenHeight = obj.GetScreenHeight()
 For i = 1 To varobj.nScreenHeight - 1
 strLine = obj.GetBuffer(i)
 If (InStr(strLine, " 第") = 1) Then
 Exit For
 End If
 strMsg = strMsg + strLine
 Next
 End If
 If (strMsg <> varobj.strLastMsg) Then
 n = n + 1
 obj.SendConvertedData obj.strReplyKey
 obj.SendData obj.strReply + vbCRLF
 varobj.strLastMsg = strMsg
 obj.bAutoReplied = True
 End If
End Sub

Sub STerm_OnAntiIdle(ByVal ID)
 Dim obj, varobj
 Set varobj = GetVariantObjByID(ID)
 Set obj = STermControlScript.GetWindowObj(ID)

 obj.SendConvertedData obj.strAntiIdle
End Sub

Sub STerm_OnMouseKBEvent(ByVal ID, ByVal nEventID, ByVal wParam, ByVal lParam)
 Dim obj, varobj
 Dim x, y, nFlags, zDelta
 Dim nChar
 Set varobj = GetVariantObjByID(ID)
 Set obj = STermControlScript.GetWindowObj(ID)

 x = CLng((lParam Mod 65536)/ obj.nFontWidth)
 y = CLng((lParam / 65536)/ obj.nFontHeight)
 nFlags = CLng(wParam Mod 65536)
 zDelta = CInt(wParam / 65536) 'this is a sign value
 nChar = wParam

 Select Case nEventID
 Case MOUSE_LBUTTONCLK
 Case MOUSE_LBUTTONDBLCLK
 Case MOUSE_MBUTTONCLK
 Case MOUSE_RBUTTONCLK
 Case MOUSE_RBUTTONDBLCLK
 MsgBox("aaa X:"+CStr(x) + " Y:"+ CStr(y))
 Case MOUSE_WHEEL
 Case KEYBOARD_ONCHAR
 End Select

 obj.OnMouseKBEvent nEventID, wParam, lParam
End Sub

Sub STerm_OnDataCome(ByVal ID)
 Dim obj, varobj
 Dim strLine
 Dim nType
 Dim r
 Dim regEx, Match, Matches
 Dim nIdLength, nTimeLength
 Dim strID, strTime, strMsg
 Dim i, bIsWho

 Set obj = STermControlScript.GetWindowObj(ID)
 Set varobj = GetVariantObjByID(ID)

 If (obj.nConnectionType = STERM_CONNECTION_BBS) Then
 If obj.nMaxBeepCount > 3 Then
 obj.nMsgState = STERM_STATE_TALK
 ElseIf obj.nMaxBeepCount > 0 Then
 varobj.bIsMsgCome = True
 obj.nMsgState = STERM_STATE_UNKNOW
 End If

 If varobj.bIsMsgCome = True Then
 strLine = obj.GetBuffer(0)
 If (InStr(strLine, "站长") = 1) Then
 bIsWho = 1
 varobj.strLastMsgCome = strLine
 varobj.bIsMsgCome = False
 ElseIf ((InStr(strLine, "(^Z回)") > 0 Or RegExpMatch("...
...*\d\d:\d\d", strLine) > 0) And strLine <> varobj.strLastMsgCome) Then
 bIsWho = 0
 varobj.strLastMsgCome = strLine
 varobj.bIsMsgCome = False
 End If

 If varobj.bIsMsgCome = False Then
 r = RegExpMatch("$([A-Z]|[a-z]|[0-9]| |:)*$", strLine)
 If bIsWho = 1 Then
 r = 4 * 256 + 11
 End If

 If r = 0 Then
 obj.nMsgState = STERM_STATE_UNKNOW
 Else
 nIdLength = CInt(r / 256)
 nTimeLength = r Mod 256

 If nIdLength = 0 Then
 obj.nMsgState = STERM_STATE_UNKNOW
 Else
 If nTimeLength < 2 Then
 obj.nMsgState = STERM_STATE_UNKNOW
 Else
 obj.nMsgState = STERM_STATE_MSG
 strID = Left(strLine, nIdLength)
 strTime = Mid(strLine, nIdLength + 2, nTimeLength
- 2)
 strMsg = Mid(strLine, nIdLength + nTimeLength + 1
+ 1)
 If (RegExpMatch("\(\^", strMsg) > 0 Or
(InStr(strLine, "广播") > 0 And RegExpMatch("\d:\d\d:\d\d", strLine) > 0))
Then 'Normal BBS Msg?

 Else
 ' Smth BBS MSG?
 strMsg = ""
 varobj.nScreenHeight = obj.GetScreenHeight()
 For i = 1 To varobj.nScreenHeight - 1
 strLine = obj.GetBuffer(i)
 If (InStr(strLine, " 第") = 1) Then
 Exit For
 End If
 strMsg = strMsg + strLine + vbCRLF
 Next

 End If
 obj.AddMsgToLst strID, strTime, strMsg, False
 End If
 End If
 End If
 End If
 End If
 End If
End Sub

Sub STerm_CanCopyArticle(ByVal ID)
 Dim obj, varobj
 Dim strLine1, strLine2, strFirstLine, strLastLine

 Set obj = STermControlScript.GetWindowObj(ID)
' Set varobj = GetVariantObjByID(ID)

 obj.bCanCopyArticle = False

 strLastLine = obj.GetBuffer(obj.GetScreenHeight() - 1)
 'Firebird系统
 If (InStr(strLastLine, "下面还有") > 0 Or InStr(strLastLine, "看到末尾")
> 0) Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 If (InStr(strLastLine, "阅读") > 0 And InStr(strLastLine, "结束") > 0)
Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 If (InStr(strLastLine, "回信") > 0 And InStr(strLastLine, "删除") > 0 And
InStr(strLastLine, "继续") > 0) Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 If (InStr(strLastLine, "密码") > 0 And InStr(strLastLine, "删除") > 0 And
InStr(strLastLine, "错误") > 0) Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 If (InStr(strLastLine, "清除") > 0 And InStr(strLastLine, "寄回") > 0)
Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 'MAPLES系统？
 If ((InStr(strLastLine, "浏览") > 0) Or (InStr(strLastLine, "文章") > 0))
And (InStr(strLastLine, "搜寻") > 0) Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

 If (CanGroupCopy(obj)) Then
 obj.bCanCopyArticle = True
 Exit Sub
 End If

End Sub

Function DetectLastLine(varobj)
 Dim i, j, bEqual
 Dim nMinLine
 nMinLine = varobj.nScreenHeight - 2

 For i = varobj.nScreenHeight - 2 To 0 Step -1
 bEqual = True
 For j = 0 To varobj.nScreenHeight - 2 - i
 If varobj.strSLine(j) <> varobj.strSLineOld(i + j) Then
 bEqual = False
 Exit For
 End If
 Next
 If bEqual Then
 nMinLine = varobj.nScreenHeight - 2 - i
 End If
 Next
 DetectLastLine = nMinLine + 1
End Function

Sub WriteHtmlHead(fso)
 fso.write "<html><head>" + vbCRLF
 fso.write "<meta http-equiv=""Content-Language"" content=""zh-cn"">" +
vbCRLF
 fso.write "<meta http-equiv=""Content-Type"" content=""text/html;
charset=gb2312"">" + vbCRLF
 fso.write "<title>S-Term, a smart, SSH enabled, script extendable
TERM...</title>" + vbCRLF
 fso.write "</head> <body>" + vbCRLF
 fso.write "S-Term文章下载" + vbCRLF
 fso.write "支持强大脚本功能的Term，支
持SSH的Term，可超强定制的Term<hr>" + vbCRLF

End Sub

Sub WriteHtmlEnd(fso)
 fso.write "<hr>欢迎光临<a
href=""http://www.sterm.com"">http://www.sterm.com</a>, <a
href=""http://sterm.smth.edu.cn"">http://sterm.smth.edu.cn</a>获取最新的S-Term
，本下载通过脚本实现" + vbCRLF
 fso.write "</body></html>" + vbCRLF
End Sub

Function GetPercent(ByVal strLine)
' Dim regEx, Match, Matches, str
' Set regEx = New RegExp
' regEx.Pattern = "\d{1,}"
' regEx.IgnoreCase = True
' regEx.Global = True
' Set Matches = regEx.Execute(strLine)
' str = ""
' For Each Match in Matches
' Str = Match.Value
' Exit For
' Next
 Dim nStart, nEnd, strTemp
 nStart = InStr(strLine, "(")
 nStart = nStart + 1
 nEnd = InStr(strLine, "%")
 nEnd = nEnd - nStart
 If nEnd > 0 Then
 strTemp = Mid(strLine, nStart, nEnd)
 GetPercent = CLng(strTemp)
 Else
 GetPercent = 100
 End If
End Function

Function RegExpMatch(patrn, strng)
 Dim n1, n2, r
 Dim regEx, Match, Matches ' Create variable.
 n1 = 0
 n2 = 0
 Set regEx = New RegExp ' Create a regular expression.
 regEx.Pattern = patrn ' Set pattern.
 regEx.IgnoreCase = True ' Set case insensitivity.
 regEx.Global = True ' Set global applicability.
 Set Matches = regEx.Execute(strng) ' Execute search.

 For Each Match in Matches ' Iterate Matches collection.
 n1 = Match.FirstIndex
 n2 = Match.Length
 Exit For
 Next
 r = n1 * 256 + n2
 RegExpMatch = r
End Function

Sub STerm_OnCopyArticle(ByVal ID, ByVal bCopyInit)
' 该事件在除了第一次外，在发生了STerm_OnDataCome后发生，因此，状态变化必须考
虑到
'是否会引起服务器发送数据

 Dim i, strLastLine, strLine, strDir, c
 Dim obj, varobj
 Dim bEndCopy, bIsEnd
 Dim fso
 Dim TestFolder

 Set obj = STermControlScript.GetWindowObj(ID)
 Set varobj = GetVariantObjByID(ID)

 If bCopyInit Then
 '用户中断 or 关闭拷贝对话框
 varobj.RedimLines(0)
 varobj.nCAStatus = CA_STATUS_IDLE
 If (CanGroupCopy(obj)) Then
 varobj.nGroupCopyStatus = GCA_STATUS_START
 Else
 varobj.nGroupCopyStatus = GCA_STATUS_COPY_SINGLE_ARTICLE
 End If

 Exit Sub
 End If

 Select Case varobj.nGroupCopyStatus
 '每次做一次操作似乎比较稳妥，每个操作都会被执行，否则执行操作方面就可能
出问题
 '不过好像还是可能会出问题，不知道为什么
 Case GCA_STATUS_IDLE
 Case GCA_STATUS_START
 strDir = STermControlScript.GetSTermDir()
 If Right(strDir, 1) <> "\" Then
 strDir = strDir + "\"
 End If
 strDir = strDir + "Article\"
 If Not m_FSO.FolderExists(strDir) Then
 '创建 article\ 目录
 m_FSO.CreateFolder(strDir)
 End If

 strLine = CStr(now)
 For i = 1 to Len(strLine)
 c = Mid(strLine, i, 1)
 If (c >= "0") And (c <= "9") Then
 strDir = strDir + c
 End If
 Next
 strDir = strDir + "\"

 If m_FSO.FolderExists(strDir) Then
 obj.InsertArticleLines "目录 "+strDir+"已存在，结束拷贝" ,
100, True
 varobj.nGroupCopyStatus = GCA_STATUS_IDLE
 Exit Sub
 End If

 varobj.strArticlePath = strDir
 m_FSO.CreateFolder(strDir) '创建文件下载目录
 obj.InsertArticleLines "生成目录 "+strDir + vbCRLF , 0, False

 obj.SendData "$" '移动到列表底部
 varobj.nGroupCopyStatus = GCA_STATUS_GETARTICLE_NUM
 Exit Sub
 Case GCA_STATUS_GETARTICLE_NUM
 i = GetArticleNum(obj, varobj)
 If (i > 0) Then
 varobj.nTotalArticleNum = i
 varobj.nCurrentArticle = 1
 varobj.nGroupCopyStatus = GCA_STATUS_MOVE_TO_NEXT_ARTICLE
 obj.SendData "j" '下移一篇文章，现在已经在最低下，移动后
到第一篇
 Set varobj.IndexTextStream = Nothing
 Set varobj.IndexTextStream =
m_FSO.CreateTextFile(varobj.strArticlePath & "index.htm")
 WriteHtmlHead(varobj.IndexTextStream)
 obj.InsertArticleLines "共有" +CStr(i) + "篇文章" + vbCRLF ,
0, False
 obj.InsertArticleLines "生成index.htm" + vbCRLF , 0, False
 End If

 Exit Sub
 Case GCA_STATUS_MOVE_TO_NEXT
 obj.SendData "j" '移动到下一篇
 varobj.nGroupCopyStatus = GCA_STATUS_MOVE_TO_NEXT_ARTICLE


 Case GCA_STATUS_MOVE_TO_NEXT_ARTICLE
 i = GetArticleNum(obj, varobj)
' MsgBox(i)
 If (i > 0) AND (i = varobj.nCurrentArticle) Then
 varobj.RedimLines(0)
 varobj.nCAStatus = CA_STATUS_IDLE
 obj.SendData chr(13) '送出回车，进入文章
 varobj.nGroupCopyStatus = GCA_STATUS_COPY_ARTICLE

 '将超级连接写入index.htm
 varobj.IndexTextStream.Write "<a href=""" & CStr(i) &
".htm"">"
 varobj.IndexTextStream.Write varobj.strArticleTitle + vbCRLF
+ "</a> "
 Set varobj.TextStream = Nothing
 Set varobj.TextStream =
m_FSO.CreateTextFile(varobj.strArticlePath & CStr(varobj.nCurrentArticle) &
".htm")
 WriteHtmlHead(varobj.TextStream)
 End If
 Case GCA_STATUS_COPY_ARTICLE

 CopyArticleSegments obj, varobj, True
 varobj.TextStream.Write varobj.strArticleSegment

 If varobj.bCopySingleArticleEnd Then
 '拷贝完一篇文章
 WriteHtmlEnd(varobj.TextStream)
 varobj.TextStream.Close
 strLine = "拷贝文章" + CStr(varobj.nCurrentArticle) + "完成"
+ vbCRLF
 obj.InsertArticleLines strLine, varobj.nCurrentArticle * 100
/ varobj.nTotalArticleNum , False
 If (varobj.nCurrentArticle = varobj.nTotalArticleNum) Then
 varobj.nGroupCopyStatus = GCA_STATUS_IDLE
 WriteHtmlEnd(varobj.IndexTextStream)
 varobj.IndexTextStream.Close
 obj.InsertArticleLines vbCRLF + "拷贝完成" + vbCRLF , 100
, False
 obj.InsertArticleLines "请打开" + varobj.strArticlePath +
"index.htm" + "观看" + vbCRLF , 100 , True
 Else
 varobj.nCurrentArticle = varobj.nCurrentArticle + 1
 varobj.nGroupCopyStatus = GCA_STATUS_MOVE_TO_NEXT
 obj.SendData "q" '退出当前文章
 End If
 End If
 Case GCA_STATUS_COPY_SINGLE_ARTICLE
 CopyArticleSegments obj, varobj, False
 obj.InsertArticleLines varobj.strArticleSegment,
varobj.nSingleArticlePercent, varobj.bCopySingleArticleEnd
 End Select

End Sub

Function GetArticleNum(obj, varobj)
 '取得当前bbs带有标记">"的行的行号，该行内容放入varobj.strArticleTitle
 Dim strLastLine, strLine, i, r, s, l
 strLastLine = Trim(obj.GetBuffer(obj.GetScreenHeight() - 1))
 If (Len(strLastLine) > 0) Then
 For i = obj.GetScreenHeight() - 2 to 3 Step -1
 strLine = obj.GetBuffer(i)
 If Left(strLine, 1) = ">" Then
 r = RegExpMatch("\d+\D", strLine)
 s = Int(r/256) + 1
 l = (r mod 256) - 1
 GetArticleNum = CLng(Mid(strLine, s, l))
 varobj.strArticleTitle = Mid(strLine, 2)
 Exit Function
 End If
 Next
 End If
 GetArticleNum = -1
End Function

Sub CopyArticleSegments(obj, varobj, bWebView)
 Dim i, nLastLine, strLastLine, nPercent, strTemp, strArticle
 Dim bEndCopy, bIsEnd, strLineEnd

 varobj.strArticleSegment = ""
 varobj.bCopySingleArticleEnd = False

 If (bWebView) Then
 strLineEnd = " " + vbCRLF
 Else
 strLineEnd = vbCRLF
 End If

 strLastLine = obj.GetBuffer(obj.GetScreenHeight() - 1)
 If (InStr(strLastLine, "阅读") = 0 And InStr(strLastLine, "下面") = 0 And
InStr(strLastLine, "删除") = 0 And InStr(strLastLine, "浏览") = 0 And
InStr(strLastLine, "选读") = 0 And InStr(strLastLine, "继续") = 0 And
InStr(strLastLine, "看到末尾") = 0) Then
 Exit Sub
 End If

 If (InStr(strLastLine, "下面") > 0 Or InStr(strLastLine, "暂存") > 0 Or
(InStr(strLastLine, "剩余: 0") = 0 And InStr(strLastLine, "讯息浏览器") >
0)) Then
 '如果文章没完
 bEndCopy = False
 nPercent = GetPercent(strLastLine)
 Else
 bEndCopy = True
 nPercent = 100
 End If

 If varobj.nCAStatus = CA_STATUS_IDLE Then
 varobj.nScreenHeight = obj.GetScreenHeight()
 varobj.RedimLines(varobj.nScreenHeight - 1)
 End If

 strTemp = ""
 If (bEndCopy = True) Then
 bIsEnd = True
 Else
 bIsEnd = False
 End If

 For i = varobj.nScreenHeight - 2 To 0 Step -1
 strTemp = RTrim(obj.GetBuffer(i))
 If (strTemp <> "" And bEndCopy = True And bIsEnd = True) Then
 bIsEnd = False
 End If
 If (bIsEnd <> True) Then
 strTemp = strTemp + strLineEnd
 End If
 varobj.strSLine(i) = strTemp
 Next

 strArticle = ""

 If (varobj.nCAStatus = CA_STATUS_IDLE) Or (Not bEndCopy) Then
 If varobj.nCAStatus <> CA_STATUS_IDLE Then
 nLastLine = 1
 Else
 nLastLine = 0
 End If
 For i = nLastLine To varobj.nScreenHeight - 2
 varobj.strSLineOld(i) = varobj.strSLine(i)
 strArticle = strArticle + varobj.strSLine(i)
 Next
 Else
 nLastLine = DetectLastLine(varobj)
 For i = nLastLine To varobj.nScreenHeight - 2
 strArticle = strArticle + varobj.strSLine(i)
 Next
 End If

 If Not bEndCopy Then
 '翻页
 obj.SendData " "
 varobj.nCAStatus = CA_STATUS_COPYNEXT
 Else
' strArticle = strArticle + strLineEnd + "(本文采用S-Term文章拷贝脚本拷贝
)" + strLineEnd + strSpr + strLineEnd
 varobj.nCAStatus = CA_STATUS_IDLE
 End If

 varobj.bCopySingleArticleEnd = bEndCopy
 varobj.strArticleSegment = strArticle
 varobj.nSingleArticlePercent = nPercent
End Sub

Sub STerm_OnInit()
 m_nWindowNumber = 0
 n = 0
 Set m_FSO = CreateObject("Scripting.FileSystemObject")

' MsgBox(STermControlScript.GetSTermDir())
End Sub

Sub STerm_OnExit()
 Dim i
 For i = 0 to m_nWindowNumber - 1
 Set m_VariantObjArray(i) = Nothing
 Next
End Sub

Function GetVariantObjByID(ID)
 Dim i
 For i = 0 to m_nWindowNumber - 1
 If m_VariantObjArray(i).ID = ID Then
 Set GetVariantObjByID = m_VariantObjArray(i)
 Exit Function
 End If
 Next
 ' not found...?
 ' Maybe this is a new script loaded when sterm is already running with
one or more windows
 ' So let's create a variant obj and init it
 Set GetVariantObjByID = CreateVariantObjByID(ID)
 InitObj(GetVariantObjByID)
End Function

Function CreateVariantObjByID(ID)
 m_nWindowNumber = m_nWindowNumber + 1
 ReDim Preserve m_VariantObjArray(m_nWindowNumber)
 Set m_VariantObjArray(m_nWindowNumber - 1) = New STermVariantObj
 m_VariantObjArray(m_nWindowNumber - 1).ID = ID
 Set CreateVariantObjByID = m_VariantObjArray(m_nWindowNumber - 1)
End Function

Function RemoveVariantObjByID(ID)
 Dim i, j
 For i = 0 to m_nWindowNumber - 1
 If m_VariantObjArray(i).ID = ID Then
 Set RemoveVariantObjByID = m_VariantObjArray(i)
 Set m_VariantObjArray(i) = Nothing
 For j = i to m_nWindowNumber - 2
 Set m_VariantObjArray(j) = m_VariantObjArray(j + 1)
 Next
 m_nWindowNumber = m_nWindowNumber - 1
 ReDim Preserve m_VariantObjArray(m_nWindowNumber)
 Exit Function
 End If
 Next
 Set RemoveVariantObjByID = Nothing
End Function

Sub InitObj(varobj)
 varobj.nCAStatus = CA_STATUS_IDLE
 varobj.strLastMsg = ""
 varobj.strLastMsgCome = ""
 varobj.bIsMsgCome = False
 varobj.nGroupCopyStatus = GCA_STATUS_IDLE
End Sub

Sub STerm_OnSessionOpen(ID)
 Dim varobj, obj

 Set varobj = CreateVariantObjByID(ID)
 InitObj(varobj)
' Set obj = STermControlScript.GetWindowObj(ID)
' MsgBox(obj.GetSessionName() + VBCRLF + obj.GetHostAddress() + ":" +
CStr(obj.GetHostPort()))
End Sub

Sub STerm_OnSessionClose(ID)
 Dim varobj

 Set varobj = RemoveVariantObjByID(ID)
End Sub

Function CanGroupCopy(obj)
 '如果此函数返回False，表示当前不是版面文章列表状态
 Dim strLine1, strLine2, strLastLine

 strLine1 = obj.GetBuffer(1)
 strLine2 = obj.GetBuffer(2)
 If Not (InStr(strLine2, "编号") > 0) Then
 CanGroupCopy = False
 Exit Function
 End If

 strLastLine = obj.GetBuffer(obj.GetScreenHeight() - 1)
 strLastLine = Trim(strLastLine)
 If Len(strLastLine) < 1 Then
 CanGroupCopy = False
 Exit Function
 End if

 If (InStr(strLastLine, "清除") > 0 And InStr(strLastLine, "寄回") > 0)
Then
 CanGroupCopy = False
 Exit Function
 End If

 'MAPLES系统？
 If ((InStr(strLastLine, "阅读") > 0) Or (InStr(strLastLine, "文章") > 0))
or (InStr(strLastLine, "下面") > 0) Then
 CanGroupCopy = False
 Exit Function
 End If

 CanGroupCopy = TRUE
End Function
--
 -╬╬- ● __ ★
 ╭╬╮ ╭═╮ ╬╭╬╮ ══╬
 -╩╬╩- ╭╮╠═╣ ╬╟┼╢ ╠║
 ╭╨╮ ╟╢╠═╣ ╭╫╰╬╯ ║║
 ∣ ∣ ╰╯║ ║ ║ ║ ╞╩║
 ╯ ╰ ╯ ╯ ╯ ╰ ╯ ╰═

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 61.190.81.68]

PersonalCorpus 版 (精华区)