Skip to content

Commit

Permalink
[DB Manager] UI bugs; [refactor] use Insertion Sort for command names…
Browse files Browse the repository at this point in the history 
… and misc changes

* Move a bunch of functions from modOtherCode to modAPI, specifically dealing with Windows API calls
* DB Manager:
  - do not allow users to type more than one of the same flag in the Flags field
  - disable all labels when locking the UI, to better show it's locked
  - do not change the caption every step of locking/unlocking the UI
  - window caption is now "User Database Manager - USER"
  - fix the group list being empty instead of showing the gray "[none]" if there are zero DB entries
* Command Manager:
  - use InsertionSort for the command name list instead of BubbleSort...
  • Loading branch information
@nmbook
nmbook committed Mar 19, 2017
1 parent 111c705 commit 955f100
Show file tree
Hide file tree
Showing 4 changed files with 202 additions and 242 deletions.
2 changes: 1 addition & 1 deletion trunk/frmCommandManager.frm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -571,7 +571,7 @@ Private Sub PopulateTreeView(Optional strScriptOwner As String = vbNullString, O
Next xmlCommand

'// sort the command names
Call BubbleSort1(commandNameArray)
Call InsertionSort(CommandNameArray)

'// loop through the sorted array and select the commands
For x = LBound(commandNameArray) To UBound(commandNameArray)
Expand Down
123 changes: 79 additions & 44 deletions trunk/frmDBManager.frm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -250,7 +250,7 @@ Begin VB.Form frmDBManager
ForeColor = &H00FFFFFF&
Height = 285
Left = 1680
MaxLength = 25
MaxLength = 50
TabIndex = 10
Top = 480
Width = 1335
Expand All @@ -261,7 +261,7 @@ Begin VB.Form frmDBManager
ForeColor = &H00FFFFFF&
Height = 285
Left = 240
MaxLength = 25
MaxLength = 4
TabIndex = 8
Top = 480
Width = 1335
Expand Down Expand Up @@ -411,7 +411,7 @@ Begin VB.Form frmDBManager
Top = 900
Width = 2775
End
Begin VB.Label lblLastMod
Begin VB.Label lblModified
BackColor = &H00000000&
Caption = "Last modified on:"
BeginProperty Font
Expand Down Expand Up @@ -516,6 +516,8 @@ Private m_GListCount As Integer
Private m_GListSel As ListItem
' target for group list right-click menu
Private m_GMenuTarget As ListItem
' GUI is clearing and form items shouldn't change the header
Private m_ClearingUI As Boolean

Private Sub Form_Load()

Expand Down Expand Up @@ -986,29 +988,33 @@ Private Sub cmdSaveUser_Click()
End Sub

Private Sub HandleSaved()
m_Modified = False
cmdSaveUser.Enabled = False
cmdDiscardUser.Enabled = False
If m_CurrentEntry Is Nothing Then
fraEntry.Caption = "Database"
Me.Caption = "Database"
Else
fraEntry.Caption = m_CurrentEntry.ToString()
Me.Caption = "Database - " & m_CurrentEntry.ToString()
If Not m_ClearingUI Then
m_Modified = False
cmdSaveUser.Enabled = False
cmdDiscardUser.Enabled = False
If m_CurrentEntry Is Nothing Then
fraEntry.Caption = vbNullString
Me.Caption = "User Database Manager"
Else
fraEntry.Caption = m_CurrentEntry.ToString()
Me.Caption = "User Database Manager - " & m_CurrentEntry.ToString()
End If
End If
End Sub

Private Sub HandleUnsaved()
If m_CurrentEntry Is Nothing Then
m_Modified = False
fraEntry.Caption = "Database"
Me.Caption = "Database"
Else
m_Modified = True
cmdSaveUser.Enabled = True
cmdDiscardUser.Enabled = True
fraEntry.Caption = m_CurrentEntry.ToString() & "*"
Me.Caption = "Database - " & m_CurrentEntry.ToString() & "*"
If Not m_ClearingUI Then
If m_CurrentEntry Is Nothing Then
m_Modified = False
fraEntry.Caption = vbNullString
Me.Caption = "User Database Manager *"
Else
m_Modified = True
cmdSaveUser.Enabled = True
cmdDiscardUser.Enabled = True
fraEntry.Caption = m_CurrentEntry.ToString() & " *"
Me.Caption = "User Database Manager - " & m_CurrentEntry.ToString() & " *"
End If
End If
End Sub

Expand Down Expand Up @@ -1348,7 +1354,10 @@ Private Sub LoadView()
m_Root.Tag = "DATABASE"

' If the database is empty, exit early
If m_DB.Entries.Count = 0 Then Exit Sub
If m_DB.Entries.Count = 0 Then
Call UpdateGroupList
Exit Sub
End If

' Get all groups from the database
For i = 1 To m_DB.Entries.Count
Expand Down Expand Up @@ -1438,71 +1447,97 @@ Private Sub LoadView()
Next i

Call UpdateGroupList

If trvUsers.NodeCount = 0 Then
Call LockGUI
End If
End Sub

Private Sub LockGUI()
Dim i As Integer


m_ClearingUI = True

' set our default frame caption
Set m_CurrentEntry = Nothing
Call HandleSaved

' disable & clear rank
lblRank.Enabled = False
txtRank.Enabled = False
txtRank.Text = vbNullString

' disable & clear flags
lblFlags.Enabled = False
txtFlags.Enabled = False
txtFlags.Text = vbNullString

' loop through listbox and clear selected items
Call ClearGroupListChecks

' disable group lists
lblGroups.Enabled = False
'lvGroups.Enabled = False

' disable & clear ban message
lblBanMessage.Enabled = False
txtBanMessage.Enabled = False
txtBanMessage.Text = vbNullString

' reset created on & modified on labels

' reset created & modified labels
lblCreated.Enabled = False
lblCreatedOn.Enabled = False
lblCreatedOn.Caption = "(not applicable)"
lblModifiedOn.Caption = "(not applicable)"

' reset created by & modified by labels
lblCreatedBy.Enabled = False
lblCreatedBy.Caption = vbNullString
lblModified.Enabled = False
lblModifiedOn.Enabled = False
lblModifiedOn.Caption = "(not applicable)"
lblModifiedBy.Enabled = False
lblModifiedBy.Caption = vbNullString

' reset inherits caption
lblInherit.Caption = vbNullString

' disable entry buttons
cmdRenameUser.Enabled = False
cmdDeleteUser.Enabled = False

m_ClearingUI = False

HandleSaved
End Sub

Private Sub UnlockGUI()
Dim i As Integer

m_ClearingUI = True

' enable rank field
lblRank.Enabled = True
txtRank.Enabled = True

' enable flags field
lblFlags.Enabled = True
txtFlags.Enabled = True

' enable ban message field
lblBanMessage.Enabled = True
txtBanMessage.Enabled = True

' enable labels
lblCreated.Enabled = True
lblCreatedOn.Enabled = True
lblCreatedBy.Enabled = True
lblModified.Enabled = True
lblModifiedOn.Enabled = True
lblModifiedBy.Enabled = True

' enable entry rename/delete buttons
cmdRenameUser.Enabled = (StrComp(trvUsers.SelectedItem.Tag, DB_TYPE_GROUP, vbTextCompare) = 0)
cmdDeleteUser.Enabled = True

' enable group lists
lblGroups.Enabled = True
'lvGroups.Enabled = True

m_ClearingUI = False

' make sure save button and caption is up to date
HandleSaved
Expand Down Expand Up @@ -2053,8 +2088,6 @@ Private Sub txtBanMessage_Change()
End Sub

Private Sub txtFlags_KeyPress(KeyAscii As Integer)
Const AZ As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

' disallow entering space
If (KeyAscii = vbKeySpace) Then KeyAscii = 0

Expand All @@ -2065,6 +2098,10 @@ Private Sub txtFlags_KeyPress(KeyAscii As Integer)
KeyAscii = AscW(UCase$(ChrW$(KeyAscii)))
End If
End If
' disallow repeating a flag already present
If (InStr(1, txtFlags.Text, ChrW$(KeyAscii), vbBinaryCompare) > 0) Then
KeyAscii = 0
End If
' else disallow entering that character (if not a control character)
ElseIf (KeyAscii > vbKeySpace) Then
KeyAscii = 0
Expand All @@ -2077,13 +2114,11 @@ Private Sub txtFlags_Change()
End Sub

Private Sub txtRank_KeyPress(KeyAscii As Integer)
Const n09 As String = "0123456789"

' disallow entering space
If (KeyAscii = vbKeySpace) Then KeyAscii = 0

' if key is not 0-9, disallow entering that character (if not a control character)
If (InStr(1, n09, ChrW$(KeyAscii), vbTextCompare) = 0 And KeyAscii > 32) Then
If (InStr(1, Num09, ChrW$(KeyAscii), vbTextCompare) = 0 And KeyAscii > 32) Then
KeyAscii = 0
End If
End Sub
Expand Down
104 changes: 103 additions & 1 deletion trunk/modAPI.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,27 @@ Option Explicit
'modAPI - project StealthBot
'February 2004 - Stealth [stealth at stealthbot dot net]

Public Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long

Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal szHost As String) As Long
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inaddr As Long) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Integer) As Integer
Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Public Declare Function lstrlen Lib "Kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function SetSockOpt Lib "wsock32.dll" Alias "setsockopt" (ByVal lSocketHandle As Long, ByVal lSocketLevel As Long, ByVal lOptName As Long, vOptVal As Any, ByVal lOptLen As Long) As Long
Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long

Public Type HOSTENT
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type

Public Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)

Expand Down Expand Up @@ -122,8 +143,11 @@ Public Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Lon

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Const MAX_USERNAME_LENGTH As Long = 256

Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetFocus Lib "User" () As Integer

Public Const LOCALE_SABBREVCTRYNAME As Long = &H7
Public Const LOCALE_SENGCOUNTRY As Long = &H1002
Expand All @@ -149,3 +173,81 @@ Public Function malloc(ByVal dwSize As Long) As Long
malloc = GlobalLock(lngHandle) + 4
Call CopyMemory(ByVal malloc - 4, lngHandle, 4)
End Function

Public Function GetComputerLanName() As String
Dim buff As String
Dim Length As Long
buff = String(MAX_COMPUTERNAME_LENGTH + 1, Chr$(0))
Length = Len(buff)
If (GetComputerName(buff, Length)) Then
GetComputerLanName = Left(buff, Length)
Else
GetComputerLanName = vbNullString
End If
End Function

Public Function GetComputerUsername() As String
Dim buff As String
Dim Length As Long
buff = String(MAX_USERNAME_LENGTH + 1, Chr$(0))
Length = Len(buff)
If (GetUserName(buff, Length)) Then
GetComputerUsername = KillNull(buff)
Else
GetComputerUsername = vbNullString
End If
End Function

Public Function GetAddressFromLong(ByVal lServer As Long) As String
Dim ptrIP As Long
Dim Length As Integer
Dim arrStr() As Byte

ptrIP = inet_ntoa(lServer)
Length = lstrlen(ptrIP)

ReDim arrStr(0 To Length) ' include NT
CopyMemory arrStr(0), ByVal ptrIP, Length ' don't copy NT

GetAddressFromLong = NTByteArrToString(arrStr)
End Function

Public Function ResolveHost(ByVal strHostName As String) As String
Dim lServer As Long
Dim HostInfo As HOSTENT
Dim ptrIP As Long
Dim sIP As String

'Do we have an IP address or a hostname?
If Not IsValidIPAddress(strHostName) Then
'Resolve the IP.
lServer = gethostbyname(strHostName)

If lServer = 0 Then
ResolveHost = vbNullString
Exit Function
Else
'Copy data to HOSTENT struct.
CopyMemory HostInfo, ByVal lServer, Len(HostInfo)

If HostInfo.h_addrtype = 2 Then
CopyMemory ptrIP, ByVal HostInfo.h_addr_list, 4
CopyMemory lServer, ByVal ptrIP, 4
sIP = GetAddressFromLong(lServer)
ResolveHost = sIP
Else
ResolveHost = vbNullString
Exit Function
End If
End If
Else
ResolveHost = strHostName
End If
End Function

Public Function IsValidIPAddress(ByVal sIn As String) As Boolean
Dim cp As Long

cp = inet_addr(sIn)
IsValidIPAddress = (cp <> -1)
End Function
Loading

0 comments on commit 955f100

Please sign in to comment.