From f6c7f240b000f40aa217baa2f74b54911bf2468e Mon Sep 17 00:00:00 2001 From: MisterVector Date: Sun, 6 May 2018 10:06:35 -0700 Subject: [PATCH 1/2] Implement the ability to rename a profile There was already skeleton code in the launcher to rename a profile but there was no button or actual logic to do so. A new form has been created to assist in renaming a profile --- trunk/Launcher/Launcher.vbp | 1 + trunk/Launcher/frmLauncher.frm | 82 +++++++++------- trunk/Launcher/frmRenameProfile.frm | 143 ++++++++++++++++++++++++++++ 3 files changed, 191 insertions(+), 35 deletions(-) create mode 100644 trunk/Launcher/frmRenameProfile.frm diff --git a/trunk/Launcher/Launcher.vbp b/trunk/Launcher/Launcher.vbp index ee27878a..6d452d1e 100644 --- a/trunk/Launcher/Launcher.vbp +++ b/trunk/Launcher/Launcher.vbp @@ -11,6 +11,7 @@ Class=clsConfig; clsConfig.cls Module=modURLDetection; modURLDetection.bas Form=frmConfig.frm Form=frmStatus.frm +Form=frmRenameProfile.frm IconForm="frmLauncher" Startup="frmLauncher" HelpFile="" diff --git a/trunk/Launcher/frmLauncher.frm b/trunk/Launcher/frmLauncher.frm index 10cf3500..ab90ea4d 100644 --- a/trunk/Launcher/frmLauncher.frm +++ b/trunk/Launcher/frmLauncher.frm @@ -1,13 +1,13 @@ VERSION 5.00 -Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" +Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" Begin VB.Form frmLauncher BackColor = &H00000000& BorderStyle = 1 'Fixed Single Caption = "StealthBot Launcher v0.0.000" - ClientHeight = 5205 + ClientHeight = 5475 ClientLeft = 150 ClientTop = 435 - ClientWidth = 3600 + ClientWidth = 3570 BeginProperty Font Name = "Tahoma" Size = 8.25 @@ -21,37 +21,45 @@ Begin VB.Form frmLauncher LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False - ScaleHeight = 347 + ScaleHeight = 365 ScaleMode = 3 'Pixel - ScaleWidth = 240 + ScaleWidth = 238 StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdRenameProfile + Caption = "R&ename Profile" + Height = 255 + Left = 240 + TabIndex = 1 + Top = 3240 + Width = 1575 + End Begin VB.CheckBox chkAutoClose BackColor = &H00000000& Caption = "&Automatically close this launcher after loading the profile" ForeColor = &H00FFFFFF& Height = 495 Left = 240 - TabIndex = 4 + TabIndex = 5 ToolTipText = "Leaving the launcher open will allow you to create and launch additional profiles." - Top = 4080 + Top = 4320 Width = 3135 End Begin VB.CommandButton cmdRemoveProfile Caption = "&Remove Profile" Enabled = 0 'False Height = 240 - Left = 1920 + Left = 1800 TabIndex = 2 Top = 3240 - Width = 1455 + Width = 1575 End Begin VB.CommandButton cmdCreateProfile Caption = "&Create Profile" Height = 240 Left = 240 - TabIndex = 1 - Top = 3240 - Width = 1695 + TabIndex = 3 + Top = 3480 + Width = 3135 End Begin VB.CommandButton cmdLaunchThis Caption = "&Launch Selected Profile" @@ -68,8 +76,8 @@ Begin VB.Form frmLauncher EndProperty Height = 360 Left = 240 - TabIndex = 5 - Top = 4680 + TabIndex = 6 + Top = 4920 Width = 3135 End Begin VB.CommandButton cmdCreateShortcut @@ -77,8 +85,8 @@ Begin VB.Form frmLauncher Enabled = 0 'False Height = 360 Left = 240 - TabIndex = 3 - Top = 3600 + TabIndex = 4 + Top = 3840 Width = 1695 End Begin MSComctlLib.ListView lstProfiles @@ -113,8 +121,8 @@ Begin VB.Form frmLauncher ForeColor = &H00FFFFFF& Height = 465 Left = 2040 - TabIndex = 7 - Top = 3600 + TabIndex = 8 + Top = 3840 Width = 1335 WordWrap = -1 'True End @@ -126,7 +134,7 @@ Begin VB.Form frmLauncher ForeColor = &H00FFFFFF& Height = 195 Left = 240 - TabIndex = 6 + TabIndex = 7 Top = 120 Width = 2955 End @@ -237,6 +245,7 @@ On Error GoTo ERROR_HANDLER 'UnHookAllProcs Unload frmNameDialog + Unload frmRenameProfile 'Unload frmConfig 'Unload frmstatus @@ -378,26 +387,14 @@ ERROR_HANDLER: ErrorHandler Err.Number, OBJECT_NAME, "cmdLaunchThis_Click" End Sub -Private Sub mnuRenameProfile_Click() -On Error GoTo ERROR_HANDLER - - If (Not lstProfiles.SelectedItem Is Nothing) Then - ' TODO: impl rename profile (Name currfoldername As newname) - ' use name dialog? - End If - - Exit Sub -ERROR_HANDLER: - ErrorHandler Err.Number, OBJECT_NAME, "mnuRenameProfile_Click" -End Sub - -' TODO: this function has no button! change UI to include rename button? Private Sub cmdRenameProfile_Click() On Error GoTo ERROR_HANDLER If (Not lstProfiles.SelectedItem Is Nothing) Then - ' TODO: impl rename profile (Name currfoldername As newname) - ' use name dialog? + If (modLauncher.ProfileExists(lstProfiles.SelectedItem.Text)) Then + frmRenameProfile.Show + frmRenameProfile.setOriginalProfile lstProfiles.SelectedItem.Text, lstProfiles.SelectedItem.Index + End If End If Exit Sub @@ -586,3 +583,18 @@ On Error GoTo ERROR_HANDLER ERROR_HANDLER: ErrorHandler Err.Number, OBJECT_NAME, "chkAutoClose_Click" End Sub + +Public Sub renameProfileInList(ByVal newName As String, ByVal Index As Integer) +On Error GoTo ERROR_HANDLER: + Dim Item As ListItem + + Set Item = lstProfiles.ListItems.Item(Index) + + If (Not Item Is Nothing) Then + Item.Text = newName + End If + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "renameProfileInList" +End Sub diff --git a/trunk/Launcher/frmRenameProfile.frm b/trunk/Launcher/frmRenameProfile.frm new file mode 100644 index 00000000..3f8442bf --- /dev/null +++ b/trunk/Launcher/frmRenameProfile.frm @@ -0,0 +1,143 @@ +VERSION 5.00 +Begin VB.Form frmRenameProfile + BackColor = &H00000000& + BorderStyle = 1 'Fixed Single + Caption = "Rename Profile" + ClientHeight = 1050 + ClientLeft = 45 + ClientTop = 375 + ClientWidth = 6975 + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 1050 + ScaleWidth = 6975 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton cmdCancel + Caption = "&Cancel" + Height = 255 + Left = 4200 + TabIndex = 3 + Top = 600 + Width = 1335 + End + Begin VB.CommandButton cmdOk + Caption = "&Ok" + Height = 255 + Left = 5520 + TabIndex = 2 + Top = 600 + Width = 1335 + End + Begin VB.TextBox txtName + BackColor = &H00993300& + ForeColor = &H00FFFFFF& + Height = 285 + Left = 120 + TabIndex = 1 + Top = 600 + Width = 3825 + End + Begin VB.Line Line1 + BorderColor = &H00FFFFFF& + X1 = 120 + X2 = 6840 + Y1 = 480 + Y2 = 480 + End + Begin VB.Label Label1 + BackColor = &H00000000& + Caption = "Enter the name you want to rename the profile to." + ForeColor = &H00FFFFFF& + Height = 255 + Left = 120 + TabIndex = 0 + Top = 120 + Width = 3615 + End +End +Attribute VB_Name = "frmRenameProfile" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Const OBJECT_NAME = "frmRenameProfile" + +Private previousProfileName As String +Private previousProfileIndex As String + +Private Sub Form_Load() +On Error GoTo ERROR_HANDLER: + + Me.Icon = frmLauncher.Icon + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "Form_Load" +End Sub + +Private Sub cmdCancel_Click() +On Error GoTo ERROR_HANDLER: + + Unload Me + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "cmdCancel_Click" +End Sub + +Private Sub cmdOk_Click() +On Error GoTo ERROR_HANDLER: + + Dim i As Integer + Dim Text As String + Dim Char As String * 1 + Dim originalPath As String + Dim destinationPath As String + + Text = txtName.Text + + If (LenB(Text) = 0) Then + MsgBox "You must enter a profile name!", vbExclamation + Exit Sub + End If + + For i = 1 To Len(INVALID_CHARS) + Char = Mid$(INVALID_CHARS, i, 1) + If (InStr(1, Text, Char, vbBinaryCompare) > 0) Then + MsgBox "Invalid character in profile name: " & Char, vbExclamation + Exit Sub + End If + Next i + + If (ProfileExists(Text)) Then + MsgBox "That profile already exists!" + Exit Sub + End If + + originalPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), previousProfileName) + destinationPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), Text) + + If (CopyFolder(originalPath, destinationPath)) Then + KillFolder originalPath + frmLauncher.renameProfileInList Text, previousProfileIndex + End If + + Unload Me + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "cmdOk_Click" +End Sub + +Public Sub setOriginalProfile(ByVal profileName As String, ByVal profileIndex As Integer) +On Error GoTo ERROR_HANDLER: + + previousProfileName = profileName + previousProfileIndex = profileIndex + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "setOriginalProfile" +End Sub + From bb21c756cfc9b7e17ee162f659f14fe5f66714a3 Mon Sep 17 00:00:00 2001 From: MisterVector Date: Tue, 8 May 2018 08:53:43 -0700 Subject: [PATCH 2/2] Fix overlapping buttons and re-use frmNameDialog for renaming a profile --- trunk/Launcher/Launcher.vbp | 1 - trunk/Launcher/frmLauncher.frm | 11 ++- trunk/Launcher/frmNameDialog.frm | 61 ++++++++++-- trunk/Launcher/frmRenameProfile.frm | 143 ---------------------------- trunk/Launcher/modLauncher.bas | 5 + 5 files changed, 63 insertions(+), 158 deletions(-) delete mode 100644 trunk/Launcher/frmRenameProfile.frm diff --git a/trunk/Launcher/Launcher.vbp b/trunk/Launcher/Launcher.vbp index 6d452d1e..ee27878a 100644 --- a/trunk/Launcher/Launcher.vbp +++ b/trunk/Launcher/Launcher.vbp @@ -11,7 +11,6 @@ Class=clsConfig; clsConfig.cls Module=modURLDetection; modURLDetection.bas Form=frmConfig.frm Form=frmStatus.frm -Form=frmRenameProfile.frm IconForm="frmLauncher" Startup="frmLauncher" HelpFile="" diff --git a/trunk/Launcher/frmLauncher.frm b/trunk/Launcher/frmLauncher.frm index ab90ea4d..95289984 100644 --- a/trunk/Launcher/frmLauncher.frm +++ b/trunk/Launcher/frmLauncher.frm @@ -47,7 +47,7 @@ Begin VB.Form frmLauncher Begin VB.CommandButton cmdRemoveProfile Caption = "&Remove Profile" Enabled = 0 'False - Height = 240 + Height = 255 Left = 1800 TabIndex = 2 Top = 3240 @@ -58,7 +58,7 @@ Begin VB.Form frmLauncher Height = 240 Left = 240 TabIndex = 3 - Top = 3480 + Top = 3510 Width = 3135 End Begin VB.CommandButton cmdLaunchThis @@ -245,7 +245,6 @@ On Error GoTo ERROR_HANDLER 'UnHookAllProcs Unload frmNameDialog - Unload frmRenameProfile 'Unload frmConfig 'Unload frmstatus @@ -311,6 +310,7 @@ Private Sub cmdCreateProfile_Click() On Error GoTo ERROR_HANDLER Load frmNameDialog frmNameDialog.Show + frmNameDialog.setWindowData "Create Profile", "Enter the name of the new profile below.", ProfileOption.CREATE_PROFILE Exit Sub ERROR_HANDLER: @@ -392,8 +392,9 @@ On Error GoTo ERROR_HANDLER If (Not lstProfiles.SelectedItem Is Nothing) Then If (modLauncher.ProfileExists(lstProfiles.SelectedItem.Text)) Then - frmRenameProfile.Show - frmRenameProfile.setOriginalProfile lstProfiles.SelectedItem.Text, lstProfiles.SelectedItem.Index + frmNameDialog.Show + frmNameDialog.setWindowData "Rename Profile", "Enter the name you want to rename the profile to.", ProfileOption.RENAME_PROFILE + frmNameDialog.setOldProfileInfo lstProfiles.SelectedItem.Text, lstProfiles.SelectedItem.Index End If End If diff --git a/trunk/Launcher/frmNameDialog.frm b/trunk/Launcher/frmNameDialog.frm index 3aaa9bdf..51c912c5 100644 --- a/trunk/Launcher/frmNameDialog.frm +++ b/trunk/Launcher/frmNameDialog.frm @@ -2,7 +2,7 @@ VERSION 5.00 Begin VB.Form frmNameDialog BackColor = &H00000000& BorderStyle = 1 'Fixed Single - Caption = "Create Profile" + Caption = "Window Title" ClientHeight = 1095 ClientLeft = 105 ClientTop = 495 @@ -72,7 +72,7 @@ Begin VB.Form frmNameDialog AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent - Caption = "Enter the name of the new profile below." + Caption = "[message]" BeginProperty Font Name = "Tahoma" Size = 8.25 @@ -87,7 +87,7 @@ Begin VB.Form frmNameDialog Left = 120 TabIndex = 3 Top = 120 - Width = 2955 + Width = 6255 End Begin VB.Line line BorderColor = &H00FFFFFF& @@ -108,6 +108,10 @@ Option Explicit Private Const OBJECT_NAME As String = "frmNameDialog" Private Const INVALID_CHARS As String = "\/*?"":<>|" +Private m_profileOption As ProfileOption +Private previousProfileName As String +Private previousProfileIndex As Integer + Private Sub Form_Load() On Error GoTo ERROR_HANDLER txtName.Text = vbNullString @@ -118,11 +122,13 @@ ERROR_HANDLER: ErrorHandler Err.Number, OBJECT_NAME, "Form_Load" End Sub -Private Sub cmdOK_Click() +Private Sub cmdOk_Click() On Error GoTo ERROR_HANDLER Dim i As Integer Dim Text As String Dim Char As String * 1 + Dim originalPath As String + Dim destinationPath As String Text = txtName.Text @@ -139,11 +145,27 @@ On Error GoTo ERROR_HANDLER End If Next i - If (CreateProfile(Text)) Then - frmLauncher.ListProfile Text - Else - 'MsgBox "Failed to create profile!" - End If + Select Case m_profileOption + Case CREATE_PROFILE + If (CreateProfile(Text)) Then + frmLauncher.ListProfile Text + Else + 'MsgBox "Failed to create profile!" + End If + Case RENAME_PROFILE + If (ProfileExists(Text)) Then + MsgBox "That profile already exists!" + Exit Sub + End If + + originalPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), previousProfileName) + destinationPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), Text) + + If (CopyFolder(originalPath, destinationPath)) Then + KillFolder originalPath + frmLauncher.renameProfileInList Text, previousProfileIndex + End If + End Select Unload Me @@ -162,3 +184,24 @@ On Error GoTo ERROR_HANDLER ERROR_HANDLER: ErrorHandler Err.Number, OBJECT_NAME, "cmdCancel_Click" End Sub + +Public Sub setWindowData(ByVal title As String, ByVal message As String, ByVal po As ProfileOption) +On Error GoTo ERROR_HANDLER + Me.Caption = title + lblText.Caption = message + m_profileOption = po + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "setWindowData" +End Sub + +Public Sub setOldProfileInfo(ByVal profileName As String, ByVal profileIndex As Integer) +On Error GoTo ERROR_HANDLER + previousProfileName = profileName + previousProfileIndex = profileIndex + + Exit Sub +ERROR_HANDLER: + ErrorHandler Err.Number, OBJECT_NAME, "setOldProfileInfo" +End Sub diff --git a/trunk/Launcher/frmRenameProfile.frm b/trunk/Launcher/frmRenameProfile.frm deleted file mode 100644 index 3f8442bf..00000000 --- a/trunk/Launcher/frmRenameProfile.frm +++ /dev/null @@ -1,143 +0,0 @@ -VERSION 5.00 -Begin VB.Form frmRenameProfile - BackColor = &H00000000& - BorderStyle = 1 'Fixed Single - Caption = "Rename Profile" - ClientHeight = 1050 - ClientLeft = 45 - ClientTop = 375 - ClientWidth = 6975 - LinkTopic = "Form1" - MaxButton = 0 'False - MinButton = 0 'False - ScaleHeight = 1050 - ScaleWidth = 6975 - StartUpPosition = 3 'Windows Default - Begin VB.CommandButton cmdCancel - Caption = "&Cancel" - Height = 255 - Left = 4200 - TabIndex = 3 - Top = 600 - Width = 1335 - End - Begin VB.CommandButton cmdOk - Caption = "&Ok" - Height = 255 - Left = 5520 - TabIndex = 2 - Top = 600 - Width = 1335 - End - Begin VB.TextBox txtName - BackColor = &H00993300& - ForeColor = &H00FFFFFF& - Height = 285 - Left = 120 - TabIndex = 1 - Top = 600 - Width = 3825 - End - Begin VB.Line Line1 - BorderColor = &H00FFFFFF& - X1 = 120 - X2 = 6840 - Y1 = 480 - Y2 = 480 - End - Begin VB.Label Label1 - BackColor = &H00000000& - Caption = "Enter the name you want to rename the profile to." - ForeColor = &H00FFFFFF& - Height = 255 - Left = 120 - TabIndex = 0 - Top = 120 - Width = 3615 - End -End -Attribute VB_Name = "frmRenameProfile" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -Private Const OBJECT_NAME = "frmRenameProfile" - -Private previousProfileName As String -Private previousProfileIndex As String - -Private Sub Form_Load() -On Error GoTo ERROR_HANDLER: - - Me.Icon = frmLauncher.Icon - - Exit Sub -ERROR_HANDLER: - ErrorHandler Err.Number, OBJECT_NAME, "Form_Load" -End Sub - -Private Sub cmdCancel_Click() -On Error GoTo ERROR_HANDLER: - - Unload Me - - Exit Sub -ERROR_HANDLER: - ErrorHandler Err.Number, OBJECT_NAME, "cmdCancel_Click" -End Sub - -Private Sub cmdOk_Click() -On Error GoTo ERROR_HANDLER: - - Dim i As Integer - Dim Text As String - Dim Char As String * 1 - Dim originalPath As String - Dim destinationPath As String - - Text = txtName.Text - - If (LenB(Text) = 0) Then - MsgBox "You must enter a profile name!", vbExclamation - Exit Sub - End If - - For i = 1 To Len(INVALID_CHARS) - Char = Mid$(INVALID_CHARS, i, 1) - If (InStr(1, Text, Char, vbBinaryCompare) > 0) Then - MsgBox "Invalid character in profile name: " & Char, vbExclamation - Exit Sub - End If - Next i - - If (ProfileExists(Text)) Then - MsgBox "That profile already exists!" - Exit Sub - End If - - originalPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), previousProfileName) - destinationPath = StringFormat("{0}\StealthBot\{1}", ReplaceEnvironmentVars("%APPDATA%"), Text) - - If (CopyFolder(originalPath, destinationPath)) Then - KillFolder originalPath - frmLauncher.renameProfileInList Text, previousProfileIndex - End If - - Unload Me - - Exit Sub -ERROR_HANDLER: - ErrorHandler Err.Number, OBJECT_NAME, "cmdOk_Click" -End Sub - -Public Sub setOriginalProfile(ByVal profileName As String, ByVal profileIndex As Integer) -On Error GoTo ERROR_HANDLER: - - previousProfileName = profileName - previousProfileIndex = profileIndex - - Exit Sub -ERROR_HANDLER: - ErrorHandler Err.Number, OBJECT_NAME, "setOriginalProfile" -End Sub - diff --git a/trunk/Launcher/modLauncher.bas b/trunk/Launcher/modLauncher.bas index 4e9c3327..ef05ab89 100644 --- a/trunk/Launcher/modLauncher.bas +++ b/trunk/Launcher/modLauncher.bas @@ -42,6 +42,11 @@ Private Const SW_SHOW As Long = 5 Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long +Public Enum ProfileOption + RENAME_PROFILE + CREATE_PROFILE +End Enum + Private xml_doc As DOMDocument60 Private CommandLine As String Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long