Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - ASP и VBScript

Страница: 1 |

 

  Вопрос: Помогите закончить скрипт Добавлено: 19.12.07 00:26  

Автор вопроса:  kirill
Значит суть просьбы такая.
У меня есть один незаконченный скриптик для бота( незакончен он на 5% =) ).
Терминалогия там немного отличается от стандартного вбс, но все остальное такое же и написано он разумеется на вбс.
Вот собственно сам скрипт:

'dotaclan
'1.0

Private Const db_cTypeBoolean = 11
Private Const db_cTypeCurrency = 6
Private Const db_cTypeDate = 7
Private Const db_cTypeDouble = 5
Private Const db_cTypeInteger = 3
Private Const db_cTypeText = 202
Private Const db_cModeReadOnly = 1
Private Const db_cModeForUpdate = 2
Public pGameStatus
Public pChallenger
Public pChallenged
Public pTeams
Public pMode
Public runme
const forReading = 1
const forWriting = 2
const forAppending = 8
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
dim db
Set db = New db_clsDatabase
dim db_path
db_path = BotPath() & "plugins\dotaclan.mdb"

Sub dotaclan_event_load()
  TimerInterval "dotaclan", "enoughppl", 5
  TimerEnabled "dotaclan", "enoughppl", False
  Dim t, rs, l
  pGameStatus = 0
  If Not db.Exists(db_path) Then
    If Not db.Create(db_path) Then
      AddChat vbRed, "Could not create database!"
      Exit Sub
    End If
  Else
    If Not db.Open(db_path) Then
      AddChat vbRed, "Could not open database!"
      Exit Sub
    End If
  End If
  If db.IsOpen() Then
    AddChat vbGreen, "Database opened."
  Else
    Exit Sub
  End If

  If Not db.TableExists("Players") Then
    If db.CreateTable("Players") Then
      AddChat vbGreen, "Created Table Players"
    Else
      AddChat vbRed, "Could not create Table Players"
      Exit Sub
    End If
  End If

  If Not db.TableExists("Captains") Then
    If db.CreateTable("Captains") Then
      AddChat vbGreen, "Created Table Captains"
    Else
      AddChat vbRed, "Could not create Table Captains"
      Exit Sub
    End If
  End If

  If Not db.TableExists("Records") Then
    If db.CreateTable("Records") Then
      AddChat vbGreen, "Created Table Records"
    Else
      AddChat vbRed, "Could not create Table Records"
      Exit Sub
    End If
  End If

  Set t = db.Table("Players")
  If Not db.ColumnExists(t.Name, "Name") Then
    t.Columns.Append "Name", db_cTypeText, 40
    AddChat vbGreen, "Created Column Name in Table Players"
  End If
  If Not db.ColumnExists(t.Name, "Captain") Then
    t.Columns.Append "Captain", db_cTypeText, 40
    AddChat vbGreen, "Created Column Captain in Table Players"
  End If

  Set t = db.Table("Captains")
  If Not db.ColumnExists(t.Name, "Name") Then
    t.Columns.Append "Name", db_cTypeText, 40
    AddChat vbGreen, "Created Column Name in Table Captains"
  End If

  Set t = db.Table("Records")
  If Not db.ColumnExists(t.Name, "Name") Then
    t.Columns.Append "Name", db_cTypeText, 40
    AddChat vbGreen, "Created Column Name in Table Records"
  End If
  If Not db.ColumnExists(t.Name, "Experience") Then
    t.Columns.Append "Experience", db_cTypeText, 40
    AddChat vbGreen, "Created Column Experience in Table Records"
  End If
  If Not db.ColumnExists(t.Name, "Wins") Then
    t.Columns.Append "Wins", db_cTypeText, 40
    AddChat vbGreen, "Created Column Wins in Table Records"
  End If
  If Not db.ColumnExists(t.Name, "Losses") Then
    t.Columns.Append "Losses", db_cTypeText, 40
    AddChat vbGreen, "Created Column Losses in Table Records"
  End If

  AddChat vbWhite, "Deleting all records from Captains ..."
  l = db.ExecuteQuery("DELETE FROM Captains")
  AddChat vbWhite, "Deleted " & l & " records."
  AddChat vbWhite, "Deleting all records from Players ..."
  l = db.ExecuteQuery("DELETE FROM Players")
  AddChat vbWhite, "Deleted " & l & " records."


  set File = fso.OpenTextFile("users.txt", ForReading, 1)
  x = 0
  Do Until File.AtEndOfStream
    Data = File.ReadLine
    Data = Split(Data, " ", 2)

    If lcase(Data(1)) = "q" Then
      AddChat vbWhite, "Inserting Captain " & Data(0) & " ..."
      l = db.ExecuteQuery("INSERT INTO Captains (Name) VALUES ('" & Data(0) & "')")
      x = x + 1
    End If
    If InStr(Data(1), " ") > 0 Then
      Datb = Split(Data(1), " ", 2)
      AddChat vbWhite, "Inserting Captain " & Data(0) & " ..."
      l = db.ExecuteQuery("INSERT INTO Captains (Name) VALUES ('" & Data(0) & "')")
      x = x + 1
    End If
  Loop
  File.Close
  AddChat vbRed, "I have added " & x & " Captain(s) to my list."
End Sub

Sub dotaclan_Event_WhisperFromUser(Username, Flags, Message)
  dotaclan_Command Username, Message, 3
End Sub
Sub dotaclan_Event_usertalk(Username, Flags, Message, Ping)
  dotaclan_Command Username, Message, 1
End Sub

Sub dotaclan_Command(Username, Message, From)
  if left(message, 1) = BotVars.Trigger Then
    getdbentry Username, myAccess, myFlags
    if IsCaptain(Username) = 1 Then
      if lcase(left(message, 11)) = BotVars.Trigger & "challenge " Then
        dotaclan_challenge Username, Message
      elseif lcase(left(message, 8)) = BotVars.Trigger & "result " Then
        dotaclan_result Username, Message
      elseif lcase(left(message, 7)) = BotVars.Trigger & "accept" Then
        dotaclan_accept Username
      elseif lcase(left(message, 5)) = BotVars.Trigger & "deny" Then
        dotaclan_deny Username
      elseif lcase(left(message, 6)) = BotVars.Trigger & "teams" Then
        dotaclan_teams From, Username
      elseif lcase(left(message, 8)) = BotVars.Trigger & "players" Then
        dotaclan_players Username
      elseif lcase(left(message, 8)) = BotVars.Trigger & "leaver " Then
        dotaclan_leaver Message
      elseif lcase(left(message, 5)) = BotVars.Trigger & "pool" Then
        dotaclan_pool
      elseif lcase(left(message, 6)) = BotVars.Trigger & "pick " Then
        dotaclan_pick Username, Message
      elseif lcase(left(message, 7)) = BotVars.Trigger & "cancel" Then
        dotaclan_cancel Username
      end if
    End If
    If myAccess > 9 Then
      if lcase(left(message, 5)) = BotVars.Trigger & "host" Then
        dotaclan_host Username
      elseif lcase(left(message, 6)) = BotVars.Trigger & "top10" Then
        dotaclan_top10
      elseif lcase(left(message, 6)) = BotVars.Trigger & "rank " Then
        dotaclan_rankother Message
      end if
    End If
    If lcase(left(message, 7)) = BotVars.Trigger & "signin" Then
      dotaclan_signin Username
    Elseif lcase(left(message, 8)) = BotVars.Trigger & "signout" Then
      dotaclan_signout Username
    Elseif lcase(message) = BotVars.Trigger & "rank" Then
      dotaclan_rank Username
    End If
  Else
    Exit Sub
  End If
End Sub

Sub dotaclan_challenge(Challenger, Message)
  Data = Split(Message, " ")
  Challenged = Data(1)
  Teams = Data(2)
  Mode = Data(3)
  AddChat vbWhite, "Challenged = " & Challenged
  AddChat vbWhite, "Challenger = " & Challenger
  If GameStatus = 1 Then
    AddQ "Sorry, but I am already in charge of a game.  Please wait for it to finish."
  End If
  If lcase(Challenged) = lcase(Challenger) Then
    AddQ "Can't challenge yourself!!"
    Exit Sub
  Else
    Addchat vbwhite, "Not Challenging self, continue."
  End If
  If IsCaptain(Challenged) = 1 Then
    AddChat vbWhite, Challenged & " is a captain, and is challengable."
    If lcase(Teams) <> "4v4" Then
      If lcase(Teams) <> "5v5" Then
        If lcase(Teams) <> "8" Then
          If lcase(Teams) <> "10" Then
            AddQ "Only 5v5 or 4v4 teams are allowed!"
            Exit Sub
          End If
        End If
      End If
    End If
    If lcase(Mode) <> "ap" Then
      If lcase(Mode) <> "ar" Then
        If lcase(Mode) <> "mr" Then
          If lcase(Mode) <> "tr" Then
            If lcase(Mode) <> "lm" Then
              If lcase(Mode) <> "rd" Then
                AddQ "Only the following modes are allowed...ap, ar, mr, tr, lm, rd"
                Exit Sub
              End if
            End If
          End If
        End If
      End If
    End If
    If InChannel(Challenged) = 1 Then
      AddChat vbwhite, "In Channel"
    Else
      AddQ "Challenged captain must be in the channel!"
      Exit Sub
    End If
    pGameStatus = 1
    pChallenger = Challenger
    pChallenged = Challenged
    pTeams = Teams
    pMode = Mode
    AddQ "/me " & pChallenger & " has challenged " & pChallenged & " for a Gather game " & pTeams & " Mode -" & pMode
    AddQ "/w " & pChallenged & " " & pChallenger & " has challenge YOU for a Gather Game " & pTeams & " Mode -" & pMode & ", Type " & BotVars.Trigger & "accept to accept the challenge or " & BotVars.Trigger & "deny to cancel the challenge."
  Else
    AddChat vbRed, "Not a captain, canceling request."
    AddQ Challenged & " is not a captain, and may not be challenged."
    Exit Sub
  End If
End Sub

Sub dotaclan_result(Username, Message)
  If pGameStatus = 0 Then
    AddQ "There is no game to report on!"
    Exit Sub
  End If
End Sub

Sub dotaclan_accept(Username)
  If pGameStatus = 0 Then
    AddQ "You have not been challenged!"
    Exit Sub
  End If
  If lcase(Username) = lcase(pChallenged) Then
    AddChat vbWhite, "Inserting 2 captains via recordset ..."
    Set rs = db.OpenRecordSet("Players", db_cModeForUpdate)
    rs.AddNew
    rs("Name") = pChallenger
    rs("Captain") = "Self"
    rs.Update
    rs.AddNew
    rs("Name") = pChallenged
    rs("Captain") = "Self"
    rs.Update
    rs.Close()
    AddChat vbWhite, "2 Captains inserted, Done!"
    TimerEnabled "dotaclan", "enoughppl", True
    AddQ "/me " & pchallenged & " has accepted " & pchallenger & "'s challenge for a Gather Game " & pTeams & " Mode -" & pMode & ", Type " & BotVars.Trigger & "signin to sign in the Gather Game or " & BotVars.Trigger & "signout to sign out of the Gather Game."
  End If
End Sub

Sub dotaclan_deny(Username)
  If pGameStatus = 0 Then
    AddQ "You have not been challenged!"
    Exit Sub
  End If
  If lcase(Username) = lcase(pChallenged) Then
    AddQ "/me " & pchallenged & " has declined " & pchallenger &"'s challenge for a Gather Game."
    pGameStatus = 0
    pChallenger = 0
    pChallenged = 0
    pTeams = 0
    pMode = 0
    TimerEnabled "dotaclan", "enoughppl", False
  End If
End Sub

Sub dotaclan_teams(Whispered, Username)
  If pGameStatus = 0 Then
    AddQ "There are no teams to report!"
    Exit Sub
  End If
  x = "Players on " & pChallenger & "'s team: "
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Captain", db_cModeReadOnly)
  Do While Not rs.EOF
    If rs("Captain") = pChallenger Then
      x = x & rs("Name") & ", "
    End If
    rs.MoveNext
  Loop
  DSP Whispered, x, Username, vbWhite
  x = "Players on " & pChallenged & "'s team: "
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Captain", db_cModeReadOnly)
  Do While Not rs.EOF
    If rs("Captain") = pChallenged Then
      x = x & rs("Name") & ", "
    End If
    rs.MoveNext
  Loop
  DSP Whispered, x, Username, vbWhite
  x = "Players on no team: "
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Captain", db_cModeReadOnly)
  Do While Not rs.EOF
    If rs("Captain") = "None" Then
      x = x & rs("Name") & ", "
    End If
    rs.MoveNext
  Loop
  DSP Whispered, x, Username, vbWhite
End Sub

Sub dotaclan_players(Username)
  If pGameStatus = 0 Then
    AddQ "There are no players to report!"
    Exit Sub
  End If
  x = "Players on your team: "
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Captain", db_cModeReadOnly)
  Do While Not rs.EOF
    If rs("Captain") = Username Then
      x = x & rs("Name") & ", "
    End If
    rs.MoveNext
  Loop
  DSP 1, x, Username, vbWhite
End Sub

Sub dotaclan_leaver(Message)
  If pGameStatus = 0 Then
    AddQ "There are no leavers to report!"
    Exit Sub
  End If
End Sub

Sub dotaclan_pool()
  If pGameStatus = 0 Then
    AddQ "There are no players to report!"
    Exit Sub
  End If
  x = "Players: "
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Name", db_cModeReadOnly)
  Do While Not rs.EOF
    if rs("Captain") = "None" Then
      x = x & rs("Name") & ", "
    End If
    rs.MoveNext
  Loop
  DSP 1, x, pChallenger, vbWhite
End Sub

Sub dotaclan_pick(Username, Message)
  If pGameStatus = 0 Then
    AddQ "There is no game to pick for!"
    Exit Sub
  End If
'  If runme = 1 Then
'    Exit Sub
'  End If
'  If lcase(Username) <> lcase(pChallenged) Then
'    If lcase(Username) <> lcase(pChallenger) Then
'      Exit Sub
'    End If
'  End If
  Msg = Split(Message, " ")
  If SignedUp(Msg(1)) = 1 Then
    
    db.ExecuteQuery("DELETE FROM Players WHERE Name='" & capUsernames(Msg(1)) & "'")
    Set rs = db.OpenRecordSet("Players", db_cModeForUpdate)
    rs.AddNew
    rs("Name") = capUsernames(Msg(1))
    rs("Captain") = Username
    rs.Update
    rs.Close()
    Exit Sub
    AddQ "/me " & Username & " has picked " & Msg(1)
  End If
End Sub

Sub dotaclan_cancel(Username)
  If pGameStatus = 0 Then
    AddQ "There is nothing to cancel!"
    Exit Sub
  End If
  If lcase(Username) <> lcase(pChallenger) Then
    If lcase(Username) <> lcase(pChallenged) Then
      Exit Sub
    End If
  End If
  AddChat vbWhite, "Deleting all records from Players ..."
  l = db.ExecuteQuery("DELETE FROM Players")
  AddChat vbWhite, "Deleted " & l & " records."
  AddQ "/me " & Username & " has CANCELED the Gather Game."
  pGameStatus = 0
  pChallenger = 0
  pChallenged = 0
  pTeams = 0
  pMode = 0
  TimerEnabled "dotaclan", "enoughppl", False
End Sub

Sub dotaclan_host(Username)
  If pGameStatus = 0 Then
    AddQ "There is nothing to host!"
    Exit Sub
  End If
End Sub

Sub dotaclan_top10()
AddQ "Top 10"
End Sub

Sub dotaclan_rankother(Message)
AddQ "Checking the rank of another user"
End Sub

Sub dotaclan_signin(Username)
  If pGameStatus = 0 Then
    AddQ "There is nothing to signin to!"
    Exit Sub
  End If
  If SignedUp(Username) = 0 Then
    AddQ "/me " & Username & " has signed into the Gather Game."
    Set rs = db.OpenRecordSet("Players", db_cModeForUpdate)
    rs.AddNew
    rs("Name") = Username
    rs("Captain") = "None"
    rs.Update
    rs.Close
  Else
    Exit Sub
  End If
End Sub

Sub dotaclan_signout(Username)
  If pGameStatus = 0 Then
    AddQ "There is nothing to sign out of!"
    Exit Sub
  End If
  If SignedUp(Username) = 1 Then
    AddQ "/me " & Username & " has signed out of the Gather Game."
    db.ExecuteQuery("DELETE FROM Players WHERE Name='" & Username & "'")
  Else
    Exit Sub
  End If
End Sub

Sub dotaclan_rank(Username)
AddQ "Checking the rank of self"
End Sub














Sub dotaclan_enoughppl_Timer()
runme = 0
'  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Name", db_cModeReadOnly)
'  x = 0
'  Do While Not rs.EOF
'    AddChat vbWhite, rs("Name") & " " & rs("Captain")
'    x = x + 1
'    rs.MoveNext
'  Loop
'  If pTeams = "5v5" Then
'    TeamsToCompare = "10"
'  Elseif pTeams = "4v4" Then
'    TeamsToCompare = "8"
'  Else
'    TeamsToCompare = pTeams
'  End If
'  x = x + 1
'  If TeamsToCompare < x Then
'    addchat vbred, "passed teamstocompare < x"
'    If runme = 1 Then
'      AddQ "/me Enough players have signed up, picking teams has been allowed!"
'      runme = 0
'      Addchat vbred, "runme = 0, passed runme = 1"
'    End If
'  ElseIf runme = 0 Then
'    addchat vbred, "passed runme = 0 and teamstocompare > x"
'    AddQ "/me Until " & TeamsToCompare & " people have signed up, picking teams has been disallowed!"
'    runme = 1
'  End If
End Sub

'Sub dotaclan_teamfull_Timer()









Function capUsernames(User) '// make sure capitalizaton of usernames in message matches usernames in channel list

For i = 1 to GetInternalUserCount()
  nameInChan = GetNameByPosition(i)
  If LCase(User) = LCase(nameInChan) Then
    capUsernames = nameInChan
  End If
Next
End Function

Function UserExists(Username)
  Set rs = db.OpenRecordSet("SELECT * FROM Records ORDER BY Name", dbc_ModeReadOnly)
  AddChat vbWhite, "Searching for a player ..."
  rs.MoveFirst
  rs.Find "Name='" & Username & "'"
  If Not rs.EOF Then
    AddChat vbWhite, "Found player!"
    UserExists = 1
  Else
    AddChat vbRed, "Could not find player!"
    UserExists = 0
  End If
End Function


Function SignedUp(Username)
  Set rs = db.OpenRecordSet("SELECT * FROM Players ORDER BY Name", db_cModeReadOnly)
  AddChat vbWhite, "Searching for a player ..."
  rs.MoveFirst
  rs.Find "Name='" & Username & "'"
  If Not rs.EOF Then
    AddChat vbWhite, "Found player!"
    SignedUp = 1
  Else
    AddChat vbRed, "Could not find player!"
    SignedUp = 0
  End If
End Function

Function InChannel(Username)
  Addchat vbwhite, "Searching for a user in the channel ..."
  State = GetInternalDataByUsername(Username, 0)
  If State = -5 Then
    addchat vbwhite, "Could not find user!"
    InChannel = 0
  Else
    addchat vbwhite, "User found!"
    InChannel = 1
  End If
End Function


Function IsCaptain(Username)
  Set rs = db.OpenRecordSet("SELECT * FROM Captains ORDER BY Name", db_cModeReadOnly)
  AddChat vbWhite, "Searching for a captain ..."
  rs.MoveFirst
  rs.Find "Name='" & Username & "'"
  If Not rs.EOF Then
    AddChat vbWhite, "Found captain!"
    IsCaptain = 1
  Else
    AddChat vbRed, "Could not find captain!"
    IsCaptain = 0
  End If
End Function

Class db_clsDatabase

    Private path_, conn_, xconn_
    
    Public Function Exists(path)
Dim fso
Exists = False
Set fso =  CreateObject("Scripting.FileSystemObject")
If fso.FileExists(path) Then
     Exists = True
End If
Set fso = Nothing
    End Function
    
    Public Function Close()
If Not conn_ Is Nothing Then
     If IsOpen() Then
   conn_.Close
     End If
     Set conn_ = Nothing
End If
Close = True
    End Function
    
    Public Function IsOpen()
IsOpen = False
If Not conn_ Is Nothing Then
     If conn_.State = 1 Then
   IsOpen = True
     End If
End If
    End Function
    
    Public Function Open(path)
On Error Resume Next
Close()
Open = False
path_ = path
Set conn_ = CreateObject("ADODB.Connection")
conn_.Provider = "Microsoft.Jet.OLEDB.4.0"
conn_.Open path_
If IsOpen() Then
     Set xconn_ = CreateObject("ADOX.Catalog")
     xconn_.ActiveConnection = conn_
     Open = True
End If
If Err.Number <> 0 Then
     AddChat vbRed, "Error in Open('" & path & "'): " & Err.Description
     Err.Clear
End If
    End Function

    Public Function Create(path)
On Error Resume Next
Dim obj_
Close()
Set obj_ = CreateObject("ADOX.Catalog")
obj_.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Jet OLEDB:Engine Type=5;Data Source=" & path
Set obj_ = Nothing
Create = Open(path)
If Err.Number <> 0 Then
     AddChat vbRed, "Error in Create('" & path & "'): " & Err.Description
     Err.Clear
End If
    End Function

    Public Function TableExists(tabname)
Dim i
TableExists = False
If Not IsOpen() Then Exit Function
If xconn_.Tables.Count = 0 Then Exit Function
For i = 0 To xconn_.Tables.Count - 1
     If UCase(tabname) = UCase(xconn_.Tables(i).Name) Then
   TableExists = True
   Exit Function
     End If
Next
    End Function
    
    Public Function ColumnExists(tabname, colname)
Dim i, t
ColumnExists = False
If Not IsOpen() Then Exit Function
If Not TableExists(tabname) Then Exit Function
Set t = xconn_.Tables(tabname)
If t.Columns.Count = 0 Then Exit Function
For i = 0 To t.Columns.Count - 1
     If UCase(colname) = UCase(t.Columns(i).Name) Then
   ColumnExists = True
   Exit Function
     End If
Next
    End Function
    
    Public Function CreateTable(tabname)
On Error Resume Next
Dim tbl_
If Not IsOpen() Then Exit Function
If TableExists(tabname) Then Exit Function
Set tbl_ = CreateObject("ADOX.Table")
tbl_.Name = tabname
xconn_.Tables.Append tbl_
CreateTable = True
If Err.Number <> 0 Then
     AddChat vbRed, "Error in CreateTable('" & tabname & "'): " & _
   Err.Description
     Err.Clear
End If
    End Function
    
    Public Property Get Table(tabname)
On Error Resume Next
Dim tbl_
Set tbl_ = Nothing
If IsOpen() Then
     Set tbl_ = xconn_.Tables(tabname)
End If
Set Table = tbl_
If Err.Number <> 0 Then
     AddChat vbRed, "Error in Table('" & tabname & "'): " & Err.Description
     Err.Clear
End If
    End Property  
    
    Public Function OpenRecordset(sql, mode)
On Error Resume Next
Dim rs_
Set OpenRecordset = Nothing
If Not IsOpen() Then Exit Function
Set rs_ = CreateObject("ADODB.Recordset")
rs_.ActiveConnection = conn_
Select Case mode
     Case db_cModeReadOnly
   rs_.CursorType = 2 ' adOpenStatic
   rs_.LockType = 1   ' adLockReadOnly
     Case db_cModeForUpdate
   rs_.CursorType = 1 ' adOpenKeyset
   rs_.LockType = 3   ' adLockOptimistic
     Case Else
   rs_.CursorType = 0 ' adOpenForwardOnly
   rs_.LockType = 1   ' adLockReadOnly
End Select
rs_.Source = sql
rs_.Open
If Err.Number <> 0 Then
     AddChat vbRed, "Error in OpenRecordSet('" & sql & "', " & _
   mode & "): " & Err.Description
     Err.Clear
     Exit Function
End If
Set OpenRecordset = rs_
    End Function
    
    Public Function ExecuteQuery(sql)
On Error Resume Next
Dim rs_, rows_affected
ExecuteQuery = 0
If Not IsOpen() Then Exit Function
Set rs_ = conn_.Execute(sql, rows_affected)
ExecuteQuery = rows_affected
If Err.Number <> 0 Then
     AddChat vbRed, "Error in ExecuteQuery('" & sql & "'): " & Err.Description
     Err.Clear
End If
    End Function
    
    Private Sub Class_Initialize()
path_ = BotPath() & "plugins\dotaclan.mdb"
Set conn_ = Nothing
Set xconn_ = Nothing
    End Sub
    Private Sub Class_Terminate()
Close()
Set conn_ = Nothing
Set xconn_ = Nothing
    End Sub
    
End Class


Как видите там есть места помеченные как пояснение - '.
Разумеется убераем - ', получаем код яккобы действующий, но тут есть один незакрытый таймер:
'Sub dotaclan_teamfull_Timer()(данный таймер должен отслеживать когда нужное кол-во игроков напишет .signin и далее разрешал выбирать их капитанам(.pick)(тоесть если 2v2, то ждёт пока как минимум пока двое не напишут .signin)
+ походу какая то загвоздка с публичным - runme с его переменной(0 или 1)
Далее следует вопрос:
Возможно в коде, есть код, к этому таймеру или же он просто отсутствует, у меня просьба к вам помоч мне дописать или найти код к этому таймеру.
Суть скрипта такая:
Скрипт посредствам бота в игре, создаёт соревнование, то есть, есть два капитана(один вызывает другова командой .challenge nick team mode), когда капитаны устроили соревнование и оно началось, другие игроки, которые хотят учавствовать в соревновании, должны написать - .signin. Далее капитаны из списка(.pool) игроков, выбирают(.pick nick) тех которые им нужны, после того как игроки выбраны бот говорит, каманда - scourge те то и тето, команда - sentinel те то и те то.
Но из за незаконченности скрипта, он не видит что игроки уже вступили в нужном кол-ве и не разрешает начинать выбирать их.
То есть если состязания 2 на 2, где два капитана уже есть и им нужно 2 человека сверху, эти двое написали .signin(то есть вступили), после этого бот должен сказать - количество игроков соотвествует размеру состязания(там всё в скрипте это написано на енг) и так же должен сказать что теперь вы можете выбирать игроков из пула. А после выбора их должен выдать команды(team sentinel игроки и team scoruge игроки).
Вот список нестандартных команд и сабов:

'//*****************************************//
'// NOTES ON USEFUL PLUGIN SUBS/FUNCTIONS //
'//*****************************************//

'// [ Settings Subs/Functions ]

'// - SetSetting
'// USAGE: SetSetting "prefix", "SettingName", SettingValue, "Setting description", Overwrite
'// Overwrite is a boolean (True or False).
'// ** NEW: Use "" for the Setting Description parameter and the existing description will be used.

'// - GetSetting
'// USAGE: Setting = GetSetting("prefix", "SettingName")


'// [ Timer Subs/Functions ]

'// - TimerInterval
'// USAGE: TimerInterval "prefix", "timerName", Interval
'// Interval is in seconds (must be an integer).

'// - TimerEnabled
'// USAGE: TimerEnabled "prefix", "timerName", Enabled
'// Enabled is a boolean (True or False).

'// - GetTimerEnabled
'// USAGE: Enabled = GetTimerEnabled("prefix", "timerName")
'// Enabled will hold a boolean (True or False).

'// - GetTimeLeft
'// USAGE: timeLeft = GetTimeLeft("prefix", "timerName")
'// timeLeft will hold the number of seconds left until your timer sub is executed.

'// - GetTimeWaiting
'// USAGE: timeWaiting = GetTimeWaiting("prefix", "timerName")
'// timeWaiting will hold the number seconds since the last time your timer sub was executed.


'// [ Message Display Sub ]

'// - dsp
'// USAGE: dsp DisplayID, Message, Username, Color
'// DisplayID must be one of the following integer values:
'// 1 = AddQ
'// 2 = Emote
'// 3 = Whisper
'// 4 = AddChat
'// Color needs to be a vbColor:
'// vbGreen, vbRed, vbCyan, vbYellow, vbBlue, vbMagenta, vbBlack, vbWhite, vbOrange, vbBrown, vbPink, vbGrey
'// ** NEW: Messages of any length can now be displayed.
Sub Event_FirstRun()
Sub Event_ServerInfo(Message)
Sub Event_ServerError(Message)
Sub Event_UserTalk(Username, Flags, Message, Ping)
Sub Event_UserEmote(Username, Flags, Message)
Sub Event_WhisperFromUser(Username, Flags, Message)
Sub Event_UserJoins(Username, Flags, Message, Ping, Product, Level, OriginalStatstring, Banned)
Sub Event_UserLeaves(Username, Flags)
Sub Event_FlagUpdate(Username, NewFlags, Ping)
Sub Event_LoggedOn(Username, Product)
Sub Event_UserInChannel(Username, Flags, Message, Ping, Product, StatUpdate)
Sub Event_ChannelJoin(ChannelName, Flags)
Sub Event_PressedEnter(Text)
Sub Event_KeyReturn(KeyName, KeyValue)
Sub Event_MessageSent(Message)
Sub Event_ClanInfo(Name, Rank, Online)
Sub Event_ClanMemberList(Username, Rank, Online)
Sub Event_ClanMemberUpdate(Username, Rank, Online)
Sub Event_ClanMOTD(Message)
Sub Event_ClanMemberLeaves(Username)
Sub Event_BotRemovedFromClan()
Sub Event_BotClanRankChanged(NewRank)
Sub Event_BotJoinedClan(ClanTag)
Sub Event_BotClanInfo(ClanTag, Rank)
Sub Event_Close()
Sub Event_Shutdown()

Ответить

  Ответы Всего ответов: 3  

Номер ответа: 1
Автор ответа:
 el-paso



Вопросов: 3
Ответов: 164
 Профиль | | #1 Добавлено: 19.12.07 11:11
Да, обработчики событий обоих таймеров не реализованы.

P.S. Псц... Код - торжество индийских программистов. :))

Ответить

Номер ответа: 2
Автор ответа:
 kirill



Вопросов: 1
Ответов: 1
 Профиль | | #2 Добавлено: 21.12.07 02:26
не сможешь помоч завершить ?

Ответить

Номер ответа: 3
Автор ответа:
 el-paso



Вопросов: 3
Ответов: 164
 Профиль | | #3 Добавлено: 21.12.07 13:09
Ну, постановка задачи до конца не ясна - чтобы закончить, надо уточнить ее.
Если хочешь, напиши мне на мыло (в профиле есть). А дальше разберемся - думаю, помогу.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам