From f591a7a985d469cf3c0ea85d946ea57518bdac28 Mon Sep 17 00:00:00 2001 From: Nate Book Date: Fri, 24 Feb 2017 21:14:05 -0500 Subject: [PATCH] Account Manager * Support for changing your password and sending the request for email change and password reset during login. * Account Manager form will appear when an account logon or other account entry error occurs, allowing the user to fix the issue or perform another account action, just like a real Battle.net client. The bot no longer disconnects from Battle.net on all account errors, unless told to. - This Account Manager can be accessed from Bot -> Account Manager. - It supports (re)connecting to return to the account entry state in order to fulfill requests. - If the window is closed when in the account entry state, the bot will disconnect. - [CLIENT] ManageOnAccountError=True|False =True [defualt]: is this behavior, and =False: causes the bot to disconnect on account errors, as before. - [CLIENT] AutoAccountAction=True|False =True [default]: The bot will try to log in automatically. This state is set when you save the Settings (implies you want to use the Settings U & P automatically). =False: The bot will bring up the Account Manager when it enters or re-enters account logon state (i.e. on "account exists" error). This state is set when you do an action from the Account Manager. - [CLIENT] AccountMode=Logon|Create|ChangePass|ResetPass|ChangeEmail =Logon [default]: The bot will attempt to log on using Username and Password. On fail, the bot will switch to Create mode (and "do action"). =Create: The bot will attempt to create an account using Username and Password. On success, the bot will switch to Logon mode (and "do action"). =ChangePass: The bot will attempt to change the password of Username from Password to NewPassword. On success, the bot will save Password=NewPassword and clear NewPassword. On success, the bot will switch to Logon mode (and "do action"). =ResetPass: The bot will request a reset password email using Username and RegisterEmailDefault. On successful send, the bot will switch to Logon mode, but will "await action". =ChangeEmail: The bot will request to change the account email using Username and RegisterEmailDefault to RegisterEmailChange. On successful send, the bot will save RegisterEmailDefault=RegisterEmailChange and clear RegisterEmailChange. On successful send, the bot will switch to Logon mode, but will "await action". On all other failures, the bot will "await action" and not change mode. When the bot "awaits action" above, it will either show the Account Manager or disconnect, depending on ManageOnAccountError. When the bot is to "do action" above, it will either do the action if the settings are set, or open the Account Manager to that page, depending on AutoAccountAction. - [CLIENT] NewPassword= RegisterEmailChange= These two settings are used to save the "change to" of the values in the new modes. * Account lock timeouts apply to password change requests and are handled by the Account Manager system. * Account success and error messages are all handled through Event_LogonEvent(). As such, SID_AUTH_* logon responses are all interpreted together. Legacy response codes are re-distributed to the SID_AUTH_* values for that event only. * clsNLS (scripting: CreateNLS(U, P)) has been improved and recieved many fixes so that change requests actually work correctly. Many function and property names have been changed, and calling properties without initializing Username and Password now result in failure/empty values instead of attempting to initialize. --- trunk/Bot.vbp | 3 +- trunk/clsCToolTip.cls | 4 +- trunk/clsConfig.cls | 60 +++ trunk/clsDataStorage.cls | 39 +- trunk/clsNLS.cls | 397 ++++++++++-------- trunk/frmAccountManager.frm | 493 +++++++++++++++++++++++ trunk/frmAccountManager.frx | Bin 0 -> 4 bytes trunk/frmChat.frm | 33 +- trunk/frmEMailReg.frm | 6 +- trunk/frmSettings.frm | 14 +- trunk/frmSettings.frx | Bin 345 -> 349 bytes trunk/modBNCS.bas | 777 +++++++++++++++++++++++++++++------- trunk/modEvents.bas | 129 ++++-- trunk/modOtherCode.bas | 2 +- trunk/modParsing.bas | 2 +- trunk/modScripting.bas | 4 +- 16 files changed, 1581 insertions(+), 382 deletions(-) create mode 100755 trunk/frmAccountManager.frm create mode 100755 trunk/frmAccountManager.frx diff --git a/trunk/Bot.vbp b/trunk/Bot.vbp index 9f70c1a1..faae4d2f 100644 --- a/trunk/Bot.vbp +++ b/trunk/Bot.vbp @@ -115,13 +115,14 @@ Module=modBNLS; modBNLS.bas Class=clsKeyDecoder; clsKeyDecoder.cls Module=modConstants; modConstants.bas Class=clsConfig; clsConfig.cls +Form=frmAccountManager.frm IconForm="frmChat" Startup="frmChat" HelpFile="" Title="StealthBot" ExeName32="StealthBot v2.7.exe" Path32="..\..\Compile" -Command32="" +Command32="-addpath "C:\Program Files (x86)\StealthBot\" -ppath "C:\Users\Nate\AppData\Roaming\StealthBot\RiboseDEV\"" Name="StealthBot" HelpContextID="0" Description="StealthBot" diff --git a/trunk/clsCToolTip.cls b/trunk/clsCToolTip.cls index c6d39fc3..aa624b00 100644 --- a/trunk/clsCToolTip.cls +++ b/trunk/clsCToolTip.cls @@ -19,7 +19,7 @@ Option Explicit Private Declare Sub InitCommonControls Lib "comctl32.dll" () ''Windows API Functions -Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long +Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long @@ -122,7 +122,7 @@ Public Property Get Centered() As Boolean Centered = mvarCentered End Property -Public Function Create(ByVal ParentHwnd As Long, X As Long, Y As Long) As Boolean +Public Function Create(ByVal ParentHwnd As Long, x As Long, y As Long) As Boolean Dim lWinStyle As Long If m_lTTHwnd <> 0 Then diff --git a/trunk/clsConfig.cls b/trunk/clsConfig.cls index 819f4a8e..7ad5a5ff 100644 --- a/trunk/clsConfig.cls +++ b/trunk/clsConfig.cls @@ -72,6 +72,10 @@ Private m_ProxyUsername As String Private m_ProxyPassword As String Private m_ProxyBNLS As Boolean Private m_ProxyMCP As Boolean +Private m_AccountMode As String +Private m_AutoAccountAction As Boolean +Private m_ManageOnAccountError As Boolean +Private m_NewPassword As String '[FEATURES] Private m_UseBackupChannel As Boolean @@ -214,6 +218,7 @@ Private m_MaxMessageLength As Integer Private m_AutoCreateChannels As String Private m_RegisterEmailAction As String Private m_RegisterEmailDefault As String +Private m_RegisterEmailChange As String Private m_RealmServerPassword As String Private m_ProtocolID As Long Private m_PlatformID As String @@ -429,6 +434,38 @@ Public Property Let ProxyMCP(ByVal sValue As Boolean) m_ProxyMCP = sValue End Property +Public Property Get AccountMode() As String + AccountMode = m_AccountMode +End Property + +Public Property Let AccountMode(ByVal sValue As String) + m_AccountMode = sValue +End Property + +Public Property Get AutoAccountAction() As Boolean + AutoAccountAction = m_AutoAccountAction +End Property + +Public Property Let AutoAccountAction(ByVal sValue As Boolean) + m_AutoAccountAction = sValue +End Property + +Public Property Get ManageOnAccountError() As Boolean + ManageOnAccountError = m_ManageOnAccountError +End Property + +Public Property Let ManageOnAccountError(ByVal sValue As Boolean) + m_ManageOnAccountError = sValue +End Property + +Public Property Get NewPassword() As String + NewPassword = m_NewPassword +End Property + +Public Property Let NewPassword(ByVal sValue As String) + m_NewPassword = sValue +End Property + '------------------------- ' SECTION: FEATURES @@ -1476,6 +1513,14 @@ Public Property Let RegisterEmailDefault(ByVal sValue As String) m_RegisterEmailDefault = sValue End Property +Public Property Get RegisterEmailChange() As String + RegisterEmailChange = m_RegisterEmailChange +End Property + +Public Property Let RegisterEmailChange(ByVal sValue As String) + m_RegisterEmailChange = sValue +End Property + Public Property Get RealmServerPassword() As String RealmServerPassword = m_RealmServerPassword End Property @@ -1697,6 +1742,10 @@ Public Sub Save(Optional ByVal sFilePath As String = vbNullString) WriteSetting SECTION_CLIENT, "ProxyPassword", m_ProxyPassword WriteSetting SECTION_CLIENT, "ProxyBNLS", m_ProxyBNLS WriteSetting SECTION_CLIENT, "ProxyMCP", m_ProxyMCP + WriteSetting SECTION_CLIENT, "AccountMode", m_AccountMode + WriteSetting SECTION_CLIENT, "AutoAccountAction", m_AutoAccountAction + WriteSetting SECTION_CLIENT, "ManageOnAccountError", m_ManageOnAccountError + WriteSetting SECTION_CLIENT, "NewPassword", m_NewPassword WriteSetting SECTION_FEATURES, "UseBackupChannel", m_UseBackupChannel WriteSetting SECTION_FEATURES, "BackupChannel", m_BackupChannel @@ -1831,6 +1880,7 @@ Public Sub Save(Optional ByVal sFilePath As String = vbNullString) WriteSetting SECTION_EMULATION, "AutoCreateChannels", m_AutoCreateChannels WriteSetting SECTION_EMULATION, "RegisterEmailAction", m_RegisterEmailAction WriteSetting SECTION_EMULATION, "RegisterEmailDefault", m_RegisterEmailDefault + WriteSetting SECTION_EMULATION, "RegisterEmailChange", m_RegisterEmailChange WriteSetting SECTION_EMULATION, "RealmServerPassword", m_RealmServerPassword WriteSetting SECTION_EMULATION, "ProtocolID", m_ProtocolID WriteSetting SECTION_EMULATION, "PlatformID", m_PlatformID @@ -1887,6 +1937,10 @@ Private Sub LoadDefaults() m_ProxyPassword = vbNullString m_ProxyBNLS = False m_ProxyMCP = True + m_AccountMode = "LOGON" + m_AutoAccountAction = True + m_ManageOnAccountError = True + m_NewPassword = vbNullString '[Features] m_UseBackupChannel = False @@ -2029,6 +2083,7 @@ Private Sub LoadDefaults() m_AutoCreateChannels = "ALWAYS" m_RegisterEmailAction = "PROMPT" m_RegisterEmailDefault = vbNullString + m_RegisterEmailChange = vbNullString m_RealmServerPassword = "password" m_ProtocolID = 0 m_PlatformID = "IX86" @@ -2233,6 +2288,10 @@ Private Sub LoadVersion6Config() m_ProxyPassword = ReadSetting(SECTION_CLIENT, "ProxyPassword", m_ProxyPassword) m_ProxyBNLS = ReadSetting(SECTION_CLIENT, "ProxyBNLS", m_ProxyBNLS) m_ProxyMCP = ReadSetting(SECTION_CLIENT, "ProxyMCP", m_ProxyMCP) + m_AccountMode = ReadSetting(SECTION_CLIENT, "AccountMode", m_AccountMode) + m_AutoAccountAction = ReadSetting(SECTION_CLIENT, "AutoAccountAction", m_AutoAccountAction) + m_ManageOnAccountError = ReadSetting(SECTION_CLIENT, "ManageOnAccountError", m_ManageOnAccountError) + m_NewPassword = ReadSetting(SECTION_CLIENT, "NewPassword", m_NewPassword) m_UseBackupChannel = ReadSettingB(SECTION_FEATURES, "UseBackupChannel", m_UseBackupChannel) m_BackupChannel = ReadSetting(SECTION_FEATURES, "BackupChannel", m_BackupChannel) @@ -2367,6 +2426,7 @@ Private Sub LoadVersion6Config() m_AutoCreateChannels = ReadSetting(SECTION_EMULATION, "AutoCreateChannels", m_AutoCreateChannels) m_RegisterEmailAction = ReadSetting(SECTION_EMULATION, "RegisterEmailAction", m_RegisterEmailAction) m_RegisterEmailDefault = ReadSetting(SECTION_EMULATION, "RegisterEmailDefault", m_RegisterEmailDefault) + m_RegisterEmailChange = ReadSetting(SECTION_EMULATION, "RegisterEmailChange", m_RegisterEmailChange) m_RealmServerPassword = ReadSetting(SECTION_EMULATION, "RealmServerPassword", m_RealmServerPassword) m_ProtocolID = ReadSettingL(SECTION_EMULATION, "ProtocolID", m_ProtocolID) m_PlatformID = ReadSetting(SECTION_EMULATION, "PlatformID", m_PlatformID) diff --git a/trunk/clsDataStorage.cls b/trunk/clsDataStorage.cls index 17e6c7a0..cdb63686 100644 --- a/trunk/clsDataStorage.cls +++ b/trunk/clsDataStorage.cls @@ -14,21 +14,22 @@ Attribute VB_Exposed = False Option Explicit Private m_lNLSHandle As Long -Private m_ServerToken As Long -Private m_ClientToken As Long -Private m_lLogonType As Long -Private m_UDPValue As Long -Private m_CRevFileTime As String -Private m_CRevFileName As String -Private m_CRevSeed As String -Private m_CRevVersion As Long -Private m_CRevChecksum As Long -Private m_CRevResult As String -Private m_ServerSig As String -Private m_EmailRegDelay As Boolean -Private m_NLS As clsNLS -Private m_MCPHandler As clsMCPHandler -Private m_FirstTimeChat As Boolean +Private m_ServerToken As Long +Private m_ClientToken As Long +Private m_lLogonType As Long +Private m_UDPValue As Long +Private m_CRevFileTime As String +Private m_CRevFileName As String +Private m_CRevSeed As String +Private m_CRevVersion As Long +Private m_CRevChecksum As Long +Private m_CRevResult As String +Private m_ServerSig As String +Private m_EmailRegDelay As Boolean +Private m_NLS As clsNLS +Private m_MCPHandler As clsMCPHandler +Private m_FirstTimeChat As Boolean +Private m_AccountEntry As Boolean Public Sub List() With frmChat @@ -63,6 +64,7 @@ Public Sub Reset() Set m_MCPHandler = Nothing Set m_NLS = Nothing m_FirstTimeChat = False + m_AccountEntry = False End Sub Public Property Get LogonType() As Long @@ -184,6 +186,13 @@ Public Property Get EnteredChatFirstTime() As Boolean EnteredChatFirstTime = m_FirstTimeChat End Property +Public Property Let AccountEntry(bData As Boolean) + m_AccountEntry = bData +End Property +Public Property Get AccountEntry() As Boolean + AccountEntry = m_AccountEntry +End Property + Private Sub Class_Terminate() Reset End Sub diff --git a/trunk/clsNLS.cls b/trunk/clsNLS.cls index d46ba270..687e6a77 100644 --- a/trunk/clsNLS.cls +++ b/trunk/clsNLS.cls @@ -22,31 +22,31 @@ Option Explicit ' BNCSutil.dll functions Private Declare Function nls_init Lib "BNCSutil.dll" _ (ByVal Username As Long, ByVal Password As Long) As Long ' returns a pointer - + Private Declare Sub nls_free Lib "BNCSutil.dll" _ (ByVal NLS As Long) - + Private Declare Sub nls_get_A Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Out As Long) - + Private Declare Sub nls_get_M1 Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Out As Long, ByVal B As Long, ByVal Salt As Long) - + Private Declare Sub nls_get_v Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Out As Long, ByVal Salt As Long) - + Private Declare Function nls_check_M2 Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal M2 As Long, ByVal B As Long, ByVal Salt As Long) As Long Private Declare Function nls_check_signature Lib "BNCSutil.dll" _ (ByVal Address As Long, ByVal Signature As Long) As Long - + Private Declare Sub nls_get_S Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Out As Long, ByVal B As Long, ByVal Salt As Long) - + Private Declare Sub nls_get_K Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Out As Long, ByVal s As Long) - + Private Declare Function nls_account_change_proof Lib "BNCSutil.dll" _ (ByVal NLS As Long, ByVal Buffer As Long, ByVal NewPassword As Long, _ ByVal B As Long, ByVal Salt As Long) As Long 'returns a new NLS pointer for the new password @@ -54,16 +54,18 @@ Private Declare Function nls_account_change_proof Lib "BNCSutil.dll" _ Private m_NlsHandle As Long Private m_NewNlsHandle As Long -Private m_OldNlsHandle As Long Private m_Salt As String * 32 -Private m_B As String * 32 Private m_v As String * 32 +Private m_New_Salt As String * 32 +Private m_New_v As String * 32 +Private m_B As String * 32 Private m_Username As String Private m_Password As String Private m_NewPassword As String Private m_Initialized As Boolean +Private m_CreateReady As Boolean ' make sure all possible handles have been freed Private Sub Class_Terminate() @@ -78,12 +80,14 @@ Private Sub Class_Terminate() m_NewNlsHandle = 0 End If - If Not m_OldNlsHandle = 0 Then - nls_free m_OldNlsHandle - m_OldNlsHandle = 0 - End If - m_Initialized = False + m_CreateReady = False + +End Sub + +Public Sub Terminate() + + Call Class_Terminate End Sub @@ -94,51 +98,84 @@ Public Function Initialize(ByVal Username As String, ByVal Password As String) A ' default to return false Initialize = False - + ' dispose of all previous NLS objects Class_Terminate - + ' save username and password m_Username = Username m_Password = Password - + arrU() = StrConv(Username, vbFromUnicode, 1033) arrP() = StrConv(Password, vbFromUnicode, 1033) m_NlsHandle = nls_init(VarPtr(arrU(0)), VarPtr(arrP(0))) - + ' return true if nls_init succeeded - If Not m_NlsHandle = 0 Then + If m_NlsHandle <> 0 Then Initialize = True m_Initialized = True - SrpGetSaltAndVerifier m_Salt, m_v End If End Function +Public Function InitializeChange(ByVal Username As String, ByVal Password As String, ByVal NewPassword As String) As Boolean + + Dim arrU() As Byte + Dim arrP() As Byte + + InitializeChange = Initialize(Username, Password) + + If InitializeChange Then + m_NewPassword = NewPassword + + arrU() = StrConv(Username, vbFromUnicode, 1033) + arrP() = StrConv(NewPassword, vbFromUnicode, 1033) + m_NewNlsHandle = nls_init(VarPtr(arrU(0)), VarPtr(arrP(0))) + + ' return true if nls_init succeeded + If m_NewNlsHandle <> 0 Then + InitializeChange = True + m_Initialized = True + Exit Function + End If + End If + + InitializeChange = False + m_Initialized = False + +End Function + Public Property Get Username() As String + Username = m_Username + End Property +Public Property Get Password() As String -' SRP-level functions (use these if you know what you're doing) + Password = m_Password -' get the A value -' get this value when building SID_AUTH_ACCOUNTLOGON->S -' length will be 32 bytes -Public Property Get SrpA() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - Dim arrA(0 To 31) As Byte +End Property - nls_get_A m_NlsHandle, VarPtr(arrA(0)) +Public Property Get NewPassword() As String - SrpA = StrConv(arrA(), vbUnicode, 1033) + NewPassword = m_NewPassword End Property +Public Property Get GeneratedSaltAndVerifier() As Boolean + + GeneratedSaltAndVerifier = m_CreateReady + +End Property + + +' SRP-level functions (use these if you know what you're doing) + ' store the Salt value ' store the value when parsing SID_AUTH_ACCOUNTLOGON->C ' length should be 32 bytes -Public Property Let SrpSalt(ByVal Salt As String) +Public Property Let Srp_Salt(ByVal Salt As String) m_Salt = Salt @@ -146,99 +183,158 @@ End Property ' gets the stored Salt value ' this just gets the value you stored (or created in AccountCreate()) -Public Property Get SrpSalt() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - If (StrComp(m_Salt, String$(32, Chr$(0))) = 0) Then Initialize BotVars.Username, BotVars.Password - - SrpSalt = m_Salt - +Public Property Get Srp_Salt() As String + + Srp_Salt = m_Salt + End Property -' store the B value -' store this value when parsing SID_AUTH_ACCOUNTLOGON->C +' store the verifier value ' length should be 32 bytes -Public Property Let SrpB(ByVal B As String) +Public Property Let Srp_v(ByVal v_Value As String) - m_B = B + m_v = v_Value End Property -' gets the stored B value -' this just gets the value you stored -Public Property Get SrpB() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - - SrpB = m_B +' gets the stored verifier value +' this just gets the value you stored (or created in AccountCreate()) +Public Property Get Srp_v() As String + + Srp_v = m_v + +End Property + +' store the Salt value +' store the value when parsing SID_AUTH_ACCOUNTLOGON->C +' length should be 32 bytes +Public Property Let Srp_New_Salt(ByVal Salt As String) + + m_New_Salt = Salt + +End Property + +' gets the stored Salt value +' this just gets the value you stored (or created in AccountCreate()) +Public Property Get Srp_New_Salt() As String + + Srp_New_Salt = m_New_Salt End Property ' store the verifier value ' length should be 32 bytes -Public Property Let Srpv(ByVal v As String) +Public Property Let Srp_New_v(ByVal v_Value As String) - m_v = v + m_New_v = v_Value End Property ' gets the stored verifier value +' this just gets the value you stored (or created in AccountCreate()) +Public Property Get Srp_New_v() As String + + Srp_New_v = m_New_v + +End Property + +' get the A value +' get this value when building SID_AUTH_ACCOUNTLOGON->S +' length will be 32 bytes +Public Property Get Srp_A() As String + + Dim arrA(0 To 31) As Byte + + If (Not m_Initialized) Then + Srp_A = String$(32, vbNullChar) + Exit Property + End If + + nls_get_A m_NlsHandle, VarPtr(arrA(0)) + + Srp_A = StrConv(arrA(), vbUnicode, 1033) + +End Property + +' store the B value +' store this value when parsing SID_AUTH_ACCOUNTLOGON->C +' length should be 32 bytes +Public Property Let Srp_B(ByVal B_Value As String) + + m_B = B_Value + +End Property + +' gets the stored B value ' this just gets the value you stored -Public Property Get Srpv() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - - Srpv = m_v +Public Property Get Srp_B() As String + + Srp_B = m_B End Property ' get the M[1] value ' get this value when building SID_AUTH_ACCOUNTLOGONPROOF->S ' length will be 20 bytes -Public Property Get SrpM1() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password +Public Property Get Srp_M1() As String - Dim M1(0 To 19) As Byte + Dim arrM1(0 To 19) As Byte Dim arrB() As Byte Dim arrSalt() As Byte - + + If (Not m_Initialized) Then + Srp_M1 = String$(20, vbNullChar) + Exit Property + End If + arrB() = StrConv(m_B, vbFromUnicode, 1033) arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033) - nls_get_M1 m_NlsHandle, VarPtr(M1(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0)) - - SrpM1 = StrConv(M1(), vbUnicode, 1033) + nls_get_M1 m_NlsHandle, VarPtr(arrM1(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0)) + + Srp_M1 = StrConv(arrM1(), vbUnicode, 1033) End Property ' get the S value (the secret value) ' length will be 32 bytes -Public Property Get SrpS() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - +Public Property Get Srp_S() As String + Dim arrS(0 To 31) As Byte Dim arrB() As Byte Dim arrSalt() As Byte - + + If (Not m_Initialized) Then + Srp_S = String$(20, vbNullChar) + Exit Property + End If + arrB() = StrConv(m_B, vbFromUnicode, 1033) arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033) - + nls_get_S m_NlsHandle, VarPtr(arrS(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0)) - SrpS = StrConv(arrS(), vbUnicode, 1033) + Srp_S = StrConv(arrS(), vbUnicode, 1033) End Property ' get the K value (a value based on the secret) ' length will be 40 bytes -Public Property Get SrpK() As String - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - +Public Property Get Srp_K() As String + Dim arrK(0 To 39) As Byte Dim arrSalt() As Byte - + + If (Not m_Initialized) Then + Srp_K = String$(40, vbNullChar) + Exit Property + End If + arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033) - + nls_get_K m_NlsHandle, VarPtr(arrK(0)), VarPtr(arrSalt(0)) - - SrpK = StrConv(arrK(), vbUnicode, 1033) + + Srp_K = StrConv(arrK(), vbUnicode, 1033) End Property @@ -246,64 +342,56 @@ End Property ' optionally check this value when parsing SID_AUTH_ACCOUNTLOGONPROOF->C ' M[2] length should be 20 bytes Public Function SrpVerifyM2(ByVal M2 As String) As Boolean - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - + Dim arrM2() As Byte Dim arrB() As Byte Dim arrSalt() As Byte - - arrM2() = StrConv(M2, vbFromUnicode, 1033) - arrB() = StrConv(m_B, vbFromUnicode, 1033) - arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033) - - SrpVerifyM2 = nls_check_M2(m_NlsHandle, VarPtr(arrM2(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0))) -End Function + If (Not m_Initialized) Then + SrpVerifyM2 = False + Exit Function + End If -' check the M[2] value -' optionally check this value when parsing SID_AUTH_ACCOUNTCHANGEPROOF->C -' M[2] length should be 20 bytes -' must have set PersistOld in .AccountChangeProof() before calling this, or the handle was lost! -Public Function SrpVerifyOldM2(ByVal M2 As String) As Boolean - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password - - Dim arrM2() As Byte - Dim arrB() As Byte - Dim arrSalt() As Byte - arrM2() = StrConv(M2, vbFromUnicode, 1033) arrB() = StrConv(m_B, vbFromUnicode, 1033) arrSalt() = StrConv(m_Salt, vbFromUnicode, 1033) - - SrpVerifyOldM2 = nls_check_M2(m_OldNlsHandle, VarPtr(arrM2(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0))) - - ' they shouldn't need to use this handle anymore-- free it - nls_free m_OldNlsHandle - - m_OldNlsHandle = 0 + + SrpVerifyM2 = nls_check_M2(m_NlsHandle, VarPtr(arrM2(0)), VarPtr(arrB(0)), VarPtr(arrSalt(0))) End Function ' create the Salt and Verifier -' create these values when building SID_AUTH_ACCOUNTCREATE->S +' create these values when building SID_AUTH_ACCOUNTCREATE->S or SID_AUTH_CHANGEPROOF->S ' Salt length will be 32 bytes ' Verifier length will be 32 bytes -Public Sub SrpGetSaltAndVerifier(ByRef Salt As String, ByRef Verifier As String) - If (Not m_Initialized) Then Initialize BotVars.Username, BotVars.Password +Public Sub GenerateSaltAndVerifier(Optional ByVal IsChangeProof As Boolean = False) + Dim arrS(0 To 31) As Byte Dim arrV(0 To 31) As Byte Dim i As Integer - + + If (Not m_Initialized) Then + Exit Sub + End If + Randomize - + For i = LBound(arrS) To UBound(arrS) arrS(i) = CByte(Rnd() * 255) Next i - - nls_get_v m_NlsHandle, VarPtr(arrV(0)), VarPtr(arrS(0)) - - Salt = StrConv(arrS(), vbUnicode, 1033) - Verifier = StrConv(arrV(), vbUnicode, 1033) + + If IsChangeProof Then + ' use the alternate Salt and v variables so it doesn't affect the old password's check/proof + nls_get_v m_NewNlsHandle, VarPtr(arrV(0)), VarPtr(arrS(0)) + m_New_Salt = StrConv(arrS(), vbUnicode, 1033) + m_New_v = StrConv(arrV(), vbUnicode, 1033) + Else + nls_get_v m_NlsHandle, VarPtr(arrV(0)), VarPtr(arrS(0)) + m_Salt = StrConv(arrS(), vbUnicode, 1033) + m_v = StrConv(arrV(), vbUnicode, 1033) + End If + + m_CreateReady = True End Sub @@ -314,18 +402,15 @@ End Sub ' populates your databuffer for SID_AUTH_ACCOUNTCREATE->S Public Sub AccountCreate(ByRef Buffer As Variant) - Dim s As String * 32 - Dim v As String * 32 - ' create an s and v - SrpGetSaltAndVerifier s, v - + Call GenerateSaltAndVerifier(False) + ' insert s - Buffer.InsertNonNTString s - + Buffer.InsertNonNTString m_Salt + ' insert v - Buffer.InsertNonNTString v - + Buffer.InsertNonNTString m_v + ' insert username Buffer.InsertNTString m_Username @@ -334,35 +419,35 @@ End Sub ' populates your databuffer for SID_AUTH_ACCOUNTLOGON->S Public Sub AccountLogon(ByRef Buffer As Variant) - Dim a As String * 32 - + Dim A_Value As String * 32 + ' get A - a = SrpA() - + A_Value = Srp_A() + ' insert A - Buffer.InsertNonNTString a - + Buffer.InsertNonNTString A_Value + ' insert username Buffer.InsertNTString m_Username End Sub ' populates your databuffer for SID_AUTH_ACCOUNTLOGONPROOF->S -Public Sub AccountLogonProof(ByRef Buffer As Variant, ByVal Salt As String, ByVal B As String) +Public Sub AccountLogonProof(ByRef Buffer As Variant, ByVal Salt As String, ByVal B_Value As String) + + Dim M1_Value As String * 20 - Dim M1 As String * 20 - ' let salt - SrpSalt = Salt - + Srp_Salt = Salt + ' let B - SrpB = B - + Srp_B = B_Value + ' get M[1] - M1 = SrpM1() - + M1_Value = Srp_M1() + ' insert M[1] - Buffer.InsertNonNTString M1 + Buffer.InsertNonNTString M1_Value End Sub @@ -374,11 +459,12 @@ Public Sub AccountChange(ByRef Buffer As Variant, ByVal NewPassword As String) ' store new password m_NewPassword = NewPassword - + ' create the new NLS handle arrU() = StrConv(m_Username, vbFromUnicode, 1033) arrP() = StrConv(m_NewPassword, vbFromUnicode, 1033) m_NewNlsHandle = nls_init(VarPtr(arrU(0)), VarPtr(arrP(0))) + If m_NewNlsHandle = 0 Then Exit Sub End If @@ -389,39 +475,20 @@ Public Sub AccountChange(ByRef Buffer As Variant, ByVal NewPassword As String) End Sub ' populates your databuffer for SID_AUTH_ACCOUNTCHANGEPROOF->S -' pass true to PersistOld here to keep a copy of the old NLS handle in order -' to check the old password's M[2] value with .SrpVerifyOldM2(M2) -Public Sub AccountChangeProof(ByRef Buffer As Variant, ByVal Salt As String, ByVal B As String, Optional ByVal PersistOld As Boolean = False) - - Dim s As String * 32 - Dim v As String * 32 +Public Sub AccountChangeProof(ByRef Buffer As Variant, ByVal Salt As String, ByVal B_Value As String) ' do the same as SID_AUTH_ACCOUNTLOGONPROOF->S - AccountLogonProof Buffer, Salt, B - - ' if we are keeping the "old" handle in m_OldNlsHandle for .VerifyOldM2()... - If PersistOld Then - ' move current handle to "old" handle-- for use with .VerifyOldM2() - m_OldNlsHandle = m_NlsHandle - Else - ' free handle - nls_free m_NlsHandle - End If - - ' move "new" handle to current handle - m_NlsHandle = m_NewNlsHandle - - ' zero "new" handle - m_NewNlsHandle = 0 - + AccountLogonProof Buffer, Salt, B_Value + ' create an s and v - SrpGetSaltAndVerifier s, v - + Call GenerateSaltAndVerifier(True) + ' insert s - Buffer.InsertNonNTString s - + Buffer.InsertNonNTString m_New_Salt + ' insert v - Buffer.InsertNonNTString v + Buffer.InsertNonNTString m_New_v + End Sub @@ -431,7 +498,7 @@ Public Function VerifyServerSignature(ByVal IPAddress As String, ByVal Signature Dim lngAddr As Long Dim arrSig() As Byte - + lngAddr = inet_addr(IPAddress) arrSig() = StrConv(Signature, vbFromUnicode, 1033) diff --git a/trunk/frmAccountManager.frm b/trunk/frmAccountManager.frm new file mode 100755 index 00000000..4cb478e8 --- /dev/null +++ b/trunk/frmAccountManager.frm @@ -0,0 +1,493 @@ +VERSION 5.00 +Begin VB.Form frmAccountManager + BackColor = &H80000007& + BorderStyle = 1 'Fixed Single + Caption = "Account Manager" + ClientHeight = 3990 + ClientLeft = 45 + ClientTop = 315 + ClientWidth = 3735 + BeginProperty Font + Name = "Tahoma" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 3990 + ScaleWidth = 3735 + StartUpPosition = 1 'CenterOwner + Begin VB.TextBox txtField3 + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 285 + IMEMode = 3 'DISABLE + Left = 240 + PasswordChar = "*" + TabIndex = 4 + Top = 3000 + Width = 3255 + End + Begin VB.CommandButton btnConnect + Caption = "&Save and Connect" + Default = -1 'True + Height = 255 + Left = 1200 + TabIndex = 6 + Top = 3480 + Width = 2295 + End + Begin VB.TextBox txtField2 + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 285 + IMEMode = 3 'DISABLE + Left = 240 + PasswordChar = "*" + TabIndex = 3 + Top = 2400 + Width = 3255 + End + Begin VB.TextBox txtField1 + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 285 + IMEMode = 3 'DISABLE + Left = 240 + PasswordChar = "*" + TabIndex = 2 + Top = 1800 + Width = 3255 + End + Begin VB.ComboBox cboMode + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 315 + ItemData = "frmAccountManager.frx":0000 + Left = 240 + List = "frmAccountManager.frx":0002 + Style = 2 'Dropdown List + TabIndex = 0 + Top = 360 + Width = 3255 + End + Begin VB.TextBox txtUsername + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 285 + Left = 240 + MaxLength = 15 + TabIndex = 1 + Top = 1200 + Width = 3255 + End + Begin VB.CommandButton btnClose + Cancel = -1 'True + Caption = "&Cancel" + Height = 255 + Left = 240 + TabIndex = 5 + Top = 3480 + Width = 975 + End + Begin VB.Label lblField3 + BackColor = &H00000000& + Caption = "Field 3" + ForeColor = &H00FFFFFF& + Height = 255 + Left = 240 + TabIndex = 12 + Top = 2760 + Width = 3255 + End + Begin VB.Label lblField2 + BackColor = &H00000000& + Caption = "Field 2" + ForeColor = &H00FFFFFF& + Height = 255 + Left = 240 + TabIndex = 10 + Top = 2160 + Width = 3255 + End + Begin VB.Label lblField1 + BackColor = &H00000000& + Caption = "Field 1" + ForeColor = &H00FFFFFF& + Height = 255 + Left = 240 + TabIndex = 9 + Top = 1560 + Width = 3255 + End + Begin VB.Label lblUsername + BackColor = &H00000000& + Caption = "Username" + ForeColor = &H00FFFFFF& + Height = 255 + Left = 240 + TabIndex = 8 + Top = 960 + Width = 3255 + End + Begin VB.Label lblMode + Alignment = 2 'Center + BackColor = &H80000007& + Caption = "Choose what to do after connecting." + ForeColor = &H00FFFFFF& + Height = 255 + Left = 240 + TabIndex = 7 + Top = 120 + Width = 3255 + End + Begin VB.Label lblModeDetail + Alignment = 2 'Center + BackColor = &H80000007& + Caption = "Log on to this account:" + ForeColor = &H00FFFFFF& + Height = 735 + Left = 240 + TabIndex = 11 + Top = 720 + Width = 3255 + End +End +Attribute VB_Name = "frmAccountManager" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Const M_LOGON As Byte = 0 +Private Const M_CREAT As Byte = 1 +Private Const M_CHPWD As Byte = 2 +Private Const M_RSPWD As Byte = 3 +Private Const M_CHREG As Byte = 4 +Private Const M_EMREG As Byte = 5 + +Private Username As String +Private Password As String +Private Email As String +Private NPassword1 As String +Private NPassword2 As String +Private NEmail1 As String +Private NEmail2 As String + +Private Sub btnClose_Click() + Unload Me +End Sub + +Private Sub btnConnect_Click() + SaveFieldsAndConnect +End Sub + +Private Sub SaveFieldsAndConnect() + Dim ErrorMsg As String + + ' save values + txtUsername_Change + txtField1_Change + txtField2_Change + txtField3_Change + + ' check that the "verify" fields match, if applicable + Select Case cboMode.ListIndex + Case M_CREAT, M_CHPWD + If (LenB(NPassword1) > 0) And (LenB(NPassword2) > 0) And (StrComp(NPassword1, NPassword2, vbBinaryCompare) <> 0) Then + ErrorMsg = "Passwords do not match! Please make sure you did not make a mistake." + End If + Case M_CHREG, M_EMREG + If (LenB(NEmail1) > 0) And (LenB(NEmail2) > 0) And (StrComp(NEmail1, NEmail2, vbTextCompare) <> 0) Then + ErrorMsg = "Email addresses do not match! Please make sure you did not make a mistake." + End If + End Select + + ' if no no-match errors, check that there's data in the fields + If LenB(ErrorMsg) = 0 Then + Dim MissingFields As String + Dim MissingFieldCount As Integer + Dim Comma As String + Dim ActionName As String + + If (LenB(Username) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Username" + Comma = ", " + End If + + Select Case cboMode.ListIndex + Case M_LOGON + ActionName = "log on" + If (LenB(Password) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Password" + Comma = ", " + End If + Case M_CREAT + ActionName = "create an account" + If (LenB(NPassword1) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Password" + Comma = ", " + End If + If (LenB(NPassword2) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Retype Password" + Comma = ", " + End If + Case M_CHPWD + ActionName = "change the password" + If (LenB(Password) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Old Password" + Comma = ", " + End If + If (LenB(NPassword1) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "New Password" + Comma = ", " + End If + If (LenB(NPassword2) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Retype New Password" + Comma = ", " + End If + Case M_RSPWD + ActionName = "reset the password" + If (LenB(Password) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Registered Email" + Comma = ", " + End If + Case M_CHREG + ActionName = "change the registered email" + If (LenB(Email) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Old Registered Email" + Comma = ", " + End If + If (LenB(NEmail1) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "New Email" + Comma = ", " + End If + If (LenB(NEmail2) = 0) Then + MissingFieldCount = MissingFieldCount + 1 + MissingFields = MissingFields & Comma & "Retype New Email" + Comma = ", " + End If + End Select + + If MissingFieldCount > 0 Then + ErrorMsg = StringFormat("The {0} field{1} {2} required to {3}.", MissingFields, _ + IIf(MissingFieldCount = 1, vbNullString, "s"), _ + IIf(MissingFieldCount = 1, "is", "are"), _ + ActionName) + End If + End If + + ' display error and abort + If LenB(ErrorMsg) > 0 Then + MsgBox "Wait! You can't do that yet! " & ErrorMsg, vbOKOnly Or vbExclamation, "StealthBot" + Exit Sub + End If + + ' save fields + Config.Username = Username + Select Case cboMode.ListIndex + Case M_LOGON + Config.Password = Password + Config.AccountMode = ACCOUNT_MODE_LOGON + Case M_CREAT + Config.Password = NPassword1 + Config.AccountMode = ACCOUNT_MODE_CREAT + Case M_CHPWD + Config.Password = Password + Config.NewPassword = NPassword1 + Config.AccountMode = ACCOUNT_MODE_CHPWD + Case M_RSPWD + Config.RegisterEmailDefault = Email + Config.AccountMode = ACCOUNT_MODE_RSPWD + Case M_CHREG + Config.RegisterEmailDefault = Email + Config.RegisterEmailChange = NEmail1 + Config.AccountMode = ACCOUNT_MODE_CHREG + End Select + Config.AutoAccountAction = False + Config.Save + + If g_Connected And ds.AccountEntry Then + Call modBNCS.DoAccountAction + Else + Call frmChat.DoConnect + End If +End Sub + +Private Sub SetFieldMode(Label As Label, TextBox As TextBox, ByVal Visible As Boolean, _ + Optional ByVal Caption As String = vbNullString, Optional ByVal PasswordChar As String = vbNullString) + Label.Visible = Visible + Label.Caption = Caption + TextBox.Visible = Visible + TextBox.PasswordChar = PasswordChar +End Sub + +Private Sub cboMode_Change() + ' set up fields based on mode + Select Case cboMode.ListIndex + Case M_LOGON + lblModeDetail.Caption = "Log on to this account:" + Call SetFieldMode(lblField1, txtField1, True, "Password", "*") + Call SetFieldMode(lblField2, txtField2, False) + Call SetFieldMode(lblField3, txtField3, False) + Case M_CREAT + lblModeDetail.Caption = "Create this account:" + Call SetFieldMode(lblField1, txtField1, True, "Password", "*") + Call SetFieldMode(lblField2, txtField2, True, "Retype Password", "*") + Call SetFieldMode(lblField3, txtField3, False) + Case M_CHPWD + lblModeDetail.Caption = "Change the password for this account:" + Call SetFieldMode(lblField1, txtField1, True, "Old Password", "*") + Call SetFieldMode(lblField2, txtField2, True, "New Password", "*") + Call SetFieldMode(lblField3, txtField3, True, "Retype New Password", "*") + Case M_RSPWD + lblModeDetail.Caption = "Request a password reset for this account:" + Call SetFieldMode(lblField1, txtField1, True, "Registered Email", vbNullString) + Call SetFieldMode(lblField2, txtField2, False) + Call SetFieldMode(lblField3, txtField3, False) + Case M_CHREG + lblModeDetail.Caption = "Change the registered email address:" + Call SetFieldMode(lblField1, txtField1, True, "Old Registered Email", vbNullString) + Call SetFieldMode(lblField2, txtField2, True, "New Email", vbNullString) + Call SetFieldMode(lblField3, txtField3, True, "Retype New Email", vbNullString) + End Select + + ' fill in fields + txtUsername.Text = Username + Select Case cboMode.ListIndex + Case M_LOGON, M_CHPWD: txtField1.Text = Password + Case M_RSPWD, M_CHREG: txtField1.Text = Email + Case M_CREAT: txtField1.Text = vbNullString + End Select + txtField2.Text = vbNullString + txtField3.Text = vbNullString +End Sub + +Private Sub cboMode_Click() + cboMode_Change +End Sub + +Private Sub Form_Load() + Me.Icon = frmChat.Icon + + ' populate modes + cboMode.AddItem "Account Logon (default)", M_LOGON + cboMode.AddItem "Create Account", M_CREAT + cboMode.AddItem "Change Password", M_CHPWD + cboMode.AddItem "Reset Password", M_RSPWD + cboMode.AddItem "Change Registered Email", M_CHREG +End Sub + +Public Sub LeftAccountEntryMode() + Call ShowMode(vbNullString) +End Sub + +Public Sub ShowMode(ByVal Mode As String, Optional ByVal ControlIndex As Integer = 1) + On Error Resume Next + Show + On Error GoTo 0 + + Username = Config.Username + Password = Config.Password + Email = Config.RegisterEmailDefault + + Select Case UCase$(Mode) + Case vbNullString: ' no change + Case ACCOUNT_MODE_CREAT: cboMode.ListIndex = M_CREAT + Case ACCOUNT_MODE_CHPWD: cboMode.ListIndex = M_CHPWD + Case ACCOUNT_MODE_RSPWD: cboMode.ListIndex = M_RSPWD + Case ACCOUNT_MODE_CHREG: cboMode.ListIndex = M_CHREG + Case Else: cboMode.ListIndex = M_LOGON + End Select + + Call cboMode_Change + + If frmChat.sckBNet.State <> sckConnected Then + lblMode.Caption = "Choose what to do after connecting:" + btnClose.Caption = "&Close" + ElseIf ds.AccountEntry Then + lblMode.Caption = "Choose what to do:" + btnClose.Caption = "Dis&connect" + Else + lblMode.Caption = "Choose what to do after reconnecting:" + btnClose.Caption = "&Close" + End If + + On Error Resume Next + Select Case ControlIndex + Case 0: cboMode.SetFocus + Case 1: txtUsername.SetFocus + Case 2: txtField1.SetFocus + Case 3: txtField2.SetFocus + Case 4: txtField3.SetFocus + End Select +End Sub + +Private Sub Form_Unload(Cancel As Integer) + If (frmChat.sckBNet.State = sckConnected) And (ds.AccountEntry) Then + frmChat.DoDisconnect + End If +End Sub + +Private Sub txtField1_Change() + Select Case cboMode.ListIndex + Case M_LOGON, M_CHPWD: Password = txtField1.Text + Case M_RSPWD, M_CHREG: Email = txtField1.Text + Case M_CREAT: NPassword1 = txtField1.Text + End Select + If frmChat.sckBNet.State = sckConnected And ds.AccountEntry Then + btnClose.Caption = "Dis&connect" + Else + btnClose.Caption = "&Cancel" + End If +End Sub + +Private Sub txtField2_Change() + Select Case cboMode.ListIndex + Case M_CHPWD: NPassword1 = txtField2.Text + Case M_CREAT: NPassword2 = txtField2.Text + Case M_CHREG: NEmail1 = txtField2.Text + End Select + If frmChat.sckBNet.State = sckConnected And ds.AccountEntry Then + btnClose.Caption = "Dis&connect" + Else + btnClose.Caption = "&Cancel" + End If +End Sub + +Private Sub txtField3_Change() + Select Case cboMode.ListIndex + Case M_CHPWD: NPassword2 = txtField3.Text + Case M_CHREG: NEmail2 = txtField3.Text + End Select + If frmChat.sckBNet.State = sckConnected And ds.AccountEntry Then + btnClose.Caption = "Dis&connect" + Else + btnClose.Caption = "&Cancel" + End If +End Sub + +Private Sub txtUsername_Change() + Username = txtUsername.Text + If frmChat.sckBNet.State = sckConnected And ds.AccountEntry Then + btnClose.Caption = "Dis&connect" + Else + btnClose.Caption = "&Cancel" + End If +End Sub diff --git a/trunk/frmAccountManager.frx b/trunk/frmAccountManager.frx new file mode 100755 index 0000000000000000000000000000000000000000..593f4708db84ac8fd0f5cc47c634f38c013fe9e4 GIT binary patch literal 4 LcmZQzU|;|M00aO5 literal 0 HcmV?d00001 diff --git a/trunk/frmChat.frm b/trunk/frmChat.frm index e43df1e0..f2196e70 100644 --- a/trunk/frmChat.frm +++ b/trunk/frmChat.frm @@ -1147,6 +1147,9 @@ Begin VB.Form frmChat Begin VB.Menu mnuSepT Caption = "-" End + Begin VB.Menu mnuAccountManager + Caption = "&Account Manager..." + End Begin VB.Menu mnuUsers Caption = "&User Database Manager..." End @@ -3255,6 +3258,7 @@ Sub Form_Unload(Cancel As Integer) Unload frmDBGameSelection Unload frmDBNameEntry Unload frmDBManager + Unload frmAccountManager Unload frmManageKeys 'Unload frmMonitor Unload frmProfile @@ -3876,6 +3880,10 @@ Private Sub lvClanList_MouseMove(Button As Integer, Shift As Integer, x As Singl End If End Sub +Private Sub mnuAccountManager_Click() + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON +End Sub + Private Sub mnuCatchPhrases_Click() frmCatch.Show End Sub @@ -5312,15 +5320,17 @@ End Sub Private Sub tmrAccountLock_Timer() tmrAccountLock.Enabled = False - + If (Not sckBNet.State = sckConnected) Then 'g_online is set to true AFTER we login... makes this moot, changed to socket being connected. Exit Sub End If - + + Call Event_LogonEvent(tmrAccountLock.Tag, -2&, vbNullString) + AddChat RTBColors.ErrorMessageText, "[BNCS] Your account appears to be locked, likely due to an excessive number of " & _ - "invalid logins. Please try connecting again in 15-20 minutes." - - DoDisconnect + "invalid logins. Please try that account again in 15-20 minutes." + + frmAccountManager.ShowMode tmrAccountLock.Tag End Sub Private Sub tmrScript_Timer(Index As Integer) @@ -6060,6 +6070,8 @@ Private Sub sckMCP_DataArrival(ByVal bytesTotal As Long) Dim buf() As Byte Dim pBuff As clsDataBuffer + If bytesTotal = 0 Then Exit Sub + ' read buffer as Byte() sckMCP.GetData buf(), vbArray + vbByte, bytesTotal ' add data to buffer @@ -6781,7 +6793,7 @@ Function AddQ(ByVal Message As String, Optional msg_priority As Integer = -1, Op ' check for tabs and replace with spaces (2005-09-23) If (InStr(1, strTmp, Chr$(9), vbBinaryCompare) <> 0) Then - strTmp = Replace$(strTmp, Chr$(9), Space(4)) + strTmp = Replace$(strTmp, Chr$(9), Space$(4)) End If ' check for invalid characters in the message @@ -7526,6 +7538,8 @@ Private Sub sckBNet_DataArrival(ByVal bytesTotal As Long) Dim buf() As Byte Dim pBuff As clsDataBuffer + If bytesTotal = 0 Then Exit Sub + ' read buffer as Byte() sckBNet.GetData buf(), vbArray + vbByte, bytesTotal ' add data to buffer @@ -7643,6 +7657,8 @@ Private Sub sckBNLS_DataArrival(ByVal bytesTotal As Long) Dim buf() As Byte Dim pBuff As clsDataBuffer + If bytesTotal = 0 Then Exit Sub + ' read buffer as Byte() sckBNLS.GetData buf(), vbArray + vbByte, bytesTotal ' add data to buffer @@ -8192,6 +8208,11 @@ Sub DoDisconnect(Optional ByVal DoNotShow As Byte = 0, Optional ByVal LeaveUCCAl g_Online = False ds.EnteredChatFirstTime = False ds.ClientToken = 0 + ds.AccountEntry = False + + If frmAccountManager.Visible Then + frmAccountManager.LeftAccountEntryMode + End If Call ClearChannel lvClanList.ListItems.Clear diff --git a/trunk/frmEMailReg.frm b/trunk/frmEMailReg.frm index f12d41b5..382dfa5e 100644 --- a/trunk/frmEMailReg.frm +++ b/trunk/frmEMailReg.frm @@ -148,13 +148,13 @@ Public Sub DoRegisterEmail(ByVal EMailAction As String, Optional ByVal EMailValu Select Case EMailAction Case "ASKLATER" ' "ASKLATER"/ask later: do nothing here - frmChat.AddChat RTBColors.SuccessText, "[EMAIL] E-mail address registration ignored. You may be prompted later." + frmChat.AddChat RTBColors.SuccessText, "[BNCS] E-mail address registration ignored. You may be prompted later." ContinueLogonSequence Case "NEVERASK" ' "NEVERASK"/never ask: register an empty email address - frmChat.AddChat RTBColors.SuccessText, "[EMAIL] E-mail address registration declined." + frmChat.AddChat RTBColors.SuccessText, "[BNCS] E-mail address registration declined." modBNCS.SEND_SID_SETEMAIL vbNullString @@ -173,7 +173,7 @@ Public Sub DoRegisterEmail(ByVal EMailAction As String, Optional ByVal EMailValu txtAddress.SetFocus Else ' value: send the provided email - frmChat.AddChat RTBColors.SuccessText, "[EMAIL] E-mail address registered." + frmChat.AddChat RTBColors.SuccessText, "[BNCS] E-mail address registered." SEND_SID_SETEMAIL EMailValue diff --git a/trunk/frmSettings.frm b/trunk/frmSettings.frm index affde4a7..964d19d9 100644 --- a/trunk/frmSettings.frm +++ b/trunk/frmSettings.frm @@ -3514,7 +3514,9 @@ Begin VB.Form frmSettings EndProperty ForeColor = &H00FFFFFF& Height = 315 + ItemData = "frmSettings.frx":0004 Left = 1920 + List = "frmSettings.frx":0006 Style = 2 'Dropdown List TabIndex = 19 Top = 840 @@ -4033,7 +4035,7 @@ Begin VB.Form frmSettings Left = 2040 TabIndex = 92 Text = "10000" - ToolTipText = $"frmSettings.frx":0004 + ToolTipText = $"frmSettings.frx":0008 Top = 3960 Width = 735 End @@ -4066,7 +4068,7 @@ Begin VB.Form frmSettings Begin VB.Label lbl5 Alignment = 2 'Center BackColor = &H00000000& - Caption = $"frmSettings.frx":00A2 + Caption = $"frmSettings.frx":00A6 BeginProperty Font Name = "Tahoma" Size = 8.25 @@ -4804,9 +4806,15 @@ Private Function SaveSettings() As Boolean Config.ExpKey = CDKeyReplacements(txtExpKey.Text) Config.HomeChannel = txtHomeChan.Text Config.Server = cboServer.Text - + Config.UseSpawn = CBool(CanSpawn(Config.Game, Len(Config.CDKey)) And CBool(chkSpawn.Value)) Config.UseD2Realms = CBool(chkUseRealm.Value) + + ' reset these when save & close normal config + Config.AccountMode = ACCOUNT_MODE_LOGON + Config.AutoAccountAction = True + Config.NewPassword = vbNullString + Config.RegisterEmailChange = vbNullString ' Advanced connection settings Config.UseBNLS = CBool(cboConnMethod.ListIndex = 0) diff --git a/trunk/frmSettings.frx b/trunk/frmSettings.frx index 02d6208cf1c630f7e5a451a553b0db23f924593c..14743c0a01b32499ba4bc8087b874feefd92d15d 100644 GIT binary patch delta 12 Scmcb~beD;R0SGokG6Db<= &H65 'Friends List or Clan-related packet @@ -334,11 +345,11 @@ On Error GoTo ERROR_HANDLER: Dim lResult As Long Dim sInfo As String Dim bSuccess As Boolean - + lResult = pBuff.GetDWORD sInfo = pBuff.GetString bSuccess = False - + Select Case lResult Case 0: Call Event_VersionCheck(1, sInfo) 'Failed Version Check Case 1: Call Event_VersionCheck(1, sInfo) 'Old Game Version @@ -347,10 +358,12 @@ On Error GoTo ERROR_HANDLER: 'Call Event_VersionCheck(0, sInfo) Case 3: Call Event_VersionCheck(1, sInfo) '"Reinstall Required", Invalid version Case Else: - Call frmChat.AddChat(RTBColors.ErrorMessageText, "Unknown SID_REPORTVERSION Response: 0x" & ZeroOffset(lResult, 8)) + frmChat.AddChat RTBColors.ErrorMessageText, "Unknown SID_REPORTVERSION Response: 0x" & ZeroOffset(lResult, 8) End Select - If (frmChat.sckBNet.State = 7 And bSuccess) Then + If Config.IgnoreVersionCheck Then bSuccess = True + + If (frmChat.sckBNet.State = sckConnected And bSuccess) Then If (GetCDKeyCount > 0) Then 'Call frmChat.AddChat(RTBColors.InformationText, "[BNCS] Sending CDKey information...") Select Case GetLogonSystem() @@ -363,12 +376,14 @@ On Error GoTo ERROR_HANDLER: End Select Else Call Event_VersionCheck(0, sInfo) ' display success here - Call frmChat.AddChat(RTBColors.InformationText, "[BNCS] Sending login information...") - frmChat.tmrAccountLock.Enabled = True - SEND_SID_LOGONRESPONSE2 + + ds.AccountEntry = True + Call DoAccountAction End If + Else + frmChat.DoDisconnect End If - + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -924,14 +939,13 @@ On Error GoTo ERROR_HANDLER: lResult = pBuff.GetDWORD sInfo = pBuff.GetString - + Select Case lResult Case 1: Call Event_VersionCheck(0, sInfo) ' display success here - 'frmChat.AddChat RTBColors.SuccessText, "[BNCS] Your CDKey was accepted!" - frmChat.AddChat RTBColors.InformationText, "[BNCS] Sending login information..." - frmChat.tmrAccountLock.Enabled = True - SEND_SID_LOGONRESPONSE2 + + ds.AccountEntry = True + Call DoAccountAction Exit Sub Case 2: Call Event_VersionCheck(2, sInfo) 'Invalid CDKey Case 3: Call Event_VersionCheck(4, sInfo) 'CDKey is for the wrong product @@ -939,8 +953,9 @@ On Error GoTo ERROR_HANDLER: Case 5: Call Event_VersionCheck(6, sInfo) 'CDKey is In Use Case Else: frmChat.AddChat RTBColors.ErrorMessageText, StringFormat("[BNCS] Unknown SID_CDKEY Response 0x{0}: {1}", ZeroOffset(lResult, 8), sInfo) End Select - 'CloseAllConnections - + + 'Call frmChat.DoDisconnect + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -973,7 +988,7 @@ On Error GoTo ERROR_HANDLER: If (LenB(Config.CDKeyOwnerName) > 0) Then .InsertNTString Config.CDKeyOwnerName Else - .InsertNTString BotVars.Username + .InsertNTString Config.Username End If .SendPacket SID_CDKEY End With @@ -987,6 +1002,86 @@ ERROR_HANDLER: StringFormat("Error: #{0}: {1} in {2}.SEND_SID_CDKEY()", Err.Number, Err.Description, OBJECT_NAME)) End Sub +'********************************** +'SID_CHANGEPASSWORD (0x31) S->C +'********************************** +' (DWORD) Status +'********************************** +Private Sub RECV_SID_CHANGEPASSWORD(pBuff As clsDataBuffer) +On Error GoTo ERROR_HANDLER: + + Dim lResult As Long + + lResult = pBuff.GetDWORD + + frmChat.tmrAccountLock.Enabled = False + + Select Case lResult + Case &H0: + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, &H0, vbNullString) + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_LOGON) + Else + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + End If + + Case Else + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, lResult + &H3100, vbNullString) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CHPWD + Else + frmChat.DoDisconnect + End If + End Select + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.RECV_SID_CHANGEPASSWORD()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + +'******************************* +'SID_CHANGEPASSWORD (0x31) C->S +'******************************* +' (DWORD) Client Token +' (DWORD) Server Token +' (DWORD) [5] Old Password Hash +' (DWORD) [5] New Password Hash +' (STRING) Username +'******************************* +Public Sub SEND_SID_CHANGEPASSWORD() +On Error GoTo ERROR_HANDLER: + Dim sHash As String + Dim sHash2 As String + Dim pBuff As New clsDataBuffer + + If Not Config.UseLowerCasePassword Then + sHash = doubleHashPassword(Config.Password, ds.ClientToken, ds.ServerToken) + sHash2 = doubleHashPassword(Config.NewPassword, ds.ClientToken, ds.ServerToken) + Else + sHash = doubleHashPassword(LCase$(Config.Password), ds.ClientToken, ds.ServerToken) + sHash2 = doubleHashPassword(LCase$(Config.NewPassword), ds.ClientToken, ds.ServerToken) + End If + + With pBuff + .InsertDWord ds.ClientToken + .InsertDWord ds.ServerToken + .InsertNonNTString sHash + .InsertNonNTString sHash2 + .InsertNTString Config.Username + .SendPacket SID_CHANGEPASSWORD + End With + + Set pBuff = Nothing + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.SEND_SID_CHANGEPASSWORD()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + '******************************* 'SID_CDKEY2 (0x36) S->C '******************************* @@ -1004,10 +1099,9 @@ On Error GoTo ERROR_HANDLER: Select Case lResult Case 1: Call Event_VersionCheck(0, sInfo) ' display success here - 'frmChat.AddChat RTBColors.SuccessText, "[BNCS] Your CDKey was accepted!" - frmChat.AddChat RTBColors.InformationText, "[BNCS] Sending login information..." - frmChat.tmrAccountLock.Enabled = True - SEND_SID_LOGONRESPONSE2 + + ds.AccountEntry = True + Call DoAccountAction Exit Sub Case 2: Call Event_VersionCheck(2, sInfo) 'Invalid CDKey Case 3: Call Event_VersionCheck(4, sInfo) 'CDKey is for the wrong product @@ -1015,7 +1109,8 @@ On Error GoTo ERROR_HANDLER: Case 5: Call Event_VersionCheck(6, sInfo) 'CDKey is In Use Case Else: frmChat.AddChat RTBColors.ErrorMessageText, StringFormat("[BNCS] Unknown SID_CDKEY2 Response 0x{0}: {1}", ZeroOffset(lResult, 8), sInfo) End Select - 'CloseAllConnections + + 'Call frmChat.DoDisconnect Exit Sub ERROR_HANDLER: @@ -1061,14 +1156,14 @@ On Error GoTo ERROR_HANDLER: If (LenB(Config.CDKeyOwnerName) > 0) Then .InsertNTString Config.CDKeyOwnerName Else - .InsertNTString BotVars.Username + .InsertNTString Config.Username End If .SendPacket SID_CDKEY2 End With - + Set pBuff = Nothing Set oKey = Nothing - + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -1089,11 +1184,21 @@ On Error GoTo ERROR_HANDLER: lResult = pBuff.GetDWORD sInfo = pBuff.GetString - + + frmChat.tmrAccountLock.Enabled = False + Select Case lResult - Case &H0: 'Logon Successful - Call Event_LogonEvent(2, sInfo) - + Case &H0 'Logon Successful + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, &H0, sInfo) + + BotVars.Username = Config.Username + BotVars.Password = Config.Password + ds.AccountEntry = False + + If frmAccountManager.Visible Then + frmAccountManager.LeftAccountEntryMode + End If + If (Not ds.WaitingForEmail) Then If (Dii And BotVars.UseRealm) Then 'Call frmChat.AddChat(RTBColors.InformationText, "[BNCS] Asking Battle.net for a list of Realm servers...") @@ -1104,22 +1209,26 @@ On Error GoTo ERROR_HANDLER: Else Call DoRegisterEmail End If - - Case &H1: 'Nonexistent account. - Call Event_LogonEvent(0, sInfo) - Call Event_LogonEvent(3, sInfo) - SEND_SID_CREATEACCOUNT2 - - Case &H2: 'Invalid password. - Call Event_LogonEvent(1, sInfo) - Call frmChat.DoDisconnect - - Case &H6: 'Account has been closed (includes a reason) - Call Event_LogonEvent(5, sInfo) - Call frmChat.DoDisconnect - - Case Else: - frmChat.AddChat RTBColors.ErrorMessageText, StringFormat("[BNCS] Unknown response to SID_LOGONRESPONSE2: 0x{0}", ZeroOffset(lResult, 8)) + + Case &H1 'Nonexistent account. + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, &H1, sInfo) + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_CREAT) + ElseIf Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CREAT + Else + frmChat.DoDisconnect + End If + + Case Else + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, lResult, sInfo) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + Else + frmChat.DoDisconnect + End If End Select Exit Sub @@ -1142,16 +1251,16 @@ On Error GoTo ERROR_HANDLER: Dim pBuff As New clsDataBuffer If Not Config.UseLowerCasePassword Then - sHash = doubleHashPassword(BotVars.Password, ds.ClientToken, ds.ServerToken) + sHash = doubleHashPassword(Config.Password, ds.ClientToken, ds.ServerToken) Else - sHash = doubleHashPassword(LCase$(BotVars.Password), ds.ClientToken, ds.ServerToken) + sHash = doubleHashPassword(LCase$(Config.Password), ds.ClientToken, ds.ServerToken) End If With pBuff .InsertDWord ds.ClientToken .InsertDWord ds.ServerToken .InsertNonNTString sHash - .InsertNTString BotVars.Username + .InsertNTString Config.Username .SendPacket SID_LOGONRESPONSE2 End With Set pBuff = Nothing @@ -1177,23 +1286,36 @@ On Error GoTo ERROR_HANDLER: lResult = pBuff.GetDWORD sInfo = pBuff.GetString - + Select Case lResult - Case 0: - frmChat.AddChat RTBColors.SuccessText, "[BNCS] Account created successfully!" - modBNCS.SEND_SID_LOGONRESPONSE2 + Case &H0: + Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H0, sInfo) + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_LOGON) + Else + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + End If + Exit Sub - - Case 2: sOut = "Your desired account name contains invalid characters." - Case 3: sOut = "Your desired account name contains a banned word." - Case 4: sOut = "Your desired account name already exists." - Case 6: sOut = "Your desired account name does not contain enough alphanumeric characters." - Case Else: sOut = StringFormat("Unknown response to SID_CREATEACCOUNT2. Result code: 0x{0}", ZeroOffset(lResult, 8)) + + Case &H1: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H7, sInfo) + Case &H2: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H8, sInfo) + Case &H3: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H9, sInfo) + Case &H4: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H4, sInfo) + Case &H5: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H3D05, sInfo) + Case &H6: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &HA, sInfo) + Case &H7: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &HB, sInfo) + Case &H8: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &HC, sInfo) + Case Else: Call Event_LogonEvent(ACCOUNT_MODE_CREAT, lResult, sInfo) End Select - - frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] There was an error in trying to create a new account." - frmChat.AddChat RTBColors.ErrorMessageText, StringFormat("[BNCS] {0}", sOut) - + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CREAT + Else + frmChat.DoDisconnect + End If + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -1206,20 +1328,20 @@ End Sub ' (DWORD) [5] Password hash ' (STRING) Username '************************************** -Private Sub SEND_SID_CREATEACCOUNT2() +Public Sub SEND_SID_CREATEACCOUNT2() On Error GoTo ERROR_HANDLER: Dim sHash As String If Not Config.UseLowerCasePassword Then - sHash = hashPassword(BotVars.Password) + sHash = hashPassword(Config.Password) Else - sHash = hashPassword(LCase(BotVars.Password)) + sHash = hashPassword(LCase(Config.Password)) End If Dim pBuff As New clsDataBuffer With pBuff .InsertNonNTString sHash - .InsertNTString BotVars.Username + .InsertNTString Config.Username .SendPacket SID_CREATEACCOUNT2 End With Set pBuff = Nothing @@ -1464,16 +1586,16 @@ On Error GoTo ERROR_HANDLER: End If If (StrComp(RemoteHostIP, "0.0.0.255", vbBinaryCompare) = 0) Then - frmChat.AddChat RTBColors.InformationText, "[BNCS] Note: a server signature was received but cannot be validated because of the proxy configuration." + frmChat.AddChat RTBColors.InformationText, "[BNCS] Note! A server signature was received but cannot be validated because of the proxy configuration." Else If (ds.NLS.VerifyServerSignature(RemoteHostIP, ds.ServerSig)) Then frmChat.AddChat RTBColors.SuccessText, "[BNCS] Server signature validated!" Else - frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Warning: server signature is invalid! This may not be a valid server." + frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Warning! The server signature is invalid. This may not be a valid server." End If End If ElseIf (GetProductKey = "W3") Then - frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Warning: server signature is missing! This may not be a valid server." + frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Warning! The server signature is missing. This may not be a valid server." End If If (BotVars.BNLS) Then @@ -1565,13 +1687,14 @@ On Error GoTo ERROR_HANDLER: lResult = pBuff.GetDWORD sInfo = pBuff.GetString + bSuccess = False Select Case lResult Case &H0: - bSuccess = True Call Event_VersionCheck(0, sInfo) - + bSuccess = True + Case &H100, &H101: Call Event_VersionCheck(1, sInfo) 'Outdated/Invalid Version Case &H200: Call Event_VersionCheck(2, sInfo) 'Invalid CDKey Case &H201: Call Event_VersionCheck(6, sInfo) 'CDKey is In Use @@ -1582,22 +1705,17 @@ On Error GoTo ERROR_HANDLER: Case &H212: Call Event_VersionCheck(9, sInfo) 'Exp CDKey is Banned Case &H213: Call Event_VersionCheck(10, sInfo) 'Exp CDKey is for the wrong product Case Else: - If Config.IgnoreVersionCheck Then bSuccess = True Call frmChat.AddChat(RTBColors.ErrorMessageText, "Unknown 0x51 Response: 0x" & ZeroOffset(lResult, 8)) End Select - If (frmChat.sckBNet.State = 7 And (Not ds.WaitingForEmail) And bSuccess) Then - Call frmChat.AddChat(RTBColors.InformationText, "[BNCS] Sending login information...") - frmChat.tmrAccountLock.Enabled = True - - If (ds.LogonType = 2) Then - ds.NLS.Initialize BotVars.Username, BotVars.Password - modBNCS.SEND_SID_AUTH_ACCOUNTLOGON - Else - modBNCS.SEND_SID_LOGONRESPONSE2 - End If + If Config.IgnoreVersionCheck Then bSuccess = True + + If (frmChat.sckBNet.State = sckConnected And bSuccess) Then + ds.AccountEntry = True + Call DoAccountAction + Exit Sub End If - + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -1683,7 +1801,7 @@ On Error GoTo ERROR_HANDLER: If (LenB(Config.CDKeyOwnerName) > 0) Then .InsertNTString Config.CDKeyOwnerName Else - .InsertNTString BotVars.Username + .InsertNTString Config.Username End If .SendPacket SID_AUTH_CHECK @@ -1709,30 +1827,29 @@ On Error GoTo ERROR_HANDLER: Dim lResult As Long lResult = pBuff.GetDWORD - + + ds.NLS.Terminate + Select Case lResult Case &H0: - Call Event_LogonEvent(4) - - If frmChat.sckBNet.State = 7 Then - Call frmChat.AddChat(RTBColors.InformationText, "[BNCS] Sending login information...") - SEND_SID_AUTH_ACCOUNTLOGON - Exit Sub + Call Event_LogonEvent(ACCOUNT_MODE_CREAT, &H0, vbNullString) + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_LOGON) + Else + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON End If - - Case &H4: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name already exists." - Case &H7: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name is too short/blank." - Case &H8: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name contains an illegal character." - Case &H9: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name contains an illegal word." - Case &HA: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name contains too few alphanumeric characters." - Case &HB: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name contains adjacent punctuation characters." - Case &HC: frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Account creation failed because your name contains too many punctuation characters." + Case Else - Call frmChat.AddChat(RTBColors.ErrorMessageText, StringFormat("Account creation failed for an unknown reason: 0x{0}", ZeroOffset(lResult, 8))) + Call Event_LogonEvent(ACCOUNT_MODE_CREAT, lResult, vbNullString) End Select - - Call frmChat.DoDisconnect - + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CREAT + Else + frmChat.DoDisconnect + End If + Exit Sub ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ @@ -1746,14 +1863,16 @@ End Sub ' (BYTE[32]) Verifier (v) ' (STRING) Username '********************************** -Private Sub SEND_SID_AUTH_ACCOUNTCREATE() +Public Sub SEND_SID_AUTH_ACCOUNTCREATE() On Error GoTo ERROR_HANDLER: - + + Call ds.NLS.Initialize(Config.Username, Config.Password) + Call ds.NLS.GenerateSaltAndVerifier(False) + Dim pBuff As New clsDataBuffer - ds.NLS.Initialize BotVars.Username, BotVars.Password With pBuff - .InsertNonNTString ds.NLS.SrpSalt - .InsertNonNTString ds.NLS.Srpv + .InsertNonNTString ds.NLS.Srp_Salt + .InsertNonNTString ds.NLS.Srp_v .InsertNTString ds.NLS.Username .SendPacket SID_AUTH_ACCOUNTCREATE End With @@ -1776,29 +1895,40 @@ Private Sub RECV_SID_AUTH_ACCOUNTLOGON(pBuff As clsDataBuffer) On Error GoTo ERROR_HANDLER: Dim lResult As Long - Dim s As String - Dim B As String lResult = pBuff.GetDWORD - ds.NLS.SrpSalt = pBuff.GetRaw(32) - ds.NLS.SrpB = pBuff.GetRaw(32) + ds.NLS.Srp_Salt = pBuff.GetRaw(32) + ds.NLS.Srp_B = pBuff.GetRaw(32) + + frmChat.tmrAccountLock.Enabled = False Select Case lResult Case &H0: 'Accepted, requires proof. SEND_SID_AUTH_ACCOUNTLOGONPROOF - + Exit Sub + Case &H1: 'Account doesn't exist. - Call Event_LogonEvent(0) - Call Event_LogonEvent(3) - Call SEND_SID_AUTH_ACCOUNTCREATE - - Case &H5: 'Account requires upgrade, Not possible anymore - frmChat.AddChat RTBColors.ErrorMessageText, "[BNCS] Your account needs to be upgraded. This is no longer possible on Battle.net. Choose a different account." - + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, &H1, vbNullString) + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_CREAT) + ElseIf Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CREAT + Else + frmChat.DoDisconnect + End If + Case Else - Call frmChat.AddChat(RTBColors.ErrorMessageText, StringFormat("[BNCS] Unknown response to SID_AUTH_ACCOUNTLOGON: 0x{0}", ZeroOffset(lResult, 8))) - frmChat.DoDisconnect + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, lResult, vbNullString) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + Else + frmChat.DoDisconnect + End If End Select + + ds.NLS.Terminate Exit Sub ERROR_HANDLER: @@ -1809,14 +1939,16 @@ End Sub '********************************** 'SID_AUTH_ACCOUNTLOGON (0x53) C->S '********************************** -' (BYTE[32]) Client Key ('A') +' (BYTE[32]) Client Key (A) ' (STRING) Username '********************************** Private Sub SEND_SID_AUTH_ACCOUNTLOGON() On Error GoTo ERROR_HANDLER: - + + Call ds.NLS.Initialize(Config.Username, Config.Password) + Dim pBuff As New clsDataBuffer - pBuff.InsertNonNTString ds.NLS.SrpA() + pBuff.InsertNonNTString ds.NLS.Srp_A pBuff.InsertNTString ds.NLS.Username pBuff.SendPacket SID_AUTH_ACCOUNTLOGON Set pBuff = Nothing @@ -1846,27 +1978,51 @@ On Error GoTo ERROR_HANDLER: sInfo = pBuff.GetString Select Case lResult - Case &H0: 'Logon successful. - Call Event_LogonEvent(2) + Case &H0 'Logon successful. + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, &H0, sInfo) + If (Not ds.NLS.SrpVerifyM2(M2)) Then - frmChat.AddChat RTBColors.InformationText, "[BNCS] Warning, The server sent an invalid password proof, it may be a fake server." + frmChat.AddChat RTBColors.InformationText, "[BNCS] Warning! The server sent an invalid password proof. It may be a fake server." End If + + BotVars.Username = Config.Username + BotVars.Password = Config.Password + ds.AccountEntry = False + + If frmAccountManager.Visible Then + frmAccountManager.LeftAccountEntryMode + End If + Call SendEnterChatSequence - - Case &H2: 'Invalid password - Call Event_LogonEvent(1) - Call frmChat.DoDisconnect - - Case &HE: DoRegisterEmail 'Email registration requried - Case &HF: 'Custom message - Call Event_LogonEvent(5, sInfo) - Call frmChat.DoDisconnect - + + Case &HE 'Email registration requried + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, &H0, sInfo) + + If (Not ds.NLS.SrpVerifyM2(M2)) Then + frmChat.AddChat RTBColors.InformationText, "[BNCS] Warning! The server sent an invalid password proof. It may be a fake server." + End If + + BotVars.Username = Config.Username + BotVars.Password = Config.Password + ds.AccountEntry = False + + If frmAccountManager.Visible Then + frmAccountManager.LeftAccountEntryMode + End If + + Call DoRegisterEmail + Case Else - Call frmChat.AddChat(RTBColors.ErrorMessageText, StringFormat("[BNCS] Unknown response to SID_AUTH_ACCOUNTLOGONPROOF: 0x{0}", ZeroOffset(lResult, 8))) - Call frmChat.DoDisconnect - + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, lResult, sInfo) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + Else + frmChat.DoDisconnect + End If End Select + + ds.NLS.Terminate Exit Sub ERROR_HANDLER: @@ -1884,7 +2040,7 @@ On Error GoTo ERROR_HANDLER: Dim pBuff As New clsDataBuffer With pBuff - .InsertNonNTString ds.NLS.SrpM1 + .InsertNonNTString ds.NLS.Srp_M1 .SendPacket SID_AUTH_ACCOUNTLOGONPROOF End With Set pBuff = Nothing @@ -1895,6 +2051,149 @@ ERROR_HANDLER: StringFormat("Error: #{0}: {1} in {2}.SEND_SID_AUTH_ACCOUNTLOGONPROOF()", Err.Number, Err.Description, OBJECT_NAME)) End Sub +'********************************** +'SID_AUTH_ACCOUNTCHANGE (0x55) S->C +'********************************** +' (DWORD) Status +' (BYTE[32]) Salt (s) +' (BYTE[32]) Server Key (B) +'********************************** +Private Sub RECV_SID_AUTH_ACCOUNTCHANGE(pBuff As clsDataBuffer) +On Error GoTo ERROR_HANDLER: + + Dim lResult As Long + + lResult = pBuff.GetDWORD + ds.NLS.Srp_Salt = pBuff.GetRaw(32) + ds.NLS.Srp_B = pBuff.GetRaw(32) + + frmChat.tmrAccountLock.Enabled = False + + Select Case lResult + Case &H0: + SEND_SID_AUTH_ACCOUNTCHANGEPROOF + Exit Sub + + Case Else + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, lResult, vbNullString) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CHPWD + Else + frmChat.DoDisconnect + End If + End Select + + ds.NLS.Terminate + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.RECV_SID_AUTH_ACCOUNTCHANGE()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + +'********************************** +'SID_AUTH_ACCOUNTCHANGE (0x55) C->S +'********************************** +' (BYTE[32]) Client Key (A) +' (STRING) Username +'********************************** +Public Sub SEND_SID_AUTH_ACCOUNTCHANGE() +On Error GoTo ERROR_HANDLER: + + Call ds.NLS.InitializeChange(Config.Username, Config.Password, Config.NewPassword) + + Dim pBuff As New clsDataBuffer + pBuff.InsertNonNTString ds.NLS.Srp_A + pBuff.InsertNTString ds.NLS.Username + pBuff.SendPacket SID_AUTH_ACCOUNTCHANGE + Set pBuff = Nothing + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.SEND_SID_AUTH_ACCOUNTCHANGE()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + +'********************************** +'SID_AUTH_ACCOUNTCHANGEPROOF (0x56) S->C +'********************************** +' (DWORD) Status +' (BYTE[20]) Server Old Password Proof (M2) +'********************************** +Private Sub RECV_SID_AUTH_ACCOUNTCHANGEPROOF(pBuff As clsDataBuffer) +On Error GoTo ERROR_HANDLER: + + Dim lResult As Long + Dim M2 As String + + lResult = pBuff.GetDWORD + M2 = pBuff.GetRaw(20) + + Select Case lResult + Case &H0 'Change successful. + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, &H0, vbNullString) + + Config.Password = Config.NewPassword + Config.NewPassword = vbNullString + Config.Save + + If (Not ds.NLS.SrpVerifyM2(M2)) Then + frmChat.AddChat RTBColors.InformationText, "[BNCS] Warning! The server sent an invalid password proof. It may be a fake server." + End If + + If Config.AutoAccountAction Then + Call DoAccountAction(ACCOUNT_MODE_LOGON) + Else + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + End If + + Case Else + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, lResult, vbNullString) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CHPWD + Else + frmChat.DoDisconnect + End If + + End Select + + ds.NLS.Terminate + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.RECV_SID_AUTH_ACCOUNTCHANGEPROOF()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + +'********************************** +'SID_AUTH_ACCOUNTCHANGEPROOF (0x56) C->S +'********************************** +' (BYTE[20]) Client Password Proof (M1) +' (BYTE[32]) Salt (s) +' (BYTE[32]) Verifier (v) +'********************************** +Public Sub SEND_SID_AUTH_ACCOUNTCHANGEPROOF() +On Error GoTo ERROR_HANDLER: + + Call ds.NLS.GenerateSaltAndVerifier(True) + + Dim pBuff As New clsDataBuffer + With pBuff + .InsertNonNTString ds.NLS.Srp_M1 + .InsertNonNTString ds.NLS.Srp_New_Salt + .InsertNonNTString ds.NLS.Srp_New_v + .SendPacket SID_AUTH_ACCOUNTCHANGEPROOF + End With + Set pBuff = Nothing + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.SEND_SID_AUTH_ACCOUNTCHANGEPROOF()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + '******************************* 'SID_SETEMAIL (0x59) S->C '******************************* @@ -1935,18 +2234,60 @@ ERROR_HANDLER: StringFormat("Error: #{0}: {1} in {2}.SEND_SID_SETEMAIL()", Err.Number, Err.Description, OBJECT_NAME)) End Sub +'************************************** +'SID_RESETPASSWORD (0x5A) C->S +'************************************** +' (STRING) Username +' (STRING) Email Address +'************************************** +Public Sub SEND_SID_RESETPASSWORD() +On Error GoTo ERROR_HANDLER: + + Dim pBuff As New clsDataBuffer + With pBuff + .InsertNTString Config.Username + .InsertNTString Config.RegisterEmailDefault + .SendPacket SID_RESETPASSWORD + End With + Set pBuff = Nothing + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.SEND_SID_RESETPASSWORD()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + +'************************************** +'SID_CHANGEEMAIL (0x5B) C->S +'************************************** +' (STRING) Username +' (STRING) Email Address +' (STRING) New Email Address +'************************************** +Public Sub SEND_SID_CHANGEEMAIL() +On Error GoTo ERROR_HANDLER: + + Dim pBuff As New clsDataBuffer + With pBuff + .InsertNTString Config.Username + .InsertNTString Config.RegisterEmailDefault + .InsertNTString Config.RegisterEmailChange + .SendPacket SID_CHANGEEMAIL + End With + Set pBuff = Nothing + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.SEND_SID_CHANGEEMAIL()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + '======================================================================================================= 'This function will open the form to prompt the user for their email, or if the overrides are set, automatically register an email. Private Sub DoRegisterEmail() On Error GoTo ERROR_HANDLER: - Dim EMailValue As String - Dim EMailAction As String - - EMailAction = Config.RegisterEmailAction - EMailValue = Config.RegisterEmailDefault - - Call frmEMailReg.DoRegisterEmail(EMailAction, EMailValue) + Call frmEMailReg.DoRegisterEmail(Config.RegisterEmailAction, Config.RegisterEmailDefault) Exit Sub ERROR_HANDLER: @@ -2164,6 +2505,146 @@ ERROR_HANDLER: StringFormat("Error: #{0}: {1} in {2}.DoChannelJoinHome()", Err.Number, Err.Description, OBJECT_NAME)) End Sub +Public Sub DoAccountAction(Optional ByVal Mode As String = vbNullString) +On Error GoTo ERROR_HANDLER: + + ' not able to change account now? + If frmChat.sckBNet.State <> sckConnected Or Not ds.AccountEntry Then + Exit Sub + End If + + ' set mode to config mode if not provided + If LenB(Mode) = 0 Then + Mode = Config.AccountMode + End If + + ' turn off automatic if account manager form is open + If frmAccountManager.Visible Then + Config.AutoAccountAction = False + Config.Save + End If + + ' execute action + Select Case UCase$(Mode) + Case ACCOUNT_MODE_CREAT + Call Event_LogonEvent(ACCOUNT_MODE_CREAT, -1&) + + If LenB(Config.Username) = 0 Or LenB(Config.Password) = 0 Then + Call Event_LogonEvent(ACCOUNT_MODE_CREAT, -3&) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CREAT + Else + frmChat.DoDisconnect + End If + + Exit Sub + End If + + If (ds.LogonType = BNCSSERVER_SRP2) Then + modBNCS.SEND_SID_AUTH_ACCOUNTCREATE + Else + modBNCS.SEND_SID_CREATEACCOUNT2 + End If + + Case ACCOUNT_MODE_CHPWD + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, -1&) + + If LenB(Config.Username) = 0 Or LenB(Config.Password) = 0 Or LenB(Config.NewPassword) = 0 Then + Call Event_LogonEvent(ACCOUNT_MODE_CHPWD, -3&) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CHPWD + Else + frmChat.DoDisconnect + End If + + Exit Sub + End If + + frmChat.tmrAccountLock.Enabled = True + frmChat.tmrAccountLock.Tag = ACCOUNT_MODE_CHPWD + If (ds.LogonType = BNCSSERVER_SRP2) Then + modBNCS.SEND_SID_AUTH_ACCOUNTCHANGE + Else + modBNCS.SEND_SID_CHANGEPASSWORD + End If + + Case ACCOUNT_MODE_RSPWD + If LenB(Config.Username) = 0 Or LenB(Config.RegisterEmailDefault) = 0 Then + Call Event_LogonEvent(ACCOUNT_MODE_RSPWD, -3&) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_RSPWD + Else + frmChat.DoDisconnect + End If + + Exit Sub + End If + + modBNCS.SEND_SID_RESETPASSWORD + + ' no response! assume success + Call Event_LogonEvent(ACCOUNT_MODE_RSPWD, &H0) + + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + + Case ACCOUNT_MODE_CHREG + If LenB(Config.Username) = 0 Or LenB(Config.RegisterEmailDefault) = 0 Or LenB(Config.RegisterEmailChange) = 0 Then + Call Event_LogonEvent(ACCOUNT_MODE_CHREG, -3&) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_CHREG + Else + frmChat.DoDisconnect + End If + + Exit Sub + End If + + modBNCS.SEND_SID_CHANGEEMAIL + + ' no response! assume success + Call Event_LogonEvent(ACCOUNT_MODE_CHREG, &H0) + + Config.RegisterEmailDefault = Config.RegisterEmailChange + Config.RegisterEmailChange = vbNullString + Config.Save + + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + + Case Else ' ACCOUNT_MODE_LOGON + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, -1&) + + If LenB(Config.Username) = 0 Or LenB(Config.Password) = 0 Then + Call Event_LogonEvent(ACCOUNT_MODE_LOGON, -3&) + + If Config.ManageOnAccountError Then + frmAccountManager.ShowMode ACCOUNT_MODE_LOGON + Else + frmChat.DoDisconnect + End If + + Exit Sub + End If + + frmChat.tmrAccountLock.Enabled = True + frmChat.tmrAccountLock.Tag = ACCOUNT_MODE_LOGON + If (ds.LogonType = BNCSSERVER_SRP2) Then + modBNCS.SEND_SID_AUTH_ACCOUNTLOGON + Else + modBNCS.SEND_SID_LOGONRESPONSE2 + End If + + End Select + + Exit Sub +ERROR_HANDLER: + Call frmChat.AddChat(RTBColors.ErrorMessageText, _ + StringFormat("Error: #{0}: {1} in {2}.DoAccountAction()", Err.Number, Err.Description, OBJECT_NAME)) +End Sub + Public Function CanSpawn(ByVal sProduct As String, ByVal iKeyLength As Integer) As Boolean sProduct = GetProductInfo(sProduct).Code diff --git a/trunk/modEvents.bas b/trunk/modEvents.bas index 4e33807b..37b0a70d 100644 --- a/trunk/modEvents.bas +++ b/trunk/modEvents.bas @@ -70,7 +70,7 @@ Public Sub Event_FlagsUpdate(ByVal Username As String, ByVal Flags As Long, ByVa Clan = UserObj.Clan Else If (g_Channel.IsSilent = False) Then - frmChat.AddChat RTBColors.ErrorMessageText, "Warning: There was a flags update received for a user that we do " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Warning! There was a flags update received for a user that we do " & _ "not have a record for. This may be indicative of a server split or other technical difficulty." Exit Sub @@ -539,48 +539,107 @@ ERROR_HANDLER: End Sub ' updated 8-10-05 for new logging system -Public Sub Event_LogonEvent(ByVal Message As Byte, Optional ByVal ExtraInfo As String) +Public Sub Event_LogonEvent(ByVal Action As String, ByVal Result As Long, Optional ByVal ExtraInfo As String) On Error GoTo ERROR_HANDLER: Dim lColor As Long Dim sMessage As String - 'Dim UseExtraInfo As Boolean - Select Case (Message) - Case 0: - lColor = RTBColors.ErrorMessageText - - sMessage = "Login error - account does not exist." - - Case 1: - lColor = RTBColors.ErrorMessageText - - sMessage = "Login error - invalid password." - - Case 2: + lColor = RTBColors.ErrorMessageText + + ' get starting text + Select Case UCase$(Action) + Case ACCOUNT_MODE_LOGON + sMessage = "Logon error - " + Case ACCOUNT_MODE_CREAT + sMessage = "Account creation error - " + Case ACCOUNT_MODE_CHPWD + sMessage = "Password change error - " + End Select + + ' choose result code + Select Case Result + Case &H0 lColor = RTBColors.SuccessText - - sMessage = "Logon successful." - - frmChat.tmrAccountLock.Enabled = False - - Case 3: + ' replace with specific success message + Select Case UCase$(Action) + Case ACCOUNT_MODE_LOGON + sMessage = "Logon successful." + Case ACCOUNT_MODE_CREAT + sMessage = "Account created successfully." + Case ACCOUNT_MODE_CHPWD + sMessage = "Account password changed successfully." + Case ACCOUNT_MODE_RSPWD + sMessage = "Sent the request to reset password. You will receive an email to continue this process." + Case ACCOUNT_MODE_CHREG + sMessage = "Sent the request to change email associated with the account." + End Select + Case &H1 + sMessage = sMessage & "account does not exist." + Case &H2 + Select Case UCase$(Action) + Case ACCOUNT_MODE_CHPWD + sMessage = sMessage & "invalid old password." + Case Else + sMessage = sMessage & "invalid password." + End Select + Case &H4 + sMessage = sMessage & "account already exists." + Case &H5 + sMessage = sMessage & "account requires upgrade." + Case &H6 + sMessage = sMessage & "account closed - " & ExtraInfo & "." + Case &H7 + sMessage = sMessage & "name too short." + Case &H8 + sMessage = sMessage & "name contains invalid characters." + Case &H9 + sMessage = sMessage & "name contains banned word." + Case &HA + sMessage = sMessage & "name contains too few alphanumeric charaters." + Case &HB + sMessage = sMessage & "name contains adjacent punctuation." + Case &HC + sMessage = sMessage & "name contains too many punctuation characters." + Case &HE + sMessage = sMessage & "account email registration." + Case &HF + sMessage = sMessage & ExtraInfo & "." + Case &H3101 ' actually status 0x01 from SID_CHANGEPASSWORD + sMessage = sMessage & "account does not exist or invalid old password." + Case &H3D05 ' actually status 0x05 from SID_CREATEACCOUNT2 + sMessage = sMessage & "account is still being created." + Case -3& ' parameter empty + Select Case UCase$(Action) + Case ACCOUNT_MODE_LOGON, ACCOUNT_MODE_CREAT + sMessage = sMessage & "username or password not provided." + Case ACCOUNT_MODE_CHPWD + sMessage = sMessage & "new password not provided." + Case ACCOUNT_MODE_RSPWD + sMessage = sMessage & "email address not provided." + Case ACCOUNT_MODE_CHREG + sMessage = sMessage & "new email address not provided." + End Select + Case -2& ' time out + sMessage = sMessage & "timed out." + Case -1& ' attempt lColor = RTBColors.InformationText - - sMessage = "Attempting to create account..." - - Case 4: - lColor = RTBColors.SuccessText - - sMessage = "Account created successfully." - - Case 5: - sMessage = ExtraInfo - - lColor = RTBColors.ErrorMessageText + ' replace with specific in-progress message + Select Case UCase$(Action) + Case ACCOUNT_MODE_LOGON + sMessage = "Sending login information..." + Case ACCOUNT_MODE_CREAT + sMessage = "Attempting to create account..." + Case ACCOUNT_MODE_CHPWD + sMessage = "Attempting to change password..." + End Select + Case Else + sMessage = sMessage & "unknown response code (0x" & Hex(Result) & ": " & ExtraInfo & ")." End Select frmChat.AddChat lColor, "[BNCS] " & sMessage + Exit Sub + ERROR_HANDLER: Call frmChat.AddChat(RTBColors.ErrorMessageText, _ StringFormat("Error: #{0}: {1} in {2}.Event_LogonEvent()", Err.Number, Err.Description, OBJECT_NAME)) @@ -1258,7 +1317,7 @@ Public Sub Event_UserJoins(ByVal Username As String, ByVal Flags As Long, ByVal g_Channel.Users.Add UserObj Else - frmChat.AddChat RTBColors.ErrorMessageText, "Warning: We have received a join event for a user that we had thought was " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Warning! We have received a join event for a user that we had thought was " & _ "already present within the channel. This may be indicative of a server split or other technical difficulty." Exit Sub @@ -1480,7 +1539,7 @@ Public Sub Event_UserLeaves(ByVal Username As String, ByVal Flags As Long) g_Channel.Users.Remove UserIndex Else - frmChat.AddChat RTBColors.ErrorMessageText, "Warning: We have received a leave event for a user that we didn't know " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Warning! We have received a leave event for a user that we didn't know " & _ "was in the channel. This may be indicative of a server split or other technical difficulty." Exit Sub diff --git a/trunk/modOtherCode.bas b/trunk/modOtherCode.bas index be25011f..07998552 100644 --- a/trunk/modOtherCode.bas +++ b/trunk/modOtherCode.bas @@ -1914,7 +1914,7 @@ Public Sub UnbanBanlistUser(ByVal sUser As String, ByVal cOperator As String) If (iterations > 9000) Then If (MDebug("debug")) Then - frmChat.AddChat RTBColors.ErrorMessageText, "Warning: Loop size limit exceeded " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Warning! Loop size limit exceeded " & _ "in UnbanBanlistUser()!" frmChat.AddChat RTBColors.ErrorMessageText, "The banned-user list has been reset.. " & _ "hope it works!" diff --git a/trunk/modParsing.bas b/trunk/modParsing.bas index 487bad1d..04300d48 100644 --- a/trunk/modParsing.bas +++ b/trunk/modParsing.bas @@ -657,7 +657,7 @@ Public Function Conv(ByVal RawString As String) As Long If Len(RawString) = 4 Then Call CopyMemory(lReturn, ByVal RawString, 4) Else - Debug.Print "---------- WARNING: Invalid string Length in Conv()!" + Debug.Print "---------- WARNING! Invalid string Length in Conv()!" Debug.Print "---------- Length: " & Len(RawString) Debug.Print DebugOutput(RawString) End If diff --git a/trunk/modScripting.bas b/trunk/modScripting.bas index e31e2e22..252be959 100644 --- a/trunk/modScripting.bas +++ b/trunk/modScripting.bas @@ -243,7 +243,7 @@ Private Function FileToModule(ByRef ScriptModule As Module, ByVal FilePath As St ' check if file exists to include If LenB(Dir$(strFullPath)) = 0 Then - frmChat.AddChat RTBColors.ErrorMessageText, "Scripting warning: " & Dir$(FilePath) & " is trying to include " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Scripting warning! " & Dir$(FilePath) & " is trying to include " & _ "a file that does not exist: " & strPath blnIncIsValid = False End If @@ -251,7 +251,7 @@ Private Function FileToModule(ByRef ScriptModule As Module, ByVal FilePath As St ' check if file is already included by this script For i = 1 To includes.Count If StrComp(includes(i), strFullPath, vbTextCompare) = 0 Then - frmChat.AddChat RTBColors.ErrorMessageText, "Scripting warning: " & Dir$(FilePath) & " is trying to include " & _ + frmChat.AddChat RTBColors.ErrorMessageText, "Scripting warning! " & Dir$(FilePath) & " is trying to include " & _ "a file that has already been included: " & strPath blnIncIsValid = False End If