五子棋人机对战批处理游戏 - 中国DOS联盟论坛

这个牛哈
看不懂，但玩的有意思

我抄袭一下zh159



If Not (IsObject(Navigator)) Then
    Dim Ie
    Set Ie=WScript.CreateObject("InternetExplorer.Application","Event_")
    'Msgbox "WSH"
    MainF()
Else
    'Msgbox "IEE"
End IF


Sub MainF()

Path="file://" & WScript.ScriptFullName


With Ie
.Navigate       ("about:blank")
.Document.Write ("<Script Language=VBScript Src=""" & Path & """></Script><Script Langage=JavaScript></Script>")   '需要写入的内容
.Document.Write ("<style>.GUIwh{width:24;height:24;cursor:hand;}</style><Body></Body>")


'窗口大小\位置
.Width          = 660               '宽
.Height         = 550               '高
.Resizable      = 0                 '不允许用户改变窗口大小'
.Left           = Fix((.Document.ParentWindow.Screen.AvailWidth-.Width)/2)      '水平居中
.Top            = Fix((.Document.ParentWindow.Screen.AvailHeight-.Height)/2)    '垂直居中


.Document.Title                         = " "                                               '标题
.Document.Body.Scroll                   = "no"                                              '关闭滚动条
.Document.Body.OnconTextMenu            = GetRef("Disabled")                                '禁止右键
.Document.Body.OnSelectStart            = GetRef("Disabled")                                '禁止选取
.Document.Body.Style.CssText            = "background: SteelBlue ;color:#ffffff;"
.Document.Body.InnerHtml                = "<table id=aT><tr><td><TABLE id=bT></TABLE></td><td id=sD></td></tr></table>"
.Document.ParentWindow.ExecScript         "build(19)","VBScript"
    With.Document.Body.All
        .aT.Align                       = "Center"
        .aT.Width                       = "630"
        .aT.Border                      = "1"
        .aT.BorderColor                 = "#ffffff"
        .aT.CellSpacing                 = "0"
        .aT.CellPadding                 = "10"
        .aT.Style.CssText               = "font: 13px 宋体;border-collapse:collapse;"

        .aT.Rows(0).Align               = "Center"
        .aT.Rows(0).Cells(0).Width      = "450"
        .aT.Rows(0).Cells(0).Height     = "450"

        .bT.Align                       = "Center"
        .bT.Border                      = "0"
        .bT.BorderColor                 = "#ffffff"
        .bT.CellSpacing                 = "0"
        .bT.CellPadding                 = "0"
        .bT.Style.CssText               =  "font: 21px 宋体;border:2px solid #ffffff;"
    End With


'窗体
'.FullScreen=1
.MenuBar        = 0                 '取消菜单栏'
.AddressBar     = 0                 '取消地址栏'
.ToolBar        = 0                 '取消工具栏'
.StatusBar      = 0                 '取消状态栏'
.Visible        = 1                 '显示IE页面'
 Set window=.Document.ParentWindow
End With
'.Document.OnClick = GetRef("Test1")
'window.ExecScript "fun()","VBScript"
'Ie.Document.ParentWindow.ExecScript  "build(19)","VBScript"


Do
    WScript.Sleep 200
Loop

End Sub


Function Test1()
    'msgbox "event_boundElements"
End Function

Function Disabled()
    Disabled=True
End Function

Function Event_OnQuit()
    WScript.Quit
End Function


Function Build(N)
PS=N-1
While (S < N)
    If S <= 1 Then charA=chr(43440):charB=chr(43472):charC=chr(43444)
    If S >= 1 Then charA=chr(43456):charB=chr(43488):charC=chr(43464)
    If S = PS Then charA=chr(43448):charB=chr(43480):charC=chr(43452)
    Document.All.bT.insertrow(S)    
    For j = 0 To PS
        If ((S*N+j) Mod PS) = (S Mod PS) Then
            Char=charA:charA=charC
        Else
            Char=charB
        End If
        
        Document.All.bT.Rows(S).insertcell(j)
        Document.All.bT.Rows(S).Cells(j).ID = S*N+j
        Document.All.bT.Rows(S).Cells(j).CLASSName = "GUIwh"
        Document.All.bT.Rows(S).Cells(j).InnerHtml = "<span onclick=Ts(this) onMouseOver='innerText=""" &chr(41457)& """;style.color=""blue""' onMouseOut='innerText=""" &chr(43488)& """;style.color=""""'>" &char& "</span>"
        'Document.All.bT.Rows(S).Cells(j).InnerHtml = "<span id=mm onclick='Ts(this)' onMouseOver='innerText=X' onMouseOut='innerText=Y'>+</span>"
    Next
    S=S+1
Wend
End Function

Function Ts(this)

    msgbox this.ParentNode.ID

    this.parentNode.style.cursor = "default"
    this.parentNode.innerHtml = chr(41457)
    'PC.style.display = "none"
    
End Function


Function fun()
    Msgbox "this is fun!"
End Function

哈哈

LS的代码只能用在IE浏览器为默认时，且有个bug：鼠标在边缘棋盘格移开后，并不是恢复边缘棋盘格的样子，而是变成中间棋盘格的样子

re 17楼
存为什么扩展名呀？我运行不了呀，
.vbs .js .html .bat
都试了不行呢？

系统：XP SP2 EN
默认浏览器：IE 6

Originally posted by zh159 at 2009-5-10 01:50 PM:
LS的代码只能用在IE浏览器为默认时，且有个bug：鼠标在边缘棋盘格移开后，并不是恢复边缘棋盘格的样子，而是变成中间棋盘格的样子

抄错了，哈哈
mouseout事件的文本应是char，我没看你后边替换的代码，直接填成+了
这个脚本我改了默认浏览器也是正常的呀

这个错误我也碰到，原来是脚本中几个双字节符号造成的，我改成了cha(ascii)才解决掉，可能是你系统是英文版的原因吧

能否改改代码让它同时兼容中英文系统呢？

这些字符我也不熟，你可以换成英文字母先试试
只需要把chr(?????)换成chr(65)-chr(75)就可以了

弄了半天，写了下边这个代码，主要用来得到五子棋落子坐标的横竖撇捺行
我的思路是电脑不去对比整个棋盘，而是紧跟对手的落子判断落子四行是否有五子的风险
只写到提取四行数组
用的是一维数组，像棋盘要是二维的话可以使用行数*总列(19)+列数转成一维的
因为一维数组识别四行比较方便，横行步进1，竖行是19，撇是18，捺是20

有关坐标的关系可以使用以下代码观察
显示二维坐标


@echo off
setlocal enabledelayedexpansion
mode con: lines=100 cols=100
for /l %%i in (0,1,18) do (
for /l %%j in (0,1,18) do (
	if %%i LSS 10  set x=0
	if %%j LSS 10  set y=0
	set/p=!x!%%i!y!%%j <nul
	set x=&set y=	
)
echo.
)

pause

显示一维坐标


@echo off
setlocal enabledelayedexpansion
for /l %%i in (0,1,18) do (
for /l %%j in (0,1,18) do (
	set /a f=%%i*19+%%j
	if !f! LSS 10  set f=0!f!
	if !f! Lss 100 set f=0!f!
	call set /p =%%f%% <nul
)
echo.
)

pause


Const N     = 19
Const msg   = 1
If Ucase(Right(WScript.FullName,11)) = "WSCRIPT.EXE" Then
    CreateObject("WScript.Shell").Run "Cmd.exe /K Cscript """ & Wscript.ScriptFullName & """"
    WScript.Quit
End If

ReDim arry(N*N-1)


For i =0 To N*N-1
arry(i)=i
Next

Function PriArry()
For i = 0 To 18
    For j = 0 To 18
        k="00"
        If i*N+j >  9  Then k="0"
        If i*N+j > 99  Then k=""
        s=s &  k & arry(i*N+j) & " "
    Next
    p s
    s=""
Next
End Function


While True
PriArry
p xypn(gcon)
Wend

Function xypn(a)
M=N-1                                                       '自定义坐标   标准x_ord*总列数+标准y_ord
x_ord           = a\N                                       '横向标准坐标 自定义坐标/总列数
y_ord           = a Mod N                                   '竖行标准坐标 自定义坐标/总列数的余数
x_base_value    = x_ord*N                                   '坐标所在行的 行首坐标值 (行数*总列数)
y_base_value    = a-x_base_value                            '坐标所在列的 列首坐标值 (坐标值-行首坐标值)

For i = 0 To N-1
hen=hen & x_base_value+i    & " "                           '横行=行首坐标值(x_base_value)以1递加至行尾
shu=shu & y_base_value+i*N  & " "                           '竖行=列首坐标值(y_base_value)以N递加至列尾
Next
str = "横:" & hen & vbCrLf & "竖:" & shu & vcCrLf

px_ord          = (Abs(x_ord+y_ord-M)+(x_ord+y_ord-M))\2    '撇行首标准坐标x   ((标准x+y) > 18)?(px_ord=(x+y) mod 18):(0)
py_ord          = x_ord+y_ord-px_ord                        '撇行首标准坐标y   ((标准x+y) > 18)?(x+y-px_ord):(x+y)
p_base_value    = px_ord*N+py_ord                           '撇行首自定义坐标值 标准x_ord*总列数+标准y_ord

For i = 0 To py_ord-px_ord                                  '撇行长度为 py_ord-px_ord
pie=pie & p_base_value+i*(N-1) & " "                        '撇行自增量为 N-1
Next
str = str & vbCrLf & "撇:" & pie & vbCrLf

nx_ord = (Abs(x_ord-y_ord)+(x_ord-y_ord))\2                 '捺行首标准坐标x   nx_ord=((x_ord-y_ord) > 0)?(x_ord-y_ord):(0)
ny_ord = (x_ord-y_ord)*(Sgn(x_ord-y_ord)-1)\2               '捺行首标准坐标y   ny_ord=((x_ord-y_ord) < 0)?(x_ord-y_ord):(0)
n_base_value = nx_ord*N+ny_ord                              '捺行首自定义坐标值 标准x_ord*总列数+标准y_ord

For i = 0 To 18-nx_ord-ny_ord                               '捺行长度为 18-(nx_ord+ny_ord)
na = na & n_base_value+i*(N+1) & " "                        '捺行自增量为 N+1
Next
str = str & "捺:" & na
xypn=str
End Function

Function p(str)
    If msg Then WScript.Echo str Else InputBox "","",str
End Function

Function gcon()
gcon=WScript.StdIn.ReadLine
End Function

不管是用二维坐标法，还是一维跨标法，最后还是要进行组串，然后才与规则串匹配
因为在进行规则串匹配时，是按串进行的。其实应该把：显示缓存、横、坚、撇、捺分别定义为数组串较好一点，不必要去进行多次组串操作。

电脑方是根据匹配到的最优规则串进行下子的，根据匹配到的是在哪个数组（横/坚/撇/捺）第几串的第几个字符，即可转换为实际坐标

因为定义了五个数组，所以只要下一个子，就要分别对这五个数组的相应位置进行替换，每个数组仅替换一行的一个字符即可

以行为单元显示肯定要比以字符为单元显示要快好多，因为用了显存串方式，所以可以直接以行为单元显示。

我的思路是电脑不去对比整个棋盘，而是紧跟对手的落子判断落子四行是否有五子的风险

这样的话电脑的棋力是否太弱了？通常的五子棋算法都是对下一步双方可能出现的情况（四三、双三等等）进行优先级排序，然后选择优先级最高的落点吧。

太牛了，批处理也有这么强的功能！

Originally posted by rubble at 2009-5-12 08:09:
太牛了，批处理也有这么强的功能！

真想不到能搞出这一个东西出来，不过代码我就很难懂了。

第16楼　huchaolan	发表于 2009-05-09 20:29
新手上路　发帖 6　积分 15
这个牛哈看不懂，但玩的有意思

第17楼　everest79	发表于 2009-05-10 07:24
金牌会员　发帖 1,127　积分 2,564
我抄袭一下zh159 If Not (IsObject(Navigator)) Then Dim Ie Set Ie=WScript.CreateObject("InternetExplorer.Application","Event_") 'Msgbox "WSH" MainF() Else 'Msgbox "IEE" End IF Sub MainF() Path="file://" & WScript.ScriptFullName With Ie .Navigate ("about:blank") .Document.Write ("<Script Language=VBScript Src=""" & Path & """></Script><Script Langage=JavaScript></Script>") '需要写入的内容 .Document.Write ("<style>.GUIwh{width:24;height:24;cursor:hand;}</style><Body></Body>") '窗口大小\位置 .Width = 660 '宽 .Height = 550 '高 .Resizable = 0 '不允许用户改变窗口大小' .Left = Fix((.Document.ParentWindow.Screen.AvailWidth-.Width)/2) '水平居中 .Top = Fix((.Document.ParentWindow.Screen.AvailHeight-.Height)/2) '垂直居中 .Document.Title = " " '标题 .Document.Body.Scroll = "no" '关闭滚动条 .Document.Body.OnconTextMenu = GetRef("Disabled") '禁止右键 .Document.Body.OnSelectStart = GetRef("Disabled") '禁止选取 .Document.Body.Style.CssText = "background: SteelBlue ;color:#ffffff;" .Document.Body.InnerHtml = "<table id=aT><tr><td><TABLE id=bT></TABLE></td><td id=sD></td></tr></table>" .Document.ParentWindow.ExecScript "build(19)","VBScript" With.Document.Body.All .aT.Align = "Center" .aT.Width = "630" .aT.Border = "1" .aT.BorderColor = "#ffffff" .aT.CellSpacing = "0" .aT.CellPadding = "10" .aT.Style.CssText = "font: 13px 宋体;border-collapse:collapse;" .aT.Rows(0).Align = "Center" .aT.Rows(0).Cells(0).Width = "450" .aT.Rows(0).Cells(0).Height = "450" .bT.Align = "Center" .bT.Border = "0" .bT.BorderColor = "#ffffff" .bT.CellSpacing = "0" .bT.CellPadding = "0" .bT.Style.CssText = "font: 21px 宋体;border:2px solid #ffffff;" End With '窗体 '.FullScreen=1 .MenuBar = 0 '取消菜单栏' .AddressBar = 0 '取消地址栏' .ToolBar = 0 '取消工具栏' .StatusBar = 0 '取消状态栏' .Visible = 1 '显示IE页面' Set window=.Document.ParentWindow End With '.Document.OnClick = GetRef("Test1") 'window.ExecScript "fun()","VBScript" 'Ie.Document.ParentWindow.ExecScript "build(19)","VBScript" Do WScript.Sleep 200 Loop End Sub Function Test1() 'msgbox "event_boundElements" End Function Function Disabled() Disabled=True End Function Function Event_OnQuit() WScript.Quit End Function Function Build(N) PS=N-1 While (S < N) If S <= 1 Then charA=chr(43440):charB=chr(43472):charC=chr(43444) If S >= 1 Then charA=chr(43456):charB=chr(43488):charC=chr(43464) If S = PS Then charA=chr(43448):charB=chr(43480):charC=chr(43452) Document.All.bT.insertrow(S) For j = 0 To PS If ((SN+j) Mod PS) = (S Mod PS) Then Char=charA:charA=charC Else Char=charB End If Document.All.bT.Rows(S).insertcell(j) Document.All.bT.Rows(S).Cells(j).ID = SN+j Document.All.bT.Rows(S).Cells(j).CLASSName = "GUIwh" Document.All.bT.Rows(S).Cells(j).InnerHtml = "<span onclick=Ts(this) onMouseOver='innerText=""" &chr(41457)& """;style.color=""blue""' onMouseOut='innerText=""" &chr(43488)& """;style.color=""""'>" &char& "</span>" 'Document.All.bT.Rows(S).Cells(j).InnerHtml = "<span id=mm onclick='Ts(this)' onMouseOver='innerText=X' onMouseOut='innerText=Y'>+</span>" Next S=S+1 Wend End Function Function Ts(this) msgbox this.ParentNode.ID this.parentNode.style.cursor = "default" this.parentNode.innerHtml = chr(41457) 'PC.style.display = "none" End Function Function fun() Msgbox "this is fun!" End Function 哈哈

第18楼　zh159	发表于 2009-05-10 13:50
金牌会员　发帖 1,467　积分 3,687
LS的代码只能用在IE浏览器为默认时，且有个bug：鼠标在边缘棋盘格移开后，并不是恢复边缘棋盘格的样子，而是变成中间棋盘格的样子

第19楼　netbenton	发表于 2009-05-10 13:56
银牌会员　发帖 752　积分 1,916　来自广西
re 17楼存为什么扩展名呀？我运行不了呀， .vbs .js .html .bat 都试了不行呢？

第20楼　HAT	发表于 2009-05-10 23:19
版主　发帖 5,017　积分 9,023
Re 17楼系统：XP SP2 EN 默认浏览器：IE 6 附件 2009-05-11_100903.png (5.66 KiB)

第21楼　everest79	发表于 2009-05-11 02:21
金牌会员　发帖 1,127　积分 2,564
Originally posted by zh159 at 2009-5-10 01:50 PM: LS的代码只能用在IE浏览器为默认时，且有个bug：鼠标在边缘棋盘格移开后，并不是恢复边缘棋盘格的样子，而是变成中间棋盘格的样子抄错了，哈哈 mouseout事件的文本应是char，我没看你后边替换的代码，直接填成+了这个脚本我改了默认浏览器也是正常的呀

第22楼　everest79	发表于 2009-05-11 02:21
金牌会员　发帖 1,127　积分 2,564
就是vbs，嘿嘿

第23楼　everest79	发表于 2009-05-11 02:23
金牌会员　发帖 1,127　积分 2,564
这个错误我也碰到，原来是脚本中几个双字节符号造成的，我改成了cha(ascii)才解决掉，可能是你系统是英文版的原因吧

第24楼　HAT	发表于 2009-05-11 08:56
版主　发帖 5,017　积分 9,023
Re 23楼能否改改代码让它同时兼容中英文系统呢？

第25楼　everest79	发表于 2009-05-11 10:44
金牌会员　发帖 1,127　积分 2,564
这些字符我也不熟，你可以换成英文字母先试试只需要把chr(?????)换成chr(65)-chr(75)就可以了

第26楼　everest79	发表于 2009-05-11 11:38
金牌会员　发帖 1,127　积分 2,564
弄了半天，写了下边这个代码，主要用来得到五子棋落子坐标的横竖撇捺行我的思路是电脑不去对比整个棋盘，而是紧跟对手的落子判断落子四行是否有五子的风险只写到提取四行数组用的是一维数组，像棋盘要是二维的话可以使用行数总列(19)+列数转成一维的因为一维数组识别四行比较方便，横行步进1，竖行是19，撇是18，捺是20 有关坐标的关系可以使用以下代码观察显示二维坐标 @echo off setlocal enabledelayedexpansion mode con: lines=100 cols=100 for /l %%i in (0,1,18) do ( for /l %%j in (0,1,18) do ( if %%i LSS 10 set x=0 if %%j LSS 10 set y=0 set/p=!x!%%i!y!%%j <nul set x=&set y= ) echo. ) pause 显示一维坐标 @echo off setlocal enabledelayedexpansion for /l %%i in (0,1,18) do ( for /l %%j in (0,1,18) do ( set /a f=%%i19+%%j if !f! LSS 10 set f=0!f! if !f! Lss 100 set f=0!f! call set /p =%%f%% <nul ) echo. ) pause Const N = 19 Const msg = 1 If Ucase(Right(WScript.FullName,11)) = "WSCRIPT.EXE" Then CreateObject("WScript.Shell").Run "Cmd.exe /K Cscript """ & Wscript.ScriptFullName & """" WScript.Quit End If ReDim arry(NN-1) For i =0 To NN-1 arry(i)=i Next Function PriArry() For i = 0 To 18 For j = 0 To 18 k="00" If iN+j > 9 Then k="0" If iN+j > 99 Then k="" s=s & k & arry(iN+j) & " " Next p s s="" Next End Function While True PriArry p xypn(gcon) Wend Function xypn(a) M=N-1 '自定义坐标标准x_ord总列数+标准y_ord x_ord = a\N '横向标准坐标自定义坐标/总列数 y_ord = a Mod N '竖行标准坐标自定义坐标/总列数的余数 x_base_value = x_ordN '坐标所在行的行首坐标值 (行数总列数) y_base_value = a-x_base_value '坐标所在列的列首坐标值 (坐标值-行首坐标值) For i = 0 To N-1 hen=hen & x_base_value+i & " " '横行=行首坐标值(x_base_value)以1递加至行尾 shu=shu & y_base_value+iN & " " '竖行=列首坐标值(y_base_value)以N递加至列尾 Next str = "横:" & hen & vbCrLf & "竖:" & shu & vcCrLf px_ord = (Abs(x_ord+y_ord-M)+(x_ord+y_ord-M))\2 '撇行首标准坐标x ((标准x+y) > 18)?(px_ord=(x+y) mod 18):(0) py_ord = x_ord+y_ord-px_ord '撇行首标准坐标y ((标准x+y) > 18)?(x+y-px_ord):(x+y) p_base_value = px_ordN+py_ord '撇行首自定义坐标值标准x_ord总列数+标准y_ord For i = 0 To py_ord-px_ord '撇行长度为 py_ord-px_ord pie=pie & p_base_value+i(N-1) & " " '撇行自增量为 N-1 Next str = str & vbCrLf & "撇:" & pie & vbCrLf nx_ord = (Abs(x_ord-y_ord)+(x_ord-y_ord))\2 '捺行首标准坐标x nx_ord=((x_ord-y_ord) > 0)?(x_ord-y_ord):(0) ny_ord = (x_ord-y_ord)(Sgn(x_ord-y_ord)-1)\2 '捺行首标准坐标y ny_ord=((x_ord-y_ord) < 0)?(x_ord-y_ord):(0) n_base_value = nx_ordN+ny_ord '捺行首自定义坐标值标准x_ord总列数+标准y_ord For i = 0 To 18-nx_ord-ny_ord '捺行长度为 18-(nx_ord+ny_ord) na = na & n_base_value+i(N+1) & " " '捺行自增量为 N+1 Next str = str & "捺:" & na xypn=str End Function Function p(str) If msg Then WScript.Echo str Else InputBox "","",str End Function Function gcon() gcon=WScript.StdIn.ReadLine End Function

第27楼　netbenton	发表于 2009-05-11 12:17
银牌会员　发帖 752　积分 1,916　来自广西
不管是用二维坐标法，还是一维跨标法，最后还是要进行组串，然后才与规则串匹配因为在进行规则串匹配时，是按串进行的。其实应该把：显示缓存、横、坚、撇、捺分别定义为数组串较好一点，不必要去进行多次组串操作。电脑方是根据匹配到的最优规则串进行下子的，根据匹配到的是在哪个数组（横/坚/撇/捺）第几串的第几个字符，即可转换为实际坐标因为定义了五个数组，所以只要下一个子，就要分别对这五个数组的相应位置进行替换，每个数组仅替换一行的一个字符即可以行为单元显示肯定要比以字符为单元显示要快好多，因为用了显存串方式，所以可以直接以行为单元显示。

第28楼　HAT	发表于 2009-05-11 12:42
版主　发帖 5,017　积分 9,023
Re 26楼我的思路是电脑不去对比整个棋盘，而是紧跟对手的落子判断落子四行是否有五子的风险这样的话电脑的棋力是否太弱了？通常的五子棋算法都是对下一步双方可能出现的情况（四三、双三等等）进行优先级排序，然后选择优先级最高的落点吧。

第29楼　rubble	发表于 2009-05-12 08:09
初级用户　发帖 15　积分 23
算法还没弄懂太牛了，批处理也有这么强的功能！

第30楼　SNSB	发表于 2009-05-12 08:33
初级用户　发帖 16　积分 31
Originally posted by rubble at 2009-5-12 08:09: 太牛了，批处理也有这么强的功能！真想不到能搞出这一个东西出来，不过代码我就很难懂了。