请问哪里有VB写的围棋人机对弈源程序？谢谢了！！！

http://www.edgewww.com/vb/code9.php3
这里有:)

围棋的人工智能很难实现，需要有大量的棋谱作为资料
而五子棋则不同，做最优下法选择猜测5步以上也用不了多少cpu时间
所以五子棋对弈常有人工智能，如果你能做出带人工智能的围棋对弈软件
你也可以去参加应氏杯了

blow_jj(纪俊)　：
http://www.edgewww.com/vb/code9.php3
上不去啊！
如果你能上去，能否帮忙发个邮件？
地址：[email protected]
谢谢了！！escapism(后门吹雪)　：
我的要求不高：有根据定式或厚势走棋的功能就可以了。

五子棋的AI你不妨自己找本人工智能的书看看
因为五子棋可以用生成搏弈树寻找最优下发的方法
这和8后问题的解决办法相差不大
若是生成围棋的搏弈树可能会在速度和系统资源上造成巨大开销
围棋可能不是用搏弈树的方法来做的（我猜的）
以国际象棋的AI（IBM深蓝）来看好像是预先储存了大量的资料以对应不同的情况
之所以拿深蓝来和人作对弈是因为深蓝可以考虑向后的多步
这又和人工智能中的搏弈问题的解决方法是一致的
所以你可以多了解些人工智能方面的资料
我有人工智能的书（这门功课刚考完不久，师太关了好多人可想而知人工智能有多可怕）可是没有电子版的
没法给你
你可以自己去买，书店应该会有的（似乎看到过）

给你源程序，给我分啊！
Option Explicit
Const Stepx = 270
Const Stepy = 270
Const StarSize = 20
Const PointSize = 100
Const SAVEF = 1
Const READF = 2
Dim Begin_Flag As Integer
Dim Startx, Starty, F, i As Integer
'F means the times of BACK Button clicked
Dim Start_Time, Black_Time, White_Time As Date
Dim MANUAL As Integer
Dim Count1, C1, Open_F As Integer
Dim Show_String(10) As String
Dim Step_Count
Public Sub Draw_Board()
Dim Intx, Inty As Integer
Startx = ScaleLeft + 1000
Starty = ScaleTop + 1000
DrawMode = 13
DrawWidth = 1
For Intx = 0 To 18
     CurrentY = Starty - 0.7 * Stepy
     CurrentX = Startx + (Intx - 0.5) * Stepx
     Print Intx + 1
Next Intx
For Inty = 0 To 18
     CurrentX = Startx - Stepx
     CurrentY = Starty + (Inty - 0.5) * Stepy
     Print Inty + 1
Next IntyFor Intx = 0 To 18
    Line (Startx + Intx * Stepx, Starty)-(Startx + Intx * Stepx, Starty + 18 * Stepy), RGB(255, 255, 0)
Next Intx
For Inty = 0 To 18
    Line (Startx, Starty + Inty * Stepy)-(Startx + 18 * Stepy, Starty + Inty * Stepy), RGB(255, 255, 0)
Next Inty
FillColor = QBColor(0)
FillStyle = 1'draw 9 starsFor Intx = 0 To 18
    For Inty = 0 To 18
    If (Intx = 3 Or Intx = 9 Or Intx = 15) And (Inty = 3 Or Inty = 9 Or Inty = 15) Then
        Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), StarSize
        Circle (Startx + Intx * Stepx, Starty + Inty * Stepy), 2 * StarSize
    End If
    Next Inty
Next IntxEnd Sub
Public Function Ini_Board()
Dim i, j As Integer
For i = 1 To 19
    For j = 1 To 19
        Board(i, j).Color = EMPTYP
        Board(i, j).X = i
        Board(i, j).Y = j
        Board(i, j).Status = UNCHECKED
        Board(i, j).Gas = 0
        Board(i, j).Current = False
    Next j
Next i
End Function
Public Function Refresh_Board()
Dim i, j, t As Integer
Cls
Draw_Board
For i = 1 To 19
    For j = 1 To 19
        Board(i, j).Status = UNCHECKED
        t = Draw_Point(Board(i, j).X, Board(i, j).Y, Board(i, j).Color)
    Next j
Next i
End Function
Public Function Draw_Point(X, Y, Color As Integer) As Integer
Dim FILL, LineCIf Color = EMPTYP Or X <= 0 Or Y <= 0 Or X >= 20 Or Y >= 20 Then
    Exit Function
End If
'It is not a legal input then exitIf Color = BLACKP Then
    FILL = RGB(0, 0, 0)
    FillStyle = vbFSSolid
    If Board(X, Y).Current = False Then
        FillColor = FILL
        Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL

    Else
        FillColor = FILL
        Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
        LineC = RGB(255, 255, 255)
        Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
        Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
    End IfEnd If
'black pointIf Color = WHITEP Then
    FILL = RGB(255, 255, 255)
    FillStyle = vbFSSolid
    If Board(X, Y).Current = False Then
        FillColor = FILL
        Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
    Else
        FillColor = FILL
        Circle ((X - 1) * Stepx + Startx, (Y - 1) * Stepy + Starty), PointSize, FILL
        LineC = RGB(0, 0, 0)
        Line ((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
        Line ((X - 1) * Stepx + Startx + PointSize / 2, (Y - 1) * Stepy + Starty - PointSize / 2)-((X - 1) * Stepx + Startx - PointSize / 2, (Y - 1) * Stepy + Starty + PointSize / 2), LineC
    End If
End If
'white pointBoard(X, Y).Color = Color
Board(X, Y).X = X
Board(X, Y).Y = Y
Board(X, Y).Status = UNCHECKED
Board(X, Y).Gas = 0End Function
Private Sub About_Click(Index As Integer)
frmAbout.Show
End Sub
Private Sub All_Step_Click()
Dim pIf Step_Count <= 0 Then
    Next_Step.Enabled = True
    Priv_Step.Enabled = True
    Exit Sub
End IfNext_Step.Enabled = False
Priv_Step.Enabled = True
Draw_Board
Ini_BoardMousePointer = 11
For i = 1 To Step_Count
    p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
    step_show.Cls
    step_show.Print Step
    p = Count_All_Gas
    If TURN = BLACKP Then
        TURN = WHITEP
    Else
        TURN = BLACKP
    End If
Next i
MousePointer = 1
Refresh_Board
Step = Step_Count
End Sub
Private Sub Back_Click()
Dim p
Static i, F, Save_Turn, Try As Integer
Step = Step - 1
If Step <= 1 Then
    Call Begin_Click
    Exit Sub
End If'Modem process begin
If ModemState = LOGIN Then
        If S_R = 0 Then
            Step = Step + 1
            Beep
            Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, UNDO, 0, 0)
        Try = 0
Resend:
        Call Modem_F.Send_Msg(Msg_No)
        Call Modem_F.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
            'Retry for 3times
                GoTo Resend
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Modem_F.Disconnect_Click
                Unload Modem_F
                Call Begin_Click
                Exit Sub
            End If
        End If
End If
'Modem process end'Winsockt process begin
If SocketState = CONNECTED Then
        If S_R = 0 Then
            Step = Step + 1
            Beep
            Exit Sub
        End If
        Call Net.Con_msg(Msg_No, UNDO, 0, 0)
        Try = 0
Resend1:
        Call Net.Send_Msg(Msg_No)
        Call Net.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
            'Retry for 3times
                GoTo Resend1
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Net.Disconnect
                Unload Net
                Call Begin_Click
                Exit Sub
            End If
        End If
End If
'Winsockt process endIni_Board
Draw_Board
Save_Turn = TURNFor i = 1 To Step - 1
    Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
    p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
    step_show.Cls
    step_show.Print Step
    'If Record(i).Eat Then
        p = Count_All_Gas
    'End If
    If TURN = BLACKP Then
        TURN = WHITEP
    Else
        TURN = BLACKP
    End If
Next i
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = True
Refresh_Board
Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
If ModemState = LOGIN Then
    TURN = Side
    S_R = 0
    R_R = 1
    Exit Sub
End If
If SocketState = CONNECTED Then
    TURN = Side
    S_R = 0
    R_R = 1
    Exit Sub
End IfF = F * -1If F = 1 Then
' press 2*n times
    If Save_Turn = BLACKP Then
        TURN = BLACKP
    Else
        TURN = WHITEP
    End If
Else
'press 2*n+1 times
    If Save_Turn = BLACKP Then
        TURN = WHITEP
    Else
        TURN = BLACKP
    End If
End IfEnd Sub
Public Sub Begin_Click()
Dim p As Integer
Cls
Step = 1
Begin_Flag = 1
PlayState = 0
F = 1
Msg_No = 1
TURN = BLACKP
Draw_Board
Ini_Board
XY.Visible = True
TimeB.Visible = True
TimeW.Visible = True
Back.Enabled = True
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
Start_Time = Time
Black_Time = 0
White_Time = 0
TimeB.Caption = " "
TimeW.Caption = " "
'Initalize some values
If SocketState = CONNECTED And Side = BLACKP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执黑对" + Net.His_Name.Text
S_R = 1
R_R = 0
    TURN = BLACKP
    Set_Hand (Hand)
    Back.Enabled = True
    Count_Area.Enabled = False
    Exit Sub
End IfIf SocketState = CONNECTED And Side = WHITEP Then
Form1.Caption = "网络对弈" + Net.My_name.Text + "执白对" + Net.His_Name.Text
S_R = 0
R_R = 1
    TURN = WHITEP
    Set_Hand (Hand)
    Back.Enabled = True
    Count_Area.Enabled = False
    Exit Sub
End IfIf ModemState = LOGIN And Side = BLACKP Then
    Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执黑对" + Modem_F.His_Name.Text
    S_R = 1
    R_R = 0
    Modem_F.Comm1.InBufferCount = 0
    TURN = BLACKP
    Set_Hand (Hand)
    Back.Enabled = True
    Count_Area.Enabled = False
    Exit Sub
End IfIf ModemState = LOGIN And Side = WHITEP Then
    Form1.Caption = "MODEM 对弈 " + Modem_F.My_name.Text + "执白对" + Modem_F.His_Name.Text
    S_R = 0
    R_R = 1
    TURN = WHITEP
    Modem_F.Comm1.InBufferCount = 0
    Set_Hand (Hand)
    Back.Enabled = True
    Count_Area.Enabled = False
    Exit Sub
End If
Form1.Caption = "打谱"
End SubPrivate Sub Count_Area_Click()
If Begin_Flag <> 1 Then
Exit Sub
End If
Count_All_Side
End SubPrivate Sub Exit_Click()
Dim Try As Integer
Cls
Step = 0
Start_Time = Time
Black_Time = 0
White_Time = 0
If ModemState <> LOGIN Then
Exit Sub
End IfIf ModemState = LOGIN Then
        If S_R <> 1 Then
            Beep
            Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, LOGOUT, 0, 0)
        Try = 0
Resend:
        Call Modem_F.Send_Msg(Msg_No)
        Call Modem_F.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
            'Retry for 3times
                GoTo Resend
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Modem_F.Disconnect_Click
                Unload Modem_F
                Call Begin_Click
                Exit Sub
            End If
        End If
   End If
End SubPrivate Sub Finish_Click()
Dim Try As Integer
Dim W$
If ModemState = LOGIN Then
        If S_R <> 1 Then
            Beep
            Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, FINISHED, 0, 0)
        Try = 0
Resend:
        Call Modem_F.Send_Msg(Msg_No)
        W$ = Modem_F.WaitForValue("R_O", 10)
        If InStr(1, W$, "NO") Then
            MsgBox ("对手不同意结束比赛！")
            Exit Sub
        End If
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
            'Retry for 3times
                GoTo Resend
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Modem_F.Disconnect_Click
                Unload Modem_F
                Call Begin_Click
                Exit Sub
            End If
        End If
   End If
PlayState = FINISHED
Count_Area.Enabled = True
End SubPrivate Sub Form_Load()
Begin_Flag = 0
Open_F = 0
Count1 = 0
C1 = 0
ModemState = UNCONNECTED
SocketState = UNCONNECTED
Dim i, j As Integer
Show_String(0) = "Welcome!!!"
Show_String(1) = "elcome!!!W"
Show_String(2) = "lcome!!!We"
Show_String(3) = "come!!!Wel"
Show_String(4) = "ome!!!Welc"
Show_String(5) = "me!!!Welco"
Show_String(6) = "e!!!Welcom"
Show_String(7) = "!!!Welcome"
Show_String(8) = "!!Welcome!"
Show_String(9) = "!Welcome!!"
Back.Enabled = False
Next_Step.Enabled = False
Priv_Step.Enabled = False
All_Step.Enabled = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, g, log_x, log_y As Integer
Dim W As String
Dim float As Double  ' a float error
Dim Try As Integer  'The time of Sending Message
MANUAL = 0
Current = False
If Begin_Flag = 0 Then
'Begin button hasn't been pressed
    Exit Sub
End If
float = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
    log_x = Int((X - Startx) / Stepx) + 2
Else
    log_x = Int((X - Startx) / Stepx) + 1
End Iffloat = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
    log_y = Int((Y - Starty) / Stepy) + 2
Else
    log_y = Int((Y - Starty) / Stepy) + 1
End IfIf (log_x <= 0 Or log_y <= 0 Or log_x >= 20 Or log_y >= 20) Then
    Exit Sub
End If
'Illegal inputIf Button <> 1 Then
    If PlayState <> FINISHED Then
        Beep
        Exit Sub
    Else
        Board(log_x, log_y).Color = EMPTYP
        Refresh_Board
        Exit Sub
    End If
End If
'Right button pressed

If (Board(log_x, log_y).Color <> EMPTYP) Then
    Beep
    Exit Sub
End If
'There are some stone here!
'Modem process begin
    If ModemState = LOGIN Then
        If S_R <> 1 Then
            Beep
            Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, PLAY, log_x, log_y)
        Try = 0
Resend:
        Call Modem_F.Send_Msg(Msg_No)
        Call Modem_F.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
            'Retry for 3times
                GoTo Resend
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Modem_F.Disconnect_Click
                Unload Modem_F
                Call Begin_Click
                Exit Sub
            End If
        End If
        Msg_No = Msg_No + 1
        S_R = 0
        R_R = 1
   End If
'Modem Process end'Winsock process begin
    If SocketState = CONNECTED Then
        If S_R <> 1 Then
            Beep
            Exit Sub
        End If
        Call Net.Con_msg(Msg_No, PLAY, log_x, log_y)
        Try = 0
Resend1:
        Call Net.Send_Msg(Msg_No)
        Call Net.WaitForValue("R_O", 10)
    'wait for "Receive Ok" confirm
        If g_ErrorCode = 1 Then
            Try = Try + 1
            If Try < 2 Then
    'Some error ocurred, Retry for 3times
                GoTo Resend1
            Else
                Beep
                MsgBox "对手已经离开！"
                Call Net.Disconnect
                Unload Net
                Call Begin_Click
                Exit Sub
            End If
        End If
        Msg_No = Msg_No + 1
        S_R = 0
        R_R = 1
   End If
'Winsock  Process end
If Button = 1 Then
MANUAL = 1
End IfIf TURN = BLACKP Then
    Board(log_x, log_y).Current = True
    p = Draw_Point(log_x, log_y, BLACKP)
    step_show.Cls
    step_show.Print Step
Else
    Board(log_x, log_y).Current = True
    p = Draw_Point(log_x, log_y, WHITEP)
    step_show.Cls
    step_show.Print Step
End Ifg = Count_All_Gas
Record(Step).Color = TURN
Record(Step).X = log_x
Record(Step).Y = log_yIf g <> 0 Then
        Record(Step).Eat = True
    Else
        Record(Step).Eat = False
    End If

Step = Step + 1'MANUAL = 0
Refresh_Board
Board(log_x, log_y).Current = False
If ModemState <> LOGIN And SocketState <> CONNECTED Then
    If MANUAL = 1 Then
        If TURN = BLACKP Then
            TURN = WHITEP
        Else
            TURN = BLACKP
        End If
    End If
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p, lg_x, lg_y As Integer
Dim float As Double
If Begin_Flag = 0 Then
Exit Sub
End Iffloat = (X - Startx) / Stepx - Int((X - Startx) / Stepx)
If float > 0.5 Then
    lg_x = Int((X - Startx) / Stepx) + 2
Else
    lg_x = Int((X - Startx) / Stepx) + 1
End Iffloat = (Y - Starty) / Stepy - Int((Y - Starty) / Stepy)
If float > 0.5 Then
    lg_y = Int((Y - Starty) / Stepy) + 2
Else
    lg_y = Int((Y - Starty) / Stepy) + 1
End IfIf (lg_x > 0 And lg_x < 20) And (lg_y > 0 And lg_y < 20) Then
    MousePointer = 2
    XY.Cls
    XY.Print "x: " & lg_x & "," & "y: " & lg_y
Else
    XY.Cls
    MousePointer = 0
End If
End Sub
Private Sub Give_Up_Click()
'Modem process begin
    If ModemState = LOGIN Then
        If S_R <> 1 Then
        Beep
        Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend2:
        Call Modem_F.Send_Msg(Msg_No)
        Call Modem_F.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
        GoTo Resend2
        End If
        Msg_No = Msg_No + 1
        MsgBox ("您已认输了.")
        Call Begin_Click
   End If
'Modem Process end'Socket process begin
    If SocketState = CONNECTED Then
        If S_R <> 1 Then
        Beep
        Exit Sub
        End If
        Call Net.Con_msg(Msg_No, GIVEUP, 0, 0)
Resend3:
        Call Net.Send_Msg(Msg_No)
        Call Net.WaitForValue("R_O", 10)
        If g_ErrorCode = 1 Then
        GoTo Resend3
        End If
        Msg_No = Msg_No + 1
        MsgBox ("您已认输了.")
        Call Begin_Click
   End If
'Socket Process end
End SubPrivate Sub Lan_Click(Index As Integer)
Net.Show
End SubPrivate Sub Modem_Click(Index As Integer)
Modem_F.Show
End Sub
Private Sub Next_Step_Click()
Dim p
Priv_Step.Enabled = True
If Step >= Step_Count Then
    Next_Step.Enabled = False
    Exit Sub
End IfStep = Step + 1
p = Draw_Point(Record(Step).X, Record(Step).Y, Record(Step).Color)
step_show.Cls
step_show.Print Step
p = Count_All_Gas
Refresh_Board
If TURN = BLACKP Then
    TURN = WHITEP
Else
    TURN = BLACKP
End If
'p = Count_All_Gas
'Refresh_Board
End Sub
Private Sub Open_Click(Index As Integer)
On Error GoTo errhandler
Dim temp
Dim i As Integer
temp = 0
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowOpen
Open (COMDIAL.FileName) For Input As #READF
Cls
Step = 0
Begin_Flag = 1
TURN = BLACKP
Draw_Board
Ini_Board
Next_Step.Enabled = True
Priv_Step.Enabled = True
All_Step.Enabled = True
TimeB.Visible = False
TimeW.Visible = False
Back.Enabled = False
Open_F = 1
For i = 1 To MAXSTEP
Line Input #READF, tempIf temp = "!" Then
    Line Input #READF, Step_Count
    Line Input #READF, Black_Name
    Line Input #READF, White_Name
    Line Input #READF, Add_Message
    Players.Black_N.Text = Black_Name
    Players.White_N.Text = White_Name
    Players.Kibbitz.Text = Add_Message
    Players.Show
    Close #READF
    Exit Sub
End IfRecord(i).Color = temp
Line Input #READF, temp
Record(i).X = temp
Line Input #READF, temp
Record(i).Y = temp
Next iClose #READF
errhandler:
Close #READF
Exit Sub
End Sub
Private Sub Priv_Step_Click()
Dim p
Dim i As Integer
Next_Step.Enabled = True
If Step <= 1 Then
    Ini_Board
    Draw_Board
    Priv_Step.Enabled = False
    Exit Sub
End IfDraw_Board
Ini_Board
For i = 1 To Step - 1
    p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
    step_show.Cls
    step_show.Print Step
    p = Count_All_Gas

    If TURN = BLACKP Then
        TURN = WHITEP
    Else
        TURN = BLACKP
    End If
Next i
Refresh_Board
Step = Step - 1
End SubPrivate Sub Quit_Click(Index As Integer)
If Net.Enabled = True Then
    Unload Net
End If
If Modem_F.Enabled = True Then
    Unload Modem_F
End If
Unload Me
End SubPrivate Sub Save_Click(Index As Integer)
On Error GoTo quit
Dim i, j As Integer
COMDIAL.Filter = "WeiQi File|*.go"
COMDIAL.ShowSave
Open (COMDIAL.FileName) For Output As #SAVEFIf Step <= 1 Then
    Beep
    MsgBox "没有可以保存的对局"
GoTo quit
End IfFor i = 1 To Step - 1
    Print #SAVEF, Record(i).Color
    Print #SAVEF, Record(i).X
    Print #SAVEF, Record(i).Y
Next i
Print #SAVEF, "!"
Print #SAVEF, Step - 1
Players.Show
Do
    If Players.Visible = False Then
        Exit Do
    End If
DoEvents
Loop

    Print #SAVEF, Black_Name
    Print #SAVEF, White_Name
    Print #SAVEF, Add_Message
    Close #SAVEF
quit:
Exit Sub
End SubPrivate Sub Talking_Click()
If ModemState = LOGIN And S_R = 1 Then
    Talk_To_Him.Show
End If
End SubPrivate Sub Timer1_Timer()
Dim ms As Boolean
Dim Info, temp As String
Dim p, p1, p2, i As Integer
Dim Ch
' Begin of Time Show Process
If ModemState <> LOGIN And SocketState <> CONNECTED Then
    'it is not a multiusers game
    Exit Sub
Else
    If (S_R = 1) And (TURN = BLACKP) Then
        Black_Time = Black_Time + Time - Start_Time
        TimeB.Caption = CDate(Black_Time / 200)
    Else
        If (S_R = 1) And (TURN = WHITEP) Then
            White_Time = White_Time + Time - Start_Time
            TimeW.Caption = CDate(White_Time / 200)
        Else
            If (S_R = 0) And (TURN = WHITEP) Then
                Black_Time = Black_Time + Time - Start_Time
                TimeB.Caption = CDate(Black_Time / 200)
                Else
                    If (S_R = 0) And (TURN = BLACKP) Then
                        White_Time = White_Time + Time - Start_Time
                        TimeW.Caption = CDate(White_Time / 200)
                    End If
            End If
        End If
    End If
End If
'End If
' End of Time Show Process
'Begin of winsockt processIf SocketState = CONNECTED And Begin_Flag = 1 Then
ms = Net.Message_Exist
    If ms = False Then
    Exit Sub
    End If
Info = Net.WaitForValue(Chr$(26), 5)
    If g_ErrorCode = 1 Then
    'Some error such as Timeout occured
    Exit Sub
    End If
p1 = InStr(Info, "B")
p2 = InStr(Info, "E|;")
If p1 = 0 Or p2 = 0 Then
    Exit Sub
End If
temp = Mid$(Info, p1 + 1, p2 - p1 - 1)
ParseLine (temp)
Msg(Msg_No).No = CInt(ParseArray(1))
Msg(Msg_No).Color = CInt(ParseArray(2))
If IsNumeric(ParseArray(3)) Then
    Msg(Msg_No).X = CInt(ParseArray(3))
    Msg(Msg_No).Y = CInt(ParseArray(4))
Else
    Msg(Msg_No).X = ParseArray(3)
    Msg(Msg_No).Y = ParseArray(4)
End If

If Msg(Msg_No).Color = GIVEUP Then
    Beep
    MsgBox ("对方已经认输了")
    Net.Winsock1.SendData ("R_O" + Chr$(26))
    Pause 3
    Call Begin_Click
    Exit Sub
End If
    If Side = BLACKP Then
        p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, WHITEP)
        Record(Step).Color = WHITEP
        step_show.Cls
        step_show.Print Step
        TURN = BLACKP
    Else
        p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, BLACKP)
        Record(Step).Color = BLACKP
        step_show.Cls
        step_show.Print Step
        TURN = WHITEP
    End If
    Record(Step).X = Msg(Msg_No).X
    Record(Step).Y = Msg(Msg_No).Y
    Step = Step + 1
    S_R = 1
    R_R = 0
    p = Count_All_Gas
    If (Msg(Msg_No).X > 0 And Msg(Msg_No).Y > 0 _
               And Msg(Msg_No).X < 20 And Msg(Msg_No).Y < 20) Then
        Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = True
        Refresh_Board
        Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = False
    End If
    Msg_No = Msg_No + 1
Pause 1
Net.Winsock1.SendData ("R_O" + Chr$(26))
Exit Sub
End If
'End of process of winsocket'Begin of modem process
If ModemState <> LOGIN Or R_R <> 1 Then
'It isn't a Inter_Modem Game
    Exit Sub
End Ifms = Modem_F.Exist_Msg
If ms = False Then
'IO Port don't have any message
    Exit Sub
End IfInfo = Modem_F.WaitForValue(Chr$(26), 5)
'Wait a playing message
If g_ErrorCode = 1 Then
'Some error such as Timeout occured
    Exit Sub
End If
p1 = InStr(Info, "B")
p2 = InStr(Info, "E|;")
If p1 = 0 Or p2 = 0 Then
    Exit Sub
End If
temp = Mid$(Info, p1 + 1, p2 - p1 - 1)
ParseLine (temp)
Msg(Msg_No).No = CInt(ParseArray(1))
Msg(Msg_No).Color = CInt(ParseArray(2))
If IsNumeric(ParseArray(3)) Then
    Msg(Msg_No).X = CInt(ParseArray(3))
    Msg(Msg_No).Y = CInt(ParseArray(4))
Else
    Msg(Msg_No).X = ParseArray(3)
    Msg(Msg_No).Y = ParseArray(4)
End IfModem_F.Comm1.InBufferCount = 0
'Clear BufferIf Msg(Msg_No).Color = LOGOUT Then
    Beep
    MsgBox ("对方已经退出了")
    Modem_F.Comm1.InBufferCount = 0
    Modem_F.Comm1.Output = "R_O" + Chr$(26)
    Cls
    Step = 0
    Start_Time = Time
    Black_Time = 0
    White_Time = 0
    Exit Sub
End IfIf Msg(Msg_No).Color = FINISHED Then
    Beep
    Ch = MsgBox("对方要求结束比赛，可以吗？", vbYesNo)
    Modem_F.Comm1.InBufferCount = 0
    If Ch = 6 Then
        Modem_F.Comm1.Output = "YESR_O" + Chr$(26)
    Else
        Modem_F.Comm1.Output = "NOR_O" + Chr$(26)
        Exit Sub
    End If
    PlayState = FINISHED
    Count_Area.Enabled = True
End IfIf Msg(Msg_No).Color = GIVEUP Then
    Beep
    MsgBox ("对方已经认输了")
    Modem_F.Comm1.InBufferCount = 0
    Modem_F.Comm1.Output = "R_O" + Chr$(26)
    Call Begin_Click
    Exit Sub
End IfIf Msg(Msg_No).Color = TALK Then
    Beep
    MsgBox (Modem_F.His_Name.Text & "说:   " & Msg(Msg_No).X)
    Modem_F.Comm1.InBufferCount = 0
    Modem_F.Comm1.Output = "R_O" + Chr$(26)
    Exit Sub
End IfIf Msg(Msg_No).Color = UNDO Then
    Step = Step - 1
    Beep
    Modem_F.Comm1.InBufferCount = 0
    Modem_F.Comm1.Output = "R_O" + Chr$(26)
    Draw_Board
    Ini_Board
    For i = 1 To Step - 1
        Board(Record(i).X, Record(i).Y).Current = False
        p = Draw_Point(Record(i).X, Record(i).Y, Record(i).Color)
        step_show.Cls
        step_show.Print Step
        p = Count_All_Gas
    Next i
    Board(Record(Step - 1).X, Record(Step - 1).Y).Current = True
    Refresh_Board
    Board(Record(Step - 1).X, Record(Step - 1).Y).Current = False
    S_R = 1
    R_R = 0
    TURN = Side
    Exit Sub
End IfModem_F.Comm1.InBufferCount = 0
Modem_F.Comm1.Output = "R_O" + Chr$(26)
    If Side = BLACKP Then
        p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, WHITEP)
        Record(Step).Color = WHITEP
        step_show.Cls
        step_show.Print Step
    Else
        p = Draw_Point(Msg(Msg_No).X, Msg(Msg_No).Y, BLACKP)
        Record(Step).Color = BLACKP
        step_show.Cls
        step_show.Print Step
    End If
    Record(Step).X = Msg(Msg_No).X
    Record(Step).Y = Msg(Msg_No).Y
    Step = Step + 1
    S_R = 1
    R_R = 0
    p = Count_All_Gas
    If (Msg(Msg_No).X > 0 And Msg(Msg_No).Y > 0 _
               And Msg(Msg_No).X < 20 And Msg(Msg_No).Y < 20) Then
        Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = True
        Refresh_Board
        Board(Msg(Msg_No).X, Msg(Msg_No).Y).Current = False
    End If
    Msg_No = Msg_No + 1
End Sub
Private Sub Timer2_Timer()
ShowS.Cls
ShowS.Print " :-):-):-):-):-) " + Show_String(C1) + " (:-(:-(:-(:-(:-"
C1 = C1 + 1
If C1 = 10 Then
    C1 = 0
End If
Game_Time.Cls
Game_Time.Print "  现在时间:  " & Time
End Sub
Private Sub Set_Hand(h As Integer)
'设置让子（1-9）
Dim p As Integer
If h <= 1 Then
'Not a Handicap game
    Exit Sub
End If
Select Case h
Case 2:
      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Step = 3
Case 3:
      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Step = 4Case 4:
      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Step = 5

Case 5:

      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(10, 10).Color = BLACKP
      Board(10, 10).Gas = 0

      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      Board(10, 10).X = 10
      Board(10, 10).Y = 10

      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      p = Draw_Point(10, 10, BLACKP)

      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Record(5).Color = BLACKP
      Record(5).X = 10
      Record(5).Y = 10
      Step = 6Case 6:

      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(4, 10).Color = BLACKP
      Board(4, 10).Gas = 0
      Board(16, 10).Color = BLACKP
      Board(16, 10).Gas = 0

      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      Board(4, 10).X = 4
      Board(4, 10).Y = 10
      Board(16, 10).X = 16
      Board(16, 10).Y = 10

      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      p = Draw_Point(4, 10, BLACKP)
      p = Draw_Point(16, 10, BLACKP)

      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Record(5).Color = BLACKP
      Record(5).X = 4
      Record(5).Y = 10
      Record(6).X = 16
      Record(6).Y = 10
      Step = 7

Case 7:

      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(4, 10).Color = BLACKP
      Board(4, 10).Gas = 0
      Board(16, 10).Color = BLACKP
      Board(16, 10).Gas = 0
      Board(10, 10).Color = BLACKP
      Board(10, 10).Gas = 0

      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      Board(4, 10).X = 4
      Board(4, 10).Y = 10
      Board(16, 10).X = 16
      Board(16, 10).Y = 10
      Board(10, 10).X = 10
      Board(10, 10).Y = 10

      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      p = Draw_Point(4, 10, BLACKP)
      p = Draw_Point(16, 10, BLACKP)
      p = Draw_Point(10, 10, BLACKP)

      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Record(5).Color = BLACKP
      Record(5).X = 4
      Record(5).Y = 10
      Record(6).X = 16
      Record(6).Y = 10
      Record(7).X = 10
      Record(7).Y = 10
      Step = 8Case 8:

      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(4, 10).Color = BLACKP
      Board(4, 10).Gas = 0
      Board(16, 10).Color = BLACKP
      Board(16, 10).Gas = 0
      Board(10, 4).Color = BLACKP
      Board(10, 4).Gas = 0
      Board(10, 16).Color = BLACKP
      Board(10, 16).Gas = 0

      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      Board(4, 10).X = 4
      Board(4, 10).Y = 10
      Board(16, 10).X = 16
      Board(16, 10).Y = 10
      Board(10, 4).X = 10
      Board(10, 4).Y = 4
      Board(10, 16).X = 10
      Board(10, 16).Y = 16

      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      p = Draw_Point(4, 10, BLACKP)
      p = Draw_Point(16, 10, BLACKP)
      p = Draw_Point(10, 4, BLACKP)
      p = Draw_Point(10, 16, BLACKP)

      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Record(5).Color = BLACKP
      Record(5).X = 4
      Record(5).Y = 10
      Record(6).X = 16
      Record(6).Y = 10
      Record(7).X = 10
      Record(7).Y = 4
      Record(8).X = 10
      Record(8).Y = 16
      Step = 9

Case 9:

      Board(4, 4).Color = BLACKP
      Board(4, 4).Gas = 0
      Board(16, 16).Color = BLACKP
      Board(16, 16).Gas = 0
      Board(16, 4).Color = BLACKP
      Board(16, 4).Gas = 0
      Board(4, 16).Color = BLACKP
      Board(4, 16).Gas = 0
      Board(4, 10).Color = BLACKP
      Board(4, 10).Gas = 0
      Board(16, 10).Color = BLACKP
      Board(16, 10).Gas = 0
      Board(10, 4).Color = BLACKP
      Board(10, 4).Gas = 0
      Board(10, 16).Color = BLACKP
      Board(10, 16).Gas = 0
      Board(10, 10).Color = BLACKP
      Board(10, 10).Gas = 0

      Board(4, 4).X = 4
      Board(4, 4).Y = 4
      Board(16, 16).X = 16
      Board(16, 16).Y = 16
      Board(16, 4).X = 16
      Board(16, 4).Y = 4
      Board(4, 16).X = 4
      Board(4, 16).Y = 16
      Board(4, 10).X = 4
      Board(4, 10).Y = 10
      Board(16, 10).X = 16
      Board(16, 10).Y = 10
      Board(10, 4).X = 10
      Board(10, 4).Y = 4
      Board(10, 16).X = 10
      Board(10, 16).Y = 16
      Board(10, 16).X = 10
      Board(10, 16).Y = 10

      p = Draw_Point(4, 4, BLACKP)
      p = Draw_Point(16, 16, BLACKP)
      p = Draw_Point(16, 4, BLACKP)
      p = Draw_Point(4, 16, BLACKP)
      p = Draw_Point(4, 10, BLACKP)
      p = Draw_Point(16, 10, BLACKP)
      p = Draw_Point(10, 4, BLACKP)
      p = Draw_Point(10, 16, BLACKP)
      p = Draw_Point(10, 10, BLACKP)

      Record(1).Color = BLACKP
      Record(1).X = 4
      Record(1).Y = 4
      Record(2).Color = BLACKP
      Record(2).X = 16
      Record(2).Y = 16
      Record(3).Color = BLACKP
      Record(3).X = 16
      Record(3).Y = 4
      Record(4).Color = BLACKP
      Record(4).X = 4
      Record(4).Y = 16
      Record(5).Color = BLACKP
      Record(5).X = 4
      Record(5).Y = 10
      Record(6).X = 16
      Record(6).Y = 10
      Record(7).X = 10
      Record(7).Y = 4
      Record(8).X = 10
      Record(8).Y = 16
      Record(9).X = 10
      Record(9).Y = 10
      Step = 10
End Select
If Side = BLACKP Then
    S_R = 0
    R_R = 1
Else
    S_R = 1
    R_R = 0
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit' 注册键安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' 注册键 ROOT 类型...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode 以 Null 结尾的字符串
Const REG_DWORD = 4                      ' 32-位数字Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
  Call StartSysInfo
End SubPrivate Sub cmdOK_Click()
  Unload Me
End SubPrivate Sub Form_Load()
    Me.Caption = "关于 " & App.Title
    'lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
    'lblTitle.Caption = App.Title
End SubPublic Sub StartSysInfo()
    On Error GoTo SysInfoErr

    Dim rc As Long
    Dim SysInfoPath As String

    ' 试图从注册表得到系统信息程序路径\名称...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' 试图从注册表得到系统信息程序路径...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' 验证已知 32 位文件版本的存在
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

        ' 错误 - 文件未找到...
        Else
            GoTo SysInfoErr
        End If
    ' 错误 - 注册项未找到...
    Else
        GoTo SysInfoErr
    End If

    Call Shell(SysInfoPath, vbNormalFocus)

    Exit Sub
SysInfoErr:
    MsgBox "此时系统信息无效", vbOKOnly
End SubPublic Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
    Dim i As Long                                           ' 循环指针
    Dim rc As Long                                          ' 返回代码
    Dim hKey As Long                                        ' 打开的注册键的句柄
    Dim hDepth As Long                                      '
    Dim KeyValType As Long                                  ' 注册键的数据类型
    Dim tmpVal As String                                    ' 注册键的临时存储区
    Dim KeyValSize As Long                                  ' 注册键变量的大小
    '------------------------------------------------------------
    ' 在根键 {HKEY_LOCAL_MACHINE...} 下打开注册键
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册键

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 句柄错误...

    tmpVal = String$(1024, 0)                             ' 分配变量空间
    KeyValSize = 1024                                       ' 标记变量大小

    '------------------------------------------------------------
    ' 检索注册键值...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)    ' 获得/创建键值

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 句柄错误

    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 添加以 Null 结尾的字符串...
        tmpVal = LEFT(tmpVal, KeyValSize - 1)               ' Null 找到，从字符串提取
    Else                                                    ' WinNT 不需要以 Null 结束字符串...
        tmpVal = LEFT(tmpVal, KeyValSize)                   ' Null 未找到，仅提取字符串
    End If
    '------------------------------------------------------------
    ' 为了转换而决定键值类型..
    '------------------------------------------------------------
    Select Case KeyValType                                  ' 搜索数据类型...
    Case REG_SZ                                             ' 字符串型注册键数据类型
        KeyVal = tmpVal                                     ' 复制字符串值
    Case REG_DWORD                                          ' 双字型注册键数据类型
        For i = Len(tmpVal) To 1 Step -1                    ' 转换每一位
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 一个字符一个字符地建立值
        Next
        KeyVal = Format$("&h" + KeyVal)                     ' 转换双字型为字符串型
    End Select

    GetKeyValue = True                                      ' 返回成功
    rc = RegCloseKey(hKey)                                  ' 关闭注册键
    Exit Function                                           ' 退出

GetKeyError:      ' 发生错误后清除...
    KeyVal = ""                                             ' 设置返回值为空字符串
    GetKeyValue = False                                     ' 返回失败
    rc = RegCloseKey(hKey)                                  ' 关闭注册键
End Function$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Dim Buffer$
Dim ConnectStatus As Integer
Dim Port As Integer
Const WaitConst = 10
Const WaitConnectConst = 90
Const NotConnected = 1
Const NeedPassword = 2
Const CONNECTED = 3Dim ParseArray(5)Const MSCOMM_HANDSHAKE_NONE = 0
Const MSCOMM_HANDSHAKE_XONXOFF = 1
Const MSCOMM_HANDSHAKE_RTS = 2
Const MSCOMM_HANDSHAKE_RTSXONXOFF = 3Const MSCOMM_EV_SEND = 1
Const MSCOMM_EV_RECEIVE = 2
Const MSCOMM_EV_CTS = 3
Const MSCOMM_EV_DSR = 4
Const MSCOMM_EV_CD = 5
Const MSCOMM_EV_RING = 6
Const MSCOMM_EV_EOF = 7Const MSCOMM_ER_BREAK = 1001
Const MSCOMM_ER_CTSTO = 1002
Const MSCOMM_ER_DSRTO = 1003
Const MSCOMM_ER_FRAME = 1004
Const MSCOMM_ER_OVERRUN = 1006
Const MSCOMM_ER_CDTO = 1007
Const MSCOMM_ER_RXOVER = 1008
Const MSCOMM_ER_RXPARITY = 1009
Const MSCOMM_ER_TXFULL = 1010
Private Sub Dial_Click()
Dim W As String
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Checking Modem..."
Pause 2
MyOpenPort (Port)
If IsNumeric(Number.Text) = False Or Len(Number.Text) <= 2 Then
Beep
MsgBox ("Invalid Phone Number")
Exit Sub
End If
Comm1.Output = "AT" + Chr$(13)
g_ErrorCode = 0
W$ = WaitForValue("OK", WaitConst)
If g_ErrorCode = 0 Then
    Modem_Status.Cls
    Modem_Status.Print "Modem OK"
    Pause 1
Else
    Modem_Status.Cls
    Modem_Status.Print "Modem Not Responding"
    Pause 1
    AbortCall
    Dial.Enabled = True
    Disconnect.Enabled = True
    Wait.Enabled = True
    Exit Sub
End If
Modem_Status.Cls
Modem_Status.Print "Dialing..."
Comm1.Output = "ATDT" + Number.Text + Chr$(13)
W$ = WaitForValue("CONNECT", WaitConnectConst)
'Wait for CONNECT
If g_ErrorCode = 0 Then
    Modem_Status.Cls
    Modem_Status.Print "Connected"
    ModemState = CONNECT
    HOST = SERVER
    Pause 3
    Sendlogin
    Pause 1
    Recievelogin
    Dial.Enabled = False
    Disconnect.Enabled = False
    Wait.Enabled = False
Else
    If InStr(W$, "BUSY") Then
    Modem_Status.Cls
    Modem_Status.Print "Line Busy"
    ModemState = BUSY
    ElseIf InStr(1, W$, "No Dialtone", 1) Then
        Modem_Status.Cls
        Modem_Status.Print "No DialTone"
        ModemState = NODIALTONE
        ElseIf InStr(1, W$, "No Carrier", 1) Then
            Modem_Status.Cls
            Modem_Status.Print "No Carrier"
            ModemState = NOCARRIER
            Else
                Modem_Status.Cls
                Modem_Status.Print "Connect Failed"
                ModemState = FAILED
            End If
            AbortCall
            Exit Sub
End If
End Sub
Private Sub Cancel_Click()
AbortCall
Unload Me
End Sub
Private Sub MyOpenPort(p As Integer)
Dim i As Integer
Dim Mss
If Comm1.PortOpen = False Then
Comm1.CommPort = p
    If (IsNumeric(Speed.Text)) Then
    Comm1.Settings = Speed.Text & ",N,8,1"
    Else
    Comm1.Settings = "9600,N,8,1"
    End If
Comm1.PortOpen = True
End If
End Sub
Private Sub Sendlogin()
If HOST = SERVER Then
    If white.Value <> True Then
    black.Value = True
    Side = BLACKP
    S_R = 1
    R_R = 0
    Comm1.Output = "NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13)
    Else
    Comm1.Output = "NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13)
    Side = WHITEP
    S_R = 0
    R_R = 1
    End If
Else
    Comm1.Output = "NA" + My_name.Text + "##" + "#H0;" + Chr$(13)
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As String
Buffer = WaitForValue(";", 15)pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")If g_ErrorCode = 0 Then
    Modem_Status.Cls
    Modem_Status.Print "LOGIN OK"
    ModemState = LOGIN If p1 <> 0 Then
        His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
    Else
        If p2 <> 0 Then
        His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
            Else
            If p3 <> 0 Then
                His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
            End If
        End If
End If

    'set handicap
If HOST = SERVER Then
Hand = CInt(Handicap.Text)
End IfIf HOST = CLIENT Then
    t = Mid$(Buffer, p4 + 2, 1)
    Hand = CInt(t)
    If p1 Then
    white.Value = True
    Side = WHITEP
    S_R = 0
    R_R = 1
    Else
    black.Value = True
    Side = BLACKP
    S_R = 1
    R_R = 0
    End If
End If
Pause 1
Me.WindowState = 1
Call Form1.Begin_Click
Else
Modem_Status.Cls
Modem_Status.Print "LOGIN Failed"
ModemState = FAILED
AbortCall
End If
End Sub
Private Sub AbortCall()
Dim i As Integer
MyOpenPort (Port)
On Error GoTo Err
Comm1.Output = "+++ATH" & Chr$(13)
ModemState = IDLE
Err:
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End SubPublic Sub Disconnect_Click()
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
Modem_Status.Cls
Modem_Status.Print "Disconnecting..."
Pause 1
AbortCall
Modem_Status.Cls
Modem_Status.Print "Modem Idle"
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Form_Load()
MPort.AddItem "COM1"
MPort.AddItem "COM2"
MPort.AddItem "COM3"
MPort.AddItem "COM4"
MPort.Text = "COM1"
Speed.AddItem "2400"
Speed.AddItem "4800"
Speed.AddItem "9600"
Speed.AddItem "14400"
Speed.AddItem "28800"
Speed.Text = "9600"
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
HOST = -1
Port = 1
End Sub
Private Sub Set_Click()
Dim i As Integer
i = 1
Select Case MPort.Text
Case "COM1":
     i = 1
Case "COM2":
     i = 2
Case "COM3":
     i = 3
Case "COM4":
     i = 4
End Select
If IsNumeric(Handicap.Text) Then
GoTo out
Else
MsgBox "Set Handicap please!"
Exit Sub
End If
out:
Port = i
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
End Sub
Private Sub Wait_Click()
Dim W$
Dial.Enabled = False
Disconnect.Enabled = False
Wait.Enabled = False
MyOpenPort (Port)
Modem_Status.Cls
Modem_Status.Print "Waiting for call..."
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
g_ErrorCode = 0
W$ = WaitForValue("RING", 30)
If g_ErrorCode = 0 Then
    Modem_Status.Cls
    Modem_Status.Print "Modem Ringing..."
    Pause 1
    Modem_Status.Cls
    Modem_Status.Print "Answering..."
    Comm1.Output = "ATA" & Chr$(13)
    W$ = WaitForValue("CONNECT", WaitConnectConst)
      If g_ErrorCode = 0 Then
        Modem_Status.Cls
        Modem_Status.Print "Connected"
        ModemState = CONNECT
        Pause 3
        HOST = CLIENT
        Recievelogin
        Sendlogin
        Dial.Enabled = False
        Disconnect.Enabled = True
        Wait.Enabled = False
      Else
        Modem_Status.Cls
        Modem_Status.Print "Connect Failed"
        AbortCall
        Modem_Status.Cls
        Modem_Status.Print "Modem Idle"
        ModemState = IDLE
        Dial.Enabled = True
        Disconnect.Enabled = True
        Wait.Enabled = True
      End If
Exit Sub
End If
ModemState = IDLE
Dial.Enabled = True
Disconnect.Enabled = True
Wait.Enabled = True
Exit Sub
End If
Loop
End Sub
Public Sub Send_Msg(Msg_No As Integer)
If ModemState = LOGIN Then
    Comm1.InBufferCount = 0
    If IsNumeric(Msg(Msg_No).X) Then
    Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
                    + Str(Msg(Msg_No).Color) + "|" _
                    + Str(Msg(Msg_No).X) + "|" _
                    + Str(Msg(Msg_No).Y) + "|" _
                    + Msg(Msg_No).E + "|;" + Chr$(26)
    Else
    Comm1.Output = "B" + Str(Msg(Msg_No).No) + "|" _
                    + Str(Msg(Msg_No).Color) + "|" _
                    + (Msg(Msg_No).X) + "|" _
                    + Str(Msg(Msg_No).Y) + "|" _
                    + Msg(Msg_No).E + "|;" + Chr$(26)
    End If
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
Comm1.InputLen = 1
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
Do
DoEvents
If Comm1.InBufferCount <> 0 Then
    MyIn$ = MyIn$ & Comm1.Input
    there% = InStr(MyIn$, Wait$)
    If there% Then
        Exit Do
    End If
End If
If Timer >= EndTime Then
    g_ErrorCode = 1
    Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Exist_Msg() As Boolean
If Comm1.InBufferCount Then
Exist_Msg = True
Else
Exist_Msg = False
End If
End Function
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Const MaxLen = 100
Dim Be_Host As Boolean
Public Message_Exist As Boolean 'indicate if a message existed
Dim Buffer$
Private Sub Called_Click()
Calling.Enabled = False
Winsock1.LocalPort = 888
Winsock1.Listen
Net_Status.Caption = "正在等待呼叫......"
Called.Enabled = False
Be_Host = True
End Sub
Private Sub Calling_Click()
Called.Enabled = False
If Address.Text <> " " Then
Winsock1.RemoteHost = Address.Text
Winsock1.RemotePort = 888
Net_Status.Caption = "正在呼叫庄家......"
Winsock1.CONNECT
End If
Be_Host = False
End Sub
Private Sub Exit_Click()
If Winsock1.State <> 0 Then
Winsock1.Close
SocketState = UNCONNECTED
End If
Unload Me
End SubPrivate Sub Form_Load()
Handicap.AddItem "0"
Handicap.AddItem "1"
Handicap.AddItem "2"
Handicap.AddItem "3"
Handicap.AddItem "4"
Handicap.AddItem "5"
Handicap.AddItem "6"
Handicap.AddItem "7"
Handicap.AddItem "8"
Handicap.AddItem "9"
Handicap.Text = "0"
Message_Exist = False
End SubPrivate Sub Winsock1_Connect()
Net_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End SubPrivate Sub Winsock1_ConnectionRequest _
(ByVal requestID As Long)
'测试 State 属性，如果当前连接是打开的话，
'则关闭连接。
If Winsock1.State <> sckClosed Then Winsock1.Close
'将 requestID 参数值传递给 Accept 方法。
Winsock1.Accept requestIDNet_Status.Caption = "正常连接！"
SocketState = CONNECTED
Pause 1
Sendlogin
Pause 1
Recievelogin
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Message_Exist = True
End SubPublic Sub Send_Msg(Msg_No As Integer)
Dim temp$
If Winsock1.State = sckConnected Then
    If Message_Exist = True Then
        Winsock1.GetData temp, vbString, MaxLen
        Message_Exist = False
    End If
    If IsNumeric(Msg(Msg_No).X) Then
    Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
                    + Str(Msg(Msg_No).Color) + "|" _
                    + Str(Msg(Msg_No).X) + "|" _
                    + Str(Msg(Msg_No).Y) + "|" _
                    + Msg(Msg_No).E + "|;" + Chr$(26))
    Else
    Winsock1.SendData ("B" + Str(Msg(Msg_No).No) + "|" _
                    + Str(Msg(Msg_No).Color) + "|" _
                    + (Msg(Msg_No).X) + "|" _
                    + Str(Msg(Msg_No).Y) + "|" _
                    + Msg(Msg_No).E + "|;" + Chr$(26))
    End If
Else
SocketState = UNCONNECTED
Beep
MsgBox ("对手已经离开！")
End If
End Sub
Public Sub Con_msg(N As Integer, C As Integer, X As Variant, Y As Variant)
Msg(N).No = N
Msg(N).Color = C
Msg(N).X = X
Msg(N).Y = Y
Msg(N).E = "E"
End Sub
Public Function WaitForValue(Wait$, WaitTime) As String
Dim Receive$, StartTime, EndTime, MyIn$, ErrCode%, there%
g_ErrorCode = 0
Receive = " "
MyIn$ = ""
StartTime = Timer
EndTime = StartTime + WaitTime
'If Winsock1.State <> sckConnected Then
'Message_Exist = False
'Exit Function
'End If
Do
DoEvents
    If Message_Exist = True Then
        Winsock1.GetData MyIn$, vbString, MaxLen
        Message_Exist = False
        there% = InStr(MyIn$, Wait$)
        If there% Then
            Exit Do
        End If
    End If
If Timer >= EndTime Then
    g_ErrorCode = 1
    Exit Do
End If
Loop
WaitForValue = MyIn$
End Function
Public Function Disconnect()
Winsock1.Close
SocketState = UNCONNECTED
Message_Exist = False
End Function
Private Sub Sendlogin()
If Be_Host = True Then
    If White.Value <> True Then
    black.Value = True
    Side = BLACKP
    S_R = 1
    R_R = 0
    Winsock1.SendData ("NA" + My_name.Text + "#B" + "#H" + Handicap.Text + ";" + Chr$(13))
    Else
    Winsock1.SendData ("NA" + My_name.Text + "#W" + "#H" + Handicap.Text + ";" + Chr$(13))
    Side = WHITEP
    S_R = 0
    R_R = 1
    End If
Else
    Winsock1.SendData ("NA" + My_name.Text + "##" + "#H0;" + Chr$(13))
End If
End Sub
Private Sub Recievelogin()
Dim pos, p1, p2, p3, p4 As Integer
Dim t As StringBuffer = WaitForValue(";", 15)pos = InStr(Buffer, "NA")
p1 = InStr(Buffer, "#B")
p2 = InStr(Buffer, "#W")
p3 = InStr(Buffer, "##")
p4 = InStr(Buffer, "#H")If g_ErrorCode = 0 Then
    Net_Status.Caption = "正常登录！"
    SocketState = CONNECTED If p1 <> 0 Then
        His_Name.Text = Mid$(Buffer, pos + 2, p1 - pos - 2)
    Else
        If p2 <> 0 Then
        His_Name.Text = Mid$(Buffer, pos + 2, p2 - pos - 2)
            Else
            If p3 <> 0 Then
                His_Name.Text = Mid$(Buffer, pos + 2, p3 - pos - 2)
            End If
        End If
End If

'set handicap
If Be_Host = True Then
    If (Len(Handicap.Text) <> 0) Then
    Hand = CInt(Handicap.Text)
    Else
    Hand = 0
    End If
End IfIf Be_Host = False Then
    t = Mid$(Buffer, p4 + 2, 1)
    If Len(t) <> 0 Then
        Hand = CInt(t)
        Handicap.Text = Str(Hand)
    Else
        Hand = 0
    End If

    If p1 Then
        White.Value = True
        Side = WHITEP
        S_R = 0
        R_R = 1
    Else
        black.Value = True
        Side = BLACKP
        S_R = 1
        R_R = 0
    End If
End IfMe.WindowState = 1
Call Form1.Begin_Click
Else
    Net_Status.Caption = "登录失败！"
    SocketState = UNCONNECTED
    Disconnect
End If
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Black_Name = " "
White_Name = " "
Add_Message = " "
Unload Me
End Sub
Private Sub Form_Load()
If ModemState = LOGIN Then
    If Len(Modem_F.My_name.Text) <> 0 And Side = BLACKP Then
        Black_N.Text = Modem_F.My_name.Text
    End If
    If Len(Modem_F.My_name.Text) <> 0 And Side = WHITEP Then
        White_N.Text = Modem_F.My_name.Text
    End If
    If Len(Modem_F.His_Name.Text) <> 0 And Side = WHITEP Then
        Black_N.Text = Modem_F.His_Name.Text
    End If
    If Len(Modem_F.His_Name.Text) <> 0 And Side = BLACKP Then
        White_N.Text = Modem_F.His_Name.Text
    End If
End If
End Sub
Private Sub OK_Click()
Black_Name = Black_N.Text
White_Name = White_N.Text
Add_Message = Kibbitz.Text
Unload Me
End Sub
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Topic.AddItem ("Hi!")
Topic.AddItem ("Hello!")
Topic.AddItem ("ByeBye")
Topic.AddItem ("Are you there?")
Topic.AddItem ("Where are you from?")
Topic.AddItem ("I have to leave now,I am sorry.")
Topic.AddItem ("I have to take a dinner.")
Topic.AddItem ("You don't mind a undo?")
Topic.AddItem ("No,I don't mind.")
Topic.AddItem ("Please don't do it!")
Topic.AddItem ("You are a good player.")
End Sub
Private Sub Say_Click()
'Modem process begin
Dim Try As Integer
Try = 0
    If ModemState = LOGIN Then
        If S_R <> 1 Then
        Beep
        Exit Sub
        End If
        Call Modem_F.Con_msg(Msg_No, TALK, Topic.Text, 0)
Resend:
        Call Modem_F.Send_Msg(Msg_No)
        Call Modem_F.WaitForValue("R_O", 10)
        If Try >= 2 Then
        'Talking failed
            Beep
            MsgBox ("对手已经离开")
            Modem_F.WindowState = 0
            Call Modem_F.Disconnect_Click
            Unload Me
            Exit Sub
        End If
        If g_ErrorCode = 1 Then
            Try = Try + 1
            GoTo Resend
        End If
        Msg_No = Msg_No + 1
   End If
  Unload Me
'Modem Process end
End Sub
##########################################
模块
Option Explicit
Global Const MAXSTEP = 400  'Max number of steps
Global Const CHECKED = 1
Global Const UNCHECKED = 0Global Const LEFT = 1
Global Const RIGHT = 2
Global Const UP = 3
Global Const Down = 4Global Const ERASEP = -1
Global Const EMPTYP = 0
Global Const BLACKP = 1
Global Const WHITEP = 2
Global Const BOLDP = 3Global TURN As IntegerGlobal MYCOLOR, HISCOLOR As Integer
Global Step As Integer
Global Msg_No As Integer
Global Hand As Integer
Global Current As Boolean
Global HOST As Integer
Global Const SERVER = 0
Global Const CLIENT = 1Global Black_Name As String
Global White_Name As String
Global Add_Message As StringGlobal ModemState As Integer
Global SocketState As Integer
Global PlayState As IntegerGlobal Const CONNECTED = 1
Global Const UNCONNECTED = 0
Global S_R As Integer  'Send Ready
Global R_R As Integer  'Receive Ready
Global Side As Integer 'Which side I am takingGlobal Const IDLE = 0
Global Const BUSY = 1
Global Const NODIALTONE = 2
Global Const NOCARRIER = 3
Global Const CONNECT = 4
Global Const FAILED = 5
Global Const LOGIN = 6Global Const GIVEUP = -1
Global Const PLAY = 2
Global Const COUNTAREA = 3
Global Const TALK = 4
Global Const FINISHED = -4
Global Const UNDO = -2
Global Const LOGOUT = -3Global g_ErrorCode As Integer
Global ParseArray(5)Public Type Stone
Color As Integer
X As Integer
Y As Integer
Eat As Boolean 'Did it eat some stone?
End TypePublic Type MyPoint
Color As Integer
X As Integer
Y As Integer
Status As Integer
Gas As Integer
Current As Boolean
End TypePublic Type Message
No As Integer
Color As Integer
X As Variant
Y As Variant
E As String
End TypeGlobal Msg(1 To MAXSTEP) As Message
Global Board(1 To 19, 1 To 19) As MyPoint
Global Record(1 To MAXSTEP) As Stone
Public Function Count_Gas(p As MyPoint) As Integer
Dim l, r, u, d As Integer
Dim lx, ly, rx, ry, ux, uy, dx, dy As Integer
Dim lc, ls, lg, rc, rs, rg, uc, us, ug, dc, ds, du, dg As Integer
Dim nogas As Boolean
Dim ltp, rtp, utp, dtp As MyPointnogas = No_Gas(p)
    lx = Near_Point(LEFT, p).X
    ly = Near_Point(LEFT, p).Y
    rx = Near_Point(RIGHT, p).X
    ry = Near_Point(RIGHT, p).Y
    ux = Near_Point(UP, p).X
    uy = Near_Point(UP, p).Y
    dx = Near_Point(Down, p).X
    dy = Near_Point(Down, p).Y

    If lx = 0 Then
        lc = BOLDP
        ls = CHECKED
        lg = 0
    Else
        lc = Board(lx, ly).Color
        ls = Board(lx, ly).Status
        lg = Board(lx, ly).Gas
    End If

    If rx = 20 Then
        rc = BOLDP
        rs = CHECKED
        rg = 0
    Else
        rc = Board(rx, ry).Color
        rs = Board(rx, ry).Status
        rg = Board(rx, ry).Gas
    End If

    If uy = 0 Then
        uc = BOLDP
        us = CHECKED
        ug = 0
    Else
        uc = Board(ux, uy).Color
        us = Board(ux, uy).Status
        ug = Board(ux, uy).Gas
    End If

    If dy = 20 Then
        dc = BOLDP
        ds = CHECKED
        dg = 0
    Else
        dc = Board(dx, dy).Color
        ds = Board(dx, dy).Status
        dg = Board(dx, dy).Gas
    End If

If nogas = False Then
Count_Gas = 1
Board(p.X, p.Y).Gas = 1
Board(p.X, p.Y).Status = CHECKED
    If (lx > 0 And lx < 20 And ly > 0 And ly < 20) Then
        If Board(lx, ly).Color = p.Color Then
            Board(lx, ly).Gas = 1
            Board(lx, ly).Status = CHECKED
        End If
    End If

    If (rx > 0 And rx < 20 And ry > 0 And ry < 20) Then
        If Board(rx, ry).Color = p.Color Then
            Board(rx, ry).Gas = 1
            Board(rx, ry).Status = CHECKED
        End If
    End If

    If (ux > 0 And ux < 20 And uy > 0 And uy < 20) Then
        If Board(ux, uy).Color = p.Color Then
            Board(ux, uy).Gas = 1
            Board(ux, uy).Status = CHECKED
        End If
    End If

    If (dx > 0 And dx < 20 And dy > 0 And dy < 20) Then
        If Board(dx, dy).Color = p.Color Then
            Board(dx, dy).Gas = 1
            Board(dx, dy).Status = CHECKED
        End If
    End If
Exit Function
End IfIf nogas = True Then
    Board(p.X, p.Y).Status = CHECKED
    l = r = u = d = 0
    If lc = EMPTYP Then
        l = 1
        GoTo out
        Else
        If lc = BOLDP Or lc <> p.Color Then
            l = 0
            Else
            If ls = CHECKED And lg = 1 Then
                l = 1
                GoTo out
                Else
                If ls = UNCHECKED Then
                    l = Count_Gas(Near_Point(LEFT, p))
                    Else
                    l = 0
                End If
            End If
        End If
    End If

    If rc = EMPTYP Then
        r = 1
        GoTo out
        Else
        If rc = BOLDP Or rc <> p.Color Then
            r = 0
            Else
            If rs = CHECKED And rg = 1 Then
                r = 1
                GoTo out
                Else
                If rs = UNCHECKED Then
                    r = Count_Gas(Near_Point(RIGHT, p))
                    Else
                    r = 0
                End If
            End If
        End If
    End If

    If uc = EMPTYP Then
        u = 1
        GoTo out
        Else
        If uc = BOLDP Or uc <> p.Color Then
            u = 0
            Else
            If us = CHECKED And ug = 1 Then
                u = 1
                GoTo out

ylt1437(乐天派)　：
这个程序好象是网络上的人人对弈版而不是人机对弈版吧？

调试易

请问哪里有VB写的围棋人机对弈源程序？谢谢了！！！

解决方案 »