BBS注册机(vb script, telnet, sterm)

#include "lib.vbs"

Const nTimeout = 3  'in second

Const NewSucceed = 0
Const NewFaild = 1
Const LimitedNew = 2
Const IDExist = 3

Const NickLen = 38
Const IDLenMin = 2
Const IDLenMax = 12

WantedIdFile = "id_wanted.txt"
DoneIdFile = "id_done.txt"

'Information used fro registration
Const strPassWord = "!@#$%^"
Const strNickName = "GRE Word List"
Const strRealName = "我爱背单词"
Const strDepartment = "浙江大学计算机学院"
Const strAddress = "浙江大学玉泉校区30舍"
Const strGrade = "2001"
Const strPhone = "87931624"

'Option Explicit
Main
MsgBox ("Script End")

Sub Main()

 'Dim bConnect, nTime, nScreenHeight, strScreenLine, nDelay
 
 Dim fsoWanted, fsoDone, tsWanted, tsDone
 Dim strLine, strID, strNick
 Dim pos

    Dim NewRegistResult

 Set fsoWanted = CreateObject("Scripting.FileSystemObject")
 Set fsoDone = CreateObject("Scripting.FileSystemObject")
 Set tsWanted = fsoWanted.OpenTextFile(WantedIdFile, ForReading)
 Set tsDone = fsoDone.OpenTextFile(DoneIdFile, ForAppending, True)

 Do While (Not tsWanted.AtEndOfStream)
        strLine = tsWanted.ReadLine
        pos = InStr(strLine, " ")
        strID = Left(strLine, pos-1)
        strNick = Mid(strLine, pos+1, NickLen)
        strID = TrimAll(strID)

        If (strNick = "") Then
            strNick = strNickName
        End If

        If (Len(strID) >= IDLenMin And Len(strID) <= IDLenMax) Then    'lenght of ID must in [2, 12]
            ReconnectHost()
            NewRegistResult = NewAndRegistrID(strID, strNick)
            If (NewRegistResult = NewSucceed) Then
                tsDone.WriteLine(strID)                     '记录注册成功的ID
            ElseIf (NewRegistResult = IDExist) Then
                tsDone.WriteLine("# "+strID+" "+strNick)    '记录冲突的ID
            ElseIf (NewRegistResult = NewFaild) Then
                tsDone.WriteLine("@ "+strID+" "+strNick)    '记录注册失败的ID
            ElseIf (NewRegistResult = LimitedNew) Then
                tsDone.WriteLine("$已经到达每日注册上限")   '不能再注册了
                STermScript.Disconnect()
                Exit Do
            End If
            STermScript.Disconnect()
        Else
            tsDone.WriteLine("& "+strID+" "+strNick)    '记录长度出错的ID
        End If

        StermScript.Delay(500)    '延时
    Loop
 

 tsWanted.Close
 tsDone.Close
 
End Sub

'************************************************************
'* Function: NewAndRegistrID(ByRef strIDWanted)              *
'* Return Value:                                            *
'* 新建一个帐号                                             *
'************************************************************
Function NewAndRegistrID(ByRef strIDWanted, ByRef strNick)

'Return Value:
'Const NewSucceed = 0
'Const NewFaild = 1
'Const LimitedNew = 2
'Const IDExist = 3

    Dim nScrH, strLine, strLeft

    '新建一个帐号
 If (Not WaitUntil("请输入帐号", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData("new" + Chr(13)) '发送new
 End If

    '您今天不能再申请新帐号了
    If (InStr(STermScript.GetBuffer(STermScript.GetCursorY()), "不能再申请") > 0) Then
        NewAndRegistrID = LimitedNew
        Exit Function
    End If

 If (Not WaitUntil("请输入帐号名称", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData(strIDWanted + Chr(13)) '输入要新建的ID
 End If

    StermScript.Delay(500) '延时，等待ID冲突判断

    '此帐号已经有人使用
    If (InStr(STermScript.GetBuffer(STermScript.GetCursorY()-1), "已经") > 0) Then
        NewAndRegistrID = IDExist
        Exit Function
    End If

 If (Not WaitUntil("请设定您的密码", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData(strPassWord + Chr(13)) '输入密码
 End If

 If (Not WaitUntil("请再输入一次你的密码", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData(strPassWord + Chr(13)) '再次输入密码
 End If

 '跳过欢迎屏幕
    Do
        STermScript.SendData(goDown)
        'StermScript.Delay(100)
    Loop Until (InStr(STermScript.GetBuffer(STermScript.GetCursorY()), "请输入您的昵称") > 0) '调到输入昵称的那行

    StermScript.SendData(strNick + Chr(13)) '输入昵称
    StermScript.SendData(strRealName + Chr(13)) '输入真实姓名

 If (Not WaitUntil("您确定要填写注册单吗", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData("Y" + Chr(13)) '再次输入密码
 End If

    StermScript.SendData(strRealName + Chr(13))     '真实姓名: 马甲
    StermScript.SendData(strDepartment + Chr(13))   '学校院系: 浙江大学计算机学院
    StermScript.SendData(strAddress + Chr(13))  '详细住址: 浙江大学玉泉校区30舍
    StermScript.SendData(strGrade + Chr(13))    '年级(如1999): 2001
    StermScript.SendData(strPhone + Chr(13))    '联络电话: 87931624

    '以上资料是否正确, 按 Q 放弃注册 (Y/N/Quit)? [N]:
 If (Not WaitUntil("以上资料是否正确", nTimeout)) Then
  NewAndRegistrID = NewFaild
  Exit Function
 Else
  STermScript.SendData("Y" + Chr(13)) '再次输入密码
 End If

 NewAndRegistrID = NewSucceed
 
End Function