发信人: feiniaoml (少白石㊣圕), 信区: SysServices
标 题: th机器人
发信站: 哈工大紫丁香 (Fri Jun 20 12:43:33 2003)
'**********************************************************************
'竟然变态到写这种程序，想来我的时日已然无多
'主要套路：
'命<50% 吃饭 --> 吃到最大命为止
'脏>50 洗澡 --> 洗到0为止
'病>10 医院 --> 到0为止
'胖了 减肥 --> 到不胖为止
'瘦了 增肥 --> 到不瘦为止
'钱<nMaxMoney 赚钱 否则 修行 --> 到 脏>50 或 命<50%
'*******************************
'赚钱方法 1岁前农场之后伐木
'**********************************
'没食物 买食物
'**********************************
'中间要应付占卜师、长大一岁、别人发message的情况
'**********************************
'采用事件驱动，更稳定
'////////////////////////////////////////////
'主要参数：
'baseinfo.txt 系统基本信息
'practice.txt 该文件中存放要修行的项目
'sysinfo.txt 该文件中存放系统信息的关键字
Option Explicit
Dim cEnter,nRefreshRate,nTime,nTimeOut,nMaxMoney,nMinMoney
Dim nAge,nMoney,nLife,nMaxLife,nDirty,nIll,nFat,nStatus,nLastInfo,nLastSave,nS
aveTime,nMaxAge
Dim bCanInput,bNoFood,bNoLife,bTooDirty,bIll,bNoMoney,bNeedSave,bNeedLoad
Dim cBusyMsg,cPractice(10),cInfo(100),nLine(100),nCode(100),nPrac,mPrac,mInfo
cEnter=Chr(13)
nStatus=0
nLastInfo=-1
bCanInput=True
bNoFood=False
bNoLife=False
bTooDirty=False
bIll=False
bNoMoney=False
bNeedSave=False
bNeedLoad=False
nLastSave=GetTime()
nPrac=0
Main
Sub Method()
If nAge > nMaxAge Then bNeedLoad=True
If nMoney > nMaxMoney Then bNoMoney=False
If nMoney < nMinMoney Then bNoMoney=True
If nIll > 10 Then bIll=True
If nIll < 1 Then bIll=False
If nDirty > 50 Then bTooDirty=True
If nDirty < 1 Then bTooDirty=False
If nLife < nMaxLife/2 Or nLife < 20 Then bNoLife=True
If nLife >= nMaxLife Then bNoLife=False
End Sub
Sub Main()
Dim n,fs,file,buf
Set fs = CreateObject("Scripting.FileSystemObject")
'读入基本信息
Set file = fs.OpenTextFile("baseinfo.txt")
nRefreshRate=CInt(GetStr(file.ReadLine(),"=",""))
nTimeOut=CInt(GetStr(file.ReadLine(),"=",""))
cBusyMsg=GetStr(file.ReadLine(),"=","")
nSaveTime=CInt(GetStr(file.ReadLine(),"=",""))
nMaxAge=CInt(GetStr(file.ReadLine(),"=",""))
nMaxMoney=CLng(GetStr(file.ReadLine(),"=",""))
nMinMoney=CLng(GetStr(file.ReadLine(),"=",""))
file.Close
'显示基本信息
buf="刷新周期 ="&cstr(nRefreshRate)&"毫秒"&cEnter
buf=buf&"超时 ="&cstr(nTimeOut*nRefreshRate)&"毫秒"&cEnter
buf=buf&"自动回信息="&"“"&cBusyMsg&"”"&cEnter
buf=buf&"存盘间隔 ="&cstr(nSaveTime)&"秒"&cEnter
buf=buf&"最大年龄 ="&cstr(nMaxAge)&cEnter
buf=buf&"最大钱数 ="&cstr(nMaxMoney)&cEnter
buf=buf&"最少钱数 ="&cstr(nMinMoney)&cEnter&cEnter
buf=buf&"以上信息是否正确？"
If MsgBox(buf,vbYesNo)=vbNo Then Exit Sub
'读入修行列表
mPrac=0
Set file = fs.OpenTextFile("practice.txt")
While Not file.AtEndOfStream
cPractice(mPrac)=file.ReadLine()
mPrac=mPrac+1
Wend
file.Close
'读入系统信息列表
mInfo=0
Set file=fs.OpenTextFile("sysinfo.txt")
While Not file.AtEndOfStream
buf=file.ReadLine()
cInfo(mInfo)=GetStr(buf,"","@")
nLine(mInfo)=CInt(GetStr(buf,"@","#"))
nCode(mInfo)=CInt(GetStr(buf,"#",""))
mInfo=mInfo+1
Wend
file.Close
While True
'刷新状态
UpdateStatus
'根据参数判断要做的事
Select Case nStatus
Case -99
Case -100
MySend "a"&cEnter
Case -1
MySend cEnter
Case -2
MySend "y"&cEnter
Case 11
bNoFood=True
MySend cEnter
Case 21
MySend "1"&cEnter
Case 22
n=CLng(GetStr(STermScript.GetBuffer(22),"上限",")"))
If n<500 Then n=n/5*4 Else n=400
MySend CStr(n)&cEnter
bNoFood=False
Case 60
If nFat > 0 Then MySend "3"&cEnter
If nFat < 0 Then MySend "1"&cEnter
Case 70
MySend "1"
bNeedLoad=False
bNeedSave=False
nLastSave=GetTime()
Case 1001
MySend "n"&cEnter
Case 1002
MySend "q"
Case 1003
MySend "r"&cBusyMsg&cEnter
Case Else
If bNeedLoad Then
GoLoad
ElseIf bNoFood Then
BuyFood
ElseIf bNoLife Then
GoEat
ElseIf bTooDirty Then
GoWash
ElseIf bIll Then
GoCure
ElseIf nFat<>0 Then
GoShape
ElseIf bNeedSave Then
GoSave
ElseIf bNoMoney Then
GoWork
Else
GoPractice
End If
End Select
STermScript.Delay nRefreshRate
Wend
End Sub
Sub MySend(cSend)
If bCanInput Then
STermScript.SendData(cSend)
bCanInput=False
nTime=0
Else
nTime=nTime+1
If nTime >= nTimeOut Then bCanInput=True
End If
End Sub
Function GetTime()
Dim buf
buf=CStr(Time())
GetTime=CLng(Mid(buf,1,2))*3600+CLng(Mid(buf,4,2))*60+CLng(Mid(buf,7,2))
End Function
Function GetStr(buf,buf1,buf2)
If buf1<>"" Then
GetStr=Right(buf,Len(buf)-InStr(buf,buf1)-Len(buf1)+1)
Else
GetStr=buf
End If
If buf2<>"" Then GetStr=Left(GetStr,InStr(GetStr,buf2)-1)
End Function
Sub GoEat
Select Case nStatus
Case 0,1
MySend "1"
Case 10
MySend "3"
Case 2,3,4,5,6,7,20
MySend "q"
End Select
End Sub
Sub BuyFood
Select Case nStatus
Case 0
MySend "2"
Case 1,3,4,5,6,7,10
MySend "q"
Case 2
MySend "2"
Case 20
MySend "b"
End Select
End Sub
Sub GoWash
Select Case nStatus
Case 0
MySend "1"
Case 1
MySend "2"
Case 2,3,4,5,6,7,10,20
MySend "q"
End Select
End Sub
Sub GoCure
Select Case nStatus
Case 0
MySend "6"
Case 1,2,3,4,5,7,10,20
MySend "q"
Case 6
MySend "1"
End Select
End Sub
Sub GoShape
Select Case nStatus
Case 0
MySend "6"
Case 1,2,3,4,5,7,10,20
MySend "q"
Case 6
MySend "2"
End Select
End Sub
Sub GoWork
Select Case nStatus
Case 0
MySend "5"
Case 1,2,3,4,6,7,10,20
MySend "q"
Case 5
If nAge > 0 Then MySend "h" Else MySend "d"
End Select
End Sub
Sub GoPractice
Select Case nStatus
Case 0
MySend "3"
Case 1,2,4,5,6,7,10,20
MySend "q"
Case 3
If bCanInput Then nPrac=(nPrac+1) Mod mPrac
MySend cPractice(nPrac)
End Select
End Sub
Sub GoLoad
Select Case nStatus
Case 0
MySend "7"
Case 1,2,3,4,5,6,10,20
MySend "q"
Case 7
MySend "5"
End Select
End Sub
Sub GoSave
Select Case nStatus
Case 0
MySend "7"
Case 1,2,3,4,5,6,10,20
MySend "q"
Case 7
MySend "4"
End Select
End Sub
Sub UpdateStatus()
Dim buf,i
While LTrim(STermScript.GetBuffer(23))="" And Left(STermScript.GetBuffer(1
),7)<>" ┌─ 星"
STermScript.Delay nRefreshRate
Wend
If Left(STermScript.GetBuffer(1),7)=" [状 态]" Then
buf=STermScript.GetBuffer(1)
nAge=CInt(GetStr(buf,"龄]","[金"))
nMoney=CLng(GetStr(buf,"钱]",""))
buf=STermScript.GetBuffer(2)
nLife=CLng(GetStr(buf,"命]","/"))
nMaxLife=CLng(GetStr(buf,"/","[法"))
buf=STermScript.GetBuffer(3)
nDirty=CInt(GetStr(buf,"脏]","[病"))
nIll=CInt(GetStr(buf,"气]","[快"))
buf=STermScript.GetBuffer(20)
If InStr(buf,"胖") > 0 Then
nFat=1
ElseIf InStr(buf,"瘦") > 0 Then
nFat=-1
Else
nFat=0
End If
Method()
End If
If (GetTime()+86400-nLastSave) Mod 86400 > nSaveTime Then bNeedSave=True
If InStr(STermScript.GetBuffer(0),":") > 0 Then
If nStatus<>1003 Then
nStatus=1003
bCanInput=True
End If
nLastInfo=-1
ElseIf InStr(STermScript.GetBuffer(21),"确定要吗") > 0 And Left(STermScrip
t.GetBuffer(23),2)=" 选" Then
If nStatus<>-2 Then
nStatus=-2
bCanInput=True
End If
nLastInfo=-1
Else
For i=0 To mInfo-1
If Left(LTrim(STermScript.GetBuffer(nLine(i))),Len(cInfo(i)))=cInf
o(i) Then Exit For
Next
If i<mInfo Then
nStatus=nCode(i)
If nLastInfo<>i Then
nLastInfo=i
bCanInput=True
End If
Else
nStatus=-99
End If
End If
End Sub
可能根据换行有所错误 文件放到252上了~~
--
╭═══╮╭═══╮╭═══╮╭═══╮╭═══╮ ╭══╮ ╭═══╮
║╔ ╭╯║╔ ╭╯║╔ ║║╔ ║║╔ ║╭╯ ╰╮║╔ ║
║║ ╰╮║║ ╰╮╰╮ ╭╯║║╭╮║╰╮ ╭╯║║╭╮ ║║║╭╮║
║ ║║ ╭╯╭╯ ╰╮║ ║║║╭╯ ╰╮║ ╰╯ ║║ ╰╯║
║ ╭╯║ ╰╮║ ║║ ║║║║ ║║ ╭╮ ║║ ║
╰══╯ ╰═══╯╰═══╯╰═╯╰╯╰═══╯╰═╯╰═╯╰═══╯
※ 来源:．哈工大紫丁香 bbs.hit.edu.cn [FROM: 210.46.78.55]
Powered by KBS BBS 2.0 (http://dev.kcn.cn)
页面执行时间：223.743毫秒