Skip to content
Permalink
Browse files

[Refactor/Scripting Support] Bug fixes to function signatures

- Use specific object return types when known. Scripting has no trouble with this.

  Channel.GetUserEx(Username, [SearchLimit])
  Channel.GetUser(Username, [SearchLimit])
  Channel.Clone()
  ClanMemberObj.Clone()
  Clan.GetMember(Username)
  Clan.GetUser(Username)
  Clan.Clone()
  FriendObj.Clone()
  Queue.Item(Index)
  Queue.ItemByID(Index)
  SSC.GetScriptControl()
  SSC.GetUserStats(Statstring)
  SSC.Logger()
  SSC.Quotes()
  SSC.Config()
  SSC.Channel()
  SSC.Clan()
  SSC.Friends()
  SSC.Queue()
  SSC.OSVersion()
  SSC.GetScriptModule(ScriptName)
  SSC.CreateCommand(Name, ScriptName)
  SSC.OpenCommand(Name, ScriptName)
  SSC.DeleteCommand(Name, ScriptName)
  SSC.Scripts()
  SSC.DataBufferEx()
  UserObj.Clone()
  modScripting.Scripts()

- Use ByVal parameters to avoid "type mismatch" errors in many cases if
  you don't happen to remember to use a particular cast.
  Though in some cases they are not script-facing, this can help avoid
  unexpected obscure issues ("it's better practice to do this").

  Channel.CheckUser(Username, [CurrentUser])
  clsCommandObjStatic.IsValidCommandName(CommandName) <internal>
  DBEntry.CreatedOn [let]
  DBEntry.ModifiedOn [let]
  DBEntry.LastSeen [let]
  DataBuffer.InsertNTString(String, [Encoding])
  Database.AddEntry(DBEntry)
  Database.RemoveEntry(DBEntry)
  Database.ContainsEntry(Name, [Type])
  clsDatabase.GetEntryAccess(DBEntry) <internal>
  Database.CanUserModifyEntry(Name, DBEntry)
  clsDatabase.GetEntryData(DBEntry) <internal>
  clsDatabase.CheckOperation(OpsString) <internal>
  Logger.Datestamp(TimeDate)
  Logger.Timestamp(TimeDate)
  SSC.CRC32(Data)
  SSC.SHA1(Data, [InHex], [Spacer])
  frmScript.ObjCount([ObjType])
  modBNCS.GetCDKeyCount([Product]) <internal>
  modBNCS.GetLogonSystem([Product]) <internal>
  modCommandsOps.GetOpsCount([Ignore]) <internal>
  modOtherCode.StringFormat* <internal>
  modUnsignedConversions.* <internal>

- When ByRef parameters are required, use Variant to avoid "type mismatch"
  errors, and do the casting on VB6's end.

  Database.GetEntry(Name, [ByRef Type])
  SSC.GetDBEntry(Name, [ByRef Rank], [ByRef Flags], [ByRef Type])
        Fixes issue where old scripts were not compatible with recent versions.
  SSC.GetStdDBEntry(Name, [ByRef Rank], [ByRef Flags], [ByRef Type])
  SSC.GetWindowCursorPos(ByRef X, ByRef Y)
  SSC.StringFormat(Format, ParamArray Params())
  SSC.ResolveHostName(HostName, [ByRef ErrCode])

- Convert to/from arrays of Variant.

  Clan.Create(ClanTag, ClanName, Users())
        Converts to String() using standard modScripting function.
  SSC.RequestUserData(Username, Keys())
        Converts to String().
        Fixes issue where there was no way to pass a script-constructed array.
  SSC.GetAllFonts()
        Converts to Variant().
        Fixes issue where you had to iterate over the fonts in order to get the values without error.

- Database.GetEntries(NameList(), [Type])
        Now takes a Variant array instead of a collection.
        This allows scripts to pass in an array of names constructed on the
        scripting side.
- Database.GetEntriesFromCollection(NameCol, [Type])
        Now exists to take a VB6-constructed Collection.
        This can be used, for example, by passing another
        DBEntry's .Groups property.
- Queue.Push() changed to a Sub since no return value was returned.
- SSC.ClearScreen() changed to a Sub since returning vbNullString was silly.
- SSC.StrConvEx() changed to accept Variant input.
- SSC.GetCurrentUsername() and SSC.GetCurrentServerIP() now specify their return types.
- Removed unused SSC.Dispose().
  • Loading branch information...
nmbook committed Dec 10, 2017
1 parent 19e7cb0 commit 9e1c7fa35b3001593331fbb4108e6c318a386429
@@ -248,7 +248,7 @@ Public Property Get Self() As clsUserObj

End Property

Public Function GetUserEx(ByVal AccountName As String, Optional ByVal SearchLimit As Integer = 0) As Object
Public Function GetUserEx(ByVal AccountName As String, Optional ByVal SearchLimit As Integer = 0) As clsUserObj

Dim Index As Integer

@@ -289,7 +289,7 @@ Public Function GetUserIndexEx(ByVal AccountName As String, Optional ByVal Searc

End Function

Public Function GetUser(ByVal Username As String, Optional ByVal SearchLimit As Integer = 0) As Object
Public Function GetUser(ByVal Username As String, Optional ByVal SearchLimit As Integer = 0) As clsUserObj

Dim Index As Integer

@@ -467,7 +467,7 @@ Public Sub RemoveBansFromOperator(ByVal Username As String)

End Sub

Public Function CheckUser(Username As String, Optional ByRef CurrentUser As clsUserObj = Nothing) As Integer
Public Function CheckUser(ByVal Username As String, Optional ByVal CurrentUser As clsUserObj = Nothing) As Integer

Dim doCheck As Boolean

@@ -712,7 +712,7 @@ Public Function CheckQueue(ByVal Username As String) As Boolean

End Function

Public Function Clone() As Object
Public Function Clone() As clsChannelObj

Dim i As Integer

@@ -100,7 +100,7 @@ Public Sub KickOut()
Call frmChat.ClanHandler.RemoveMember(m_Name, IsSelf, reqScriptingCall)
End Sub

Public Function Clone() As Object
Public Function Clone() As clsClanMemberObj
Set Clone = New clsClanMemberObj

Clone.Name = Name
@@ -164,11 +164,11 @@ Public Property Get Peons() As Collection
End Property

' alias for GetUser()
Public Function GetMember(ByVal Username As String) As Object
Public Function GetMember(ByVal Username As String) As clsClanMemberObj
Set GetMember = GetUser(Username)
End Function

Public Function GetUser(ByVal Username As String) As Object
Public Function GetUser(ByVal Username As String) As clsClanMemberObj
Dim Index As Integer

If (StrictIsNumeric(Username)) Then
@@ -204,11 +204,11 @@ Public Function GetUserIndex(ByVal Username As String) As Integer
End Function

' alias for GetUserEx()
Public Function GetMemberEx(ByVal Username As String) As Object
Public Function GetMemberEx(ByVal Username As String) As clsClanMemberObj
Set GetMemberEx = GetUserEx(Username)
End Function

Public Function GetUserEx(ByVal Username As String) As Object
Public Function GetUserEx(ByVal Username As String) As clsClanMemberObj
Dim Index As Integer

If (StrictIsNumeric(Username)) Then
@@ -260,15 +260,12 @@ Public Sub FindCandidates(ByVal ClanTag As String)
End Sub

Public Sub Create(ByVal ClanTag As String, ByVal ClanName As String, ByRef Users() As Variant)
Dim Candidates() As String
Dim sArray() As String
Dim i As Integer

If LBound(Users) < UBound(Users) Then
ReDim Candidates(0 To UBound(Users) - LBound(Users))
For i = LBound(Users) To UBound(Users)
Candidates(i) = CStr(Users(i + LBound(Users)))
Next i
Call frmChat.ClanHandler.CreateInviteMultiple(ClanTag, ClanName, Candidates(), reqScriptingCall)
sArray = modScripting.ConvertToStringArray(Users())
Call frmChat.ClanHandler.CreateInviteMultiple(ClanTag, ClanName, sArray(), reqScriptingCall)
End If
End Sub

@@ -288,7 +285,7 @@ Public Sub SetMOTD(ByVal MOTD As String)
Call frmChat.ClanHandler.SetClanMOTD(MOTD, reqScriptingCall)
End Sub

Public Function Clone() As Object
Public Function Clone() As clsClanObj
Dim i As Integer
Set Clone = New clsClanObj

@@ -551,7 +551,7 @@ Public Function GetCommandXPath(ByVal strCommand As String, Optional ByVal strSc
End Function

'Function to check if command names are valid
Public Function IsValidCommandName(sName As String) As Boolean
Public Function IsValidCommandName(ByVal sName As String) As Boolean
Dim x As Integer
Dim sValid As String

@@ -123,7 +123,7 @@ Public Property Get CreatedOn() As Date
CreatedOn = m_CreatedOn
End Property

Public Property Let CreatedOn(ByRef dCreatedOn As Date)
Public Property Let CreatedOn(ByVal dCreatedOn As Date)
m_CreatedOn = dCreatedOn
End Property

@@ -139,7 +139,7 @@ Public Property Get ModifiedOn() As Date
ModifiedOn = m_ModifiedOn
End Property

Public Property Let ModifiedOn(ByRef dModifiedOn As Date)
Public Property Let ModifiedOn(ByVal dModifiedOn As Date)
m_ModifiedOn = dModifiedOn
End Property

@@ -155,7 +155,7 @@ Public Property Get LastSeen() As Date
LastSeen = m_LastSeen
End Property

Public Property Let LastSeen(ByRef dLastSeen As Date)
Public Property Let LastSeen(ByVal dLastSeen As Date)
m_LastSeen = dLastSeen
End Property

@@ -228,7 +228,7 @@ Public Sub InsertNonNTString(ByVal Data As String)
m_bufsize = (m_bufsize + UBound(arrStr) + 1)
End Sub

Public Sub InsertNTString(ByRef Data As String, _
Public Sub InsertNTString(ByVal Data As String, _
Optional ByVal Encoding As STRINGENCODING = STRINGENCODING.ANSI)

Dim arrStr() As Byte
@@ -139,14 +139,14 @@ Public Sub Save(Optional ByVal sPath As String = vbNullString)
End Sub

' Adds an entry to the database
Public Sub AddEntry(ByRef oEntry As clsDBEntryObj)
Public Sub AddEntry(ByVal oEntry As clsDBEntryObj)
On Error Resume Next
m_Entries.Add oEntry, oEntry.ToString()
On Error GoTo 0
End Sub

' Removes an entry from the database.
Public Sub RemoveEntry(ByRef oEntry As clsDBEntryObj)
Public Sub RemoveEntry(ByVal oEntry As clsDBEntryObj)
Dim i As Integer

If oEntry Is Nothing Then Exit Sub
@@ -416,7 +416,7 @@ End Sub

' Returns the first matching entry for the specified name from the database.
' If a type is supplied then only an entry of the specified type will be returned.
Public Function GetEntry(ByVal sName As String, Optional ByRef sType As String = vbNullString) As clsDBEntryObj
Public Function GetEntry(ByVal sName As String, Optional ByRef sType As Variant = vbNullString) As clsDBEntryObj
Dim i As Integer

Set GetEntry = Nothing ' default value
@@ -429,30 +429,46 @@ Public Function GetEntry(ByVal sName As String, Optional ByRef sType As String =
' Check entry type (if null then any type is accepted)
If ((Len(sType) = 0) Or (StrComp(.EntryType, sType, vbBinaryCompare) = 0)) Then
Set GetEntry = m_Entries.Item(i)
sType = GetEntry.EntryType
sType = CStr(GetEntry.EntryType)
Exit Function
End If
End If
End With
Next i
End Function

' Returns a collection of entries for the specified name collection from the database.
' Returns a collection of entries for the specified array of names from the database.
' If a type is supplied then only entries oif the specified type will be returned.
Public Function GetEntries(ByRef cNameList As Collection, Optional ByVal sType As String = vbNullString) As Collection
Dim i, j As Integer
Public Function GetEntries(ByRef aNameList() As Variant, Optional ByVal sType As String = vbNullString) As Collection
Dim NameCol As Collection
Dim x As Integer

Set NameCol = New Collection

For x = LBound(aNameList) To UBound(aNameList)
On Error Resume Next
NameCol.Add CStr(aNameList(x)), CStr(aNameList(x))
On Error GoTo 0
Next x

Set GetEntries = GetEntriesFromCollection(NameCol, sType)
End Function

' same as the above but from an Entry.Groups collection
Public Function GetEntriesFromCollection(ByVal NameCol As Collection, Optional ByVal sType As String = vbNullString) As Collection
Dim i As Integer
Dim j As Integer

Set GetEntriesFromCollection = New Collection

Set GetEntries = New Collection

For i = 1 To m_Entries.Count
With m_Entries.Item(i)
For j = 1 To cNameList.Count
For j = 1 To NameCol.Count
' Compare names
If StrComp(.Name, cNameList.Item(j), vbTextCompare) = 0 Then

If StrComp(.Name, NameCol.Item(j), vbTextCompare) = 0 Then
' Compare types
If ((Len(sType) = 0) Or (StrComp(.EntryType, sType, vbBinaryCompare) = 0)) Then
GetEntries.Add m_Entries.Item(i), .ToString()
GetEntriesFromCollection.Add m_Entries.Item(i), .ToString()
End If
End If
Next j
@@ -463,7 +479,7 @@ End Function

' Returns TRUE if the database contains an item with the specified name and type.
' If no name is supplied, any entry with the specified name will match.
Public Function ContainsEntry(ByVal sName As String, Optional ByRef sType As String = vbNullString) As Boolean
Public Function ContainsEntry(ByVal sName As String, Optional ByVal sType As String = vbNullString) As Boolean
ContainsEntry = Not CBool(GetEntry(sName, sType) Is Nothing)
End Function

@@ -507,9 +523,9 @@ End Function
' If no type is specified then any entry with a matching name will be returned and the type param will be set.
Friend Function HasAccess(ByVal sName As String, Optional ByRef sType As String = vbNullString) As Boolean
Dim oAccess As udtUserAccess

oAccess = GetAccess(sName, sType)

' Did we find access?
If ((oAccess.Rank > 0) Or (Len(oAccess.Flags) > 0)) Then
HasAccess = True
@@ -518,31 +534,31 @@ End Function

' Returns the level of access available to a given database entry.
' This level considers all of the groups the entry is assigned to, but not context-based access.
Friend Function GetEntryAccess(ByRef oEntry As clsDBEntryObj) As udtUserAccess
Friend Function GetEntryAccess(ByVal oEntry As clsDBEntryObj) As udtUserAccess
Dim i As Integer
Dim cGroups As Collection

' Get default values
GetEntryAccess = GetDefaultAccessResponse()

' Was an entry provided?
If oEntry Is Nothing Then Exit Function

With GetEntryAccess
.Username = oEntry.ToString()

.Rank = oEntry.Rank
.Flags = oEntry.Flags

.BanMessage = oEntry.BanMessage

Set .Groups = New Collection
If oEntry.Groups.Count > 0 Then
Set cGroups = GetEntries(oEntry.Groups, DB_TYPE_GROUP)
Set cGroups = GetEntriesFromCollection(oEntry.Groups, DB_TYPE_GROUP)

' Include access for each group this entry is a member of.
For i = 1 To cGroups.Count
Call MergeAccess(GetEntryAccess, GetEntryAccess(cGroups.Item(i)))
Call MergeAccess(GetEntryAccess, GetEntryAccess(cGroups.Item(i)))
.Groups.Add cGroups.Item(i).ToString()
Next i
End If
@@ -748,7 +764,7 @@ Public Function CreateNewEntry(ByVal sName As String, Optional ByVal sCreator As
End Function

' Returns TRUE if the specified username has sufficient access to modify the given database entry.
Public Function CanUserModifyEntry(ByVal sUsername As String, ByRef oEntry As clsDBEntryObj) As Boolean
Public Function CanUserModifyEntry(ByVal sUsername As String, ByVal oEntry As clsDBEntryObj) As Boolean
Dim oUserAccess As udtUserAccess ' Access available to the user making modifications.
Dim oEntryAccess As udtUserAccess ' Access available to the entry being modified.

@@ -922,7 +938,7 @@ ERROR_HANDLER:
End Function

' Returns a string used to store the specified entry in the database file.
Private Function GetEntryData(ByRef oEntry As clsDBEntryObj) As String
Private Function GetEntryData(ByVal oEntry As clsDBEntryObj) As String
Dim e() As Variant
Dim i As Integer
Dim DDate As Date
@@ -1009,7 +1025,7 @@ End Function
' Determines the operation indicated by the specified string.
' This parses the +/- from flags and group arguments.
' Updates the provided string with the indicator removed.
Private Function CheckOperation(ByRef sOpString As String) As enuDatabaseOperation
Private Function CheckOperation(ByVal sOpString As String) As enuDatabaseOperation
If Len(sOpString) = 0 Then
CheckOperation = dbopNothing
Exit Function
@@ -94,7 +94,7 @@ Public Property Get DisplayName() As String
DisplayName = ConvertUsername(m_Username)
End Property

Public Function Clone() As Object
Public Function Clone() As clsFriendObj
Set Clone = New clsFriendObj

Clone.Name = Name
@@ -281,15 +281,15 @@ Public Sub RemoveLogsCreated()
Next i
End Sub

Private Function Datestamp(Optional TimeDate As Date) As String
Private Function Datestamp(Optional ByVal TimeDate As Date) As String
If (DateDiff("s", TimeDate, "00:00:00 12/30/1899") = 0) Then
TimeDate = Now
End If

Datestamp = Format(TimeDate, "YYYY-MM-DD")
End Function

Private Function Timestamp(Optional TimeDate As Date) As String
Private Function Timestamp(Optional ByVal TimeDate As Date) As String
If (DateDiff("s", TimeDate, "00:00:00 12/30/1899") = 0) Then
TimeDate = Now
End If
@@ -313,7 +313,6 @@ End Sub

' Battle.net packet-level functions (use these to populate a DataBuffer automatically)
' this is more for scripts-- they must pass a clsDataBuffer into the Buffer As Variant arguments
' (defining them As clsDataBuffer resulted in scripting type mismatch errors)

' populates your databuffer for SID_AUTH_ACCOUNTCREATE->S
Public Sub AccountCreate(ByRef Buffer As Variant)

0 comments on commit 9e1c7fa

Please sign in to comment.
You can’t perform that action at this time.