├── .gitattributes ├── Classes ├── OmlDatabase.cls └── OmlSQLBuilder.cls ├── Modules ├── OmeColourCodes.bas ├── OmeHash.bas ├── OmeVariable.bas └── modVBAdmin.bas ├── README.md ├── Resources ├── Font │ ├── Font Awesome 5 Brands-Regular-400.otf │ ├── Font Awesome 5 Free-Regular-400.otf │ ├── Font Awesome 5 Free-Solid-900.otf │ └── Font Awesome 5.txt └── Icon │ ├── appicon.res │ └── hand.ico ├── Screenshots ├── VBAdmin-Carbon.png ├── VBAdmin-Login.png ├── VBAdmin-Update-Salt-Password.png ├── VBAdmin-User-Details.png └── VBAdmin-Users.png ├── Storage └── Data.mdb ├── VBAdmin.png ├── VBAdmin.vbp ├── VBAdmin.vbw ├── frmDashboard.frm ├── frmHelp.frm ├── frmLogin.frm ├── frmTemplate.frm ├── frmUserDetails.frm ├── frmUserUpdateSaltPassword.frm └── frmUsers.frm /.gitattributes: -------------------------------------------------------------------------------- 1 | *.frm linguist-language=vb6 2 | *.bas linguist-language=vb6 3 | *.vbp linguist-language=vb6 4 | *.vbp linguist-detectable=true 5 | -------------------------------------------------------------------------------- /Classes/OmlDatabase.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "OmlDatabase" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | '************************************************************************** 17 | ' Library Name: Omelette Database Class (OmlDatabase) 18 | '************************************************************************** 19 | ' Version: 1.1.0.0 20 | ' Created on: 01 Feb 2018 21 | ' Updated on: 24 Jan 2019 22 | ' Created by: Aeric Poon Yip Hoon 23 | ' Description: A high level API written for MS Visual Basic 6.0 24 | '************************************************************************** 25 | ' 26 | '************************************************************************** 27 | ' Disclaimer 28 | '************************************************************************** 29 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 30 | ' You are free to use this code within your own applications, but you are ' 31 | ' expressly forbidden from selling or otherwise distributing this source ' 32 | ' code without prior written consent. ' 33 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 34 | ' References: 35 | ' Microsoft ActiveX Data Objects 6.1 Library 36 | ' C:\Program Files (x86)\Common Files\System\ado\msado15.dll 37 | ' Can use older version such as 2.8 38 | ' Recommend to install VB6SP6 for latest version of libraries 39 | ' 40 | '************************************************************************** 41 | ' Global Constants 42 | '************************************************************************** 43 | Option Explicit 44 | Private mstrErrorDesc As String 45 | Private mstrConnectionString As String 46 | Private mstrProvider As String 47 | Private mstrDataPath As String 48 | Private mstrDataFile As String 49 | Private mstrDataSource As String 50 | Private mstrDataPassword As String 51 | Private mconADODB As ADODB.Connection 52 | 53 | Public Property Let ErrorDesc(ByVal strErrorDesc As String) 54 | mstrErrorDesc = strErrorDesc 55 | End Property 56 | Public Property Get ErrorDesc() As String 57 | ErrorDesc = mstrErrorDesc 58 | End Property 59 | 60 | Public Property Let ConnectionString(ByVal strConStr As String) 61 | mstrConnectionString = strConStr 62 | End Property 63 | Public Property Get ConnectionString() As String 64 | ConnectionString = mstrConnectionString 65 | End Property 66 | 67 | Public Property Let Provider(ByVal strProvider As String) 68 | mstrProvider = strProvider 69 | End Property 70 | Public Property Get Provider() As String 71 | Provider = mstrProvider 72 | End Property 73 | 74 | Public Property Let DataPath(ByVal strDataPath As String) 75 | mstrDataPath = strDataPath 76 | End Property 77 | Public Property Get DataPath() As String 78 | DataPath = mstrDataPath 79 | End Property 80 | 81 | Public Property Let DataFile(ByVal strDataFile As String) 82 | mstrDataFile = strDataFile 83 | End Property 84 | Public Property Get DataFile() As String 85 | DataFile = mstrDataFile 86 | End Property 87 | 88 | Public Property Let DataSource(ByVal strDataSource As String) 89 | mstrDataSource = strDataSource 90 | End Property 91 | Public Property Get DataSource() As String 92 | DataSource = mstrDataSource 93 | End Property 94 | 95 | Public Property Let DataPassword(ByVal strDataPassword As String) 96 | mstrDataPassword = strDataPassword 97 | End Property 98 | Public Property Get DataPassword() As String 99 | DataPassword = mstrDataPassword 100 | End Property 101 | 102 | Public Property Let Connection(ByVal conADODB As ADODB.Connection) 103 | mconADODB = conADODB 104 | End Property 105 | Public Property Get Connection() As ADODB.Connection 106 | Connection = mconADODB 107 | End Property 108 | 109 | Private Sub Class_Initialize() 110 | Provider = "Microsoft.Jet.OLEDB.4.0" 111 | 'DataSource = DataPath & DataFile ' & "\" & mstrDataFile 112 | 'ConnectionString = "Data Source=" & DataSource 113 | 'DataPassword = "" 114 | End Sub 115 | 116 | Public Sub OpenMdb() 117 | On Error GoTo Catch 118 | Try: ' Optional 119 | Set mconADODB = New ADODB.Connection 120 | DataSource = DataPath & DataFile ' & "\" & mstrDataFile 121 | ConnectionString = "Data Source=" & DataSource 122 | With mconADODB 123 | .Provider = mstrProvider 124 | .ConnectionString = mstrConnectionString 125 | .Properties("Jet OLEDB:Database Password") = mstrDataPassword 126 | .Open 127 | End With 128 | Exit Sub 129 | Catch: 130 | ErrorDesc = Err.Description 131 | End Sub 132 | 133 | Public Sub CloseMdb() 134 | On Error GoTo Catch 135 | Try: 136 | If mconADODB Is Nothing Then 137 | ' No action 138 | Else 139 | With mconADODB 140 | If .State = adStateOpen Then 141 | .Close 142 | End If 143 | End With 144 | Set mconADODB = Nothing 145 | End If 146 | Exit Sub 147 | Catch: 148 | ErrorDesc = Err.Description 149 | End Sub 150 | 151 | Public Sub Execute(ByVal strSQL As String, Optional ByRef lngRecordsAffected As Long) 152 | On Error GoTo Catch 153 | Try: ' Optional 154 | With mconADODB 155 | .BeginTrans 156 | .Execute strSQL, lngRecordsAffected 157 | .CommitTrans 158 | End With 159 | Exit Sub 160 | Catch: 161 | ErrorDesc = Err.Description 162 | On Error Resume Next 163 | If Not mconADODB Is Nothing Then 164 | mconADODB.RollbackTrans 165 | End If 166 | 'ErrorDesc = ErrorDesc & vbCrLf & "SQL: " & strSQL 167 | End Sub 168 | 169 | ' Created on 19 Jan 2019 170 | ' Not yet tested 171 | Public Sub Execute2(ByVal strSQL As String, ByRef ParamName() As String, ByRef ParamValue() As String, Optional ByRef lngRecordsAffected As Long) 172 | On Error GoTo Catch 173 | 'Dim cmd As ADODB.Command 174 | 'Set cmd = New ADODB.Command 175 | Dim cmd As New ADODB.Command 176 | 'Dim prm As ADODB.Parameter 177 | 'Set prm = New ADODB.Parameter 178 | Dim prm As New ADODB.Parameter 179 | Dim i As Integer 180 | Try: ' Optional 181 | With mconADODB 182 | .BeginTrans 183 | '.Execute strSQL, lngRecordsAffected 184 | With cmd 185 | .ActiveConnection = mconADODB 186 | .CommandType = adCmdText 187 | .CommandText = strSQL 188 | .Prepared = True 189 | 'Dim prm As New ADODB.Parameter 190 | For i = 0 To UBound(ParamName) 191 | With prm 192 | '.Type = adEmpty 193 | '.Direction = adParamInput 194 | 'If ParamLength(i) > 0 Then .Size = ParamLength(i) 195 | .Name = ParamName(i) 196 | .Value = ParamValue(i) 197 | End With 198 | '.Parameters(i) = prm 199 | 'prm = .CreateParameter(ParamName(i), adEmpty, adParamInput, ADO_LONGPTR, ParamValue(i)) 200 | .Parameters.Append prm 201 | Next 202 | '.Execute lngRecordsAffected, prm 203 | .Execute lngRecordsAffected 204 | End With 205 | .CommitTrans 206 | End With 207 | Exit Sub 208 | Catch: 209 | ErrorDesc = Err.Description 210 | On Error Resume Next 211 | If Not mconADODB Is Nothing Then 212 | mconADODB.RollbackTrans 213 | End If 214 | 'ErrorDesc = ErrorDesc & vbCrLf & "SQL: " & strSQL 215 | End Sub 216 | 217 | Public Function OpenRs(ByVal strSQL As String) As ADODB.Recordset 218 | Dim rst As New ADODB.Recordset 219 | On Error GoTo Catch 220 | Try: 221 | rst.Open strSQL, mconADODB, adOpenStatic, adLockPessimistic, adCmdText 222 | Set OpenRs = rst 223 | Exit Function 224 | Catch: 225 | ErrorDesc = Err.Description & vbCrLf & "SQL: " & strSQL 226 | End Function 227 | 228 | Public Sub CloseRs(ByVal rst As ADODB.Recordset) 229 | On Error GoTo Catch 230 | Try: 231 | If rst Is Nothing Then 232 | Else 233 | If rst.State = adStateOpen Then 234 | rst.Close 235 | End If 236 | Set rst = Nothing 237 | End If 238 | Exit Sub 239 | Catch: 240 | ErrorDesc = Err.Description 241 | End Sub 242 | -------------------------------------------------------------------------------- /Classes/OmlSQLBuilder.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "OmlSQLBuilder" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | '************************************************************************** 15 | ' Library Name: Omelette SQL Builder Class (OmlSQLBuilder) 16 | '************************************************************************** 17 | ' Version: 1.0.0.0 18 | ' Created on: 19 Jan 2019 19 | ' Updated on: 24 Jan 2019 20 | ' Created by: Aeric Poon Yip Hoon 21 | ' Description: A way to simplify SQL query written for MS Visual Basic 6.0 22 | ' This class replaced modSQLQuery which uses gstrSQL 23 | '************************************************************************** 24 | ' 25 | '************************************************************************** 26 | ' Disclaimer 27 | '************************************************************************** 28 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 29 | ' You are free to use this code within your own applications, but you are ' 30 | ' expressly forbidden from selling or otherwise distributing this source ' 31 | ' code without prior written consent. ' 32 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 33 | ' References: 34 | ' No dependencies 35 | ' 36 | '************************************************************************** 37 | ' Global Constants 38 | '************************************************************************** 39 | Option Explicit 40 | Private mstrError As String 41 | Private mstrText As String 42 | 43 | Public Property Let Error(ByVal strError As String) 44 | mstrError = strError 45 | End Property 46 | Public Property Get Error() As String 47 | Error = mstrError 48 | End Property 49 | 50 | Public Property Let Text(ByVal strText As String) 51 | mstrText = strText 52 | End Property 53 | Public Property Get Text() As String 54 | Text = mstrText 55 | End Property 56 | 57 | Private Sub Class_Initialize() 58 | mstrText = "" 59 | End Sub 60 | 61 | ' Set a Text value for Update 62 | Public Sub UTX(strField As String, strText As String, Optional blnEndComma As Boolean = True) 63 | mstrText = mstrText & " " & strField & " = '" & strText & "'" 64 | If blnEndComma = True Then 65 | mstrText = mstrText & "," 66 | End If 67 | End Sub 68 | 69 | ' Set a Double value for Update 70 | Public Sub UDB(strField As String, dblNumber As Double, Optional blnEndComma As Boolean = True) 71 | mstrText = mstrText & " " & strField & " = " & dblNumber 72 | If blnEndComma = True Then 73 | mstrText = mstrText & "," 74 | End If 75 | End Sub 76 | 77 | ' Set a Long value for Update 78 | Public Sub ULN(strField As String, lngNumber As Long, Optional blnEndComma As Boolean = True) 79 | mstrText = mstrText & " " & strField & " = " & lngNumber 80 | If blnEndComma = True Then 81 | mstrText = mstrText & "," 82 | End If 83 | End Sub 84 | 85 | ' Set a Boolean value for Update 86 | Public Sub UBL(strField As String, blnValue As Boolean, Optional blnEndComma As Boolean = True) 87 | mstrText = mstrText & " " & strField 88 | If blnValue Then 89 | mstrText = mstrText & " = TRUE" 90 | Else 91 | mstrText = mstrText & " = FALSE" 92 | End If 93 | If blnEndComma = True Then 94 | mstrText = mstrText & "," 95 | End If 96 | End Sub 97 | ' Set a YesNo value for Update 98 | Public Sub UYN(strField As String, blnValue As Boolean, Optional blnEndComma As Boolean = True) 99 | mstrText = mstrText & " " & strField 100 | If blnValue Then 101 | mstrText = mstrText & " = Yes" 102 | Else 103 | mstrText = mstrText & " = No" 104 | End If 105 | If blnEndComma = True Then 106 | mstrText = mstrText & "," 107 | End If 108 | End Sub 109 | 110 | ' Set a DateTime value for Update 111 | Public Sub UDT(strField As String, strDateTime As String, Optional blnEndComma As Boolean = True) 112 | mstrText = mstrText & " " & strField & " = #" & strDateTime & "#" 113 | If blnEndComma = True Then 114 | mstrText = mstrText & "," 115 | End If 116 | End Sub 117 | 118 | ''' Append text to SQL statement string 119 | Public Sub SQL(strText As String, Optional blnEndComma As Boolean = True, Optional blnBeginSpace As Boolean = True) 120 | If blnBeginSpace = True Then 121 | mstrText = mstrText & " " 122 | End If 123 | mstrText = mstrText & strText 124 | If blnEndComma = True Then 125 | mstrText = mstrText & "," 126 | End If 127 | End Sub 128 | 129 | ''' Open Bracket when building INSERT statement 130 | ''' blnSpaceAfter is adding a blankspace after open bracket "( " 131 | Public Sub SQL_Open_Bracket(strText As String, Optional blnEndComma As Boolean = True, Optional blnSpaceAfter As Boolean = False) 132 | mstrText = mstrText & "(" 133 | If blnSpaceAfter = True Then 134 | mstrText = mstrText & " " 135 | End If 136 | mstrText = mstrText & strText 137 | If blnEndComma = True Then 138 | mstrText = mstrText & "," 139 | End If 140 | End Sub 141 | Public Sub SOB(strText As String, Optional blnEndComma As Boolean = True, Optional blnSpaceAfter As Boolean = False) 142 | SQL_Open_Bracket strText, blnEndComma, blnSpaceAfter 143 | End Sub 144 | 145 | ''' Close Bracket when building INSERT statement 146 | ''' blnSpaceBefore is adding a blankspace before close bracket " )" 147 | Public Sub SQL_Close_Bracket(strText As String, Optional blnEndComma As Boolean = False, Optional blnSpaceBefore As Boolean = False) 148 | If blnSpaceBefore = True Then 149 | mstrText = mstrText & " " 150 | End If 151 | mstrText = mstrText & strText 152 | If blnEndComma = True Then 153 | mstrText = mstrText & "," 154 | End If 155 | mstrText = mstrText & ")" 156 | End Sub 157 | Public Sub SCB(strText As String, Optional blnEndComma As Boolean = False, Optional blnSpaceBefore As Boolean = False) 158 | SQL_Close_Bracket strText, blnEndComma, blnSpaceBefore 159 | End Sub 160 | 161 | ''' Single Field inside Brackets 162 | ''' blnBeginSpace is adding a blankspace before open bracket " (" 163 | ''' blnSpaceAfter is adding a blankspace after open bracket "( " 164 | ''' blnSpaceBefore is adding a blankspace before close bracket " )" 165 | Public Sub SQL_Single_Field(strField As String, Optional blnSpaceAfter As Boolean = True, Optional blnSpaceBefore As Boolean = True, Optional blnBeginSpace As Boolean = True) 166 | If blnBeginSpace = True Then 167 | mstrText = " " & mstrText 168 | End If 169 | mstrText = mstrText & "(" 170 | If blnSpaceAfter = True Then 171 | mstrText = mstrText & " " 172 | End If 173 | mstrText = mstrText & strField 174 | If blnSpaceBefore = True Then 175 | mstrText = mstrText & " " 176 | End If 177 | mstrText = mstrText & ")" 178 | End Sub 179 | Public Sub SSF(strField As String, Optional blnSpaceAfter As Boolean = True, Optional blnSpaceBefore As Boolean = True, Optional blnBeginSpace As Boolean = True) 180 | SQL_Single_Field strField, blnSpaceAfter, blnSpaceBefore, blnBeginSpace 181 | End Sub 182 | 183 | ''' Append WHERE to SQL statement with first condition field is a Text type 184 | Public Sub WHERE_Text(strField As String, strText As String) 185 | mstrText = mstrText & " WHERE " & strField & " = '" & strText & "'" 186 | End Sub 187 | 188 | ''' Append WHERE to SQL statement with first condition field is a Long type 189 | Public Sub WHERE_Long(strField As String, lngNumber As Long) 190 | mstrText = mstrText & " WHERE " & strField & " = " & lngNumber 191 | End Sub 192 | 193 | ''' Append WHERE to SQL statement with first condition field is a Integer type 194 | Public Sub WHERE_Integer(strField As String, intNumber As Integer) 195 | mstrText = mstrText & " WHERE " & strField & " = " & intNumber 196 | End Sub 197 | 198 | ''' Append WHERE to SQL statement with first condition field is a Boolean type 199 | Public Sub WHERE_Boolean(strField As String, blnBoolean As Boolean) 200 | 'mstrText = mstrText & " WHERE " & strField & " = " & blnBoolean 201 | If blnBoolean Then 202 | mstrText = mstrText & " WHERE " & strField & " = Yes" 203 | Else 204 | mstrText = mstrText & " WHERE " & strField & " = No" 205 | End If 206 | End Sub 207 | 208 | ''' Append WHERE to SQL statement with first condition field is using BETWEEN 209 | Public Sub WHERE_BETWEEN(strField As String, strLeftValue As String, strRightValue As String) 210 | mstrText = mstrText & " WHERE " & strField & " BETWEEN " & strLeftValue & " AND " & strRightValue 211 | End Sub 212 | 213 | ''' Append WHERE to SQL statement with first condition field is using LIKE 214 | Public Sub WHERE_LIKE_Text(strField As String, strText As String) 215 | mstrText = mstrText & " WHERE " & strField & " LIKE '%" & strText & "%'" 216 | End Sub 217 | 218 | ''' Append OR to SQL statement with condition field is using LIKE 219 | Public Sub OR_LIKE_Text(strField As String, strText As String) 220 | mstrText = mstrText & " OR " & strField & " LIKE '%" & strText & "%'" 221 | End Sub 222 | 223 | ''' Append AND to SQL statement with condition field is a Text type 224 | Public Sub AND_Text(strField As String, strText As String) 225 | mstrText = mstrText & " AND " & strField & " = '" & strText & "'" 226 | End Sub 227 | 228 | ''' Append AND to SQL statement with condition field is Yes/No 229 | Public Sub AND_Boolean(strField As String, strYesNo As String) 230 | mstrText = mstrText & " AND " & strField & " = " & strYesNo 231 | End Sub 232 | 233 | ''' Append ORDER BY to SQL statement 234 | Public Sub ORDER_BY(strField As String, Optional blnAscending As Boolean = True) 235 | mstrText = mstrText & " ORDER BY " & strField 236 | If blnAscending = False Then 237 | mstrText = mstrText & " DESC" 238 | End If 239 | End Sub 240 | 241 | ''' Append INNER JOIN to SQL statement 242 | Public Sub INNER_JOIN(strTable1 As String, strTable2 As String, strCommonField1 As String, strCommonField2 As String) 243 | 'SQL "FROM " & strTable1, False 244 | SQL "INNER JOIN " & strTable2, False 245 | SQL "ON " & strTable1 & "." & strCommonField1 & " = " & strTable2 & "." & strCommonField2, False 246 | End Sub 247 | 248 | ''' Append LEFT JOIN to SQL statement 249 | Public Sub LEFT_JOIN(strTable1 As String, strTable2 As String, strCommonField1 As String, strCommonField2 As String) 250 | 'SQL "FROM " & strTable1, False 251 | SQL "LEFT JOIN " & strTable2, False 252 | SQL "ON " & strTable1 & "." & strCommonField1 & " = " & strTable2 & "." & strCommonField2, False 253 | End Sub 254 | 255 | ''' Start building SELECT SQL statement 256 | Public Sub SELECT_(Optional strField As String = "") 257 | mstrText = "SELECT" 258 | If strField <> "" Then mstrText = mstrText & " " & strField 259 | End Sub 260 | 261 | ''' Start building SELECT SQL statement with all fields 262 | Public Sub SELECT_ALL(strTable As String) 263 | mstrText = "SELECT * FROM " & strTable 264 | End Sub 265 | 266 | ''' Start building SELECT SQL statement with Top n rows 267 | Public Sub SELECT_TOP(strField As String, strTable As String, Optional intTop As Integer = 1) 268 | mstrText = "SELECT TOP " & intTop & " " & strField & " FROM " & strTable 269 | End Sub 270 | 271 | ''' Start building SELECT SQL statement with first field name ID, optional Top n rows 272 | Public Sub SELECT_ID(strTable As String, Optional intTop As Integer = 1) 273 | If intTop > 0 Then 274 | mstrText = "SELECT TOP " & intTop & " ID FROM " & strTable 275 | Else 276 | mstrText = "SELECT ID FROM " & strTable 277 | End If 278 | End Sub 279 | 280 | ''' Append FROM to SQL statement 281 | Public Sub FROM(strTable As String) 282 | mstrText = mstrText & " FROM " & strTable 283 | End Sub 284 | 285 | ''' Build INSERT INTO Table SQL statement 286 | Public Sub INSERT(strTable As String, Optional blnSpaceBeforeBracket As Boolean = True, Optional blnOpenBracket As Boolean = False) 287 | mstrText = "INSERT INTO " & strTable '& " (" 288 | If blnSpaceBeforeBracket Then mstrText = mstrText & " " 289 | If blnOpenBracket Then mstrText = mstrText & "(" 290 | End Sub 291 | 292 | ' Result = [ ][)] VALUES [(] 293 | Public Sub VALUES(Optional blnCloseBracket As Boolean = False, Optional blnOpenBracket As Boolean = False, Optional blnBeginSpace As Boolean = True) 294 | If blnBeginSpace = True Then mstrText = mstrText & " " 295 | If blnCloseBracket Then mstrText = mstrText & ")" 296 | mstrText = mstrText & " VALUES " ' Space BEFORE and AFTER is set as default 297 | If blnOpenBracket Then mstrText = mstrText & "(" 298 | End Sub 299 | 300 | ''' Build UPDATE Table SET SQL statement 301 | Public Sub UPDATE(strTable As String) 302 | mstrText = "UPDATE " & strTable & " SET" 303 | End Sub 304 | 305 | ''' Build DELETE FROM Table SQL statement 306 | Public Sub DELETE(strTable As String) 307 | mstrText = "DELETE FROM " & strTable 308 | End Sub 309 | 310 | ''' Build DROP Table SQL statement 311 | Public Sub DROP(strTable As String) 312 | mstrText = "DROP TABLE [" & strTable & "]" 313 | End Sub 314 | 315 | ''' Build ALTER Table SQL statement 316 | Public Sub ALTER_TABLE(strTable As String) 317 | mstrText = "ALTER TABLE " & strTable 318 | End Sub 319 | 320 | ' References: 321 | ' http://allenbrowne.com/ser-49.html 322 | ' https://docs.microsoft.com/en-us/sql/odbc/microsoft/microsoft-access-data-types 323 | ' https://msdn.microsoft.com/en-us/library/aa140015(office.10).aspx (VERY GOOD) 324 | ''' Build CREATE Table SQL statement 325 | Public Sub CREATE(strTable As String, Optional strPrefix As String = "") 326 | mstrText = "CREATE TABLE " & strPrefix & strTable 327 | mstrText = mstrText & " (" 328 | End Sub 329 | 330 | ''' Append ID column in CREATE Table SQL statement 331 | Public Sub COLUMN_ID(Optional strColumnName As String = "ID", Optional blnPrimaryKey As Boolean = True, Optional blnAutoIncrement As Boolean = True, Optional blnEndComma As Boolean = True) 332 | 'mstrText = mstrText & "[" & strColumnName & "]" 333 | mstrText = mstrText & strColumnName 334 | 'If blnAutoIncrement Then mstrText = mstrText & " AUTOINCREMENT" 335 | If blnAutoIncrement Then 336 | mstrText = mstrText & " AUTOINCREMENT" 337 | Else 338 | mstrText = mstrText & " LONG" 339 | End If 340 | If blnPrimaryKey Then mstrText = mstrText & " PRIMARY KEY" 341 | If blnEndComma = True Then mstrText = mstrText & "," 'mstrText = mstrText & "," 342 | End Sub 343 | 344 | ''' Append Text type column in CREATE Table SQL statement 345 | Public Sub COLUMN_TEXT(strColumnName As String, Optional intLength As Integer = 255, Optional strDefault As String = "", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 346 | If blnBeginSpace Then mstrText = mstrText & " " 347 | mstrText = mstrText & strColumnName & " TEXT(" & intLength & ")" 348 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT """ & strDefault & """" 349 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 350 | If blnEndComma = True Then mstrText = mstrText & "," 351 | End Sub 352 | 353 | ''' Append Memo type column in CREATE Table SQL statement 354 | Public Sub COLUMN_MEMO(strColumnName As String, Optional strDefault As String = "", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 355 | If blnBeginSpace Then mstrText = mstrText & " " 356 | mstrText = mstrText & strColumnName & " MEMO" 357 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT " & strDefault 358 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 359 | If blnEndComma = True Then mstrText = mstrText & "," 360 | End Sub 361 | 362 | ' NOTE: Not yet used or tested 363 | ''' Append Number type column in CREATE Table SQL statement 364 | Public Sub COLUMN_NUMBER(strColumnName As String, Optional strFieldSize As String = "LONG", Optional strDefault As String = "", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 365 | If blnBeginSpace Then mstrText = mstrText & " " 366 | Select Case strFieldSize 367 | Case "BYTE" 368 | mstrText = mstrText & strColumnName & " BYTE" 369 | Case "SHORT" 370 | mstrText = mstrText & strColumnName & " SHORT" 371 | Case "INTEGER" ' Same as SHORT ? 372 | mstrText = mstrText & strColumnName & " INTEGER" 373 | Case "LONG" ' Default 374 | mstrText = mstrText & strColumnName & " LONG" 375 | Case "SINGLE" 376 | mstrText = mstrText & strColumnName & " SINGLE" 377 | Case "DOUBLE" 378 | mstrText = mstrText & strColumnName & " DOUBLE" 379 | Case "REPLICA", "GUID" 380 | mstrText = mstrText & strColumnName & " GUID" 381 | Case "DECIMAL" 382 | mstrText = mstrText & strColumnName & " DECIMAL (18, 0)" ' (precision, scale) 9, 4 383 | Case Else ' LONG 384 | mstrText = mstrText & strColumnName & " LONG" 385 | End Select 386 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT " & strDefault 387 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 388 | If blnEndComma = True Then mstrText = mstrText & "," 389 | End Sub 390 | 391 | ''' Append Bit type column in CREATE Table SQL statement 392 | Public Sub COLUMN_BIT(strColumnName As String, Optional strDefault As String = "-1", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 393 | If blnBeginSpace Then mstrText = mstrText & " " 394 | mstrText = mstrText & strColumnName & " BIT" 395 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT " & strDefault 396 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 397 | If blnEndComma = True Then mstrText = mstrText & "," 398 | End Sub 399 | 400 | ' Same as COLUMN_BIT 401 | ''' Append YesNo type column in CREATE Table SQL statement 402 | Public Sub COLUMN_YESNO(strColumnName As String, Optional strDefault As String = "Yes", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 403 | If blnBeginSpace Then mstrText = mstrText & " " 404 | mstrText = mstrText & strColumnName & " YESNO" 405 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT " & strDefault 406 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 407 | If blnEndComma = True Then mstrText = mstrText & "," 408 | End Sub 409 | 410 | ''' Append DateTime type column in CREATE Table SQL statement 411 | Public Sub COLUMN_DATETIME(strColumnName As String, Optional strDefault As String = "", Optional blnNullable As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnEndComma As Boolean = True) 412 | If blnBeginSpace Then mstrText = mstrText & " " 413 | mstrText = mstrText & strColumnName & " DATETIME" 414 | If strDefault <> "" Then mstrText = mstrText & " DEFAULT " & strDefault 415 | If Not blnNullable Then mstrText = mstrText & " NOT NULL" 416 | If blnEndComma = True Then mstrText = mstrText & "," 417 | End Sub 418 | 419 | ''' Append a comma character to SQL statement 420 | Public Sub Comma() 421 | mstrText = mstrText & "," 422 | End Sub 423 | 424 | ''' Append an open bracket character to SQL statement 425 | Public Sub Open_Bracket() 426 | mstrText = mstrText & "(" 427 | End Sub 428 | 429 | ''' Append a close bracket character to SQL statement 430 | Public Sub Close_Bracket() 431 | mstrText = mstrText & ")" 432 | End Sub 433 | 434 | ''' Appending value when building INSERT statement, default with single quote 435 | ' blnAddQuotes = True for Text 436 | ' blnAddQuotes = False for Number 437 | Public Sub VAL(strValue As String, Optional blnAddQuotes As Boolean = True, Optional blnEndComma As Boolean = True, Optional blnBeginSpace As Boolean = True) 438 | If blnBeginSpace = True Then 439 | mstrText = mstrText & " " 440 | End If 441 | If blnAddQuotes Then 442 | mstrText = mstrText & "'" & strValue & "'" 443 | Else 444 | mstrText = mstrText & strValue 445 | End If 446 | If blnEndComma = True Then 447 | mstrText = mstrText & "," 448 | End If 449 | End Sub 450 | Public Sub VTX(strValue As String, Optional blnAddQuotes As Boolean = True, Optional blnEndComma As Boolean = True, Optional blnBeginSpace As Boolean = True) 451 | If blnBeginSpace = True Then 452 | mstrText = mstrText & " " 453 | End If 454 | If blnAddQuotes Then 455 | mstrText = mstrText & "'" & strValue & "'" 456 | Else 457 | mstrText = mstrText & strValue 458 | End If 459 | If blnEndComma = True Then 460 | mstrText = mstrText & "," 461 | End If 462 | End Sub 463 | 464 | ''' Append First Value in Values when building INSERT SQL statement 465 | Public Sub VOB(strValue As String, Optional blnAddQuotes As Boolean = True, Optional blnEndComma As Boolean = True, Optional blnBeginSpace As Boolean = False, Optional blnOpenBracket As Boolean = True) 466 | If blnBeginSpace = True Then mstrText = mstrText & " " 467 | If blnOpenBracket = True Then mstrText = mstrText & "(" 468 | If blnAddQuotes Then 469 | mstrText = mstrText & "'" & strValue & "'" 470 | Else 471 | mstrText = mstrText & strValue 472 | End If 473 | If blnEndComma = True Then mstrText = mstrText & "," 474 | End Sub 475 | 476 | ''' Append Last Value in Values when building INSERT SQL statement 477 | Public Sub VCB(strValue As String, Optional blnAddQuotes As Boolean = True, Optional blnBeginSpace As Boolean = True, Optional blnCloseBracket As Boolean = True) 478 | If blnBeginSpace = True Then 479 | mstrText = mstrText & " " 480 | End If 481 | If blnAddQuotes Then 482 | mstrText = mstrText & "'" & strValue & "'" 483 | Else 484 | mstrText = mstrText & strValue 485 | End If 486 | If blnCloseBracket = True Then mstrText = mstrText & ")" 487 | End Sub 488 | 489 | ''' Append Single Value in Values when building INSERT SQL statement 490 | Public Sub VSV(strValue As String, Optional blnAddQuotes As Boolean = True, Optional blnBeginSpace As Boolean = True) 491 | If blnBeginSpace = True Then mstrText = mstrText & " " 492 | If blnAddQuotes Then 493 | mstrText = mstrText & "('" & strValue & "')" 494 | Else 495 | mstrText = mstrText & "(" & strValue & ")" 496 | End If 497 | End Sub 498 | 499 | ''' Appending Double type value when building INSERT statement 500 | Public Sub VDB(dblNumber As Double, Optional blnEndComma As Boolean = True) 501 | mstrText = mstrText & " " & dblNumber 502 | If blnEndComma = True Then 503 | mstrText = mstrText & "," 504 | End If 505 | End Sub 506 | 507 | ''' Appending Long type value when building INSERT statement 508 | Public Sub VLN(lngNumber As Long, Optional blnEndComma As Boolean = True) 509 | mstrText = mstrText & " " & lngNumber 510 | If blnEndComma = True Then 511 | mstrText = mstrText & "," 512 | End If 513 | End Sub 514 | 515 | ''' Appending Integer type value when building INSERT statement 516 | Public Sub VIN(intNumber As Integer, Optional blnEndComma As Boolean = True) 517 | mstrText = mstrText & " " & intNumber 518 | If blnEndComma = True Then 519 | mstrText = mstrText & "," 520 | End If 521 | End Sub 522 | 523 | ''' Appending Boolean type value when building INSERT statement 524 | Public Sub VBL(blnValue As Boolean, Optional blnEndComma As Boolean = True) 525 | If blnValue Then 526 | mstrText = mstrText & " TRUE" 527 | Else 528 | mstrText = mstrText & " FALSE" 529 | End If 530 | If blnEndComma = True Then 531 | mstrText = mstrText & "," 532 | End If 533 | End Sub 534 | 535 | ''' Appending DateTime type value when building INSERT statement 536 | Public Sub VDT(strDateTime As String, Optional blnEndComma As Boolean = True) 537 | mstrText = mstrText & " #" & strDateTime & "#" 538 | If blnEndComma = True Then 539 | mstrText = mstrText & "," 540 | End If 541 | End Sub 542 | Public Sub DAT(strValue As String, Optional blnAddHatches As Boolean = True, Optional blnEndComma As Boolean = True, Optional blnBeginSpace As Boolean = True) 543 | If blnBeginSpace = True Then 544 | mstrText = mstrText & " " 545 | End If 546 | If blnAddHatches Then 547 | mstrText = mstrText & "#" & strValue & "#" 548 | Else 549 | mstrText = mstrText & strValue 550 | End If 551 | If blnEndComma = True Then 552 | mstrText = mstrText & "," 553 | End If 554 | End Sub 555 | -------------------------------------------------------------------------------- /Modules/OmeColourCodes.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "OmeColourCodes" 2 | ' Nice Theme: http://keenthemes.com/preview/metronic/theme/admin_2/ui_colors.html 3 | 4 | ' VB6 Control Backcolor is reversed RGB Hex 5 | 6 | ' Example: Blue-Soft #4C87C9 7 | 8 | ' We separate the code to 3 parts 9 | 10 | ' R=4C, G=87, B=C9 11 | 12 | ' VB Control colour code 13 | 14 | ' &H00 C9 87 4C & 15 | ' B G R 16 | 17 | ' So the code is &H00C9874C& (13207372) 18 | -------------------------------------------------------------------------------- /Modules/OmeHash.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "OmeHash" 2 | '************************************************************************** 3 | ' Module Name: Hash 4 | '************************************************************************** 5 | ' Version: 1.0.0.0 6 | ' Created on: 17 April 2016 7 | ' Updated on: 08 Feb 2018 8 | ' Created by: Aeric Poon Yip Hoon 9 | ' Description: Create MD5 Hashing to store in database 10 | '************************************************************************** 11 | ' Modified based on: 12 | ' http://khoiriyyah.blogspot.com/2012/06/vb6-hash-class-md5-sha-1-sha-256-sha.html 13 | ' Credit to: KARIM WAFI 14 | ' Posted Date: TUESDAY, OCTOBER 1, 2013 15 | ' Description: VB6 Hash Class - MD5 , SHA-1, SHA-256, SHA-384, SHA-512 16 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 17 | Option Explicit 18 | Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _ 19 | (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _ 20 | ByVal dwProvType As Long, ByVal dwFlags As Long) As Long 21 | Private Declare Function CryptReleaseContext Lib "advapi32.dll" _ 22 | (ByVal hProv As Long, ByVal dwFlags As Long) As Long 23 | Private Declare Function CryptCreateHash Lib "advapi32.dll" _ 24 | (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _ 25 | ByRef phHash As Long) As Long 26 | Private Declare Function CryptDestroyHash Lib "advapi32.dll" _ 27 | (ByVal hHash As Long) As Long 28 | Private Declare Function CryptHashData Lib "advapi32.dll" _ 29 | (ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long 30 | Private Declare Function CryptGetHashParam Lib "advapi32.dll" _ 31 | (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _ 32 | ByVal dwFlags As Long) As Long 33 | 34 | Private Const PROV_RSA_FULL As Long = 1 35 | Private Const PROV_RSA_AES As Long = 24 36 | Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000 37 | 38 | Private Const HP_HASHVAL As Long = 2 39 | Private Const HP_HASHSIZE As Long = 4 40 | 41 | Private Const ALG_TYPE_ANY As Long = 0 42 | Private Const ALG_CLASS_HASH As Long = 32768 43 | 44 | 'Private Const ALG_SID_MD2 As Long = 1 45 | 'Private Const ALG_SID_MD4 As Long = 2 46 | Private Const ALG_SID_MD5 As Long = 3 47 | Private Const ALG_SID_SHA As Long = 4 48 | Private Const ALG_SID_SHA_256 As Long = 12 49 | 'Private Const ALG_SID_SHA_384 As Long = 13 50 | 'Private Const ALG_SID_SHA_512 As Long = 14 51 | 52 | 'Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2) 53 | 'Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4) 54 | Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5) 55 | Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA) 56 | Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256) 57 | 'Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384) 58 | 'Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512) 59 | 60 | ' Create Hash 61 | Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String 62 | Dim hProv As Long, hHash As Long 63 | Dim abytHash(0 To 63) As Byte 64 | Dim lngLength As Long 65 | Dim lngResult As Long 66 | Dim strHash As String 67 | Dim i As Long 68 | strHash = "" 69 | If CryptAcquireContext(hProv, vbNullString, vbNullString, _ 70 | IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _ 71 | CRYPT_VERIFYCONTEXT) <> 0& Then 72 | If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then 73 | lngLength = UBound(abytData()) - LBound(abytData()) + 1 74 | If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _ 75 | Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&) 76 | If lngResult <> 0& Then 77 | lngLength = UBound(abytHash()) - LBound(abytHash()) + 1 78 | If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then 79 | For i = 0 To lngLength - 1 80 | strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2) 81 | Next 82 | End If 83 | End If 84 | CryptDestroyHash hHash 85 | End If 86 | CryptReleaseContext hProv, 0& 87 | End If 88 | CreateHash = LCase$(strHash) 89 | End Function 90 | 91 | ' Create Hash From String(Shift_JIS) 92 | Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String 93 | CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID) 94 | End Function 95 | 96 | ' MD5 97 | Public Function MD5(ByVal strData As String) As String 98 | MD5 = CreateHashString(strData, CALG_MD5) 99 | End Function 100 | 101 | ' SHA-1 102 | Public Function SHA1(ByVal strData As String) As String 103 | SHA1 = CreateHashString(strData, CALG_SHA) 104 | End Function 105 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /Modules/OmeVariable.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "OmeVariable" 2 | ' Global Declaration 3 | ' Public variables or constant naming connvention starts with g 4 | 5 | Public gstrUserID As String 6 | Public gstrUserName As String 7 | -------------------------------------------------------------------------------- /Modules/modVBAdmin.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modVBAdmin" 2 | Sub Main() 3 | 'frmDashboard.Show 4 | frmLogin.Show 5 | End Sub 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # vbadmin 2 | Admin Dashboard Panel (VB6) 3 | 4 | **Screenshot** 5 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/VBAdmin.png) 6 | 7 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/Screenshots/VBAdmin-Login.png) 8 | 9 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/Screenshots/VBAdmin-Users.png) 10 | 11 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/Screenshots/VBAdmin-User-Details.png) 12 | 13 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/Screenshots/VBAdmin-Update-Salt-Password.png) 14 | 15 | ![VBAdmin](https://github.com/pyhoon/vbadmin/blob/master/Screenshots/VBAdmin-Carbon.png) 16 | -------------------------------------------------------------------------------- /Resources/Font/Font Awesome 5 Brands-Regular-400.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Resources/Font/Font Awesome 5 Brands-Regular-400.otf -------------------------------------------------------------------------------- /Resources/Font/Font Awesome 5 Free-Regular-400.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Resources/Font/Font Awesome 5 Free-Regular-400.otf -------------------------------------------------------------------------------- /Resources/Font/Font Awesome 5 Free-Solid-900.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Resources/Font/Font Awesome 5 Free-Solid-900.otf -------------------------------------------------------------------------------- /Resources/Font/Font Awesome 5.txt: -------------------------------------------------------------------------------- 1 | Downloaded from: https://fontawesome.com/get-started/desktop 2 | 3 | Copied from folder: use-on-desktop 4 | 5 | Font used: Font Awesome 5 Free Solid 6 | 7 | For the label caption, refer to: https://fontawesome.com/cheatsheet 8 | 9 | Example: tachometer-alt -------------------------------------------------------------------------------- /Resources/Icon/appicon.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Resources/Icon/appicon.res -------------------------------------------------------------------------------- /Resources/Icon/hand.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Resources/Icon/hand.ico -------------------------------------------------------------------------------- /Screenshots/VBAdmin-Carbon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Screenshots/VBAdmin-Carbon.png -------------------------------------------------------------------------------- /Screenshots/VBAdmin-Login.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Screenshots/VBAdmin-Login.png -------------------------------------------------------------------------------- /Screenshots/VBAdmin-Update-Salt-Password.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Screenshots/VBAdmin-Update-Salt-Password.png -------------------------------------------------------------------------------- /Screenshots/VBAdmin-User-Details.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Screenshots/VBAdmin-User-Details.png -------------------------------------------------------------------------------- /Screenshots/VBAdmin-Users.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Screenshots/VBAdmin-Users.png -------------------------------------------------------------------------------- /Storage/Data.mdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/Storage/Data.mdb -------------------------------------------------------------------------------- /VBAdmin.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyhoon/vbadmin-vb6/f4061db725e1b2083bea8f897ba3602b281d783e/VBAdmin.png -------------------------------------------------------------------------------- /VBAdmin.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{B691E011-1797-432E-907A-4D8C69339129}#6.1#0#C:\Program Files (x86)\Common Files\System\ado\msado15.dll#Microsoft ActiveX Data Objects 6.1 Library 4 | Class=OmlDatabase; Classes\OmlDatabase.cls 5 | Module=OmeVariable; Modules\OmeVariable.bas 6 | Module=OmeColourCodes; Modules\OmeColourCodes.bas 7 | Module=modVBAdmin; Modules\modVBAdmin.bas 8 | Form=frmDashboard.frm 9 | Form=frmUsers.frm 10 | Form=frmUserUpdateSaltPassword.frm 11 | Form=frmTemplate.frm 12 | Form=frmHelp.frm 13 | Module=OmeHash; Modules\OmeHash.bas 14 | Form=frmLogin.frm 15 | Form=frmUserDetails.frm 16 | Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX 17 | Class=OmlSQLBuilder; Classes\OmlSQLBuilder.cls 18 | ResFile32="Resources\Icon\appicon.res" 19 | Startup="Sub Main" 20 | HelpFile="" 21 | Title="VBAdmin" 22 | ExeName32="VBAdmin.exe" 23 | Command32="" 24 | Name="VBAdmin" 25 | HelpContextID="0" 26 | CompatibleMode="0" 27 | MajorVer=1 28 | MinorVer=0 29 | RevisionVer=0 30 | AutoIncrementVer=0 31 | ServerSupportFiles=0 32 | VersionCompanyName="Computerise System Solutions" 33 | CompilationType=0 34 | OptimizationType=0 35 | FavorPentiumPro(tm)=0 36 | CodeViewDebugInfo=0 37 | NoAliasing=0 38 | BoundsCheck=0 39 | OverflowCheck=0 40 | FlPointCheck=0 41 | FDIVCheck=0 42 | UnroundedFP=0 43 | StartMode=0 44 | Unattended=0 45 | Retained=0 46 | ThreadPerObject=0 47 | MaxNumberOfThreads=1 48 | -------------------------------------------------------------------------------- /VBAdmin.vbw: -------------------------------------------------------------------------------- 1 | OmlDatabase = 150, 150, 924, 601, C 2 | OmeVariable = 146, 64, 920, 515, C 3 | OmeColourCodes = 200, 200, 947, 651, C 4 | modVBAdmin = 75, 75, 822, 526, C 5 | frmDashboard = 26, 24, 773, 475, C, 25, 25, 772, 476, C 6 | frmUsers = 75, 75, 822, 526, Z, 50, 50, 797, 501, C 7 | frmUserUpdateSaltPassword = 97, 20, 844, 471, C, 50, 50, 797, 501, C 8 | frmTemplate = 100, 100, 847, 551, C, 75, 75, 822, 526, C 9 | frmHelp = 175, 175, 922, 626, C, 114, 59, 933, 620, C 10 | OmeHash = 175, 175, 922, 626, C 11 | frmLogin = 75, 75, 954, 511, C, 50, 50, 929, 486, C 12 | frmUserDetails = 106, 9, 916, 445, C, 108, 19, 918, 455, C 13 | OmlSQLBuilder = 50, 50, 940, 415, C 14 | -------------------------------------------------------------------------------- /frmDashboard.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmDashboard 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 8790 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 17295 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 8790 24 | ScaleWidth = 17295 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.Frame fraContainer2 27 | Appearance = 0 'Flat 28 | BackColor = &H80000005& 29 | BorderStyle = 0 'None 30 | ForeColor = &H80000008& 31 | Height = 5175 32 | Left = 10680 33 | TabIndex = 18 34 | Top = 3360 35 | Width = 6375 36 | Begin VB.Frame fraButton2 37 | Appearance = 0 'Flat 38 | BackColor = &H00B7D736& 39 | BorderStyle = 0 'None 40 | ForeColor = &H80000008& 41 | Height = 735 42 | Left = 3360 43 | MousePointer = 99 'Custom 44 | TabIndex = 23 45 | Top = 4200 46 | Width = 2775 47 | Begin VB.Label lblButton2 48 | Alignment = 2 'Center 49 | AutoSize = -1 'True 50 | BackStyle = 0 'Transparent 51 | Caption = "BUTTON LABEL 2" 52 | BeginProperty Font 53 | Name = "MS Sans Serif" 54 | Size = 12 55 | Charset = 0 56 | Weight = 700 57 | Underline = 0 'False 58 | Italic = 0 'False 59 | Strikethrough = 0 'False 60 | EndProperty 61 | ForeColor = &H00FFFFFF& 62 | Height = 300 63 | Left = 240 64 | TabIndex = 24 65 | Top = 240 66 | Width = 2205 67 | End 68 | End 69 | Begin VB.Frame fraContainerTitle2 70 | Appearance = 0 'Flat 71 | BackColor = &H8000000D& 72 | BorderStyle = 0 'None 73 | ForeColor = &H80000008& 74 | Height = 735 75 | Left = 0 76 | TabIndex = 21 77 | Top = 0 78 | Width = 6375 79 | Begin VB.Label lblContainerTitle2 80 | AutoSize = -1 'True 81 | BackStyle = 0 'Transparent 82 | Caption = "CONTAINER TITLE 2" 83 | BeginProperty Font 84 | Name = "MS Sans Serif" 85 | Size = 12 86 | Charset = 0 87 | Weight = 700 88 | Underline = 0 'False 89 | Italic = 0 'False 90 | Strikethrough = 0 'False 91 | EndProperty 92 | ForeColor = &H00FFFFFF& 93 | Height = 300 94 | Left = 240 95 | TabIndex = 22 96 | Top = 240 97 | Width = 2565 98 | End 99 | End 100 | End 101 | Begin VB.Frame fraContainer1 102 | Appearance = 0 'Flat 103 | BackColor = &H80000005& 104 | BorderStyle = 0 'None 105 | ForeColor = &H80000008& 106 | Height = 5175 107 | Left = 3960 108 | TabIndex = 17 109 | Top = 3360 110 | Width = 6375 111 | Begin VB.Frame fraContainerTitle1 112 | Appearance = 0 'Flat 113 | BackColor = &H8000000D& 114 | BorderStyle = 0 'None 115 | ForeColor = &H80000008& 116 | Height = 735 117 | Left = 0 118 | TabIndex = 19 119 | Top = 0 120 | Width = 6375 121 | Begin VB.Label lblContainerTitle1 122 | AutoSize = -1 'True 123 | BackStyle = 0 'Transparent 124 | Caption = "CONTAINER TITLE 1" 125 | BeginProperty Font 126 | Name = "MS Sans Serif" 127 | Size = 12 128 | Charset = 0 129 | Weight = 700 130 | Underline = 0 'False 131 | Italic = 0 'False 132 | Strikethrough = 0 'False 133 | EndProperty 134 | ForeColor = &H00FFFFFF& 135 | Height = 300 136 | Left = 240 137 | TabIndex = 20 138 | Top = 240 139 | Width = 2565 140 | End 141 | End 142 | End 143 | Begin VB.Frame fraBox4 144 | Appearance = 0 'Flat 145 | BorderStyle = 0 'None 146 | ForeColor = &H80000008& 147 | Height = 2000 148 | Left = 14040 149 | TabIndex = 12 150 | Top = 1080 151 | Width = 3000 152 | Begin VB.Label fa4 153 | AutoSize = -1 'True 154 | BackStyle = 0 'Transparent 155 | Caption = "sync-alt" 156 | BeginProperty Font 157 | Name = "Font Awesome 5 Free Solid" 158 | Size = 36 159 | Charset = 0 160 | Weight = 400 161 | Underline = 0 'False 162 | Italic = 0 'False 163 | Strikethrough = 0 'False 164 | EndProperty 165 | ForeColor = &H00E0E0E0& 166 | Height = 750 167 | Left = 240 168 | TabIndex = 28 169 | Top = 240 170 | Width = 720 171 | End 172 | Begin VB.Label Label3 173 | Alignment = 1 'Right Justify 174 | Appearance = 0 'Flat 175 | AutoSize = -1 'True 176 | BackColor = &H80000005& 177 | BackStyle = 0 'Transparent 178 | Caption = "99 Updates" 179 | BeginProperty Font 180 | Name = "Arial" 181 | Size = 18 182 | Charset = 0 183 | Weight = 400 184 | Underline = 0 'False 185 | Italic = 0 'False 186 | Strikethrough = 0 'False 187 | EndProperty 188 | ForeColor = &H00E0E0E0& 189 | Height = 405 190 | Left = 900 191 | TabIndex = 16 192 | Top = 1440 193 | Width = 1845 194 | End 195 | End 196 | Begin VB.Frame fraBox3 197 | Appearance = 0 'Flat 198 | BorderStyle = 0 'None 199 | ForeColor = &H80000008& 200 | Height = 2000 201 | Left = 10680 202 | TabIndex = 11 203 | Top = 1080 204 | Width = 3000 205 | Begin VB.Label fa3 206 | AutoSize = -1 'True 207 | BackStyle = 0 'Transparent 208 | Caption = "database" 209 | BeginProperty Font 210 | Name = "Font Awesome 5 Free Solid" 211 | Size = 36 212 | Charset = 0 213 | Weight = 400 214 | Underline = 0 'False 215 | Italic = 0 'False 216 | Strikethrough = 0 'False 217 | EndProperty 218 | ForeColor = &H00E0E0E0& 219 | Height = 750 220 | Left = 240 221 | TabIndex = 27 222 | Top = 240 223 | Width = 630 224 | End 225 | Begin VB.Label Label2 226 | Alignment = 1 'Right Justify 227 | Appearance = 0 'Flat 228 | AutoSize = -1 'True 229 | BackColor = &H80000005& 230 | BackStyle = 0 'Transparent 231 | Caption = "99,999 Records" 232 | BeginProperty Font 233 | Name = "Arial" 234 | Size = 18 235 | Charset = 0 236 | Weight = 400 237 | Underline = 0 'False 238 | Italic = 0 'False 239 | Strikethrough = 0 'False 240 | EndProperty 241 | ForeColor = &H00E0E0E0& 242 | Height = 405 243 | Left = 180 244 | TabIndex = 15 245 | Top = 1440 246 | Width = 2520 247 | End 248 | End 249 | Begin VB.Frame fraBox2 250 | Appearance = 0 'Flat 251 | BorderStyle = 0 'None 252 | ForeColor = &H80000008& 253 | Height = 2000 254 | Left = 7320 255 | TabIndex = 10 256 | Top = 1080 257 | Width = 3000 258 | Begin VB.Label fa2 259 | AutoSize = -1 'True 260 | BackStyle = 0 'Transparent 261 | Caption = "users" 262 | BeginProperty Font 263 | Name = "Font Awesome 5 Free Solid" 264 | Size = 36 265 | Charset = 0 266 | Weight = 400 267 | Underline = 0 'False 268 | Italic = 0 'False 269 | Strikethrough = 0 'False 270 | EndProperty 271 | ForeColor = &H00E0E0E0& 272 | Height = 750 273 | Left = 240 274 | TabIndex = 26 275 | Top = 240 276 | Width = 900 277 | End 278 | Begin VB.Label Label1 279 | Alignment = 1 'Right Justify 280 | Appearance = 0 'Flat 281 | AutoSize = -1 'True 282 | BackColor = &H80000005& 283 | BackStyle = 0 'Transparent 284 | Caption = "1,000,000 Users" 285 | BeginProperty Font 286 | Name = "Arial" 287 | Size = 18 288 | Charset = 0 289 | Weight = 400 290 | Underline = 0 'False 291 | Italic = 0 'False 292 | Strikethrough = 0 'False 293 | EndProperty 294 | ForeColor = &H00E0E0E0& 295 | Height = 405 296 | Left = 135 297 | TabIndex = 14 298 | Top = 1440 299 | Width = 2610 300 | End 301 | End 302 | Begin VB.Frame fraBox1 303 | Appearance = 0 'Flat 304 | BorderStyle = 0 'None 305 | ForeColor = &H80000008& 306 | Height = 2000 307 | Left = 3960 308 | TabIndex = 9 309 | Top = 1080 310 | Width = 3000 311 | Begin VB.Label fa1 312 | AutoSize = -1 'True 313 | BackStyle = 0 'Transparent 314 | Caption = "tachometer-alt" 315 | BeginProperty Font 316 | Name = "Font Awesome 5 Free Solid" 317 | Size = 36 318 | Charset = 0 319 | Weight = 400 320 | Underline = 0 'False 321 | Italic = 0 'False 322 | Strikethrough = 0 'False 323 | EndProperty 324 | ForeColor = &H00E0E0E0& 325 | Height = 750 326 | Left = 240 327 | TabIndex = 25 328 | Top = 240 329 | Width = 810 330 | End 331 | Begin VB.Label lblBox1 332 | Alignment = 1 'Right Justify 333 | Appearance = 0 'Flat 334 | AutoSize = -1 'True 335 | BackColor = &H80000005& 336 | BackStyle = 0 'Transparent 337 | Caption = "90% Memory" 338 | BeginProperty Font 339 | Name = "Arial" 340 | Size = 18 341 | Charset = 0 342 | Weight = 400 343 | Underline = 0 'False 344 | Italic = 0 'False 345 | Strikethrough = 0 'False 346 | EndProperty 347 | ForeColor = &H00E0E0E0& 348 | Height = 405 349 | Left = 600 350 | TabIndex = 13 351 | Top = 1440 352 | Width = 2085 353 | End 354 | End 355 | Begin VB.Frame fraMenuContainer 356 | Appearance = 0 'Flat 357 | BackColor = &H80000010& 358 | BorderStyle = 0 'None 359 | BeginProperty Font 360 | Name = "MS Sans Serif" 361 | Size = 8.25 362 | Charset = 0 363 | Weight = 400 364 | Underline = 0 'False 365 | Italic = 0 'False 366 | Strikethrough = 0 'False 367 | EndProperty 368 | ForeColor = &H80000008& 369 | Height = 8055 370 | Left = 0 371 | TabIndex = 4 372 | Top = 720 373 | Width = 3615 374 | Begin VB.Frame fraMenu2 375 | Appearance = 0 'Flat 376 | BackColor = &H80000010& 377 | BorderStyle = 0 'None 378 | ForeColor = &H80000008& 379 | Height = 735 380 | Left = 120 381 | MousePointer = 99 'Custom 382 | TabIndex = 7 383 | Top = 1200 384 | Width = 3375 385 | Begin VB.Label lblMenu2 386 | AutoSize = -1 'True 387 | BackStyle = 0 'Transparent 388 | Caption = "Users" 389 | BeginProperty Font 390 | Name = "Arial" 391 | Size = 12 392 | Charset = 0 393 | Weight = 700 394 | Underline = 0 'False 395 | Italic = 0 'False 396 | Strikethrough = 0 'False 397 | EndProperty 398 | Height = 285 399 | Left = 240 400 | TabIndex = 8 401 | Top = 240 402 | Width = 675 403 | End 404 | End 405 | Begin VB.Frame fraMenu1 406 | Appearance = 0 'Flat 407 | BackColor = &H80000010& 408 | BorderStyle = 0 'None 409 | ForeColor = &H80000008& 410 | Height = 735 411 | Left = 120 412 | MousePointer = 99 'Custom 413 | TabIndex = 5 414 | Top = 240 415 | Width = 3375 416 | Begin VB.Label lblMenu1 417 | AutoSize = -1 'True 418 | BackStyle = 0 'Transparent 419 | Caption = "Dashboard" 420 | BeginProperty Font 421 | Name = "Arial" 422 | Size = 12 423 | Charset = 0 424 | Weight = 700 425 | Underline = 0 'False 426 | Italic = 0 'False 427 | Strikethrough = 0 'False 428 | EndProperty 429 | Height = 285 430 | Left = 240 431 | TabIndex = 6 432 | Top = 240 433 | Width = 1275 434 | End 435 | End 436 | End 437 | Begin VB.Frame fraTitle 438 | BackColor = &H8000000D& 439 | BorderStyle = 0 'None 440 | BeginProperty Font 441 | Name = "MS Sans Serif" 442 | Size = 8.25 443 | Charset = 0 444 | Weight = 400 445 | Underline = 0 'False 446 | Italic = 0 'False 447 | Strikethrough = 0 'False 448 | EndProperty 449 | Height = 735 450 | Left = 0 451 | TabIndex = 0 452 | Top = 0 453 | Width = 17295 454 | Begin VB.Label lblUserIcon 455 | AutoSize = -1 'True 456 | BackStyle = 0 'Transparent 457 | Caption = "user" 458 | BeginProperty Font 459 | Name = "Font Awesome 5 Free Regular" 460 | Size = 15.75 461 | Charset = 0 462 | Weight = 400 463 | Underline = 0 'False 464 | Italic = 0 'False 465 | Strikethrough = 0 'False 466 | EndProperty 467 | ForeColor = &H00FFFFFF& 468 | Height = 315 469 | Left = 14400 470 | TabIndex = 29 471 | Top = 180 472 | Width = 315 473 | End 474 | Begin VB.Label lblUserName 475 | Appearance = 0 'Flat 476 | AutoSize = -1 'True 477 | BackColor = &H80000005& 478 | BackStyle = 0 'Transparent 479 | Caption = "Administrator" 480 | BeginProperty Font 481 | Name = "Arial" 482 | Size = 12 483 | Charset = 0 484 | Weight = 700 485 | Underline = 0 'False 486 | Italic = 0 'False 487 | Strikethrough = 0 'False 488 | EndProperty 489 | ForeColor = &H00FFFFFF& 490 | Height = 285 491 | Left = 14880 492 | TabIndex = 3 493 | Top = 240 494 | Width = 1575 495 | End 496 | Begin VB.Label lblX 497 | Alignment = 2 'Center 498 | Appearance = 0 'Flat 499 | BackColor = &H80000005& 500 | BackStyle = 0 'Transparent 501 | Caption = "x" 502 | BeginProperty Font 503 | Name = "Arial" 504 | Size = 21.75 505 | Charset = 0 506 | Weight = 400 507 | Underline = 0 'False 508 | Italic = 0 'False 509 | Strikethrough = 0 'False 510 | EndProperty 511 | ForeColor = &H00000000& 512 | Height = 615 513 | Left = 16680 514 | TabIndex = 2 515 | Top = 0 516 | Width = 615 517 | End 518 | Begin VB.Shape shpX 519 | BorderColor = &H8000000D& 520 | FillColor = &H8000000D& 521 | FillStyle = 0 'Solid 522 | Height = 615 523 | Left = 16680 524 | Top = 0 525 | Width = 615 526 | End 527 | Begin VB.Label lblTitle 528 | AutoSize = -1 'True 529 | BackStyle = 0 'Transparent 530 | Caption = "APPLICATION TITLE" 531 | BeginProperty Font 532 | Name = "MS Sans Serif" 533 | Size = 12 534 | Charset = 0 535 | Weight = 700 536 | Underline = 0 'False 537 | Italic = 0 'False 538 | Strikethrough = 0 'False 539 | EndProperty 540 | ForeColor = &H00FFFFFF& 541 | Height = 300 542 | Left = 240 543 | TabIndex = 1 544 | Top = 240 545 | Width = 2535 546 | End 547 | End 548 | End 549 | Attribute VB_Name = "frmDashboard" 550 | Attribute VB_GlobalNameSpace = False 551 | Attribute VB_Creatable = False 552 | Attribute VB_PredeclaredId = True 553 | Attribute VB_Exposed = False 554 | Option Explicit 555 | Dim strAppDataPath As String 556 | Dim strAppDataFile As String 557 | Dim MoveStartX As Single 558 | Dim MoveStartY As Single 559 | Dim MoveEndX As Single 560 | Dim MoveEndY As Single 561 | 562 | Private Sub Form_Initialize() 563 | ' Source: http://www.vbforums.com/showthread.php?432036-Classic-VB-How-can-I-set-my-exe-icon-using-a-resource-file 564 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 565 | End Sub 566 | 567 | Private Sub Form_Load() 568 | Me.Caption = "ADMIN DASHBOARD" 569 | lblTitle.Caption = Me.Caption 570 | lblUserName.Caption = gstrUserName 571 | LoadMousePointer 572 | SetBoxColour 573 | SetContainerTitle 574 | End Sub 575 | 576 | Private Sub LoadMousePointer() 577 | On Error Resume Next 578 | fraMenu1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 579 | fraMenu2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 580 | fraButton2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 581 | End Sub 582 | 583 | Private Sub SetBoxColour() 584 | fraBox1.BackColor = &HC9874C 585 | fraBox2.BackColor = &HB7D736 586 | fraBox3.BackColor = &H453AE4 587 | fraBox4.BackColor = &H18CAF7 588 | End Sub 589 | 590 | Private Sub SetContainerTitle() 591 | lblContainerTitle1.Caption = "CRUD FUNCTIONS" 592 | lblContainerTitle2.Caption = "HELP" 593 | lblButton2.Caption = "HELP" 594 | End Sub 595 | 596 | Private Sub fraButton2_Click() 597 | Me.Hide 598 | frmHelp.Show 599 | End Sub 600 | 601 | Private Sub fraMenu2_Click() 602 | frmUsers.Show 603 | Me.Hide 604 | End Sub 605 | 606 | Private Sub fraMenuContainer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 607 | fraMenu1.BackColor = &H80000010 608 | fraMenu2.BackColor = &H80000010 609 | End Sub 610 | 611 | Private Sub fraMenu1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 612 | fraMenu1.BackColor = &HE0E0E0 613 | End Sub 614 | 615 | Private Sub fraMenu2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 616 | fraMenu2.BackColor = &HE0E0E0 617 | End Sub 618 | 619 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 620 | GetMouseMove Button, X, Y 621 | End Sub 622 | 623 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 624 | SetMouseMove Button, X, Y 625 | End Sub 626 | 627 | Private Sub lblButton2_Click() 628 | frmHelp.Show 629 | Me.Hide 630 | End Sub 631 | 632 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 633 | GetMouseMove Button, X, Y 634 | End Sub 635 | 636 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 637 | SetMouseMove Button, X, Y 638 | End Sub 639 | 640 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 641 | MoveStartX = X 642 | MoveStartY = Y 643 | End Sub 644 | 645 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 646 | MoveEndX = X - MoveStartX 647 | MoveEndY = Y - MoveStartY 648 | If Button = 1 Then 649 | Me.Left = Me.Left + MoveEndX 650 | Me.Top = Me.Top + MoveEndY 651 | End If 652 | shpX.FillColor = &H8000000D 653 | shpX.BorderColor = &H8000000D 654 | 'lblX.ForeColor = &H8000000D 655 | lblX.ForeColor = &H0& 656 | End Sub 657 | 658 | Private Sub lblX_Click() 659 | Unload Me 660 | frmLogin.Show 661 | End Sub 662 | 663 | Private Sub lblX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 664 | lblX.ForeColor = vbWhite 665 | shpX.FillColor = vbRed 666 | End Sub 667 | -------------------------------------------------------------------------------- /frmHelp.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmHelp 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 8790 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 17295 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 8790 24 | ScaleWidth = 17295 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.Frame fraContainer1 27 | Appearance = 0 'Flat 28 | BackColor = &H80000005& 29 | BorderStyle = 0 'None 30 | ForeColor = &H80000008& 31 | Height = 7455 32 | Left = 3960 33 | TabIndex = 9 34 | Top = 1080 35 | Width = 12975 36 | Begin VB.Frame fraContainerTitle1 37 | Appearance = 0 'Flat 38 | BackColor = &H8000000D& 39 | BorderStyle = 0 'None 40 | ForeColor = &H80000008& 41 | Height = 735 42 | Left = 0 43 | TabIndex = 10 44 | Top = 0 45 | Width = 12975 46 | Begin VB.Label lblContainerTitle1 47 | AutoSize = -1 'True 48 | BackStyle = 0 'Transparent 49 | Caption = "CONTAINER TITLE 1" 50 | BeginProperty Font 51 | Name = "MS Sans Serif" 52 | Size = 12 53 | Charset = 0 54 | Weight = 700 55 | Underline = 0 'False 56 | Italic = 0 'False 57 | Strikethrough = 0 'False 58 | EndProperty 59 | ForeColor = &H00FFFFFF& 60 | Height = 300 61 | Left = 240 62 | TabIndex = 11 63 | Top = 240 64 | Width = 2565 65 | End 66 | End 67 | End 68 | Begin VB.Frame fraMenuContainer 69 | Appearance = 0 'Flat 70 | BackColor = &H80000010& 71 | BorderStyle = 0 'None 72 | BeginProperty Font 73 | Name = "MS Sans Serif" 74 | Size = 8.25 75 | Charset = 0 76 | Weight = 400 77 | Underline = 0 'False 78 | Italic = 0 'False 79 | Strikethrough = 0 'False 80 | EndProperty 81 | ForeColor = &H80000008& 82 | Height = 8055 83 | Left = 0 84 | TabIndex = 4 85 | Top = 720 86 | Width = 3615 87 | Begin VB.Frame fraMenu2 88 | Appearance = 0 'Flat 89 | BackColor = &H80000010& 90 | BorderStyle = 0 'None 91 | ForeColor = &H80000008& 92 | Height = 735 93 | Left = 120 94 | MousePointer = 99 'Custom 95 | TabIndex = 7 96 | Top = 1200 97 | Width = 3375 98 | Begin VB.Label lblMenu2 99 | AutoSize = -1 'True 100 | BackStyle = 0 'Transparent 101 | Caption = "Users" 102 | BeginProperty Font 103 | Name = "Arial" 104 | Size = 12 105 | Charset = 0 106 | Weight = 700 107 | Underline = 0 'False 108 | Italic = 0 'False 109 | Strikethrough = 0 'False 110 | EndProperty 111 | Height = 285 112 | Left = 240 113 | TabIndex = 8 114 | Top = 240 115 | Width = 675 116 | End 117 | End 118 | Begin VB.Frame fraMenu1 119 | Appearance = 0 'Flat 120 | BackColor = &H80000010& 121 | BorderStyle = 0 'None 122 | ForeColor = &H80000008& 123 | Height = 735 124 | Left = 120 125 | MousePointer = 99 'Custom 126 | TabIndex = 5 127 | Top = 240 128 | Width = 3375 129 | Begin VB.Label lblMenu1 130 | AutoSize = -1 'True 131 | BackStyle = 0 'Transparent 132 | Caption = "Dashboard" 133 | BeginProperty Font 134 | Name = "Arial" 135 | Size = 12 136 | Charset = 0 137 | Weight = 700 138 | Underline = 0 'False 139 | Italic = 0 'False 140 | Strikethrough = 0 'False 141 | EndProperty 142 | Height = 285 143 | Left = 240 144 | TabIndex = 6 145 | Top = 240 146 | Width = 1275 147 | End 148 | End 149 | End 150 | Begin VB.Frame fraTitle 151 | BackColor = &H8000000D& 152 | BorderStyle = 0 'None 153 | BeginProperty Font 154 | Name = "MS Sans Serif" 155 | Size = 8.25 156 | Charset = 0 157 | Weight = 400 158 | Underline = 0 'False 159 | Italic = 0 'False 160 | Strikethrough = 0 'False 161 | EndProperty 162 | Height = 735 163 | Left = 0 164 | TabIndex = 0 165 | Top = 0 166 | Width = 17295 167 | Begin VB.Label lblUserIcon 168 | AutoSize = -1 'True 169 | BackStyle = 0 'Transparent 170 | Caption = "user" 171 | BeginProperty Font 172 | Name = "Font Awesome 5 Free Regular" 173 | Size = 15.75 174 | Charset = 0 175 | Weight = 400 176 | Underline = 0 'False 177 | Italic = 0 'False 178 | Strikethrough = 0 'False 179 | EndProperty 180 | ForeColor = &H00FFFFFF& 181 | Height = 315 182 | Left = 14400 183 | TabIndex = 12 184 | Top = 180 185 | Width = 315 186 | End 187 | Begin VB.Label lblUserName 188 | Appearance = 0 'Flat 189 | AutoSize = -1 'True 190 | BackColor = &H80000005& 191 | BackStyle = 0 'Transparent 192 | Caption = "Administrator" 193 | BeginProperty Font 194 | Name = "Arial" 195 | Size = 12 196 | Charset = 0 197 | Weight = 700 198 | Underline = 0 'False 199 | Italic = 0 'False 200 | Strikethrough = 0 'False 201 | EndProperty 202 | ForeColor = &H00FFFFFF& 203 | Height = 285 204 | Left = 14880 205 | TabIndex = 3 206 | Top = 240 207 | Width = 1575 208 | End 209 | Begin VB.Label lblX 210 | Alignment = 2 'Center 211 | Appearance = 0 'Flat 212 | BackColor = &H80000005& 213 | BackStyle = 0 'Transparent 214 | Caption = "x" 215 | BeginProperty Font 216 | Name = "Arial" 217 | Size = 21.75 218 | Charset = 0 219 | Weight = 400 220 | Underline = 0 'False 221 | Italic = 0 'False 222 | Strikethrough = 0 'False 223 | EndProperty 224 | ForeColor = &H00FFFFFF& 225 | Height = 615 226 | Left = 16680 227 | TabIndex = 2 228 | Top = 0 229 | Width = 615 230 | End 231 | Begin VB.Shape shpX 232 | BorderColor = &H000000FF& 233 | FillColor = &H000000FF& 234 | FillStyle = 0 'Solid 235 | Height = 615 236 | Left = 16680 237 | Top = 0 238 | Width = 615 239 | End 240 | Begin VB.Label lblTitle 241 | AutoSize = -1 'True 242 | BackStyle = 0 'Transparent 243 | Caption = "APPLICATION TITLE" 244 | BeginProperty Font 245 | Name = "MS Sans Serif" 246 | Size = 12 247 | Charset = 0 248 | Weight = 700 249 | Underline = 0 'False 250 | Italic = 0 'False 251 | Strikethrough = 0 'False 252 | EndProperty 253 | ForeColor = &H00FFFFFF& 254 | Height = 300 255 | Left = 240 256 | TabIndex = 1 257 | Top = 240 258 | Width = 2535 259 | End 260 | End 261 | End 262 | Attribute VB_Name = "frmHelp" 263 | Attribute VB_GlobalNameSpace = False 264 | Attribute VB_Creatable = False 265 | Attribute VB_PredeclaredId = True 266 | Attribute VB_Exposed = False 267 | Option Explicit 268 | Dim MoveStartX As Single 269 | Dim MoveStartY As Single 270 | Dim MoveEndX As Single 271 | Dim MoveEndY As Single 272 | 273 | Private Sub Form_Initialize() 274 | ' Source: http://www.vbforums.com/showthread.php?432036-Classic-VB-How-can-I-set-my-exe-icon-using-a-resource-file 275 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 276 | End Sub 277 | 278 | Private Sub Form_Load() 279 | Me.Caption = "HELP" 280 | lblTitle.Caption = Me.Caption 281 | lblUserName.Caption = gstrUserName 282 | LoadMousePointer 283 | SetContainerTitle 284 | End Sub 285 | 286 | Private Sub LoadMousePointer() 287 | On Error Resume Next 288 | fraMenu1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 289 | fraMenu2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 290 | End Sub 291 | 292 | Private Sub SetContainerTitle() 293 | lblContainerTitle1.Caption = "HELP" 294 | End Sub 295 | 296 | Private Sub Form_Unload(Cancel As Integer) 297 | 'frmDashboard.Show 298 | End Sub 299 | 300 | Private Sub fraMenu1_Click() 301 | Unload Me 302 | frmDashboard.Show 303 | End Sub 304 | 305 | Private Sub fraMenu2_Click() 306 | Unload Me 307 | frmUsers.Show 308 | End Sub 309 | 310 | Private Sub fraMenuContainer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 311 | fraMenu1.BackColor = &H80000010 312 | fraMenu2.BackColor = &H80000010 313 | End Sub 314 | 315 | Private Sub fraMenu1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 316 | fraMenu1.BackColor = &HE0E0E0 317 | End Sub 318 | 319 | Private Sub fraMenu2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 320 | fraMenu2.BackColor = &HE0E0E0 321 | End Sub 322 | 323 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 324 | GetMouseMove Button, X, Y 325 | End Sub 326 | 327 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 328 | SetMouseMove Button, X, Y 329 | End Sub 330 | 331 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 332 | GetMouseMove Button, X, Y 333 | End Sub 334 | 335 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 336 | SetMouseMove Button, X, Y 337 | End Sub 338 | 339 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 340 | MoveStartX = X 341 | MoveStartY = Y 342 | End Sub 343 | 344 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 345 | MoveEndX = X - MoveStartX 346 | MoveEndY = Y - MoveStartY 347 | If Button = 1 Then 348 | Me.Left = Me.Left + MoveEndX 349 | Me.Top = Me.Top + MoveEndY 350 | End If 351 | End Sub 352 | 353 | Private Sub lblX_Click() 354 | Unload Me 355 | frmDashboard.Show 356 | End Sub 357 | -------------------------------------------------------------------------------- /frmLogin.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmLogin 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 7110 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 13365 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 7110 24 | ScaleWidth = 13365 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.Frame fraContainer1 27 | Appearance = 0 'Flat 28 | BackColor = &H80000005& 29 | BorderStyle = 0 'None 30 | ForeColor = &H80000008& 31 | Height = 5655 32 | Left = 360 33 | TabIndex = 6 34 | Top = 1080 35 | Width = 12615 36 | Begin VB.Frame fraButton1 37 | Appearance = 0 'Flat 38 | BackColor = &H00B7D736& 39 | BorderStyle = 0 'None 40 | ForeColor = &H80000008& 41 | Height = 735 42 | Left = 5280 43 | MousePointer = 99 'Custom 44 | TabIndex = 9 45 | Top = 4440 46 | Width = 2775 47 | Begin VB.Label lblButton1 48 | Alignment = 2 'Center 49 | AutoSize = -1 'True 50 | BackStyle = 0 'Transparent 51 | Caption = "BUTTON LABEL 1" 52 | BeginProperty Font 53 | Name = "MS Sans Serif" 54 | Size = 12 55 | Charset = 0 56 | Weight = 700 57 | Underline = 0 'False 58 | Italic = 0 'False 59 | Strikethrough = 0 'False 60 | EndProperty 61 | ForeColor = &H00FFFFFF& 62 | Height = 300 63 | Left = 225 64 | TabIndex = 2 65 | Top = 240 66 | Width = 2235 67 | End 68 | End 69 | Begin VB.TextBox txtPassword 70 | BeginProperty Font 71 | Name = "Wingdings" 72 | Size = 20.25 73 | Charset = 2 74 | Weight = 400 75 | Underline = 0 'False 76 | Italic = 0 'False 77 | Strikethrough = 0 'False 78 | EndProperty 79 | ForeColor = &H00404040& 80 | Height = 615 81 | IMEMode = 3 'DISABLE 82 | Left = 3120 83 | PasswordChar = "n" 84 | TabIndex = 1 85 | ToolTipText = "Password is case sensitive" 86 | Top = 3120 87 | Width = 6975 88 | End 89 | Begin VB.TextBox txtUserID 90 | BeginProperty Font 91 | Name = "Arial" 92 | Size = 20.25 93 | Charset = 0 94 | Weight = 400 95 | Underline = 0 'False 96 | Italic = 0 'False 97 | Strikethrough = 0 'False 98 | EndProperty 99 | ForeColor = &H00404040& 100 | Height = 615 101 | Left = 3120 102 | TabIndex = 0 103 | Top = 1920 104 | Width = 6975 105 | End 106 | Begin VB.Frame fraContainerTitle1 107 | Appearance = 0 'Flat 108 | BackColor = &H00C0FFFF& 109 | BorderStyle = 0 'None 110 | ForeColor = &H80000008& 111 | Height = 735 112 | Left = 0 113 | TabIndex = 7 114 | Top = 0 115 | Width = 12615 116 | Begin VB.Label lblContainerTitle1 117 | AutoSize = -1 'True 118 | BackStyle = 0 'Transparent 119 | Caption = "CONTAINER TITLE 1" 120 | BeginProperty Font 121 | Name = "MS Sans Serif" 122 | Size = 12 123 | Charset = 0 124 | Weight = 700 125 | Underline = 0 'False 126 | Italic = 0 'False 127 | Strikethrough = 0 'False 128 | EndProperty 129 | ForeColor = &H00404040& 130 | Height = 300 131 | Left = 240 132 | TabIndex = 8 133 | Top = 240 134 | Width = 2565 135 | End 136 | End 137 | Begin VB.Label Label2 138 | AutoSize = -1 'True 139 | BackStyle = 0 'Transparent 140 | Caption = "LABEL 2" 141 | BeginProperty Font 142 | Name = "MS Sans Serif" 143 | Size = 12 144 | Charset = 0 145 | Weight = 700 146 | Underline = 0 'False 147 | Italic = 0 'False 148 | Strikethrough = 0 'False 149 | EndProperty 150 | ForeColor = &H00404040& 151 | Height = 300 152 | Left = 3120 153 | TabIndex = 11 154 | Top = 2760 155 | Width = 1080 156 | End 157 | Begin VB.Label Label1 158 | AutoSize = -1 'True 159 | BackStyle = 0 'Transparent 160 | Caption = "LABEL 1" 161 | BeginProperty Font 162 | Name = "MS Sans Serif" 163 | Size = 12 164 | Charset = 0 165 | Weight = 700 166 | Underline = 0 'False 167 | Italic = 0 'False 168 | Strikethrough = 0 'False 169 | EndProperty 170 | ForeColor = &H00404040& 171 | Height = 300 172 | Left = 3120 173 | TabIndex = 10 174 | Top = 1560 175 | Width = 1080 176 | End 177 | End 178 | Begin VB.Frame fraTitle 179 | BackColor = &H8000000D& 180 | BorderStyle = 0 'None 181 | BeginProperty Font 182 | Name = "MS Sans Serif" 183 | Size = 8.25 184 | Charset = 0 185 | Weight = 400 186 | Underline = 0 'False 187 | Italic = 0 'False 188 | Strikethrough = 0 'False 189 | EndProperty 190 | Height = 735 191 | Left = 0 192 | TabIndex = 3 193 | Top = 0 194 | Width = 13365 195 | Begin VB.Label lblX 196 | Alignment = 2 'Center 197 | Appearance = 0 'Flat 198 | BackColor = &H80000005& 199 | BackStyle = 0 'Transparent 200 | Caption = "x" 201 | BeginProperty Font 202 | Name = "Arial" 203 | Size = 21.75 204 | Charset = 0 205 | Weight = 400 206 | Underline = 0 'False 207 | Italic = 0 'False 208 | Strikethrough = 0 'False 209 | EndProperty 210 | ForeColor = &H00FFFFFF& 211 | Height = 615 212 | Left = 12750 213 | TabIndex = 5 214 | Top = 0 215 | Width = 615 216 | End 217 | Begin VB.Shape shpX 218 | BorderColor = &H000000FF& 219 | FillColor = &H000000FF& 220 | FillStyle = 0 'Solid 221 | Height = 615 222 | Left = 12730 223 | Top = 0 224 | Width = 615 225 | End 226 | Begin VB.Label lblTitle 227 | AutoSize = -1 'True 228 | BackStyle = 0 'Transparent 229 | Caption = "APPLICATION TITLE" 230 | BeginProperty Font 231 | Name = "MS Sans Serif" 232 | Size = 12 233 | Charset = 0 234 | Weight = 700 235 | Underline = 0 'False 236 | Italic = 0 'False 237 | Strikethrough = 0 'False 238 | EndProperty 239 | ForeColor = &H00FFFFFF& 240 | Height = 300 241 | Left = 240 242 | TabIndex = 4 243 | Top = 240 244 | Width = 2535 245 | End 246 | End 247 | End 248 | Attribute VB_Name = "frmLogin" 249 | Attribute VB_GlobalNameSpace = False 250 | Attribute VB_Creatable = False 251 | Attribute VB_PredeclaredId = True 252 | Attribute VB_Exposed = False 253 | Option Explicit 254 | Dim strAppDataPath As String 255 | Dim strAppDataFile As String 256 | Dim MoveStartX As Single 257 | Dim MoveStartY As Single 258 | Dim MoveEndX As Single 259 | Dim MoveEndY As Single 260 | 261 | Private Sub Form_Initialize() 262 | ' Source: http://www.vbforums.com/showthread.php?432036-Classic-VB-How-can-I-set-my-exe-icon-using-a-resource-file 263 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 264 | End Sub 265 | 266 | Private Sub Form_Load() 267 | Me.Caption = "LOGIN" 268 | lblTitle.Caption = Me.Caption 269 | Label1.Caption = "USER ID" 270 | Label2.Caption = "PASSWORD" 271 | lblButton1.Caption = "SUBMIT" 272 | txtUserID.MaxLength = 20 273 | txtPassword.MaxLength = 20 274 | LoadMousePointer 275 | SetContainerTitle 276 | End Sub 277 | 278 | Private Sub LoadMousePointer() 279 | On Error Resume Next 280 | fraButton1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 281 | End Sub 282 | 283 | Private Sub SetContainerTitle() 284 | lblContainerTitle1.Caption = "PLEASE ENTER YOUR LOGIN CREDENTIALS" 285 | End Sub 286 | 287 | Private Sub Form_Unload(Cancel As Integer) 288 | 'frmDashboard.Show 289 | End Sub 290 | 291 | Private Sub fraButton1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 292 | With fraButton1 293 | .BackColor = &HE0E0E0 294 | End With 295 | With lblButton1 296 | .ForeColor = &H404040 297 | End With 298 | End Sub 299 | 300 | Private Sub fraContainer1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 301 | With fraButton1 302 | .BackColor = &HB7D736 303 | End With 304 | With lblButton1 305 | .ForeColor = &HFFFFFF 306 | End With 307 | End Sub 308 | 309 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 310 | GetMouseMove Button, X, Y 311 | End Sub 312 | 313 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 314 | SetMouseMove Button, X, Y 315 | End Sub 316 | 317 | Private Sub fraButton1_Click() 318 | If Not AuthenticateUser Then 319 | MsgBox "Wrong User ID or Password!", vbExclamation, "Access Denied" 320 | Else 321 | frmDashboard.Show 322 | Unload Me 323 | End If 324 | End Sub 325 | 326 | Private Sub lblButton1_Click() 327 | If Not AuthenticateUser Then 328 | MsgBox "Wrong User ID or Password!", vbExclamation, "Access Denied" 329 | Else 330 | frmDashboard.Show 331 | Unload Me 332 | End If 333 | End Sub 334 | 335 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 336 | GetMouseMove Button, X, Y 337 | End Sub 338 | 339 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 340 | SetMouseMove Button, X, Y 341 | End Sub 342 | 343 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 344 | MoveStartX = X 345 | MoveStartY = Y 346 | End Sub 347 | 348 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 349 | MoveEndX = X - MoveStartX 350 | MoveEndY = Y - MoveStartY 351 | If Button = 1 Then 352 | Me.Left = Me.Left + MoveEndX 353 | Me.Top = Me.Top + MoveEndY 354 | End If 355 | End Sub 356 | 357 | Private Sub lblX_Click() 358 | Unload Me 359 | 'frmDashboard.Show 360 | End Sub 361 | 362 | Private Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer) 363 | If KeyCode = vbKeyReturn Then 364 | If Not AuthenticateUser Then 365 | MsgBox "Wrong User ID or Password!", vbExclamation, "Access Denied" 366 | Exit Sub 367 | Else 368 | frmDashboard.Show 369 | Unload Me 370 | End If 371 | End If 372 | End Sub 373 | 374 | Private Sub txtUserID_KeyUp(KeyCode As Integer, Shift As Integer) 375 | If KeyCode = vbKeyReturn Then 376 | With txtPassword 377 | .SetFocus 378 | .SelStart = Len(.Text) 379 | .SelLength = 0 380 | End With 381 | End If 382 | End Sub 383 | 384 | Private Function AuthenticateUser() As Boolean 385 | Dim DB As New OmlDatabase 386 | Dim SB As New OmlSQLBuilder 387 | Dim rst As ADODB.Recordset 388 | Dim strUserID As String 389 | Dim strPassword As String 390 | Dim strSalt As String 391 | On Error GoTo Catch 392 | strAppDataPath = App.Path & "\Storage\" 393 | strAppDataFile = "Data.mdb" 394 | 395 | strUserID = Trim(txtUserID.Text) 396 | strPassword = Trim(txtPassword.Text) 397 | strSalt = GetSalt(strUserID) 398 | 399 | DB.DataPath = strAppDataPath 400 | DB.DataFile = strAppDataFile 401 | 'DB.DataPassword = "" 402 | DB.OpenMdb 403 | If DB.ErrorDesc <> "" Then 404 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 405 | Exit Function 406 | End If 407 | 'strSQL = "SELECT UserName" 408 | 'strSQL = strSQL & " FROM Users" 409 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 410 | 'strSQL = strSQL & " AND UserPassword = '" & MD5(strPassword & strSalt) & "'" 411 | 'strSQL = strSQL & " AND Active = Yes" 412 | SB.SELECT_ "UserName" 413 | SB.FROM "Users" 414 | SB.WHERE_Text "UserID", strUserID 415 | SB.AND_Text "UserPassword", MD5(strPassword & strSalt) 416 | SB.AND_Boolean "Active", "Yes" 417 | Set rst = DB.OpenRs(SB.Text) 418 | If DB.ErrorDesc <> "" Then 419 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 420 | Exit Function 421 | End If 422 | If Not rst.EOF Then 423 | gstrUserName = rst!UserName 424 | AuthenticateUser = True 425 | Else 426 | gstrUserName = "" 427 | AuthenticateUser = False 428 | End If 429 | DB.CloseRs rst 430 | DB.CloseMdb 431 | Exit Function 432 | Catch: 433 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "AuthenticateUser" 434 | DB.CloseRs rst 435 | DB.CloseMdb 436 | AuthenticateUser = False 437 | End Function 438 | 439 | Private Function GetSalt(ByVal strUserID As String) As String 440 | Dim DB As New OmlDatabase 441 | Dim SB As New OmlSQLBuilder 442 | Dim rst As ADODB.Recordset 443 | On Error GoTo Catch 444 | strAppDataPath = App.Path & "\Storage\" 445 | strAppDataFile = "Data.mdb" 446 | DB.DataPath = strAppDataPath 447 | DB.DataFile = strAppDataFile 448 | 'DB.DataPassword = "" 449 | DB.OpenMdb 450 | If DB.ErrorDesc <> "" Then 451 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 452 | Exit Function 453 | End If 454 | 'strSQL = "SELECT Salt" 455 | 'strSQL = strSQL & " FROM Users" 456 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 457 | SB.SELECT_ "Salt" 458 | SB.FROM "Users" 459 | SB.WHERE_Text "UserID", strUserID 460 | Set rst = DB.OpenRs(SB.Text) 461 | If DB.ErrorDesc <> "" Then 462 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 463 | Exit Function 464 | End If 465 | If Not rst.EOF Then 466 | GetSalt = rst!Salt 467 | Else 468 | GetSalt = "" 469 | End If 470 | DB.CloseRs rst 471 | DB.CloseMdb 472 | Exit Function 473 | Catch: 474 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "GetSalt" 475 | DB.CloseRs rst 476 | DB.CloseMdb 477 | GetSalt = "" 478 | End Function 479 | -------------------------------------------------------------------------------- /frmTemplate.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmTemplate 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 8790 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 17295 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 8790 24 | ScaleWidth = 17295 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.Frame fraContainer2 27 | Appearance = 0 'Flat 28 | BackColor = &H80000005& 29 | BorderStyle = 0 'None 30 | ForeColor = &H80000008& 31 | Height = 5175 32 | Left = 10680 33 | TabIndex = 18 34 | Top = 3360 35 | Width = 6375 36 | Begin VB.Frame fraContainerTitle2 37 | Appearance = 0 'Flat 38 | BackColor = &H8000000D& 39 | BorderStyle = 0 'None 40 | ForeColor = &H80000008& 41 | Height = 735 42 | Left = 0 43 | TabIndex = 21 44 | Top = 0 45 | Width = 6375 46 | Begin VB.Label lblContainerTitle2 47 | AutoSize = -1 'True 48 | BackStyle = 0 'Transparent 49 | Caption = "CONTAINER TITLE 2" 50 | BeginProperty Font 51 | Name = "MS Sans Serif" 52 | Size = 12 53 | Charset = 0 54 | Weight = 700 55 | Underline = 0 'False 56 | Italic = 0 'False 57 | Strikethrough = 0 'False 58 | EndProperty 59 | ForeColor = &H00FFFFFF& 60 | Height = 300 61 | Left = 240 62 | TabIndex = 22 63 | Top = 240 64 | Width = 2565 65 | End 66 | End 67 | End 68 | Begin VB.Frame fraContainer1 69 | Appearance = 0 'Flat 70 | BackColor = &H80000005& 71 | BorderStyle = 0 'None 72 | ForeColor = &H80000008& 73 | Height = 5175 74 | Left = 3960 75 | TabIndex = 17 76 | Top = 3360 77 | Width = 6375 78 | Begin VB.Frame fraContainerTitle1 79 | Appearance = 0 'Flat 80 | BackColor = &H8000000D& 81 | BorderStyle = 0 'None 82 | ForeColor = &H80000008& 83 | Height = 735 84 | Left = 0 85 | TabIndex = 19 86 | Top = 0 87 | Width = 6375 88 | Begin VB.Label lblContainerTitle1 89 | AutoSize = -1 'True 90 | BackStyle = 0 'Transparent 91 | Caption = "CONTAINER TITLE 1" 92 | BeginProperty Font 93 | Name = "MS Sans Serif" 94 | Size = 12 95 | Charset = 0 96 | Weight = 700 97 | Underline = 0 'False 98 | Italic = 0 'False 99 | Strikethrough = 0 'False 100 | EndProperty 101 | ForeColor = &H00FFFFFF& 102 | Height = 300 103 | Left = 240 104 | TabIndex = 20 105 | Top = 240 106 | Width = 2565 107 | End 108 | End 109 | End 110 | Begin VB.Frame fraBox4 111 | Appearance = 0 'Flat 112 | BorderStyle = 0 'None 113 | ForeColor = &H80000008& 114 | Height = 2000 115 | Left = 14040 116 | TabIndex = 12 117 | Top = 1080 118 | Width = 3000 119 | Begin VB.Label fa4 120 | AutoSize = -1 'True 121 | BackStyle = 0 'Transparent 122 | Caption = "sync-alt" 123 | BeginProperty Font 124 | Name = "Font Awesome 5 Free Solid" 125 | Size = 36 126 | Charset = 0 127 | Weight = 400 128 | Underline = 0 'False 129 | Italic = 0 'False 130 | Strikethrough = 0 'False 131 | EndProperty 132 | ForeColor = &H00E0E0E0& 133 | Height = 750 134 | Left = 240 135 | TabIndex = 26 136 | Top = 240 137 | Width = 720 138 | End 139 | Begin VB.Label Label3 140 | Alignment = 1 'Right Justify 141 | Appearance = 0 'Flat 142 | AutoSize = -1 'True 143 | BackColor = &H80000005& 144 | BackStyle = 0 'Transparent 145 | Caption = "99 Updates" 146 | BeginProperty Font 147 | Name = "Arial" 148 | Size = 18 149 | Charset = 0 150 | Weight = 400 151 | Underline = 0 'False 152 | Italic = 0 'False 153 | Strikethrough = 0 'False 154 | EndProperty 155 | ForeColor = &H00E0E0E0& 156 | Height = 405 157 | Left = 900 158 | TabIndex = 16 159 | Top = 1440 160 | Width = 1845 161 | End 162 | End 163 | Begin VB.Frame fraBox3 164 | Appearance = 0 'Flat 165 | BorderStyle = 0 'None 166 | ForeColor = &H80000008& 167 | Height = 2000 168 | Left = 10680 169 | TabIndex = 11 170 | Top = 1080 171 | Width = 3000 172 | Begin VB.Label fa3 173 | AutoSize = -1 'True 174 | BackStyle = 0 'Transparent 175 | Caption = "database" 176 | BeginProperty Font 177 | Name = "Font Awesome 5 Free Solid" 178 | Size = 36 179 | Charset = 0 180 | Weight = 400 181 | Underline = 0 'False 182 | Italic = 0 'False 183 | Strikethrough = 0 'False 184 | EndProperty 185 | ForeColor = &H00E0E0E0& 186 | Height = 750 187 | Left = 240 188 | TabIndex = 25 189 | Top = 240 190 | Width = 630 191 | End 192 | Begin VB.Label Label2 193 | Alignment = 1 'Right Justify 194 | Appearance = 0 'Flat 195 | AutoSize = -1 'True 196 | BackColor = &H80000005& 197 | BackStyle = 0 'Transparent 198 | Caption = "99,999 Records" 199 | BeginProperty Font 200 | Name = "Arial" 201 | Size = 18 202 | Charset = 0 203 | Weight = 400 204 | Underline = 0 'False 205 | Italic = 0 'False 206 | Strikethrough = 0 'False 207 | EndProperty 208 | ForeColor = &H00E0E0E0& 209 | Height = 405 210 | Left = 180 211 | TabIndex = 15 212 | Top = 1440 213 | Width = 2520 214 | End 215 | End 216 | Begin VB.Frame fraBox2 217 | Appearance = 0 'Flat 218 | BorderStyle = 0 'None 219 | ForeColor = &H80000008& 220 | Height = 2000 221 | Left = 7320 222 | TabIndex = 10 223 | Top = 1080 224 | Width = 3000 225 | Begin VB.Label fa2 226 | AutoSize = -1 'True 227 | BackStyle = 0 'Transparent 228 | Caption = "users" 229 | BeginProperty Font 230 | Name = "Font Awesome 5 Free Solid" 231 | Size = 36 232 | Charset = 0 233 | Weight = 400 234 | Underline = 0 'False 235 | Italic = 0 'False 236 | Strikethrough = 0 'False 237 | EndProperty 238 | ForeColor = &H00E0E0E0& 239 | Height = 750 240 | Left = 240 241 | TabIndex = 24 242 | Top = 240 243 | Width = 900 244 | End 245 | Begin VB.Label Label1 246 | Alignment = 1 'Right Justify 247 | Appearance = 0 'Flat 248 | AutoSize = -1 'True 249 | BackColor = &H80000005& 250 | BackStyle = 0 'Transparent 251 | Caption = "1,000,000 Users" 252 | BeginProperty Font 253 | Name = "Arial" 254 | Size = 18 255 | Charset = 0 256 | Weight = 400 257 | Underline = 0 'False 258 | Italic = 0 'False 259 | Strikethrough = 0 'False 260 | EndProperty 261 | ForeColor = &H00E0E0E0& 262 | Height = 405 263 | Left = 135 264 | TabIndex = 14 265 | Top = 1440 266 | Width = 2610 267 | End 268 | End 269 | Begin VB.Frame fraBox1 270 | Appearance = 0 'Flat 271 | BorderStyle = 0 'None 272 | ForeColor = &H80000008& 273 | Height = 2000 274 | Left = 3960 275 | TabIndex = 9 276 | Top = 1080 277 | Width = 3000 278 | Begin VB.Label fa1 279 | AutoSize = -1 'True 280 | BackStyle = 0 'Transparent 281 | Caption = "tachometer-alt" 282 | BeginProperty Font 283 | Name = "Font Awesome 5 Free Solid" 284 | Size = 36 285 | Charset = 0 286 | Weight = 400 287 | Underline = 0 'False 288 | Italic = 0 'False 289 | Strikethrough = 0 'False 290 | EndProperty 291 | ForeColor = &H00E0E0E0& 292 | Height = 750 293 | Left = 240 294 | TabIndex = 23 295 | Top = 240 296 | Width = 810 297 | End 298 | Begin VB.Label lblBox1 299 | Alignment = 1 'Right Justify 300 | Appearance = 0 'Flat 301 | AutoSize = -1 'True 302 | BackColor = &H80000005& 303 | BackStyle = 0 'Transparent 304 | Caption = "90% Memory" 305 | BeginProperty Font 306 | Name = "Arial" 307 | Size = 18 308 | Charset = 0 309 | Weight = 400 310 | Underline = 0 'False 311 | Italic = 0 'False 312 | Strikethrough = 0 'False 313 | EndProperty 314 | ForeColor = &H00E0E0E0& 315 | Height = 405 316 | Left = 600 317 | TabIndex = 13 318 | Top = 1440 319 | Width = 2085 320 | End 321 | End 322 | Begin VB.Frame fraMenuContainer 323 | Appearance = 0 'Flat 324 | BackColor = &H80000010& 325 | BorderStyle = 0 'None 326 | BeginProperty Font 327 | Name = "MS Sans Serif" 328 | Size = 8.25 329 | Charset = 0 330 | Weight = 400 331 | Underline = 0 'False 332 | Italic = 0 'False 333 | Strikethrough = 0 'False 334 | EndProperty 335 | ForeColor = &H80000008& 336 | Height = 8055 337 | Left = 0 338 | TabIndex = 4 339 | Top = 720 340 | Width = 3615 341 | Begin VB.Frame fraMenu2 342 | Appearance = 0 'Flat 343 | BackColor = &H80000010& 344 | BorderStyle = 0 'None 345 | ForeColor = &H80000008& 346 | Height = 735 347 | Left = 120 348 | MousePointer = 99 'Custom 349 | TabIndex = 7 350 | Top = 1200 351 | Width = 3375 352 | Begin VB.Label lblMenu2 353 | AutoSize = -1 'True 354 | BackStyle = 0 'Transparent 355 | Caption = "Users" 356 | BeginProperty Font 357 | Name = "Arial" 358 | Size = 12 359 | Charset = 0 360 | Weight = 700 361 | Underline = 0 'False 362 | Italic = 0 'False 363 | Strikethrough = 0 'False 364 | EndProperty 365 | Height = 285 366 | Left = 240 367 | TabIndex = 8 368 | Top = 240 369 | Width = 675 370 | End 371 | End 372 | Begin VB.Frame fraMenu1 373 | Appearance = 0 'Flat 374 | BackColor = &H80000010& 375 | BorderStyle = 0 'None 376 | ForeColor = &H80000008& 377 | Height = 735 378 | Left = 120 379 | MousePointer = 99 'Custom 380 | TabIndex = 5 381 | Top = 240 382 | Width = 3375 383 | Begin VB.Label lblMenu1 384 | AutoSize = -1 'True 385 | BackStyle = 0 'Transparent 386 | Caption = "Dashboard" 387 | BeginProperty Font 388 | Name = "Arial" 389 | Size = 12 390 | Charset = 0 391 | Weight = 700 392 | Underline = 0 'False 393 | Italic = 0 'False 394 | Strikethrough = 0 'False 395 | EndProperty 396 | Height = 285 397 | Left = 240 398 | TabIndex = 6 399 | Top = 240 400 | Width = 1275 401 | End 402 | End 403 | End 404 | Begin VB.Frame fraTitle 405 | BackColor = &H8000000D& 406 | BorderStyle = 0 'None 407 | BeginProperty Font 408 | Name = "MS Sans Serif" 409 | Size = 8.25 410 | Charset = 0 411 | Weight = 400 412 | Underline = 0 'False 413 | Italic = 0 'False 414 | Strikethrough = 0 'False 415 | EndProperty 416 | Height = 735 417 | Left = 0 418 | TabIndex = 0 419 | Top = 0 420 | Width = 17295 421 | Begin VB.Label lblUserIcon 422 | AutoSize = -1 'True 423 | BackStyle = 0 'Transparent 424 | Caption = "user" 425 | BeginProperty Font 426 | Name = "Font Awesome 5 Free Regular" 427 | Size = 15.75 428 | Charset = 0 429 | Weight = 400 430 | Underline = 0 'False 431 | Italic = 0 'False 432 | Strikethrough = 0 'False 433 | EndProperty 434 | ForeColor = &H00FFFFFF& 435 | Height = 315 436 | Left = 14400 437 | TabIndex = 27 438 | Top = 180 439 | Width = 315 440 | End 441 | Begin VB.Label lblUserName 442 | Appearance = 0 'Flat 443 | AutoSize = -1 'True 444 | BackColor = &H80000005& 445 | BackStyle = 0 'Transparent 446 | Caption = "Administrator" 447 | BeginProperty Font 448 | Name = "Arial" 449 | Size = 12 450 | Charset = 0 451 | Weight = 700 452 | Underline = 0 'False 453 | Italic = 0 'False 454 | Strikethrough = 0 'False 455 | EndProperty 456 | ForeColor = &H00FFFFFF& 457 | Height = 285 458 | Left = 14880 459 | TabIndex = 3 460 | Top = 240 461 | Width = 1575 462 | End 463 | Begin VB.Label lblX 464 | Alignment = 2 'Center 465 | Appearance = 0 'Flat 466 | BackColor = &H80000005& 467 | BackStyle = 0 'Transparent 468 | Caption = "x" 469 | BeginProperty Font 470 | Name = "Arial" 471 | Size = 21.75 472 | Charset = 0 473 | Weight = 400 474 | Underline = 0 'False 475 | Italic = 0 'False 476 | Strikethrough = 0 'False 477 | EndProperty 478 | ForeColor = &H00FFFFFF& 479 | Height = 615 480 | Left = 16680 481 | TabIndex = 2 482 | Top = 0 483 | Width = 615 484 | End 485 | Begin VB.Shape shpX 486 | BorderColor = &H000000FF& 487 | FillColor = &H000000FF& 488 | FillStyle = 0 'Solid 489 | Height = 615 490 | Left = 16680 491 | Top = 0 492 | Width = 615 493 | End 494 | Begin VB.Label lblTitle 495 | AutoSize = -1 'True 496 | BackStyle = 0 'Transparent 497 | Caption = "APPLICATION TITLE" 498 | BeginProperty Font 499 | Name = "MS Sans Serif" 500 | Size = 12 501 | Charset = 0 502 | Weight = 700 503 | Underline = 0 'False 504 | Italic = 0 'False 505 | Strikethrough = 0 'False 506 | EndProperty 507 | ForeColor = &H00FFFFFF& 508 | Height = 300 509 | Left = 240 510 | TabIndex = 1 511 | Top = 240 512 | Width = 2535 513 | End 514 | End 515 | End 516 | Attribute VB_Name = "frmTemplate" 517 | Attribute VB_GlobalNameSpace = False 518 | Attribute VB_Creatable = False 519 | Attribute VB_PredeclaredId = True 520 | Attribute VB_Exposed = False 521 | Option Explicit 522 | Dim MoveStartX As Single 523 | Dim MoveStartY As Single 524 | Dim MoveEndX As Single 525 | Dim MoveEndY As Single 526 | 527 | Private Sub Form_Initialize() 528 | ' Source: http://www.vbforums.com/showthread.php?432036-Classic-VB-How-can-I-set-my-exe-icon-using-a-resource-file 529 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 530 | End Sub 531 | 532 | Private Sub Form_Load() 533 | Me.Caption = "ADMIN DASHBOARD" 534 | lblTitle.Caption = Me.Caption 535 | 'lblUserName.Caption = gstrUserName 536 | LoadMousePointer 537 | SetBoxColour 538 | SetContainerTitle 539 | End Sub 540 | 541 | Private Sub LoadMousePointer() 542 | On Error Resume Next 543 | fraMenu1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 544 | fraMenu2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 545 | End Sub 546 | 547 | Private Sub SetBoxColour() 548 | fraBox1.BackColor = &HC9874C 549 | fraBox2.BackColor = &HB7D736 550 | fraBox3.BackColor = &H453AE4 551 | fraBox4.BackColor = &H18CAF7 552 | End Sub 553 | 554 | Private Sub SetContainerTitle() 555 | lblContainerTitle1.Caption = "CRUD FUNCTIONS" 556 | lblContainerTitle2.Caption = "HELP" 557 | End Sub 558 | 559 | Private Sub Form_Unload(Cancel As Integer) 560 | 'frmDashboard.Show 561 | End Sub 562 | 563 | Private Sub fraMenu1_Click() 564 | 'MsgBox "" & lblMenu1.Caption, vbInformation, "Click" 565 | End Sub 566 | 567 | Private Sub fraMenu2_Click() 568 | 'MsgBox "" & lblMenu2.Caption, vbInformation, "Click" 569 | End Sub 570 | 571 | Private Sub fraMenuContainer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 572 | fraMenu1.BackColor = &H80000010 573 | fraMenu2.BackColor = &H80000010 574 | End Sub 575 | 576 | Private Sub fraMenu1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 577 | fraMenu1.BackColor = &HE0E0E0 578 | End Sub 579 | 580 | Private Sub fraMenu2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 581 | fraMenu2.BackColor = &HE0E0E0 582 | End Sub 583 | 584 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 585 | GetMouseMove Button, X, Y 586 | End Sub 587 | 588 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 589 | SetMouseMove Button, X, Y 590 | End Sub 591 | 592 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 593 | GetMouseMove Button, X, Y 594 | End Sub 595 | 596 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 597 | SetMouseMove Button, X, Y 598 | End Sub 599 | 600 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 601 | MoveStartX = X 602 | MoveStartY = Y 603 | End Sub 604 | 605 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 606 | MoveEndX = X - MoveStartX 607 | MoveEndY = Y - MoveStartY 608 | If Button = 1 Then 609 | Me.Left = Me.Left + MoveEndX 610 | Me.Top = Me.Top + MoveEndY 611 | End If 612 | End Sub 613 | 614 | Private Sub lblX_Click() 615 | Unload Me 616 | End Sub 617 | -------------------------------------------------------------------------------- /frmUserDetails.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmUserDetails 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 8595 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 13365 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 8595 24 | ScaleWidth = 13365 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.ComboBox cboUserRole 27 | BeginProperty Font 28 | Name = "Arial" 29 | Size = 20.25 30 | Charset = 0 31 | Weight = 400 32 | Underline = 0 'False 33 | Italic = 0 'False 34 | Strikethrough = 0 'False 35 | EndProperty 36 | Height = 600 37 | Left = 3360 38 | Style = 2 'Dropdown List 39 | TabIndex = 13 40 | Top = 4320 41 | Width = 6975 42 | End 43 | Begin VB.Frame fraContainer1 44 | Appearance = 0 'Flat 45 | BackColor = &H80000005& 46 | BorderStyle = 0 'None 47 | ForeColor = &H80000008& 48 | Height = 7215 49 | Left = 360 50 | TabIndex = 6 51 | Top = 1080 52 | Width = 12615 53 | Begin VB.Frame fraButton2 54 | Appearance = 0 'Flat 55 | BackColor = &H00B7D736& 56 | BorderStyle = 0 'None 57 | ForeColor = &H80000008& 58 | Height = 735 59 | Left = 9360 60 | MousePointer = 99 'Custom 61 | TabIndex = 17 62 | Top = 6000 63 | Width = 2775 64 | Begin VB.Label lblButton2 65 | Alignment = 2 'Center 66 | AutoSize = -1 'True 67 | BackStyle = 0 'Transparent 68 | Caption = "BUTTON LABEL 2" 69 | BeginProperty Font 70 | Name = "MS Sans Serif" 71 | Size = 12 72 | Charset = 0 73 | Weight = 700 74 | Underline = 0 'False 75 | Italic = 0 'False 76 | Strikethrough = 0 'False 77 | EndProperty 78 | ForeColor = &H00FFFFFF& 79 | Height = 300 80 | Left = 225 81 | TabIndex = 18 82 | Top = 240 83 | Width = 2235 84 | End 85 | End 86 | Begin VB.OptionButton optActive 87 | Appearance = 0 'Flat 88 | BackColor = &H80000005& 89 | Caption = "No" 90 | BeginProperty Font 91 | Name = "Arial" 92 | Size = 20.25 93 | Charset = 0 94 | Weight = 400 95 | Underline = 0 'False 96 | Italic = 0 'False 97 | Strikethrough = 0 'False 98 | EndProperty 99 | ForeColor = &H80000008& 100 | Height = 600 101 | Index = 1 102 | Left = 5400 103 | TabIndex = 16 104 | Top = 4200 105 | Value = -1 'True 106 | Width = 1215 107 | End 108 | Begin VB.OptionButton optActive 109 | Appearance = 0 'Flat 110 | BackColor = &H80000005& 111 | Caption = "Yes" 112 | BeginProperty Font 113 | Name = "Arial" 114 | Size = 20.25 115 | Charset = 0 116 | Weight = 400 117 | Underline = 0 'False 118 | Italic = 0 'False 119 | Strikethrough = 0 'False 120 | EndProperty 121 | ForeColor = &H80000008& 122 | Height = 600 123 | Index = 0 124 | Left = 3000 125 | TabIndex = 15 126 | Top = 4200 127 | Width = 1215 128 | End 129 | Begin VB.Frame fraButton1 130 | Appearance = 0 'Flat 131 | BackColor = &H00B7D736& 132 | BorderStyle = 0 'None 133 | ForeColor = &H80000008& 134 | Height = 735 135 | Left = 5280 136 | MousePointer = 99 'Custom 137 | TabIndex = 9 138 | Top = 6000 139 | Width = 2775 140 | Begin VB.Label lblButton1 141 | Alignment = 2 'Center 142 | AutoSize = -1 'True 143 | BackStyle = 0 'Transparent 144 | Caption = "BUTTON LABEL 1" 145 | BeginProperty Font 146 | Name = "MS Sans Serif" 147 | Size = 12 148 | Charset = 0 149 | Weight = 700 150 | Underline = 0 'False 151 | Italic = 0 'False 152 | Strikethrough = 0 'False 153 | EndProperty 154 | ForeColor = &H00FFFFFF& 155 | Height = 300 156 | Left = 225 157 | TabIndex = 2 158 | Top = 240 159 | Width = 2235 160 | End 161 | End 162 | Begin VB.TextBox txtUserName 163 | BeginProperty Font 164 | Name = "Arial" 165 | Size = 20.25 166 | Charset = 0 167 | Weight = 400 168 | Underline = 0 'False 169 | Italic = 0 'False 170 | Strikethrough = 0 'False 171 | EndProperty 172 | ForeColor = &H00404040& 173 | Height = 615 174 | IMEMode = 3 'DISABLE 175 | Left = 3000 176 | MaxLength = 20 177 | TabIndex = 1 178 | Top = 2280 179 | Width = 6975 180 | End 181 | Begin VB.TextBox txtUserID 182 | BeginProperty Font 183 | Name = "Arial" 184 | Size = 20.25 185 | Charset = 0 186 | Weight = 400 187 | Underline = 0 'False 188 | Italic = 0 'False 189 | Strikethrough = 0 'False 190 | EndProperty 191 | ForeColor = &H00404040& 192 | Height = 615 193 | Left = 3000 194 | MaxLength = 20 195 | TabIndex = 0 196 | Top = 1320 197 | Width = 6975 198 | End 199 | Begin VB.Frame fraContainerTitle1 200 | Appearance = 0 'Flat 201 | BackColor = &H00C0FFFF& 202 | BorderStyle = 0 'None 203 | ForeColor = &H80000008& 204 | Height = 735 205 | Left = 0 206 | TabIndex = 7 207 | Top = 0 208 | Width = 12615 209 | Begin VB.Label lblContainerTitle1 210 | AutoSize = -1 'True 211 | BackStyle = 0 'Transparent 212 | Caption = "CONTAINER TITLE 1" 213 | BeginProperty Font 214 | Name = "MS Sans Serif" 215 | Size = 12 216 | Charset = 0 217 | Weight = 700 218 | Underline = 0 'False 219 | Italic = 0 'False 220 | Strikethrough = 0 'False 221 | EndProperty 222 | ForeColor = &H00404040& 223 | Height = 300 224 | Left = 240 225 | TabIndex = 8 226 | Top = 240 227 | Width = 2565 228 | End 229 | End 230 | Begin VB.Label Label4 231 | AutoSize = -1 'True 232 | BackStyle = 0 'Transparent 233 | Caption = "LABEL 4" 234 | BeginProperty Font 235 | Name = "MS Sans Serif" 236 | Size = 12 237 | Charset = 0 238 | Weight = 700 239 | Underline = 0 'False 240 | Italic = 0 'False 241 | Strikethrough = 0 'False 242 | EndProperty 243 | ForeColor = &H00404040& 244 | Height = 300 245 | Left = 960 246 | TabIndex = 14 247 | Top = 4200 248 | Width = 1080 249 | End 250 | Begin VB.Label Label3 251 | AutoSize = -1 'True 252 | BackStyle = 0 'Transparent 253 | Caption = "LABEL 3" 254 | BeginProperty Font 255 | Name = "MS Sans Serif" 256 | Size = 12 257 | Charset = 0 258 | Weight = 700 259 | Underline = 0 'False 260 | Italic = 0 'False 261 | Strikethrough = 0 'False 262 | EndProperty 263 | ForeColor = &H00404040& 264 | Height = 300 265 | Left = 960 266 | TabIndex = 12 267 | Top = 3240 268 | Width = 1080 269 | End 270 | Begin VB.Label Label2 271 | AutoSize = -1 'True 272 | BackStyle = 0 'Transparent 273 | Caption = "LABEL 2" 274 | BeginProperty Font 275 | Name = "MS Sans Serif" 276 | Size = 12 277 | Charset = 0 278 | Weight = 700 279 | Underline = 0 'False 280 | Italic = 0 'False 281 | Strikethrough = 0 'False 282 | EndProperty 283 | ForeColor = &H00404040& 284 | Height = 300 285 | Left = 960 286 | TabIndex = 11 287 | Top = 2280 288 | Width = 1080 289 | End 290 | Begin VB.Label Label1 291 | AutoSize = -1 'True 292 | BackStyle = 0 'Transparent 293 | Caption = "LABEL 1" 294 | BeginProperty Font 295 | Name = "MS Sans Serif" 296 | Size = 12 297 | Charset = 0 298 | Weight = 700 299 | Underline = 0 'False 300 | Italic = 0 'False 301 | Strikethrough = 0 'False 302 | EndProperty 303 | ForeColor = &H00404040& 304 | Height = 300 305 | Left = 960 306 | TabIndex = 10 307 | Top = 1320 308 | Width = 1080 309 | End 310 | End 311 | Begin VB.Frame fraTitle 312 | BackColor = &H8000000D& 313 | BorderStyle = 0 'None 314 | BeginProperty Font 315 | Name = "MS Sans Serif" 316 | Size = 8.25 317 | Charset = 0 318 | Weight = 400 319 | Underline = 0 'False 320 | Italic = 0 'False 321 | Strikethrough = 0 'False 322 | EndProperty 323 | Height = 735 324 | Left = 0 325 | TabIndex = 3 326 | Top = 0 327 | Width = 13365 328 | Begin VB.Label lblX 329 | Alignment = 2 'Center 330 | Appearance = 0 'Flat 331 | BackColor = &H80000005& 332 | BackStyle = 0 'Transparent 333 | Caption = "x" 334 | BeginProperty Font 335 | Name = "Arial" 336 | Size = 21.75 337 | Charset = 0 338 | Weight = 400 339 | Underline = 0 'False 340 | Italic = 0 'False 341 | Strikethrough = 0 'False 342 | EndProperty 343 | ForeColor = &H00FFFFFF& 344 | Height = 615 345 | Left = 12730 346 | TabIndex = 5 347 | Top = 0 348 | Width = 615 349 | End 350 | Begin VB.Shape shpX 351 | BorderColor = &H000000FF& 352 | FillColor = &H000000FF& 353 | FillStyle = 0 'Solid 354 | Height = 615 355 | Left = 12750 356 | Top = 0 357 | Width = 615 358 | End 359 | Begin VB.Label lblTitle 360 | AutoSize = -1 'True 361 | BackStyle = 0 'Transparent 362 | Caption = "APPLICATION TITLE" 363 | BeginProperty Font 364 | Name = "MS Sans Serif" 365 | Size = 12 366 | Charset = 0 367 | Weight = 700 368 | Underline = 0 'False 369 | Italic = 0 'False 370 | Strikethrough = 0 'False 371 | EndProperty 372 | ForeColor = &H00FFFFFF& 373 | Height = 300 374 | Left = 240 375 | TabIndex = 4 376 | Top = 240 377 | Width = 2535 378 | End 379 | End 380 | End 381 | Attribute VB_Name = "frmUserDetails" 382 | Attribute VB_GlobalNameSpace = False 383 | Attribute VB_Creatable = False 384 | Attribute VB_PredeclaredId = True 385 | Attribute VB_Exposed = False 386 | Option Explicit 387 | Dim strAppDataPath As String 388 | Dim strAppDataFile As String 389 | Dim strUserID As String 390 | Dim strUserName As String 391 | Dim strUserRole As String 392 | Dim strActive As String 393 | Dim strSalt As String 394 | Dim strPassword As String 395 | Dim MoveStartX As Single 396 | Dim MoveStartY As Single 397 | Dim MoveEndX As Single 398 | Dim MoveEndY As Single 399 | 400 | Private Sub Form_Initialize() 401 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 402 | End Sub 403 | 404 | Private Sub Form_Load() 405 | Me.Caption = "USER DETAILS" 406 | lblTitle.Caption = Me.Caption 407 | Label1.Caption = "USER ID" 408 | Label2.Caption = "USER NAME" 409 | Label3.Caption = "USER ROLE" 410 | Label4.Caption = "ACTIVE" 411 | lblButton1.Caption = "UPDATE" 412 | lblButton2.Caption = "SECRET" 413 | With cboUserRole 414 | .AddItem "Admin" 415 | .AddItem "Manager" 416 | .AddItem "User" 417 | End With 418 | LoadMousePointer 419 | SetContainerTitle 420 | End Sub 421 | 422 | Private Sub LoadMousePointer() 423 | On Error Resume Next 424 | fraButton1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 425 | fraButton2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 426 | End Sub 427 | 428 | Private Sub SetContainerTitle() 429 | lblContainerTitle1.Caption = "USER DETAILS" 430 | End Sub 431 | 432 | Private Sub fraButton1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 433 | With fraButton1 434 | .BackColor = &HE0E0E0 435 | End With 436 | With lblButton1 437 | .ForeColor = &H404040 438 | End With 439 | End Sub 440 | 441 | Private Sub fraButton2_Click() 442 | If txtUserID.Text = "" Then 443 | MsgBox "User ID is empty!", vbExclamation, "User ID" 444 | Exit Sub 445 | End If 446 | With frmUserUpdateSaltPassword 447 | .Show 448 | .LoadCombo 449 | .cboUserID.Text = txtUserID.Text 450 | End With 451 | Unload Me 452 | End Sub 453 | 454 | Private Sub fraContainer1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 455 | With fraButton1 456 | .BackColor = &HB7D736 457 | End With 458 | With lblButton1 459 | .ForeColor = &HFFFFFF 460 | End With 461 | End Sub 462 | 463 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 464 | GetMouseMove Button, X, Y 465 | End Sub 466 | 467 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 468 | SetMouseMove Button, X, Y 469 | End Sub 470 | 471 | Private Sub fraButton1_Click() 472 | If txtUserID.Text = "" Then 473 | MsgBox "User ID is empty!", vbExclamation, "User ID" 474 | Exit Sub 475 | End If 476 | If FindUser Then 477 | UpdateUser 478 | Else 479 | AddUser 480 | End If 481 | End Sub 482 | 483 | Private Sub lblButton1_Click() 484 | fraButton1_Click 485 | End Sub 486 | 487 | Private Sub lblButton2_Click() 488 | fraButton2_Click 489 | End Sub 490 | 491 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 492 | GetMouseMove Button, X, Y 493 | End Sub 494 | 495 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 496 | SetMouseMove Button, X, Y 497 | End Sub 498 | 499 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 500 | MoveStartX = X 501 | MoveStartY = Y 502 | End Sub 503 | 504 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 505 | MoveEndX = X - MoveStartX 506 | MoveEndY = Y - MoveStartY 507 | If Button = 1 Then 508 | Me.Left = Me.Left + MoveEndX 509 | Me.Top = Me.Top + MoveEndY 510 | End If 511 | End Sub 512 | 513 | Private Sub lblX_Click() 514 | Unload Me 515 | frmUsers.Show 516 | End Sub 517 | 518 | Public Sub PopulateValues(strUserID As String) 519 | Dim DB As New OmlDatabase 520 | Dim SB As New OmlSQLBuilder 521 | Dim rst As ADODB.Recordset 522 | On Error GoTo Catch 523 | strAppDataPath = App.Path & "\Storage\" 524 | strAppDataFile = "Data.mdb" 525 | DB.DataPath = strAppDataPath 526 | DB.DataFile = strAppDataFile 527 | 'DB.DataPassword = "" 528 | DB.OpenMdb 529 | If DB.ErrorDesc <> "" Then 530 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 531 | Exit Sub 532 | End If 533 | 'strSQL = "SELECT" 534 | 'strSQL = strSQL & " UserID," 535 | 'strSQL = strSQL & " UserName," 536 | 'strSQL = strSQL & " UserRole," 537 | 'strSQL = strSQL & " Active" 538 | 'strSQL = strSQL & " FROM Users" 539 | 'strSQL = strSQL & " WHERE ID = " & strUserID 540 | SB.SELECT_ 541 | SB.SQL "UserID" 542 | SB.SQL "UserName" 543 | SB.SQL "UserRole" 544 | SB.SQL "Active", 0 545 | SB.FROM "Users" 546 | SB.WHERE_Long "ID", CLng(strUserID) 547 | Set rst = DB.OpenRs(SB.Text) 548 | If DB.ErrorDesc <> "" Then 549 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 550 | Exit Sub 551 | End If 552 | If Not rst.EOF Then 553 | txtUserID.Text = rst!UserID 554 | txtUserName.Text = rst!UserName 555 | cboUserRole.Text = rst!UserRole 556 | If rst!Active Then 557 | optActive(0).Value = True 558 | Else 559 | optActive(1).Value = True 560 | End If 561 | txtUserID.Enabled = False 562 | With txtUserName 563 | .SelStart = Len(.Text) 564 | .SelLength = 0 565 | End With 566 | Else 567 | txtUserID.Text = "" 568 | txtUserName.Text = "" 569 | cboUserRole.ListIndex = -1 570 | optActive(1).Value = True ' Default = No 571 | With txtUserID 572 | .Enabled = True 573 | .SetFocus 574 | End With 575 | End If 576 | DB.CloseRs rst 577 | DB.CloseMdb 578 | Exit Sub 579 | Catch: 580 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "PopulateValues" 581 | DB.CloseRs rst 582 | DB.CloseMdb 583 | End Sub 584 | 585 | Private Function FindUser() As Boolean 586 | Dim DB As New OmlDatabase 587 | Dim SB As New OmlSQLBuilder 588 | Dim rst As ADODB.Recordset 589 | On Error GoTo Catch 590 | strAppDataPath = App.Path & "\Storage\" 591 | strAppDataFile = "Data.mdb" 592 | DB.DataPath = strAppDataPath 593 | DB.DataFile = strAppDataFile 594 | 'DB.DataPassword = "" 595 | DB.OpenMdb 596 | If DB.ErrorDesc <> "" Then 597 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 598 | Exit Function 599 | End If 600 | strUserID = Trim(txtUserID.Text) 601 | 'strSQL = "SELECT ID" 602 | 'strSQL = strSQL & " FROM Users" 603 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 604 | SB.SELECT_ID "Users" 605 | SB.WHERE_Text "UserID", strUserID 606 | Set rst = DB.OpenRs(SB.Text) 607 | If DB.ErrorDesc <> "" Then 608 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 609 | Exit Function 610 | End If 611 | If Not rst.EOF Then 612 | FindUser = True 613 | Else 614 | FindUser = False 615 | End If 616 | DB.CloseRs rst 617 | DB.CloseMdb 618 | Exit Function 619 | Catch: 620 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "FindUser" 621 | DB.CloseRs rst 622 | DB.CloseMdb 623 | FindUser = False 624 | End Function 625 | 626 | Private Sub AddUser() 627 | Dim DB As New OmlDatabase 628 | Dim SB As New OmlSQLBuilder 629 | On Error GoTo Catch 630 | strAppDataPath = App.Path & "\Storage\" 631 | strAppDataFile = "Data.mdb" 632 | DB.DataPath = strAppDataPath 633 | DB.DataFile = strAppDataFile 634 | 'DB.DataPassword = "" 635 | DB.OpenMdb 636 | If DB.ErrorDesc <> "" Then 637 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 638 | Exit Sub 639 | End If 640 | strUserID = Trim(txtUserID.Text) 641 | strUserName = Trim(txtUserName.Text) 642 | strUserRole = cboUserRole.Text 643 | If optActive(0).Value = True Then 644 | strActive = "Yes" 645 | Else 646 | strActive = "No" 647 | End If 648 | strSalt = GenerateSalt("SECRET") ' default 649 | strPassword = strUserID ' default 650 | strPassword = MD5(strPassword & strSalt) 651 | 'strSQL = "INSERT INTO Users" 652 | 'strSQL = strSQL & " (UserID," 653 | 'strSQL = strSQL & " UserName," 654 | 'strSQL = strSQL & " UserRole," 655 | 'strSQL = strSQL & " Salt," 656 | 'strSQL = strSQL & " UserPassword," 657 | 'strSQL = strSQL & " Active)" 658 | 'strSQL = strSQL & " VALUES" 659 | 'strSQL = strSQL & " ('" & strUserID & "'," 660 | 'strSQL = strSQL & " '" & strUserName & "'," 661 | 'strSQL = strSQL & " '" & strUserRole & "'," 662 | 'strSQL = strSQL & " '" & strSalt & "'," 663 | 'strSQL = strSQL & " '" & strPassword & "'," 664 | 'strSQL = strSQL & " " & strActive & ")" 665 | SB.INSERT "Users" 666 | SB.SOB "UserID" 667 | SB.SQL "UserName" 668 | SB.SQL "UserRole" 669 | SB.SQL "Salt" 670 | SB.SQL "UserPassword" 671 | SB.SCB "Active" 672 | SB.VALUES 673 | SB.VOB strUserID 674 | SB.VTX strUserName 675 | SB.VTX strUserRole 676 | SB.VTX strSalt 677 | SB.VTX strPassword 678 | SB.VCB strActive, 0 679 | DB.Execute SB.Text 680 | If DB.ErrorDesc <> "" Then 681 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Add User" 682 | Exit Sub 683 | End If 684 | MsgBox "User added", vbInformation, "Add User" 685 | DB.CloseMdb 686 | Exit Sub 687 | Catch: 688 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "AddUser" 689 | DB.CloseMdb 690 | End Sub 691 | 692 | Private Sub UpdateUser() 693 | Dim DB As New OmlDatabase 694 | Dim SB As New OmlSQLBuilder 695 | On Error GoTo Catch 696 | strAppDataPath = App.Path & "\Storage\" 697 | strAppDataFile = "Data.mdb" 698 | DB.DataPath = strAppDataPath 699 | DB.DataFile = strAppDataFile 700 | 'DB.DataPassword = "" 701 | DB.OpenMdb 702 | If DB.ErrorDesc <> "" Then 703 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 704 | Exit Sub 705 | End If 706 | strUserID = Trim(txtUserID.Text) 707 | strUserName = Trim(txtUserName.Text) 708 | strUserRole = cboUserRole.Text 709 | 'If optActive(0).Value = True Then 710 | ' strActive = "Yes" 711 | 'Else 712 | ' strActive = "No" 713 | 'End If 714 | 'strSQL = "UPDATE Users SET" 715 | 'strSQL = strSQL & " UserName = '" & strUserName & "'," 716 | 'strSQL = strSQL & " UserRole = '" & strUserRole & "'," 717 | 'strSQL = strSQL & " Active = " & strActive 718 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 719 | SB.UPDATE "Users" 720 | SB.UTX "UserName", strUserName 721 | SB.UTX "UserRole", strUserRole 722 | SB.UYN "Active", optActive(0).Value, 0 723 | SB.WHERE_Text "UserID", strUserID 724 | DB.Execute SB.Text 725 | If DB.ErrorDesc <> "" Then 726 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Update User" 727 | Exit Sub 728 | End If 729 | MsgBox "User updated", vbInformation, "Update User" 730 | DB.CloseMdb 731 | Exit Sub 732 | Catch: 733 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "UpdateUser" 734 | DB.CloseMdb 735 | End Sub 736 | 737 | Private Function GenerateSalt(ByVal strPlain As String) As String 738 | ' A better way is to generate a random string for salt 739 | GenerateSalt = MD5(strPlain) 740 | End Function 741 | -------------------------------------------------------------------------------- /frmUserUpdateSaltPassword.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmUserUpdateSaltPassword 3 | Appearance = 0 'Flat 4 | BackColor = &H00E0E0E0& 5 | BorderStyle = 0 'None 6 | ClientHeight = 8595 7 | ClientLeft = 14865 8 | ClientTop = 1005 9 | ClientWidth = 13365 10 | FillStyle = 0 'Solid 11 | BeginProperty Font 12 | Name = "Arial" 13 | Size = 9.75 14 | Charset = 0 15 | Weight = 400 16 | Underline = 0 'False 17 | Italic = 0 'False 18 | Strikethrough = 0 'False 19 | EndProperty 20 | LinkTopic = "Form1" 21 | MaxButton = 0 'False 22 | MinButton = 0 'False 23 | ScaleHeight = 8595 24 | ScaleWidth = 13365 25 | StartUpPosition = 1 'CenterOwner 26 | Begin VB.Frame fraContainer1 27 | Appearance = 0 'Flat 28 | BackColor = &H80000005& 29 | BorderStyle = 0 'None 30 | ForeColor = &H80000008& 31 | Height = 7215 32 | Left = 360 33 | TabIndex = 5 34 | Top = 1080 35 | Width = 12615 36 | Begin VB.ComboBox cboUserID 37 | Appearance = 0 'Flat 38 | BeginProperty Font 39 | Name = "Arial" 40 | Size = 20.25 41 | Charset = 0 42 | Weight = 400 43 | Underline = 0 'False 44 | Italic = 0 'False 45 | Strikethrough = 0 'False 46 | EndProperty 47 | Height = 600 48 | Left = 3000 49 | Style = 2 'Dropdown List 50 | TabIndex = 13 51 | Top = 1920 52 | Width = 6975 53 | End 54 | Begin VB.OptionButton optType 55 | Appearance = 0 'Flat 56 | BackColor = &H80000005& 57 | Caption = "PASSWORD" 58 | BeginProperty Font 59 | Name = "Arial" 60 | Size = 20.25 61 | Charset = 0 62 | Weight = 400 63 | Underline = 0 'False 64 | Italic = 0 'False 65 | Strikethrough = 0 'False 66 | EndProperty 67 | ForeColor = &H80000008& 68 | Height = 600 69 | Index = 1 70 | Left = 6360 71 | TabIndex = 12 72 | Top = 4200 73 | Width = 2895 74 | End 75 | Begin VB.OptionButton optType 76 | Appearance = 0 'Flat 77 | BackColor = &H80000005& 78 | Caption = "SALT" 79 | BeginProperty Font 80 | Name = "Arial" 81 | Size = 20.25 82 | Charset = 0 83 | Weight = 400 84 | Underline = 0 'False 85 | Italic = 0 'False 86 | Strikethrough = 0 'False 87 | EndProperty 88 | ForeColor = &H80000008& 89 | Height = 600 90 | Index = 0 91 | Left = 3000 92 | TabIndex = 11 93 | Top = 4200 94 | Value = -1 'True 95 | Width = 2895 96 | End 97 | Begin VB.Frame fraButton1 98 | Appearance = 0 'Flat 99 | BackColor = &H00B7D736& 100 | BorderStyle = 0 'None 101 | ForeColor = &H80000008& 102 | Height = 735 103 | Left = 5280 104 | MousePointer = 99 'Custom 105 | TabIndex = 8 106 | Top = 6000 107 | Width = 2775 108 | Begin VB.Label lblButton1 109 | Alignment = 2 'Center 110 | AutoSize = -1 'True 111 | BackStyle = 0 'Transparent 112 | Caption = "BUTTON LABEL 1" 113 | BeginProperty Font 114 | Name = "MS Sans Serif" 115 | Size = 12 116 | Charset = 0 117 | Weight = 700 118 | Underline = 0 'False 119 | Italic = 0 'False 120 | Strikethrough = 0 'False 121 | EndProperty 122 | ForeColor = &H00FFFFFF& 123 | Height = 300 124 | Left = 225 125 | TabIndex = 1 126 | Top = 240 127 | Width = 2235 128 | End 129 | End 130 | Begin VB.TextBox txtSecretWord 131 | BeginProperty Font 132 | Name = "Arial" 133 | Size = 20.25 134 | Charset = 0 135 | Weight = 400 136 | Underline = 0 'False 137 | Italic = 0 'False 138 | Strikethrough = 0 'False 139 | EndProperty 140 | ForeColor = &H00404040& 141 | Height = 615 142 | IMEMode = 3 'DISABLE 143 | Left = 3000 144 | MaxLength = 20 145 | TabIndex = 0 146 | Top = 3120 147 | Width = 6975 148 | End 149 | Begin VB.Frame fraContainerTitle1 150 | Appearance = 0 'Flat 151 | BackColor = &H00C0FFFF& 152 | BorderStyle = 0 'None 153 | ForeColor = &H80000008& 154 | Height = 735 155 | Left = 0 156 | TabIndex = 6 157 | Top = 0 158 | Width = 12615 159 | Begin VB.Label lblContainerTitle1 160 | AutoSize = -1 'True 161 | BackStyle = 0 'Transparent 162 | Caption = "CONTAINER TITLE 1" 163 | BeginProperty Font 164 | Name = "MS Sans Serif" 165 | Size = 12 166 | Charset = 0 167 | Weight = 700 168 | Underline = 0 'False 169 | Italic = 0 'False 170 | Strikethrough = 0 'False 171 | EndProperty 172 | ForeColor = &H00404040& 173 | Height = 300 174 | Left = 240 175 | TabIndex = 7 176 | Top = 240 177 | Width = 2565 178 | End 179 | End 180 | Begin VB.Label Label2 181 | AutoSize = -1 'True 182 | BackStyle = 0 'Transparent 183 | Caption = "LABEL 2" 184 | BeginProperty Font 185 | Name = "MS Sans Serif" 186 | Size = 12 187 | Charset = 0 188 | Weight = 700 189 | Underline = 0 'False 190 | Italic = 0 'False 191 | Strikethrough = 0 'False 192 | EndProperty 193 | ForeColor = &H00404040& 194 | Height = 300 195 | Left = 3000 196 | TabIndex = 10 197 | Top = 2760 198 | Width = 1080 199 | End 200 | Begin VB.Label Label1 201 | AutoSize = -1 'True 202 | BackStyle = 0 'Transparent 203 | Caption = "LABEL 1" 204 | BeginProperty Font 205 | Name = "MS Sans Serif" 206 | Size = 12 207 | Charset = 0 208 | Weight = 700 209 | Underline = 0 'False 210 | Italic = 0 'False 211 | Strikethrough = 0 'False 212 | EndProperty 213 | ForeColor = &H00404040& 214 | Height = 300 215 | Left = 3000 216 | TabIndex = 9 217 | Top = 1560 218 | Width = 1080 219 | End 220 | End 221 | Begin VB.Frame fraTitle 222 | BackColor = &H8000000D& 223 | BorderStyle = 0 'None 224 | BeginProperty Font 225 | Name = "MS Sans Serif" 226 | Size = 8.25 227 | Charset = 0 228 | Weight = 400 229 | Underline = 0 'False 230 | Italic = 0 'False 231 | Strikethrough = 0 'False 232 | EndProperty 233 | Height = 735 234 | Left = 0 235 | TabIndex = 2 236 | Top = 0 237 | Width = 13365 238 | Begin VB.Label lblX 239 | Alignment = 2 'Center 240 | Appearance = 0 'Flat 241 | BackColor = &H80000005& 242 | BackStyle = 0 'Transparent 243 | Caption = "x" 244 | BeginProperty Font 245 | Name = "Arial" 246 | Size = 21.75 247 | Charset = 0 248 | Weight = 400 249 | Underline = 0 'False 250 | Italic = 0 'False 251 | Strikethrough = 0 'False 252 | EndProperty 253 | ForeColor = &H00FFFFFF& 254 | Height = 615 255 | Left = 12730 256 | TabIndex = 4 257 | Top = 0 258 | Width = 615 259 | End 260 | Begin VB.Shape shpX 261 | BorderColor = &H000000FF& 262 | FillColor = &H000000FF& 263 | FillStyle = 0 'Solid 264 | Height = 615 265 | Left = 12750 266 | Top = 0 267 | Width = 615 268 | End 269 | Begin VB.Label lblTitle 270 | AutoSize = -1 'True 271 | BackStyle = 0 'Transparent 272 | Caption = "APPLICATION TITLE" 273 | BeginProperty Font 274 | Name = "MS Sans Serif" 275 | Size = 12 276 | Charset = 0 277 | Weight = 700 278 | Underline = 0 'False 279 | Italic = 0 'False 280 | Strikethrough = 0 'False 281 | EndProperty 282 | ForeColor = &H00FFFFFF& 283 | Height = 300 284 | Left = 240 285 | TabIndex = 3 286 | Top = 240 287 | Width = 2535 288 | End 289 | End 290 | End 291 | Attribute VB_Name = "frmUserUpdateSaltPassword" 292 | Attribute VB_GlobalNameSpace = False 293 | Attribute VB_Creatable = False 294 | Attribute VB_PredeclaredId = True 295 | Attribute VB_Exposed = False 296 | Option Explicit 297 | Dim strAppDataPath As String 298 | Dim strAppDataFile As String 299 | Dim MoveStartX As Single 300 | Dim MoveStartY As Single 301 | Dim MoveEndX As Single 302 | Dim MoveEndY As Single 303 | 304 | Private Sub Form_Initialize() 305 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 306 | End Sub 307 | 308 | Private Sub Form_Load() 309 | Me.Caption = "UPDATE SALT && PASSWORD" 310 | lblTitle.Caption = Me.Caption 311 | Label1.Caption = "USER ID" 312 | Label2.Caption = "SECRET WORD" 313 | lblButton1.Caption = "UPDATE" 314 | LoadMousePointer 315 | SetContainerTitle 316 | LoadCombo 317 | End Sub 318 | 319 | Private Sub LoadMousePointer() 320 | On Error Resume Next 321 | fraButton1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 322 | End Sub 323 | 324 | Private Sub SetContainerTitle() 325 | lblContainerTitle1.Caption = "PLEASE UPDATE PASSWORD AGAIN AFTER UPDATE SALT" 326 | End Sub 327 | 328 | Private Sub fraButton1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 329 | With fraButton1 330 | .BackColor = &HE0E0E0 331 | End With 332 | With lblButton1 333 | .ForeColor = &H404040 334 | End With 335 | End Sub 336 | 337 | Private Sub fraContainer1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 338 | With fraButton1 339 | .BackColor = &HB7D736 340 | End With 341 | With lblButton1 342 | .ForeColor = &HFFFFFF 343 | End With 344 | End Sub 345 | 346 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 347 | GetMouseMove Button, X, Y 348 | End Sub 349 | 350 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 351 | SetMouseMove Button, X, Y 352 | End Sub 353 | 354 | Private Sub fraButton1_Click() 355 | Dim strUser As String 356 | Dim strSecret As String 357 | strUser = Trim(cboUserID.Text) 358 | strSecret = Trim(txtSecretWord.Text) 359 | If optType(0).Value = True Then 360 | UpdateSalt strUser, strSecret 361 | Else 362 | UpdatePassword strUser, strSecret 363 | End If 364 | End Sub 365 | 366 | Private Sub lblButton1_Click() 367 | fraButton1_Click 368 | End Sub 369 | 370 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 371 | GetMouseMove Button, X, Y 372 | End Sub 373 | 374 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 375 | SetMouseMove Button, X, Y 376 | End Sub 377 | 378 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 379 | MoveStartX = X 380 | MoveStartY = Y 381 | End Sub 382 | 383 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 384 | MoveEndX = X - MoveStartX 385 | MoveEndY = Y - MoveStartY 386 | If Button = 1 Then 387 | Me.Left = Me.Left + MoveEndX 388 | Me.Top = Me.Top + MoveEndY 389 | End If 390 | End Sub 391 | 392 | Private Sub lblX_Click() 393 | frmUsers.Show 394 | Unload Me 395 | End Sub 396 | 397 | Public Sub LoadCombo() 398 | Dim DB As New OmlDatabase 399 | Dim SB As New OmlSQLBuilder 400 | Dim rst As ADODB.Recordset 401 | Dim i As Integer 402 | Dim r As Integer 403 | On Error GoTo Catch 404 | strAppDataPath = App.Path & "\Storage\" 405 | strAppDataFile = "Data.mdb" 406 | DB.DataPath = strAppDataPath 407 | DB.DataFile = strAppDataFile 408 | 'DB.DataPassword = "" 409 | DB.OpenMdb 410 | If DB.ErrorDesc <> "" Then 411 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 412 | Exit Sub 413 | End If 414 | 'strSQL = "SELECT" 415 | 'strSQL = strSQL & " UserID" 416 | 'strSQL = strSQL & " FROM Users" 417 | ''strSQL = strSQL & " WHERE Active = Yes" 418 | SB.SELECT_ "UserID" 419 | SB.FROM "Users" 420 | 'SB.WHERE_Boolean "Active", True 421 | Set rst = DB.OpenRs(SB.Text) 422 | If DB.ErrorDesc <> "" Then 423 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 424 | Exit Sub 425 | End If 426 | cboUserID.Clear 427 | While Not rst.EOF 428 | cboUserID.AddItem rst!UserID 429 | rst.MoveNext 430 | Wend 431 | DB.CloseRs rst 432 | DB.CloseMdb 433 | Exit Sub 434 | Catch: 435 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "LoadCombo" 436 | DB.CloseRs rst 437 | DB.CloseMdb 438 | End Sub 439 | 440 | Private Function GetSalt(ByVal strUserID As String) As String 441 | Dim DB As New OmlDatabase 442 | Dim SB As New OmlSQLBuilder 443 | Dim rst As ADODB.Recordset 444 | On Error GoTo Catch 445 | strAppDataPath = App.Path & "\Storage\" 446 | strAppDataFile = "Data.mdb" 447 | DB.DataPath = strAppDataPath 448 | DB.DataFile = strAppDataFile 449 | 'DB.DataPassword = "" 450 | DB.OpenMdb 451 | If DB.ErrorDesc <> "" Then 452 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 453 | Exit Function 454 | End If 455 | 'strSQL = "SELECT Salt" 456 | 'strSQL = strSQL & " FROM Users" 457 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 458 | SB.SELECT_ "Salt" 459 | SB.FROM "Users" 460 | SB.WHERE_Text "UserID", strUserID 461 | Set rst = DB.OpenRs(SB.Text) 462 | If DB.ErrorDesc <> "" Then 463 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 464 | Exit Function 465 | End If 466 | If Not rst.EOF Then 467 | GetSalt = rst!Salt 468 | Else 469 | GetSalt = "" 470 | End If 471 | DB.CloseRs rst 472 | DB.CloseMdb 473 | Exit Function 474 | Catch: 475 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "GetSalt" 476 | DB.CloseRs rst 477 | DB.CloseMdb 478 | GetSalt = "" 479 | End Function 480 | 481 | Private Sub UpdateSalt(ByVal strUserID As String, ByVal strSalt As String) 482 | Dim DB As New OmlDatabase 483 | Dim SB As New OmlSQLBuilder 484 | On Error GoTo Catch 485 | strAppDataPath = App.Path & "\Storage\" 486 | strAppDataFile = "Data.mdb" 487 | DB.DataPath = strAppDataPath 488 | DB.DataFile = strAppDataFile 489 | 'DB.DataPassword = "" 490 | DB.OpenMdb 491 | If DB.ErrorDesc <> "" Then 492 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 493 | Exit Sub 494 | End If 495 | 'strSQL = "UPDATE Users SET" 496 | 'strSQL = strSQL & " Salt = '" & GenerateSalt(strSalt) & "'" 497 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 498 | SB.UPDATE "Users" 499 | SB.UTX "Salt", GenerateSalt(strSalt), 0 500 | SB.WHERE_Text "UserID", strUserID 501 | DB.Execute SB.Text 502 | If DB.ErrorDesc <> "" Then 503 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Update Database" 504 | Exit Sub 505 | End If 506 | MsgBox "Salt updated", vbInformation, "UpdateSalt" 507 | DB.CloseMdb 508 | Exit Sub 509 | Catch: 510 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "UpdateSalt" 511 | DB.CloseMdb 512 | End Sub 513 | 514 | Private Sub UpdatePassword(ByVal strUserID As String, ByVal strPassword As String) 515 | Dim DB As New OmlDatabase 516 | Dim SB As New OmlSQLBuilder 517 | Dim strSalt As String 518 | On Error GoTo Catch 519 | strAppDataPath = App.Path & "\Storage\" 520 | strAppDataFile = "Data.mdb" 521 | DB.DataPath = strAppDataPath 522 | DB.DataFile = strAppDataFile 523 | 'DB.DataPassword = "" 524 | DB.OpenMdb 525 | If DB.ErrorDesc <> "" Then 526 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 527 | Exit Sub 528 | End If 529 | strSalt = GetSalt(strUserID) 530 | 'strSQL = "UPDATE Users SET" 531 | 'strSQL = strSQL & " UserPassword = '" & MD5(strPassword & strSalt) & "'" 532 | 'strSQL = strSQL & " WHERE UserID = '" & strUserID & "'" 533 | SB.UPDATE "Users" 534 | SB.UTX "UserPassword", MD5(strPassword & strSalt), 0 535 | SB.WHERE_Text "UserID", strUserID 536 | DB.Execute SB.Text 537 | If DB.ErrorDesc <> "" Then 538 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Update Database" 539 | Exit Sub 540 | End If 541 | MsgBox "Password updated", vbInformation, "UpdatePassword" 542 | DB.CloseMdb 543 | Exit Sub 544 | Catch: 545 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "UpdatePassword" 546 | DB.CloseMdb 547 | End Sub 548 | 549 | Private Function GenerateSalt(ByVal strPlain As String) As String 550 | GenerateSalt = MD5(strPlain) 551 | End Function 552 | -------------------------------------------------------------------------------- /frmUsers.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 3 | Begin VB.Form frmUsers 4 | Appearance = 0 'Flat 5 | BackColor = &H00E0E0E0& 6 | BorderStyle = 0 'None 7 | ClientHeight = 8790 8 | ClientLeft = 14865 9 | ClientTop = 1005 10 | ClientWidth = 17295 11 | FillStyle = 0 'Solid 12 | BeginProperty Font 13 | Name = "Arial" 14 | Size = 9.75 15 | Charset = 0 16 | Weight = 400 17 | Underline = 0 'False 18 | Italic = 0 'False 19 | Strikethrough = 0 'False 20 | EndProperty 21 | LinkTopic = "Form1" 22 | MaxButton = 0 'False 23 | MinButton = 0 'False 24 | ScaleHeight = 8790 25 | ScaleWidth = 17295 26 | StartUpPosition = 1 'CenterOwner 27 | Begin VB.Frame fraContainer1 28 | Appearance = 0 'Flat 29 | BackColor = &H80000005& 30 | BorderStyle = 0 'None 31 | ForeColor = &H80000008& 32 | Height = 7455 33 | Left = 3960 34 | TabIndex = 9 35 | Top = 1080 36 | Width = 12975 37 | Begin VB.Frame fraButton1 38 | Appearance = 0 'Flat 39 | BackColor = &H00B7D736& 40 | BorderStyle = 0 'None 41 | ForeColor = &H80000008& 42 | Height = 735 43 | Left = 3360 44 | MousePointer = 99 'Custom 45 | TabIndex = 18 46 | Top = 6360 47 | Width = 2775 48 | Begin VB.Label lblButton1 49 | Alignment = 2 'Center 50 | AutoSize = -1 'True 51 | BackStyle = 0 'Transparent 52 | Caption = "BUTTON LABEL 1" 53 | BeginProperty Font 54 | Name = "MS Sans Serif" 55 | Size = 12 56 | Charset = 0 57 | Weight = 700 58 | Underline = 0 'False 59 | Italic = 0 'False 60 | Strikethrough = 0 'False 61 | EndProperty 62 | ForeColor = &H00FFFFFF& 63 | Height = 300 64 | Left = 225 65 | TabIndex = 19 66 | Top = 240 67 | Width = 2235 68 | End 69 | End 70 | Begin VB.Frame fraButton2 71 | Appearance = 0 'Flat 72 | BackColor = &H00B7D736& 73 | BorderStyle = 0 'None 74 | ForeColor = &H80000008& 75 | Height = 735 76 | Left = 6600 77 | MousePointer = 99 'Custom 78 | TabIndex = 16 79 | Top = 6360 80 | Width = 2775 81 | Begin VB.Label lblButton2 82 | Alignment = 2 'Center 83 | AutoSize = -1 'True 84 | BackStyle = 0 'Transparent 85 | Caption = "BUTTON LABEL 2" 86 | BeginProperty Font 87 | Name = "MS Sans Serif" 88 | Size = 12 89 | Charset = 0 90 | Weight = 700 91 | Underline = 0 'False 92 | Italic = 0 'False 93 | Strikethrough = 0 'False 94 | EndProperty 95 | ForeColor = &H00FFFFFF& 96 | Height = 300 97 | Left = 225 98 | TabIndex = 17 99 | Top = 240 100 | Width = 2235 101 | End 102 | End 103 | Begin VB.Frame fraButton3 104 | Appearance = 0 'Flat 105 | BackColor = &H00B7D736& 106 | BorderStyle = 0 'None 107 | ForeColor = &H80000008& 108 | Height = 735 109 | Left = 9840 110 | MousePointer = 99 'Custom 111 | TabIndex = 14 112 | Top = 6360 113 | Width = 2775 114 | Begin VB.Label lblButton3 115 | Alignment = 2 'Center 116 | AutoSize = -1 'True 117 | BackStyle = 0 'Transparent 118 | Caption = "BUTTON LABEL 3" 119 | BeginProperty Font 120 | Name = "MS Sans Serif" 121 | Size = 12 122 | Charset = 0 123 | Weight = 700 124 | Underline = 0 'False 125 | Italic = 0 'False 126 | Strikethrough = 0 'False 127 | EndProperty 128 | ForeColor = &H00FFFFFF& 129 | Height = 300 130 | Left = 225 131 | TabIndex = 15 132 | Top = 240 133 | Width = 2235 134 | End 135 | End 136 | Begin VB.Frame fraContainerTitle1 137 | Appearance = 0 'Flat 138 | BackColor = &H8000000D& 139 | BorderStyle = 0 'None 140 | ForeColor = &H80000008& 141 | Height = 735 142 | Left = 0 143 | TabIndex = 10 144 | Top = 0 145 | Width = 12975 146 | Begin VB.Label lblContainerTitle1 147 | AutoSize = -1 'True 148 | BackStyle = 0 'Transparent 149 | Caption = "CONTAINER TITLE 1" 150 | BeginProperty Font 151 | Name = "MS Sans Serif" 152 | Size = 12 153 | Charset = 0 154 | Weight = 700 155 | Underline = 0 'False 156 | Italic = 0 'False 157 | Strikethrough = 0 'False 158 | EndProperty 159 | ForeColor = &H00FFFFFF& 160 | Height = 300 161 | Left = 240 162 | TabIndex = 11 163 | Top = 240 164 | Width = 2565 165 | End 166 | End 167 | Begin MSComctlLib.ListView ListView1 168 | Height = 5055 169 | Left = 360 170 | TabIndex = 13 171 | Top = 1080 172 | Width = 12255 173 | _ExtentX = 21616 174 | _ExtentY = 8916 175 | View = 3 176 | LabelEdit = 1 177 | LabelWrap = -1 'True 178 | HideSelection = -1 'True 179 | FlatScrollBar = -1 'True 180 | FullRowSelect = -1 'True 181 | GridLines = -1 'True 182 | _Version = 393217 183 | ForeColor = -2147483640 184 | BackColor = -2147483643 185 | BorderStyle = 1 186 | Appearance = 0 187 | BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 188 | Name = "Arial" 189 | Size = 12 190 | Charset = 0 191 | Weight = 400 192 | Underline = 0 'False 193 | Italic = 0 'False 194 | Strikethrough = 0 'False 195 | EndProperty 196 | NumItems = 0 197 | End 198 | End 199 | Begin VB.Frame fraMenuContainer 200 | Appearance = 0 'Flat 201 | BackColor = &H80000010& 202 | BorderStyle = 0 'None 203 | BeginProperty Font 204 | Name = "MS Sans Serif" 205 | Size = 8.25 206 | Charset = 0 207 | Weight = 400 208 | Underline = 0 'False 209 | Italic = 0 'False 210 | Strikethrough = 0 'False 211 | EndProperty 212 | ForeColor = &H80000008& 213 | Height = 8055 214 | Left = 0 215 | TabIndex = 4 216 | Top = 720 217 | Width = 3615 218 | Begin VB.Frame fraMenu2 219 | Appearance = 0 'Flat 220 | BackColor = &H80000010& 221 | BorderStyle = 0 'None 222 | ForeColor = &H80000008& 223 | Height = 735 224 | Left = 120 225 | TabIndex = 7 226 | Top = 1200 227 | Width = 3375 228 | Begin VB.Label lblMenu2 229 | AutoSize = -1 'True 230 | BackStyle = 0 'Transparent 231 | Caption = "Users" 232 | BeginProperty Font 233 | Name = "Arial" 234 | Size = 12 235 | Charset = 0 236 | Weight = 700 237 | Underline = 0 'False 238 | Italic = 0 'False 239 | Strikethrough = 0 'False 240 | EndProperty 241 | Height = 285 242 | Left = 240 243 | TabIndex = 8 244 | Top = 240 245 | Width = 675 246 | End 247 | End 248 | Begin VB.Frame fraMenu1 249 | Appearance = 0 'Flat 250 | BackColor = &H80000010& 251 | BorderStyle = 0 'None 252 | ForeColor = &H80000008& 253 | Height = 735 254 | Left = 120 255 | MousePointer = 99 'Custom 256 | TabIndex = 5 257 | Top = 240 258 | Width = 3375 259 | Begin VB.Label lblMenu1 260 | AutoSize = -1 'True 261 | BackStyle = 0 'Transparent 262 | Caption = "Dashboard" 263 | BeginProperty Font 264 | Name = "Arial" 265 | Size = 12 266 | Charset = 0 267 | Weight = 700 268 | Underline = 0 'False 269 | Italic = 0 'False 270 | Strikethrough = 0 'False 271 | EndProperty 272 | Height = 285 273 | Left = 240 274 | TabIndex = 6 275 | Top = 240 276 | Width = 1275 277 | End 278 | End 279 | End 280 | Begin VB.Frame fraTitle 281 | BackColor = &H8000000D& 282 | BorderStyle = 0 'None 283 | BeginProperty Font 284 | Name = "MS Sans Serif" 285 | Size = 8.25 286 | Charset = 0 287 | Weight = 400 288 | Underline = 0 'False 289 | Italic = 0 'False 290 | Strikethrough = 0 'False 291 | EndProperty 292 | Height = 735 293 | Left = 0 294 | TabIndex = 0 295 | Top = 0 296 | Width = 17295 297 | Begin VB.Label lblUserIcon 298 | AutoSize = -1 'True 299 | BackStyle = 0 'Transparent 300 | Caption = "user" 301 | BeginProperty Font 302 | Name = "Font Awesome 5 Free Regular" 303 | Size = 15.75 304 | Charset = 0 305 | Weight = 400 306 | Underline = 0 'False 307 | Italic = 0 'False 308 | Strikethrough = 0 'False 309 | EndProperty 310 | ForeColor = &H00FFFFFF& 311 | Height = 315 312 | Left = 14400 313 | TabIndex = 12 314 | Top = 180 315 | Width = 315 316 | End 317 | Begin VB.Label lblUserName 318 | Appearance = 0 'Flat 319 | AutoSize = -1 'True 320 | BackColor = &H80000005& 321 | BackStyle = 0 'Transparent 322 | Caption = "Administrator" 323 | BeginProperty Font 324 | Name = "Arial" 325 | Size = 12 326 | Charset = 0 327 | Weight = 700 328 | Underline = 0 'False 329 | Italic = 0 'False 330 | Strikethrough = 0 'False 331 | EndProperty 332 | ForeColor = &H00FFFFFF& 333 | Height = 285 334 | Left = 14880 335 | TabIndex = 3 336 | Top = 240 337 | Width = 1575 338 | End 339 | Begin VB.Label lblX 340 | Alignment = 2 'Center 341 | Appearance = 0 'Flat 342 | BackColor = &H80000005& 343 | BackStyle = 0 'Transparent 344 | Caption = "x" 345 | BeginProperty Font 346 | Name = "Arial" 347 | Size = 21.75 348 | Charset = 0 349 | Weight = 400 350 | Underline = 0 'False 351 | Italic = 0 'False 352 | Strikethrough = 0 'False 353 | EndProperty 354 | ForeColor = &H00FFFFFF& 355 | Height = 615 356 | Left = 16680 357 | TabIndex = 2 358 | Top = 0 359 | Width = 615 360 | End 361 | Begin VB.Shape shpX 362 | BorderColor = &H000000FF& 363 | FillColor = &H000000FF& 364 | FillStyle = 0 'Solid 365 | Height = 615 366 | Left = 16680 367 | Top = 0 368 | Width = 615 369 | End 370 | Begin VB.Label lblTitle 371 | AutoSize = -1 'True 372 | BackStyle = 0 'Transparent 373 | Caption = "APPLICATION TITLE" 374 | BeginProperty Font 375 | Name = "MS Sans Serif" 376 | Size = 12 377 | Charset = 0 378 | Weight = 700 379 | Underline = 0 'False 380 | Italic = 0 'False 381 | Strikethrough = 0 'False 382 | EndProperty 383 | ForeColor = &H00FFFFFF& 384 | Height = 300 385 | Left = 240 386 | TabIndex = 1 387 | Top = 240 388 | Width = 2535 389 | End 390 | End 391 | End 392 | Attribute VB_Name = "frmUsers" 393 | Attribute VB_GlobalNameSpace = False 394 | Attribute VB_Creatable = False 395 | Attribute VB_PredeclaredId = True 396 | Attribute VB_Exposed = False 397 | Option Explicit 398 | Dim strAppDataPath As String 399 | Dim strAppDataFile As String 400 | Dim MoveStartX As Single 401 | Dim MoveStartY As Single 402 | Dim MoveEndX As Single 403 | Dim MoveEndY As Single 404 | 405 | Private Sub Form_Initialize() 406 | ' Source: http://www.vbforums.com/showthread.php?432036-Classic-VB-How-can-I-set-my-exe-icon-using-a-resource-file 407 | Me.Icon = LoadResPicture("APPICON", vbResIcon) 408 | End Sub 409 | 410 | Private Sub Form_Load() 411 | Me.Caption = "USERS" 412 | lblTitle.Caption = Me.Caption 413 | lblUserName.Caption = gstrUserName 414 | lblButton1.Caption = "ADD USER" 415 | lblButton2.Caption = "EDIT USER" 416 | lblButton3.Caption = "DELETE USER" 417 | LoadMousePointer 418 | SetContainerTitle 419 | LoadList 420 | End Sub 421 | 422 | Private Sub AddColHeader() 423 | Dim intWidth(0 To 4) As Integer 424 | On Error GoTo CheckErr 425 | With ListView1 426 | .ColumnHeaders.Clear 427 | intWidth(0) = .Width * 0.1 428 | intWidth(1) = .Width * 0.25 429 | intWidth(2) = .Width * 0.35 430 | intWidth(3) = .Width * 0.15 431 | intWidth(4) = .Width * 0.15 432 | .ColumnHeaders.Add , "ID", "ID", intWidth(0) 433 | .ColumnHeaders.Add , "User ID", "User ID", intWidth(1), lvwColumnLeft 434 | .ColumnHeaders.Add , "User Name", "User Name", intWidth(2), lvwColumnLeft 435 | .ColumnHeaders.Add , "Role", "Role", intWidth(3), lvwColumnLeft 436 | .ColumnHeaders.Add , "Active", "Active", intWidth(4), lvwColumnCenter 437 | .Refresh 438 | End With 439 | Exit Sub 440 | CheckErr: 441 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "AddColHeader" 442 | End Sub 443 | 444 | Private Sub LoadList() 445 | Dim DB As New OmlDatabase 446 | Dim SB As New OmlSQLBuilder 447 | Dim rst As ADODB.Recordset 448 | Dim List As ListItem 449 | Dim i As Integer 450 | Dim r As Integer 451 | On Error GoTo Catch 452 | strAppDataPath = App.Path & "\Storage\" 453 | strAppDataFile = "Data.mdb" 454 | DB.DataPath = strAppDataPath 455 | DB.DataFile = strAppDataFile 456 | 'DB.DataPassword = "" 457 | DB.OpenMdb 458 | If DB.ErrorDesc <> "" Then 459 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 460 | Exit Sub 461 | End If 462 | 'strSQL = "SELECT *" 463 | 'strSQL = strSQL & " FROM Users" 464 | SB.SELECT_ALL "Users" 465 | Set rst = DB.OpenRs(SB.Text) 466 | If DB.ErrorDesc <> "" Then 467 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 468 | Exit Sub 469 | End If 470 | ListView1.ListItems.Clear 471 | AddColHeader 472 | While Not rst.EOF 473 | Set List = ListView1.ListItems.Add(, "U" & rst!ID, rst!ID, , 0) 474 | List.SubItems(1) = rst!UserID 475 | List.SubItems(2) = rst!UserName 476 | List.SubItems(3) = rst!UserRole 477 | List.SubItems(4) = rst!Active 478 | If rst!Active = False Then 479 | List.ForeColor = vbRed 480 | For r = 1 To List.ListSubItems.Count 481 | List.ListSubItems(r).ForeColor = vbRed 482 | Next 483 | Else 484 | List.ForeColor = vbBlack 485 | For r = 1 To List.ListSubItems.Count 486 | List.ListSubItems(r).ForeColor = vbBlack 487 | Next 488 | End If 489 | rst.MoveNext 490 | i = i + 1 491 | Wend 492 | DB.CloseRs rst 493 | DB.CloseMdb 494 | Exit Sub 495 | Catch: 496 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "LoadList" 497 | DB.CloseRs rst 498 | DB.CloseMdb 499 | End Sub 500 | 501 | Private Sub DeleteUser() 502 | Dim DB As New OmlDatabase 503 | Dim SB As New OmlSQLBuilder 504 | Dim rst As ADODB.Recordset 505 | Dim strUserID As String 506 | On Error GoTo Catch 507 | If ListView1.ListItems.Count = 0 Then 508 | Exit Sub 509 | End If 510 | strAppDataPath = App.Path & "\Storage\" 511 | strAppDataFile = "Data.mdb" 512 | DB.DataPath = strAppDataPath 513 | DB.DataFile = strAppDataFile 514 | 'DB.DataPassword = "" 515 | DB.OpenMdb 516 | If DB.ErrorDesc <> "" Then 517 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Open Database" 518 | Exit Sub 519 | End If 520 | strUserID = ListView1.SelectedItem.Text 521 | 'strSQL = "SELECT *" 522 | 'strSQL = strSQL & " FROM Users" 523 | SB.SELECT_ID "Users" 524 | SB.WHERE_Long "ID", CLng(strUserID) 525 | Set rst = DB.OpenRs(SB.Text) 526 | If DB.ErrorDesc <> "" Then 527 | MsgBox "Error: " & DB.ErrorDesc, vbExclamation, "Query Database" 528 | Exit Sub 529 | End If 530 | If Not rst.EOF Then 531 | SB.DELETE "Users" 532 | SB.WHERE_Long "ID", CLng(strUserID) 533 | DB.Execute SB.Text 534 | MsgBox "Success: User has been deleted!", vbInformation, "DeleteUser" 535 | Else 536 | MsgBox "Error: User not found!", vbExclamation, "DeleteUser" 537 | End If 538 | DB.CloseRs rst 539 | DB.CloseMdb 540 | Exit Sub 541 | Catch: 542 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "DeleteUser" 543 | DB.CloseRs rst 544 | DB.CloseMdb 545 | End Sub 546 | 547 | Private Sub LoadMousePointer() 548 | On Error Resume Next 549 | fraButton1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 550 | fraMenu1.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 551 | fraButton2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 552 | fraButton3.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 553 | 'fraMenu2.MouseIcon = LoadPicture(App.Path & "\Resources\Icon\hand.ico") 554 | End Sub 555 | 556 | Private Sub SetContainerTitle() 557 | lblContainerTitle1.Caption = "USERS" 558 | End Sub 559 | 560 | Private Sub fraButton1_Click() 561 | With frmUserDetails 562 | .Show 563 | .PopulateValues "0" 564 | End With 565 | Unload Me 566 | End Sub 567 | 568 | Private Sub fraButton2_Click() 569 | On Error GoTo CheckErr 570 | If ListView1.ListItems.Count = 0 Then 571 | Exit Sub 572 | End If 573 | With frmUserDetails 574 | .Show 575 | .PopulateValues ListView1.SelectedItem.Text 576 | End With 577 | Unload Me 578 | Exit Sub 579 | CheckErr: 580 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "fraButton2_Click" 581 | End Sub 582 | 583 | Private Sub fraButton3_Click() 584 | If vbYes = MsgBox("Are you sure to delete?", vbQuestion + vbYesNo, "Delete User") Then 585 | DeleteUser 586 | LoadList 587 | End If 588 | End Sub 589 | 590 | Private Sub fraMenu1_Click() 591 | frmDashboard.Show 592 | Unload Me 593 | End Sub 594 | 595 | Private Sub fraMenuContainer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 596 | fraMenu1.BackColor = &H80000010 597 | fraMenu2.BackColor = &H80000010 598 | End Sub 599 | 600 | Private Sub fraMenu1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 601 | fraMenu1.BackColor = &HE0E0E0 602 | End Sub 603 | 604 | Private Sub fraTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 605 | GetMouseMove Button, X, Y 606 | End Sub 607 | 608 | Private Sub fraTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 609 | SetMouseMove Button, X, Y 610 | End Sub 611 | 612 | Private Sub lblButton1_Click() 613 | fraButton1_Click 614 | End Sub 615 | 616 | Private Sub lblButton2_Click() 617 | fraButton2_Click 618 | End Sub 619 | 620 | Private Sub lblButton3_Click() 621 | fraButton3_Click 622 | End Sub 623 | 624 | Private Sub lblMenu1_Click() 625 | frmDashboard.Show 626 | Unload Me 627 | End Sub 628 | 629 | Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 630 | GetMouseMove Button, X, Y 631 | End Sub 632 | 633 | Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 634 | SetMouseMove Button, X, Y 635 | End Sub 636 | 637 | Private Sub GetMouseMove(Button As Integer, X As Single, Y As Single) 638 | MoveStartX = X 639 | MoveStartY = Y 640 | End Sub 641 | 642 | Private Sub SetMouseMove(Button As Integer, X As Single, Y As Single) 643 | MoveEndX = X - MoveStartX 644 | MoveEndY = Y - MoveStartY 645 | If Button = 1 Then 646 | Me.Left = Me.Left + MoveEndX 647 | Me.Top = Me.Top + MoveEndY 648 | End If 649 | End Sub 650 | 651 | Private Sub lblX_Click() 652 | Unload Me 653 | frmDashboard.Show 654 | End Sub 655 | 656 | Private Sub ListView1_DblClick() 657 | On Error GoTo CheckErr 658 | If ListView1.ListItems.Count = 0 Then 659 | Exit Sub 660 | End If 661 | With frmUserDetails 662 | .Show 663 | .PopulateValues ListView1.SelectedItem.Text 664 | End With 665 | Unload Me 666 | Exit Sub 667 | CheckErr: 668 | MsgBox Err.Number & " - " & Err.Description, vbExclamation, "ListView1_DblClick" 669 | End Sub 670 | --------------------------------------------------------------------------------