VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmBBS 
   AutoRedraw      =   -1  'True
   Caption         =   "bbs"
   ClientHeight    =   6195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7890
   BeginProperty Font 
      Name            =   "宋體"
      Size            =   12
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   722
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   1016
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   960
      Top             =   900
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   360
      Top             =   0
   End
   Begin VB.Menu mnu_file 
      Caption         =   "文件"
      Begin VB.Menu mnu_file_connect 
         Caption         =   "連接上一次站點"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnu_file_book 
         Caption         =   "地址簿"
      End
      Begin VB.Menu mnu_file_leave 
         Caption         =   "快速離站"
      End
      Begin VB.Menu mnu_file_off 
         Caption         =   "斷開"
      End
      Begin VB.Menu aa 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_file_exit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnu_edit 
      Caption         =   "編輯"
      Begin VB.Menu mnu_edit_copy 
         Caption         =   "拷貝"
      End
      Begin VB.Menu mnu_edit_paste 
         Caption         =   "粘貼"
      End
   End
   Begin VB.Menu mnu_tools 
      Caption         =   "工具"
      Begin VB.Menu mnu_tools_historyword 
         Caption         =   "查看通話記錄"
      End
      Begin VB.Menu mnu_tools_historyscreen 
         Caption         =   "查看歷史屏幕"
      End
      Begin VB.Menu mnu_tools_word 
         Caption         =   "外出留言"
      End
      Begin VB.Menu bb 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_tools_bat 
         Caption         =   "批處理"
      End
   End
   Begin VB.Menu mnu_help 
      Caption         =   "幫助"
      Begin VB.Menu mnu_help_about 
         Caption         =   "關于"
      End
   End
End
Attribute VB_Name = "frmBBS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'project modified by wxp
Option Explicit
DefInt A-Z
Dim Bold, Reverse, Bcolor, Fcolor, Css, ox, oy
Dim LastLoginSite As String
Dim LastLoginSitePort As Integer
Dim Connected As Boolean


Const WordWidth = 22
Const LetterWidth = 11
Const WordHeight = 22
Const VerSpace = 2
Const HorSpace = 16

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Connected Then
    Select Case KeyCode
        Case 38: SendChars "27;91;65"
        Case 40: SendChars "27;91;66"
        Case 37: SendChars "27;91;68"
        Case 39: SendChars "27;91;67"
    End Select
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim L&
If Connected Then
        
    If KeyAscii >= 0 Then
        SendChars Str$(KeyAscii)
    Else
        L& = KeyAscii + 65536
        SendChars Str$(L& \ 256) + ";" + Str$(L& Mod 256)
    End If
Else
    Call mnu_file_connect_Click
End If
End Sub

Private Sub Form_Load()
    Fcolor = 7
    Bcolor = 0
    BackColor = 0
    'frmBBS.Width = 648 * 12
    'frmBBS.Height = 416 * 12
    
    LastLoginSite = GetSetting("MyBBS", "Login", "Site", "")
    LastLoginSitePort = CInt(GetSetting("MyBBS", "Login", "Port", "0"))
    
    Timer1.Enabled = False
    
    If LastLoginSite <> "" Then
        mnu_file_connect.Enabled = True
    End If
    
'    Winsock1.Connect "10.12.13.66", 23
End Sub


Private Sub mnu_file_book_Click()
Dim myConnect As New frmAddress
myConnect.Show 1
If myConnect.Action = comdOK Then
    Winsock1.Close
    Winsock1.Connect myConnect.IPAddress, myConnect.PortNum
    Connected = False
    Me.Caption = myConnect.IPAddress
    mnu_file_connect.Enabled = True
    LastLoginSite = myConnect.IPAddress
    LastLoginSitePort = myConnect.PortNum
    SaveSetting "MyBBS", "Login", "Site", LastLoginSite
    SaveSetting "MyBBS", "Login", "Port", LastLoginSitePort
    Timer1.Enabled = True

    Do While Not Connected Or Winsock1.State = sckClosing
        DoEvents
    Loop
    
    If Connected Then
        AutoLogin (myConnect.LoginStr)
    End If
End If
End Sub

Private Sub mnu_file_connect_Click()
    Winsock1.Close
    Winsock1.Connect LastLoginSite, LastLoginSitePort
    Connected = False
    Timer1.Enabled = True
    Me.Caption = LastLoginSite
End Sub

Private Sub mnu_file_leave_Click()
Dim I As Integer
On Error Resume Next
Connected = False
For I = 0 To 5
    SendChars "27;91;68"
    Sleep (50)
Next I

For I = 0 To 2
    SendChars "13"
    Sleep (50)
Next I

End Sub

Private Sub mnu_file_off_Click()
    frmBBS.Picture = LoadPicture("")
    frmBBS.Cls
    Winsock1.Close
End Sub

Private Sub Timer1_Timer()
Dim X, Y, C As Integer
    Main
    
    Css = (Css + 1) Mod 10
    X = CurrentX
    Y = CurrentY
    
    If X <> ox Or Y <> oy Then
        Line (ox, oy + 15)-Step(7, 0), QBColor(Bcolor)
        ox = X
        oy = Y
    End If
    
    If Css < 5 Then
        C = Bcolor
    Else
        C = Fcolor
    End If
    
    Line (X, Y + WordHeight)-Step(LetterWidth, 0), QBColor(C)
    CurrentX = X
    CurrentY = Y
    
End Sub

Function Inkey() As Byte
Dim b As Byte
'循環等待服務器端的數據
While Winsock1.BytesReceived = 0
    Nop
Wend
'獲得服務器端數據，每次獲得一個字節
Winsock1.GetData b
'返回獲得的字節
Inkey = b
Debug.Print b & "--" & Chr(b)
End Function
'控操作過程，以等待服務器端的數據
Sub Nop()
    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents:
    DoEvents: DoEvents
End Sub

Function VVV(D$)
    '將字符串轉換成數值
    VVV = Val(D$)
    '然后去除被轉換成數值的字符串
    D$ = Mid$(D$, InStr(D$ + ";", ";") + 1)
End Function

Sub SendChars(D$)
Dim b As Byte
    While D$ <> ""
        b = VVV(D$)
        '然后發送該字節
        
        
        Winsock1.SendData b
    Wend
End Sub

Sub Main()
Dim b As Byte, LL
Dim C, D, V, xx, yy As Byte
Dim X, Y, L, F, T As Integer
Dim s$, dat$, p&

While Winsock1.BytesReceived > 0
    'DoEvents
    b = Inkey
    '分析得到的字節數據
    Select Case b
    Case 255
    '255表示的是命令的先導字符，即后面的數據是命令
        '接著獲得后面兩個字節的數據，分別放在變量c和d中
        C = Inkey
        D = Inkey
        '如果c為253，表示發出do命令，服務器提出要求協商
        If C = 253 And (D = 1 Or D = 24) Then
            SendChars "255;251;" & D
            GoTo L2
        End If
        '如果c為254，表示拒絕接收
        If C = 254 And D = 1 Then
            SendChars "255;252;1"
            GoTo L2
        End If
        '如果為251 ，表示愿意激活某個選項
        If C = 251 And D = 1 Then
            SendChars "255;254;1"
            GoTo L2
        End If
        '如果是250，表示的是子協商選項
        If C = 250 Then
            '循環等到d等于240，表示子協商結束
            While D <> 240
                D = Inkey
            Wend
            SendChars "255;250;24;0;118;116;49;48;48;255;240"
            GoTo L2
        End If
        '如果是253，發出do命令
'        If C = 253 Then
'            SendChars "255;252;" & D
'            GoTo L2
'        End If
    Case 27
    '如果接收到的數據是27
        s$ = ""
        '獲取下一個字節
        C = Inkey
        '如果c不等于91，則跳出
        If C <> 91 Then
            GoTo L2
        End If
        '如果c等于91 則執行下面的代碼
L1:
        '將字節型轉換成字符
        dat$ = Chr$(Inkey)
        '分析獲得字符是否在字符串" 0123456789;"中
        If InStr(" 0123456789;", dat$) > 1 Then
            '如果是則將字符串累加
            s$ = s$ + dat
            '跳轉到l1，直到獲得字節不再字符串" 0123456789;"中
            GoTo L1
        End If
        Select Case dat$
            Case "m"
                If s$ = "" Then
                    s$ = "0"
                End If
                While s$ <> ""
                    V = VVV(s$)
                    '設置前景顏色
                    If V > 29 And V < 38 Then
                        Fcolor = V - 30 + Bold * 8
                    End If
                    '設置背景顏色
                    If V > 39 And V < 48 Then
                        Bcolor = V - 40
                    End If
                    
                    If V = 0 Then
                        Bold = 0
                        Reverse = 0
                        Fcolor = 7
                        Bcolor = 0 ': 'Fcolor Mod8
                    End If
                    '重新設置背景顏色
                    If Bcolor = 4 Then
                        Bcolor = 1
                    End If
                    
                    If V = 1 Then
                        Bold = 1
                        Fcolor = Fcolor Mod 8 + 8
                    End If
                    If V = 7 Then
                        Reverse = 1
                    End If
                    ForeColor = QBColor(Fcolor)
                Wend
            Case "K"
            '獲得坐標位置
                '獲得當前位置坐標，并畫一個水平填充區域
                X = CurrentX
                Y = CurrentY
                Line (X, Y)-Step(1000, WordHeight), QBColor(Bcolor), BF
                CurrentX = X
                CurrentY = Y
            Case "C"
                '設置橫坐標
                xx = VVV(s$)
                CurrentX = CurrentX + xx * LetterWidth
            Case "H"
                '重新設置當前坐標位置
                yy = VVV(s$)
                xx = VVV(s$)
                If xx > 0 And yy > 0 Then
                    CurrentX = (xx - 1) * LetterWidth
                    CurrentY = (yy - 1) * WordHeight
                End If
            Case "J"
                '如果為J，則表示清空屏幕
                frmBBS.Picture = LoadPicture()
                frmBBS.Cls
        End Select
    Case 7
    '發出聲音
        Beep
    Case 8
        '改變當前橫坐標的位置
        If CurrentX > 0 Then
            CurrentX = CurrentX - LetterWidth
        End If
    Case 13
        '如果是13，表示設置當前橫坐標為0，表示回車
        CurrentX = 0
    Case 0
    Case 10
        '將縱坐標增加16，表示換行
        CurrentY = CurrentY + WordHeight
        '如果當前縱坐標太大，則應該換頁
        If CurrentY >= 600 Then
            CurrentY = CurrentY - WordHeight
            frmBBS.Picture = frmBBS.Image
            
            PaintPicture frmBBS.Picture, 0, -WordHeight
            '將縱坐標減一
            oy = oy - WordHeight
        End If
    Case Else
    '如果為其他情況
        p& = -1
        If b < 128 Then
            LL = 0
            p& = b
        End If
        '表示輸出的是漢字，漢字是由兩個字節組成的
        If b >= 128 And LL = 0 Then
            LL = b
        Else
            p& = LL * 256& + b
            LL = 0
        End If
        If p& > 256 Then
            L = WordWidth
        Else
            L = LetterWidth
        End If
        X = CurrentX
        Y = CurrentY
        F = Fcolor
        b = Bcolor
        If Reverse Then
            T = F
            F = b
            b = T
        End If
        ForeColor = QBColor(F)
        If p& >= 0 Then
            Line (X, Y)-Step(L - 1, WordHeight), QBColor(b), BF
            CurrentX = X
            CurrentY = Y
            Print Chr$(p&);
            CurrentX = X + L
        End If
    End Select
L2: Wend
End Sub

Private Sub Winsock1_Close()
    frmBBS.Picture = LoadPicture("")
    frmBBS.Cls
    Timer1.Enabled = False
    Connected = False
    'MsgBox "服務器斷線了！"
    'End
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Connected = True
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    frmBBS.Cls
    Timer1.Enabled = False
    frmBBS.Picture = LoadPicture("")
    MsgBox "無法連接服務器！"
End Sub
'該函數的功能是進行自動登錄
Private Sub AutoLogin(LoginStr As String)
Dim I As Integer
Dim tempChar As String
Dim tempChar1 As String

LoginStr = Trim(LoginStr)
'首先判斷登錄字符串是否為空
If Len(LoginStr) <> 0 Then
    '發送每一字符
    Do While Winsock1.BytesReceived <> 0
        DoEvents: DoEvents
    Loop
    For I = 1 To Len(LoginStr)
        Sleep (100)
        '獲得一個字符
        tempChar = Mid(LoginStr, I, 1)
        '判斷該字符是否是“\”，“\n”表示回車
        If tempChar <> "\" Then
            If tempChar <> "n" Or (tempChar = "n" And _
                Mid(LoginStr, IIf((I - 1) > 0, I - 1, I), 1) <> "\") Then
                SendChars (CStr(Asc(tempChar)))
            End If
        ElseIf Mid(LoginStr, I + 1, 1) = "n" Then
            SendChars ("13")
        Else
            SendChars (CStr(Asc("\")))
        End If
    Next I
End If

End Sub