Simple steps listed to create a ruby on rails application

This article lists all the steps required to create a simple web site in ruby on rails.

This article a fast track approach in developing a ruby on rails website.

First download and install the ruby on rails. If you haven't yet then you can go to Ruby on rails website and then download and install and start mysql and Apache web server that can be done by starting InstantRails.exe in the Instant rails folder.

Now go to command prompt and enter use_ruby

This will take you to rails application path if ruby on rails has been installed properly in the drive.

Then follow the following steps to create a complete website:

1 . rails AppName

2. Change database.yml file to point to required database

3. rake db:create:all Creates the database

4. ruby script/generate scaffold Table1 column1:string column2:text column3:integer

5. ruby script/generate scaffold Table2 column1:string column2:text column3:integer

6. change db/migrate/ 001_create_table1.rb file specify the limit and add t.references :table2 for foreign key

7. rake db:migrate

8. Open up modals and setup Active record base for recipie and category.

9. put has_many :recipes in category ActiveRecord:: base

10. put belongs_to:category in reciepe ActiveRecord:: base

11. go to public folder and delete index.html

12. open routes.rb file from config folder and find map.root and enable that portion.

13. Set map.root :controller => "categories"

14. Now open C:\InstantRails-2.0\rails_apps\astroun\app\views\categories\new.html.erb and

C:\InstantRails-2.0\rails_apps\astroun\app\views\recipie\new.html.erb

15. delete the portion between <% form_for(@recipe) do |f| %>

<% end %> from recipie.

16. create a new file called _form.html.erb which is partial and it renders the form.

17. Paste the portion deleted in new.html.erb into this new file _form.html.erb and

18. Now put the render code in the deleted portion of new.html.erb :

<%= render :partial => "form", :locals => { :f => f, :button => "Create" } %>

19. And similarly in edit.html.erb put

<%= render :partial => "form", :locals => { :f => f, :button => "Update" } %>

20. Now run and see by doing ruby script/server and run http://localhost:3000/

21. Scaffold creates layouts in views that can be delted and modified as per need.

22. Lets delete these files in layout folder and create application.html.erb as application wide layout.

23. Now it works fine but with one problem if there are reciepies in category but if we destroy the category then when we try to list the recipies that throws error because category is not there.

24. To fix this make changes in categories_controller saying if it has items in it then don't destroy the category.

Read more!

Learn how to develop a three tier .net application using (vb.net) with visual basic source code

This article focuses on explaining how to code a three tier application using
visual basic .net . Here I will be explaining each an every step from creating
new sql server database table to running the vb program going through most of
the vb code in the application and also providing some links that I find useful
for the learners.In this visual basic net tutorial, I will be mainly focusing
the beginners to mid level .net programmers so I will try to expalin each and
every detail as I can but even that if I missed something don't hesitate to post
a comment on this blog article. I hope this will be a good vb tutorial for
whoever is interested in it and this application can be easily extended to asp
net three tier application for web developers.

Now lets start (Note: Source code of this tutorial is available at the end of
this article)

Step 1

Let's first create two tables in the sql server database with the following sql
query:

Table 1 : Class

CREATE TABLE [dbo].[Class](
[ClassID] [int] IDENTITY(1,1) NOT NULL,[ClassName] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
CONSTRAINT [PK_Class] PRIMARY KEY CLUSTERED
(
[ClassID] ASC) ON [PRIMARY]
) ON [PRIMARY]

(Note: You can create the tables yourself in Microsoft Sql Server Management
Studio and it looks like the image shown below)


Table 2 : Students

CREATE TABLE [dbo].[Students](
[StudentID] [int] IDENTITY(1,1) NOT NULL,
[StudentName] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
[ClassID] [int] NULL,
CONSTRAINT [PK_Students] PRIMARY KEY CLUSTERED
(
[StudentID] ASC
) ON [PRIMARY]
) ON [PRIMARY]

ALTER TABLE [dbo].[Students] WITH CHECK ADD CONSTRAINT [FK_Students_Class]

FOREIGN KEY([ClassID])
REFERENCES [dbo].[Class] ([ClassID])

(Note: You can create the tables yourself in Microsoft Sql Server Management
Studio and it looks like the image shown below)



Now here you have to create a Foreign key constraint to classID (If you don't
know what foreign key is then you can (Learn Foreign key)

Step 2

Now create a window project in visual basic and name it ThreeTierVB and save
your project and solution in your desired Path.



Add Two folders in the project by right clicking the ThreeTierVB on your
solution explorer and
Add --> New Folder and name them
Forms
GlobalClasses

Right click the forms Folder and add a windows form and name it frmStudent then
add the following components in the form and name them accordingly as follows:

1 combobox
name:cboClass

4 command Buttons
name: cmdNew
Text: New Class

name: cmdClassSave
Text: Save Class

name: cmdSave
Text: Save

name: cmdExit
Text: Exit

2 text boxes
name: txtClassName

name: txtStudentName

1 Datagridview

name: grdStudents

A quick snapshot of my form is shown below:



(add the labels and name the labels appropriately and also you can place the controls wherever you like them comfortable)

Step 3

Now before going to the coding lets create the three tier structure so that it
would be easier to understand for beginner programmers.

1. Add a new Class library to the solution by going to
File --> Add --> New project

2. Select the class library and name it ThreeTierVB.BusinessLogic and
add two folders BLLClasses and GenericClasses as explained on step 2

3. Similarly add another class library as above and name it ThreeTierVB.DataAccess
and add three folders and name them DataClasses, GlobalClasses and Modules

4. Similarly add another class library as above and name it ThreeTierVB.Info
and add a folder and name it InfoClasses

Now your solution Explorer should look like the following



Step 4

Now we have got 4 projects in our solution Explorer. Lets make the idea clear
Now here we are making DataAccess , BusinessLogic and GuI the three tiers and
Info is the info for all the three tiers, so we have to be clear on what get
access to what.

Add the references to the projects

1. ThreeTierVB which is our presentation tier and this needs to know the info
and business logic but it doesn't worry about Dataaccess.

For this right click on ThreeTierVB project and Addreference in the add reference screen go to projects and select ThreeTierVB.Businesslogic and ThreeTierVB.Info by clicking ctrl and click ok button.



2. Similarly Businesslogic only needs to know the DataAccess and info so as done
in 1 add references to ThreeTierVB.DataAccess and ThreeTierVB.Info.

3. Now in DataAccess project just add ThreeTierVB.Info as a reference.

Step 5

Add the required classes in the projects to run the application now as we have
set up all the necessary references.

1. In ThreeTierVB.Info add two classes and name them as ClassInfo and StudentInfo in ClassInfo Write the following code:

Public Class ClassInfo 

#Region "Private Member Declarations"

Private mClassId As Integer
Private mClassName As String

Private mAction As Byte

#End Region

#Region "Public Properties"

Public Property Action() As Byte
Get
Return mAction
End Get
Set(ByVal value As Byte)
mAction = value
End Set
End Property

Public Property ClassID() As Integer
Get
Return mClassId
End Get
Set(ByVal value As Integer)
mClassId = value
End Set
End Property

Public Property ClassName() As String
Get
Return mClassName
End Get
Set(ByVal value As String)
mClassName = value
End Set
End Property


#End Region

End Class

In StudentInfo Write the following code:

Public Class StudentInfo

#Region "Private Member Declarations"

Private mStudentID As Integer
Private mStudentName As String
Private mClassID As Integer

Private mAction As Byte

#End Region

#Region " Public Properties"

Public Property Action() As Byte
Get
Return mAction
End Get
Set(ByVal value As Byte)
mAction = value
End Set
End Property

Public Property StudentID() As Integer
Get
Return mStudentID
End Get
Set(ByVal value As Integer)
mStudentID = value
End Set
End Property

Public Property ClassID() As Integer
Get
Return mClassID
End Get
Set(ByVal value As Integer)
mClassID = value
End Set
End Property

Public Property StudentName() As String
Get
Return mStudentName
End Get
Set(ByVal value As String)
mStudentName = value
End Set
End Property
#End Region

End Class

These two classes will act as objects of student and class throughout the
solution.
Now your Solution Explorer will look like the following:


2. In ThreeTierVB.DataAccess

In DataClasses folder add ClasDB and StudentsDB classes and in GlobalClasses
folder add sqlHelp class and add a module modDB in modules folder.
I will just provide the code below for this tutorial but for full details on how
to access data from the database you can check How to insert record in SQL
server database from VB.Net?

Now in SQLHelp class add the following code:

Imports System.Data.SqlClient


Public NotInheritable Class SqlHelp

'Since this class provides only static methods, make the default constructor private to prevent
'instances from being created with "new SqlHelper()".

Dim conn As SqlConnection
Dim cmd As SqlCommand
Dim isTran As Boolean
Private trans As SqlTransaction
Dim connStr As String

Private Function Connect() As Boolean
Dim bln As Boolean
' Try
If conn Is Nothing Then
bln = ReadDatabseConfig(strDBConfFile)
If bln = True Then
conn = New SqlConnection(connStr)
End If
End If
If conn.State = ConnectionState.Closed Then
conn.Open()
End If

Exit Function

End Function

Public Sub BeginTransaction()

If isTran Then Return
If conn.State = ConnectionState.Closed Then
conn.Open()
End If
trans = conn.BeginTransaction()
isTran = True
End Sub

Public Sub CommitTransaction()
If Not isTran Then Return
trans.Commit()
conn.Close()
trans = Nothing
isTran = False
End Sub

Public Sub RollBackTransaction()
If Not isTran Then Return
trans.Rollback()
conn.Close()
trans = Nothing
isTran = False
End Sub

Public Sub CloseConn()
If Not conn Is Nothing Then
If Not conn.State = ConnectionState.Closed Then

conn.Close()
End If
End If
End Sub

Public Function ExecuteQuery(ByVal strCmdTxt As String) As Boolean
Dim intRows As Integer

If conn.State = ConnectionState.Closed Then
Connect()
End If

cmd = New SqlCommand
cmd.Connection = conn
cmd.CommandText = strCmdTxt
cmd.CommandType = CommandType.Text

If Not isTran Then
intRows = cmd.ExecuteNonQuery()
conn.Close()
Else
cmd.Transaction = trans
intRows = cmd.ExecuteNonQuery()

End If

If intRows> 0 Then
ExecuteQuery = True
Else
ExecuteQuery = False
End If

End Function

Public Function ExecuteAndGetID(ByVal strCmdTxt As String, Optional ByVal

blnNonID As Boolean = False) As String

If conn.State = ConnectionState.Closed Then
Connect()
End If
If Not blnNonID Then
strCmdTxt = strCmdTxt & " ; select scope_Identity();"
End If
cmd = New SqlCommand
cmd.Connection = conn
cmd.CommandText = strCmdTxt
cmd.CommandType = CommandType.Text

If Not isTran Then
ExecuteAndGetID = CStr(cmd.ExecuteScalar())
conn.Close()
Else
cmd.Transaction = trans
ExecuteAndGetID = CStr(cmd.ExecuteScalar())
End If

End Function


Public Function ExecuteAndGetReader(ByVal strCmdTxt As String) As

SqlDataReader

If conn.State = ConnectionState.Closed Then
Connect()
End If

cmd = New SqlCommand
cmd.Connection = conn
cmd.CommandText = strCmdTxt
cmd.CommandType = CommandType.Text

If Not isTran Then
ExecuteAndGetReader = cmd.ExecuteReader

Else
cmd.Transaction = trans
ExecuteAndGetReader = cmd.ExecuteReader
End If

End Function

Public Function ExecuteAndGetRow(ByVal strCmdTxt As String) As DataRow

Dim dt As DataTable
Dim da As SqlDataAdapter
Dim row As DataRow

If conn.State = ConnectionState.Closed Then
Connect()
End If
cmd = New SqlCommand
cmd.Connection = conn
cmd.CommandText = strCmdTxt
cmd.CommandType = CommandType.Text
dt = New DataTable
If Not isTran Then

da = New SqlDataAdapter(cmd)
Else
cmd.Transaction = trans
da = New SqlDataAdapter(cmd)
End If

da.Fill(dt)
da.Dispose()
row = dt.Rows(0)
ExecuteAndGetRow = row

End Function


Public Function getDataset(ByVal strCmdTxt As String) As DataSet
Dim da As SqlDataAdapter = New SqlDataAdapter
Dim ds As DataSet = New DataSet

If conn.State = ConnectionState.Closed Then

Connect()
End If

cmd = New SqlCommand
cmd.Connection = conn
cmd.CommandText = strCmdTxt
cmd.CommandType = CommandType.Text
If isTran Then
cmd.Transaction = trans
End If
da.SelectCommand = cmd
da.Fill(ds)
If Not isTran Then
conn.Close()
End If
Return ds

End Function

Public Sub New()

If Not Connect() Then
Exit Sub
End If
End Sub

Private Function ReadDatabseConfig(ByVal filename As String) As Boolean

Dim result As Boolean
Dim strDataSource As String = ""
Dim strInitialCatalog As String = ""
Dim strUserID As String = ""
Dim strPassword As String = ""

Dim sr As New IO.StreamReader(filename)
Dim ln As String = sr.ReadLine
While IsNothing(ln) = False
If ln.StartsWith("DataSource") = True Then
strDataSource = getConfigValue(ln)
ElseIf ln.StartsWith("DBaseName") = True Then
strInitialCatalog = getConfigValue(ln)
ElseIf ln.StartsWith("UserID") Then
strUserID = getConfigValue(ln)
ElseIf ln.StartsWith("Password") = True Then
strPassword = getConfigValue(ln)

End If
ln = sr.ReadLine
End While
sr.Close()
connStr = "Data Source=" & strDataSource & ";" & "Initial Catalog=" &

strInitialCatalog & _
";User ID=" & strUserID & ";Password=" & strPassword
result = True
ReadDatabseConfig = result

End Function

Private Function getConfigValue(ByVal line As String) As String
Dim values() As String = Split(line, "=")
Dim reply As String = values(1).Trim

Return reply
End Function
End Class

In Module modDB add the following code

Module modDB
Public strDBConfFile As String = "C:\DBConfig.ini"
Public Enum FlagAction
Insert = 1
Update = 2
Delete = 3
NoAction = 0
End Enum
End Module

Similarly in ClassDB add the following code

Imports System.Data.SqlClient
Imports ThreeTierVB.Info

Public Class classDB

' The function below will Delete the row of the class table with the provided
class ID. But to do this we have to first delete the related students in the
class because class has relation with the student table, this is the one of the
advantages of relational database.

Public Function DeleteClass(ByVal ClassID As Integer) As Boolean
Dim strSql As String
Dim objdb As New SqlHelp

strSql = "Delete from Students where ClassID= " & ClassID
objdb.ExecuteQuery(strSql)
objdb = New SqlHelp
strSql = "Delete from Class where ClassID= " & ClassID
objdb.ExecuteQuery(strSql)

Return True
End Function

' The function below gets all the rows of the class table and returns the
classInfo() collection so that this collection can be used in presentation
layer.

Public Function GetClass() As ClassInfo()
Dim strSql As String
Dim objdb As New SqlHelp

strSql = "Select * from Class"
Dim dr As SqlDataReader = objdb.ExecuteAndGetReader(strSql)
Dim arr As New ArrayList
While dr.Read

Dim cls As ClassInfo = New ClassInfo
cls.ClassID = IIf(IsDBNull(dr("ClassID")), 0, dr("ClassID"))
cls.ClassName = IIf(IsDBNull(dr("ClassName")), "", dr("ClassName"))
arr.Add(cls)
End While
dr.Close()
Return CType(arr.ToArray(GetType(ClassInfo)), ClassInfo())

End Function

'The function below gets the particular row of the class with the provided
classID and again returns the collection.

Public Function GetClass(ByVal ClassId As Integer) As ClassInfo()
Dim strSql As String
Dim objdb As New SqlHelp

strSql = "Select * from Class where classID= " & ClassId
Dim dr As SqlDataReader = objdb.ExecuteAndGetReader(strSql)
Dim arr As New ArrayList
While dr.Read

Dim cls As ClassInfo = New ClassInfo
cls.ClassID = IIf(IsDBNull(dr("ClassID")), 0, dr("ClassID"))
cls.ClassName = IIf(IsDBNull(dr("ClassName")), "", dr("ClassName"))
arr.Add(cls)
End While
dr.Close()
Return CType(arr.ToArray(GetType(ClassInfo)), ClassInfo())

End Function

' The below function gets the classInfo object as the parameter and saves the
record in the database and return true when inserted successfully.

Public Function Save(ByVal cls As ClassInfo) As Boolean
Dim strsql As String = ""
Dim objDB As New SqlHelp
If cls.Action = FlagAction.Insert Then
strsql = "Insert into Class (ClassName) " & _
"values( '" & cls.ClassName.Trim() & "')"
ElseIf cls.Action = FlagAction.Update Then
strsql = "Update Class set " & _
"ClassName='" & cls.ClassName.Trim() & "'" & _
" where ClassID=" & cls.ClassID
Else
Return False
End If
objDB.ExecuteQuery(strsql)
Return True
End Function

End Class

Similarly in StudentsDB add the following code

Imports System.Data.SqlClient
Imports ThreeTierVB.Info



Public Class StudentsDB

' The function deletes the student

Public Function DeleteStudent(ByVal StudentID As Integer) As Boolean
Dim strSql As String
Dim objDB As SqlHelp
strSql = "Delete from Students where StudentID=" & StudentID
objDB = New SqlHelp
objDB.ExecuteQuery(strSql)
Return True
End Function

'Retrieves the collection of student
Public Function GetStudent() As StudentInfo()
Dim objdb As New SqlHelp
Dim strSql As String = ""
strSql = "Select * from Students"
Dim dr As SqlDataReader = objdb.ExecuteAndGetReader(strSql)
Dim arr As New ArrayList
While dr.Read
Dim sI As StudentInfo = New StudentInfo
sI.ClassID = IIf(IsDBNull(dr("ClassID")), 0, dr("ClassID"))
sI.StudentID = IIf(IsDBNull(dr("StudentID")), 0, dr("StudentID"))
sI.StudentName = IIf(IsDBNull(dr("Student")), "", dr("StudentName"))
arr.Add(sI)
End While
dr.Close()
Return CType(arr.ToArray(GetType(StudentInfo)), StudentInfo())
End Function

'Retrieves the collection of student
Public Function GetStudent(ByVal StudentID As Integer) As StudentInfo()
Dim objdb As New SqlHelp
Dim strSql As String = ""
strSql = "Select * from Students where StudentID= " & StudentID
Dim dr As SqlDataReader = objdb.ExecuteAndGetReader(strSql)
Dim arr As New ArrayList
While dr.Read
Dim sI As StudentInfo = New StudentInfo
sI.ClassID = IIf(IsDBNull(dr("ClassID")), 0, dr("ClassID"))
sI.StudentID = IIf(IsDBNull(dr("StudentID")), 0, dr("StudentID"))
sI.StudentName = IIf(IsDBNull(dr("Student")), "", dr("StudentName"))
arr.Add(sI)
End While
dr.Close()
Return CType(arr.ToArray(GetType(StudentInfo)), StudentInfo())
End Function

'Retrieves the collection of student provided the classID as the parameter

Public Function GetStudentByClass(ByVal ClassID As Integer) As StudentInfo()
Dim objdb As New SqlHelp
Dim strSql As String = ""
strSql = "Select * from Students where ClassID= " & ClassID
Dim dr As SqlDataReader = objdb.ExecuteAndGetReader(strSql)
Dim arr As New ArrayList
While dr.Read
Dim sI As StudentInfo = New StudentInfo
sI.ClassID = IIf(IsDBNull(dr("ClassID")), 0, dr("ClassID"))
sI.StudentID = IIf(IsDBNull(dr("StudentID")), 0, dr("StudentID"))
sI.StudentName = IIf(IsDBNull(dr("StudentName")), "", dr

("StudentName"))
arr.Add(sI)
End While
dr.Close()
Return CType(arr.ToArray(GetType(StudentInfo)), StudentInfo())
End Function

' The function below saves the student

Public Function Save(ByVal student As StudentInfo) As Boolean
Dim strsql As String = ""
Dim objDB As New SqlHelp
If student.Action = FlagAction.Insert Then
strsql = "Insert into Students (StudentName,ClassID) " & _
"values( '" & student.StudentName.Trim() & "', " &

student.ClassID & ")"
ElseIf student.Action = FlagAction.Update Then
strsql = "Update Students set" & _
"StudentName='" & student.StudentName & "'," & _
" ClassID=" & student.ClassID & "' " & _
" where StudentID=" & student.StudentID
End If
objDB.ExecuteQuery(strsql)
Return True
End Function


End Class

3. In ThreeTierVB.BusinessLogic

In BLLClasses folder add classBll and studentsBll classes
and in classBLL add the following code:

Public Class classBLL
' This class now just acts as a bridge between the presentation layer and the
data access layer but later as the application grows most of the business cases
and business level logic can be implemented in this layer.

Public Function GetClass() As ThreeTierVB.Info.ClassInfo()
Dim db As New ThreeTierVB.DataAccess.classDB
Return db.GetClass()
End Function

Public Function GetClass(ByVal ClassID As Integer) As

ThreeTierVB.Info.ClassInfo()
Dim db As New ThreeTierVB.DataAccess.classDB
Return db.GetClass(ClassID)
End Function

Public Function Save(ByVal cls As ThreeTierVB.Info.ClassInfo)
Dim db As New ThreeTierVB.DataAccess.classDB
Return db.Save(cls)
End Function

Public Function Delete(ByVal intClassID As Integer)
Dim db As New ThreeTierVB.DataAccess.classDB
Return db.DeleteClass(intClassID)
End Function

End Class

Similarly in StudentBLL add the following code:

Public Class StudentsBLL
Public Function GetStudent() As ThreeTierVB.Info.StudentInfo()
Dim db As New ThreeTierVB.DataAccess.StudentsDB
Return db.GetStudent
End Function

Public Function GetStudent(ByVal studentID As Integer) As

ThreeTierVB.Info.StudentInfo()
Dim db As New ThreeTierVB.DataAccess.StudentsDB
Return db.GetStudent(studentID)
End Function

Public Function GetStudentByClass(ByVal intClassID As Integer)
Dim db As New ThreeTierVB.DataAccess.StudentsDB
Return db.GetStudentByClass(intClassID)
End Function

Public Function Save(ByVal student As ThreeTierVB.Info.StudentInfo)
Dim db As New ThreeTierVB.DataAccess.StudentsDB
Return db.Save(student)
End Function

Public Function Delete(ByVal intStudentID As Integer)
Dim db As New ThreeTierVB.DataAccess.StudentsDB
Return db.DeleteStudent(intStudentID)
End Function

End Class

Step 6 - Presentation Layer starts here

3. In ThreeTierVB

Now we have completed all the Business logic and Dataaccess coding and came back
to the form that we have left before.
Add the following code to the form: (Note if error you can copy individual
functions and subs and paste it in your form code page accordingly)

Public Enum FlagAction
Insert = 1
Update = 2
Delete = 3
NoAction = 0
End Enum

Public Class frmStudent

Private _students As ThreeTierVB.Info.StudentInfo()
Private _student As ThreeTierVB.Info.StudentInfo
Private _class As ThreeTierVB.Info.ClassInfo
Private _classes As ThreeTierVB.Info.ClassInfo()


Private Sub frmStudent_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load

LoadCbo()
LoadGrid(cboClass.SelectedValue)
End Sub

Sub LoadCbo()
' Get data for Class combo
Dim clsC As New ThreeTierVB.BusinessLogic.classBLL
_classes = clsC.GetClass
With cboClass

'to understand the following you can see How to use an object as a data source
in Visual Studio 2005 ?
.DataSource = _classes
.DisplayMember = "ClassName"
.ValueMember = "ClassID"
End With
' cboClass.SelectedIndex = 0

End Sub

Sub LoadGrid(ByVal classID As Integer)
Dim clsS As New ThreeTierVB.BusinessLogic.StudentsBLL
_students = clsS.GetStudentByClass(classID)

With grdStudents

'to understand the following you can see How to use an object as a data
source in Visual Studio 2005 ?
.DataSource = _students
.ColumnHeadersVisible = True

.ColumnHeadersDefaultCellStyle.ForeColor = Color.BurlyWood
.Columns.Item("ClassID").Visible = False
.Columns.Item("StudentID").HeaderText = "Student ID"
.Columns.Item("StudentName").HeaderText = "Student Name"
.Columns.Item("Action").Visible = False
End With
End Sub

Sub SaveClass()
Dim bln As Boolean
Dim clsC As New ThreeTierVB.BusinessLogic.classBLL
Dim clsInfo As New ThreeTierVB.Info.ClassInfo
clsInfo.ClassName = Me.txtClassName.Text.Trim
If cboClass.SelectedIndex = -1 Then
clsInfo.Action = FlagAction.Insert
Else
clsInfo.ClassID = cboClass.SelectedValue
clsInfo.Action = FlagAction.Update
End If
bln = clsC.Save(clsInfo)

If bln Then
MessageBox.Show("Data updated Successfully!!")
If cboClass.SelectedIndex = -1 Then
LoadCbo()
cboClass.SelectedIndex = UBound(_classes)
End If
_classes.SetValue(clsInfo, cboClass.SelectedIndex)

Refresh(cboClass.SelectedIndex)
grpNewClass.Visible = False
grpMain.Enabled = True
Else
MessageBox.Show("There is some error Updating record!! Try again")
End If
End Sub

Public Overloads Sub Refresh(ByVal intID As Integer)
cboClass.DataSource = _classes
cboClass.Refresh()
cboClass.SelectedIndex = intID

End Sub

Sub SaveStudent()
Dim bln As Boolean
Dim stuB As New ThreeTierVB.BusinessLogic.StudentsBLL
Dim stuInfo As New ThreeTierVB.Info.StudentInfo
Dim cls As ThreeTierVB.Info.ClassInfo
cls = _classes.GetValue(cboClass.SelectedIndex)
stuInfo.ClassID = cls.ClassID
stuInfo.StudentName = Me.txtStudentName.Text
stuInfo.Action = FlagAction.Insert
bln = stuB.Save(stuInfo)
MessageBox.Show("Student Data Updated Successfully!!")

End Sub

Private Sub cmdClassSave_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles cmdClassSave.Click

SaveClass()
End Sub

Private Sub cboClass_SelectedIndexChanged(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles cboClass.SelectedIndexChanged

If cboClass.SelectedIndex = -1 Then Exit Sub
Dim cls As ThreeTierVB.Info.ClassInfo
grpNewClass.Text = "Change this Class Name"
cls = _classes.GetValue(cboClass.SelectedIndex)
LoadGrid(cls.ClassID)
Me.txtClassName.Text = cls.ClassName

End Sub

Private Sub cmdNew_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles cmdNew.Click
Me.txtClassName.Text = ""
Me.cboClass.SelectedIndex = -1
grpNewClass.Text = "Add New Class Name"
grpNewClass.BackColor = Color.MintCream
grpNewClass.Visible = True
grpMain.Enabled = False

Me.txtClassName.Focus()
End Sub

Private Sub cmdSave_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles cmdSave.Click
errDisplay.Clear()
If cboClass.SelectedIndex = -1 Then
errDisplay.SetError(Me.cboClass, "Please Select Class!!")
Exit Sub
End If
If Me.txtStudentName.Text.Trim() = "" Then
errDisplay.SetError(Me.txtStudentName, "Please Enter Student Name")

Exit Sub
End If
SaveStudent()

End Sub
Private Sub cmdExit_Click(ByVal sender As System.Object, ByVal e As

System.EventArgs) Handles cmdExit.Click
Application.Exit()
End Sub

End Class

Now you can run the application and test, if you find errors try debugging it as
enough information was provided during this tutorial. If not you can download
this full application by clicking the link provided below.

Note: for website developers the presentation layer can be your web page and you
can bind your data to the _Students or _classes collection objects as well.

Download full three tier vb.net sample application

Read more!

How to use an object as a data source in Visual Studio 2005 ?

This article can serve the following topics as well:

Step by step tutorial on how to display a data (bind a data) in the text box controls and data grid view in visual studio 2005.

This can be the perfect vb net tutorial or asp net tutorial for vb net three tier application or asp net application using asp net 2.0 and vb net 2.0. 

By reading this article learner can distinctly distinguish the presentation layer, business layer and data access layer and understand the logic of the code.

Main article starts here


In the .NET Framework 2.0, any object that exposes public properties can serve as a data source.
In this application I have just used one form and one class named customer to make the tutorial easier for the beginners.

To make the readers clear on what are the data in the customers and make the data binding clear, this application creates an array of Customer objects and uses the BindingContext to navigate through the array of objects in much the same way as you would navigate through records in a DataSet.

Step 1


First open a project in .net 2005 and add a form named Customer having following controls:

4 text boxes named txtCustName, txtCustAddress,txtCustPhone,txtCustMobile

4 labels and write the logical text

1 Data grid view named grdDisplay

3 buttons named cmdPrev, cmdNext,cmdExit

Step 2

Add a class named clsCustomer and write the following code:

Public Class clsCustomer
#Region "Private Declarations"

Private _mCustName As String
Private _mCustAdd As String
Private _mCustPhone As Long
Private _mCustMobile As Long


#End Region

#Region "Public Declarations"

Public Property CustName() As String
Get
Return _mCustName
End Get
Set(ByVal value As String)
_mCustName = value
End Set
End Property

Public Property CustAddress() As String
Get
Return _mCustAdd
End Get
Set(ByVal value As String)
_mCustAdd = value
End Set
End Property

Public Property CustPhone() As Long
Get
Return _mCustPhone
End Get
Set(ByVal value As Long)
_mCustPhone = value
End Set
End Property

Public Property CustMobile() As Long
Get
Return _mCustMobile
End Get
Set(ByVal value As Long)
_mCustMobile = value
End Set
End Property

#End Region
End Class

(Note in this above class I have declared the public properties of the customer)


Step 3

Now in the form add the follwoing code

Public Class Customer
Private Customers(3) As clsCustomer
Private myBinding As BindingManagerBase

' In the above declarations there is a customer collection of 4 customers and binding manager



Private Sub LoadCustomers()

' Customers can be loaded manually for testing purpose but
' here we can retrieve the information from the database
' for more on retrieve from the database go to 
' How to get data from sql server database from visual basic .net or asp.net application

Customers(0) = New clsCustomer
Customers(0).CustName = "Harry Potter"
Customers(0).CustAddress = "Potter Village"
Customers(0).CustMobile = 6665555
Customers(0).CustPhone = 999945444


Customers(1) = New clsCustomer
Customers(1).CustName = "Bat Man"
Customers(1).CustAddress = "Bat Cave"
Customers(1).CustMobile = 666
Customers(1).CustPhone = 999

Customers(2) = New clsCustomer
Customers(2).CustName = "Spiderman"
Customers(2).CustAddress = " Spider Web"
Customers(2).CustMobile = 111111
Customers(2).CustPhone = 2222222

Customers(3) = New clsCustomer
Customers(3).CustName = "Hulk"
Customers(3).CustAddress = "Hulk house"
Customers(3).CustMobile = 55555
Customers(3).CustPhone = 44444

End Sub

Private Sub cmdPrev_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdPrev.Click

myBinding.Position -= 1

End Sub

Private Sub cmdNext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdNext.Click

myBinding.Position += 1

End Sub

Private Sub cmdExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExit.Click

Me.Close()

End Sub

Private Sub Customer_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load

LoadCustomers()
txtCustName.DataBindings.Add("Text", Customers, "CustName")
txtCustAdd.DataBindings.Add("Text", Customers, "CustAddress")
txtCustMobile.DataBindings.Add("Text", Customers, "CustMobile")
txtCustPhone.DataBindings.Add("Text", Customers, "CustPhone")
'Binding the text boxes to the customers object
myBinding = BindingContext.Item(Customers)

grdDisplay.DataSource = Customers


End Sub

End Class

Now run the application and look how it works.

The main objective of this application is to provide the knowlege of how to use the objects directly as a datasource.

The ability to work with your own business entity classes instead of DataTables can be beneficial in many situations, such as in ntier systems that require the user interface to be completely  ignorant of the type and structure of the underlying data stores for a given system. In such a situation, the presentation layer can retrieve a set of objects from a middle tier and bind those objects directly to the user interface.

Certainly object data sources are not appropriate for all applications, but in many situations they are an extremely powerful and useful option.

And Visual Studio 2005 makes data binding with objects amazingly easy.

References:
Introducing Microsoft Visual Basic 2005 for Developers
Microsoft Press

Read more!

Ajax like look and feel from Json and what is Json?

JSON what is it and how it works?

The description of JSON is "JavaScript Object notation".
According to the official website it is a lightweight data-interchange
format. It is human readable and writeable and is a subset of the Javascript
Programming Language.
It is completely language independent.
Jason Looks like this and is in easily readable format like xml.

{
"Firstname": "John",
"Lastname": "Smith",
"emailaddrs": [
{"type": "work", "value": "abc@work.com.au"},
{"type": "home", "pref": 1, "value": "abc@work.com.au"}
],
"phones": [
{"type": "work", "pref": 1, "value": "123 12321221321"},
{"type": "mobile", "value": "123 23232323"}
],
"Experience":
["2006", "2007", "2008"]

}

You can access the jason property in javaScript as follows:



var fname = jsonObject.FirstName


I found this help from Codeville.net and I have tried this out myself and found this to be interesting topic to be explored.

Also while trying this I have a test project that i will explain it to you guys that helps you to understand about it more.

This example shows how easy it is to build dynamic lists using jason and and having the ajax experience in ASP.net

1. First step is to download the following dlls from Download Jason Dlls

2. Open a web project and put those two dlls in the bin folder of your project.

3. add a web form and name it rprateekDemo.aspx and copy the following code :
(or you can add any name and modify code as per the name of the aspx)



(note: you can get the source file on the JasonDll.rar that you downloaded above

4. Then add the following code in the code behind file rprateeDemo.aspx.cs :

using System;

namespace rprateek.blogspot
{
public partial class SimpleListDemoPage : System.Web.UI.Page
{
protected void Page_Load(object sender, EventArgs e)
{
if (!IsPostBack)
{
TagList.Model["tags"] = new string[] { "AjaxFeel", "MVC", "JavaScript" };
}
}

protected void SubmitButton_Click(object sender, EventArgs e)
{
// Retrieve updated data model from control
string[] tags = (string[])TagList.Model["tags"];
ResultsLabel.Text = string.Format("You entered {0} tag(s): {1}", tags.Length, string.Join(", ", tags));
}
}
}

5. Add a file name it TagList.jmvc and copy the following code in the file :

(note: you can get the source file on the JasonDll.rar that you downloaded above )

6. Now save build and run the application and check out how sweetly it works.

Read more!

MVC Pattern from VB 6.0 Tutorial

Model view controller is a most effective way of programming. In this article i will be explaining how we can achieve MVC pattern in visual basic 6.0.

There will be three projects

1. Data Project
Does all the data access work
All insert, update and select are done here

Has direct access to database
Has all the reference to data access objects


2. BusinessLogic Project
Does all the business logic processing
All calculations and how data should be rendered is done

Has data Project Reference

3. Forms Project
Does all the interfacing part here
Has direct user interaction

Has businessLogic Reference


Lets start the visual basic MVC Tutorial from here


(I am simply using the example of "User Access module" of an application here to explain this article, hope it works well)

Note:
In this tutorial there can be some functions which can be ignored
You have to work around a little to make this code working
It won't work on copy paste basis
But Main way of doing is clearly Explained so Enjoy coding

1.. Tables used in the tutorial

CREATE TABLE DUSERACCESS (
USERID VARCHAR(10) NOT NULL,
MENU_ID DECIMAL(10,0) NOT NULL,
PRIMARY KEY(USERID,MENU_ID)
)
GO


CREATE TABLE MENUTABLE (
MENU_ID DECIMAL(10,0) NOT NULL,
MENUNAME VARCHAR(30),
MENUCAPTION VARCHAR(30),
MODULE_ID DECIMAL(2,0),
MENU_SEQ DECIMAL(3,0),
PRIMARY KEY(MENU_ID)
)
GO


CREATE TABLE TBLUSER (
USERID VARCHAR(15) NOT NULL,
DESCRIPTION VARCHAR(50),
PASSWORD VARCHAR(50) NOT NULL,
DISTRICT DECIMAL(2,0) NOT NULL,
ACCESSLEVEL DECIMAL(5,0) NOT NULL,
USERIP VARCHAR(20) NOT NULL,
ISACTIVE VARCHAR(1) NOT NULL,
PRIMARY KEY(USERID)
)
GO
ALTER TABLE TBLUSER
ADD CONSTRAINT CHK1
CHECK (ISACTIVE IN('Y','N'))
GO
ALTER TABLE TBLUSER
ADD CONSTRAINT U_R_FK
FOREIGN KEY(ACCESSLEVEL)
REFERENCES TBLROLE(ROLLID)
ON DELETE NO ACTION
ON UPDATE NO ACTION
GO


2.. Data Project Classes and Modules Required

modules
name : modConn ( this module is for connection ODBC Connection is used in this context)

Global Cnn As ADODB.Connection


Sub Main()

If Cnn Is Nothing Then
On Error GoTo ConnectionError
Set Cnn = New ADODB.Connection
' Cnn.CursorLocation = adUseClient
'Cnn.Open "dsn=vote"
Cnn.Open "dsn=Election", "db2admin", "commission"


frmCreateUserAccess.Show
End If

Exit Sub

ConnectionError:
Set Cnn = Nothing
Err.Raise Err.Number, "Opening Database", Err.Description


End Sub

name: DataProperties ( this module is for mapping the Database table fields)

Public Type DUserProps

strUserID As String * 10
strDescription As String * 50
strPassword As String * 50
intDistrict As Integer
intAccessLevel As Integer
strUserIP As String * 20
strIsActive As String * 1
strAccessLevel As String * 10

End Type

Public Type DUserData
Buffer As String * 150
End Type


Public Type DUserAccessProps

lngMenuId As Long
strMenuName As String * 30
strMenuCaption As String * 50
strUserID As String * 10
End Type

Public Type DUserAccessData
Buffer As String * 94
End Type




classes
name: Buffer (this class is for data transformation to and from in a binary string format)

Option Explicit

Private Type BufferProps
Length As Integer
EstCount As Long
MaxCount As Long
Count As Long
End Type

Private Type BufferData
Buffer As String * 8
End Type

Private Const BUFFER_START = 9
Private mstrBuffer As String
Private mudtProps As BufferProps
Private mlngPos As Long

Public Sub Initialize(Length As Integer, EstimatedCount As Long)

With mudtProps
.Length = Length
.EstCount = EstimatedCount
.MaxCount = EstimatedCount
.Count = 0
mstrBuffer = Space$(BUFFER_START + .MaxCount * .Length)
mlngPos = BUFFER_START
End With

End Sub

Public Sub Add(Data As String)

With mudtProps
If .Count = .MaxCount Then
mstrBuffer = mstrBuffer & _
Space$(mudtProps.EstCount / 2 * mudtProps.Length)
.MaxCount = .MaxCount + mudtProps.EstCount / 2
End If

Mid$(mstrBuffer, mlngPos, .Length) = Data
mlngPos = mlngPos + .Length
.Count = .Count + 1
End With

End Sub

Public Function GetState() As String

Dim udtData As BufferData

LSet udtData = mudtProps
Mid$(mstrBuffer, 1, Len(udtData.Buffer)) = udtData.Buffer
GetState = Left$(mstrBuffer, mlngPos)

End Function

Public Sub SetState(Buffer As String)

Dim udtData As BufferData

udtData.Buffer = Mid$(Buffer, 1, Len(udtData.Buffer))
LSet mudtProps = udtData
mstrBuffer = Buffer

End Sub

Public Property Get Item(Index As Long) As String

Item = Mid$(mstrBuffer, BUFFER_START + (Index - 1) * _
mudtProps.Length, mudtProps.Length)

End Property

Public Function Count() As Long

Count = mudtProps.Count

End Function

Public Function Length() As Long

Length = mudtProps.Length

End Function

Public Property Let Item(Index As Long, Buffer As String)

Mid$(mstrBuffer, BUFFER_START + (Index - 1) * _
mudtProps.Length, mudtProps.Length) = Buffer

End Property

Name:clsdbLogin


Private DUProps As DUserProps

Private Function GetState() As String

Dim DUdata As DUserData
LSet DUdata = DUProps
GetState = DUdata.Buffer

End Function

Private Sub SetState(Buffer As String)

Dim DUdata As DUserData

DUdata.Buffer = Buffer
LSet DUProps = DUdata

End Sub



Public Function getLoginDetails(ByVal strUName As String, _
Optional strPass As String, Optional intmod As Integer) As String
Dim mObjBuffer As New Buffer
Dim rs As Recordset
Dim DUdtData As DUserData
Dim DUdtProps As DUserProps
Dim Mysql As String
On Error GoTo ACerr
If strPass <> "" And intmod <> 0 Then
Set rs = New Recordset
' Mysql = " SELECT DECRYPT_CHAR('" & strPass & "','" & strUName & "') FROM a"
' rs.Open Mysql, Cnn, adOpenStatic
' strPass = rs!DECRYPT_CHAR

Mysql = "select * from tblUser where Userid='" & strUName & "'" _
& " AND DECRYPT_CHAR(Password,'" & strUName & "') ='" & strPass & "' AND district= " & intmod & ""
ElseIf strPass = "" And intmod <> 0 Then
Mysql = " select USERID,DESCRIPTION, DECRYPT_CHAR(password,'" & strUName & "')as Password ,DISTRICT,ACCESSLEVEL,USERIP,ISACTIVE " & _
" From tblUser where userid='" & strUName & "' AND district= " & intmod
'Mysql = "select * from tblUser where userid='" & strUName & "' AND district= " & intmod

End If


Set rs = New Recordset
rs.Open Mysql, Cnn, adOpenStatic


mObjBuffer.Initialize Len(DUdtData.Buffer), rs.RecordCount

Do While Not rs.EOF
With DUdtProps
.strUserID = IIf(IsNull(rs("UserID")), "", rs("UserID"))
.strDescription = IIf(IsNull(rs("Description")), "", rs("Description"))
.strPassword = IIf(IsNull(rs("Password")), "", rs("Password"))
.intDistrict = IIf(IsNull(rs("DISTRICT")), "0", rs("DISTRICT"))
.intAccessLevel = IIf(IsNull(rs("ACCESSLEVEL")), "0", rs("ACCESSLEVEL"))
.strUserIP = IIf(IsNull(rs("USERIP")), "", rs("USERIP"))
.strIsActive = IIf(IsNull(rs("ISACTIVE")), "", rs("ISACTIVE"))

End With
LSet DUdtData = DUdtProps
mObjBuffer.Add DUdtData.Buffer
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
getLoginDetails = mObjBuffer.GetState
Exit Function
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Function



'Public Function getPassword(ByVal strUName As String) As ADODB.Recordset
'
' On Error GoTo err
' Dim MySql As String
'
'
'
' MySql = "select * from DUser where user_name='" & strUName & "'"
'
' Set getPassword = New ADODB.Recordset
' getPassword.Open (MySql), Cnn, adOpenKeyset, adLockOptimistic
'
'
'Exit Function
'err:
' err.Raise err.Number, "getPass", OracleError.OracleError(err.Number)
'
'End Function


Public Function searchUser(ByVal strFilter As String) As String
Dim mObjBuffer As New Buffer
Dim rs As Recordset
Dim DUdtData As DUserData
Dim DUdtProps As DUserProps
Dim Mysql As String
On Error GoTo ACerr
Mysql = "select * from TBLUSER " & strFilter
' Mysql = " select USERID,DESCRIPTION, DECRYPT_CHAR(password,'" & UserID & "') as Password ,DISTRICT,ACCESSLEVEL,USERIP,ISACTIVE " & _
' " From tblUser " & strFilter
Set rs = New Recordset
rs.Open Mysql, Cnn, adOpenKeyset


mObjBuffer.Initialize Len(DUdtData.Buffer), rs.RecordCount

Do While Not rs.EOF
With DUdtProps
.strUserID = IIf(IsNull(rs("UserID")), "", rs("UserID"))
.strDescription = IIf(IsNull(rs("Description")), "", rs("Description"))
.strPassword = IIf(IsNull(rs("Password")), "", rs("Password"))
.intDistrict = IIf(IsNull(rs("DISTRICT")), "0", rs("DISTRICT"))
.intAccessLevel = IIf(IsNull(rs("ACCESSLEVEL")), "0", rs("ACCESSLEVEL"))
.strUserIP = IIf(IsNull(rs("USERIP")), "", rs("USERIP"))
.strIsActive = IIf(IsNull(rs("ISACTIVE")), "", rs("ISACTIVE"))


End With
LSet DUdtData = DUdtProps
mObjBuffer.Add DUdtData.Buffer
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
searchUser = mObjBuffer.GetState
Exit Function
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Function



Public Sub Add_User(ByVal Buffer As String)

On Error GoTo ACerr
SetState Buffer
Dim strSql As String


strSql = "INSERT INTO TBLUSER (USERID, Description, PASSWORD, District, AccessLevel" _
& ",UserIP, isactive) VALUES " & _
"('" & Trim(MakeStr(DUProps.strUserID)) & "','" & Trim(MakeStr(DUProps.strDescription)) & "'," & _
"ENCRYPT('" & Trim(DUProps.strPassword) & "','" & Trim(DUProps.strUserID) & "','') ," & DUProps.intDistrict & "," & _
"" & DUProps.intAccessLevel & ",'" & Trim(MakeStr(DUProps.strUserIP)) & "'," & _
"'" & Trim(MakeStr(DUProps.strIsActive)) & "' )"
Cnn.Execute strSql


Exit Sub
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Sub

Public Sub Modify_User(ByVal Buffer As String, intUserID As String)

On Error GoTo ACerr
Dim strSql As String
SetState Buffer
If Trim(DUProps.strPassword) = "" Then
strSql = "UPDATE TBLUSER SET Description ='" & Trim(MakeStr(DUProps.strDescription)) & "'," & _
"District=" & DUProps.intDistrict & ",AccessLevel=" & DUProps.intAccessLevel & "," & _
" USERIP='" & Trim(MakeStr(DUProps.strUserIP)) & "',isactive='" & DUProps.strIsActive & "'" & _
" WHERE UserID='" & Trim(intUserID) & "'"

ElseIf Trim(DUProps.strPassword) = "N/A" Then
strSql = "UPDATE TBLUSER SET Description ='" & Trim(MakeStr(DUProps.strDescription)) & "'," & _
"District=" & DUProps.intDistrict & ",AccessLevel=" & DUProps.intAccessLevel & "," & _
" USERIP='" & Trim(MakeStr(DUProps.strUserIP)) & "',isactive='" & DUProps.strIsActive & "'" & _
" WHERE UserID='" & Trim(intUserID) & "'"
Else
strSql = "UPDATE TBLUSER SET Description ='" & Trim(MakeStr(DUProps.strDescription)) & "'," & _
"District=" & DUProps.intDistrict & ",AccessLevel=" & DUProps.intAccessLevel & "," & _
" USERIP='" & Trim(MakeStr(DUProps.strUserIP)) & "',isactive='" & DUProps.strIsActive & "'," & _
" Password=ENCRYPT('" & Trim(DUProps.strPassword) & "','" & Trim(DUProps.strUserID) & "','') WHERE UserID='" & Trim(intUserID) & "'"
End If
Cnn.Execute strSql

Exit Sub
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Sub

Public Sub ChangePassword(ByVal strPass As String, strUserID As String)

On Error GoTo ACerr
Dim strSql As String


'Cnn.Execute StrSql

'StrSql = "UPDATE TBLUSER SET Password=ENCRYPT('" & Trim(strPass) & "','" & Trim(strUserID) & "','') WHERE UserID='" & intUserID & "'"

strSql = "UPDATE TBLUSER SET Password=ENCRYPT('" & Trim(strPass) & "','" & Trim(strUserID) & "','') WHERE USERID='" & Trim(strUserID) & "'"
Cnn.Execute strSql

Exit Sub
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Sub



Name : clsdbDUserAccess

Option Explicit
Private DUAProps As DUserAccessProps

Private Function GetState() As String

Dim DUAData As DUserAccessData
LSet DUAData = DUAProps
GetState = DUAData.Buffer

End Function

Private Sub SetState(Buffer As String)

Dim DUAData As DUserAccessData

DUAData.Buffer = Buffer
LSet DUAProps = DUAData

End Sub

Public Function getAccessDetails(ByVal strUserID As String, intModID As Integer) As String
Dim mObjBuffer As New Buffer
Dim rs As Recordset
Dim DUAData As DUserAccessData
Dim DUAProps As DUserAccessProps
Dim Mysql As String
On Error GoTo ACerr
If intModID = 1 Then
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a where a.MODULE_ID<>9 order by a.MENU_SEQ asc "
ElseIf intModID = 2 Then
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a Where a.module_id in (0,2) order by a.MENU_SEQ asc "
ElseIf intModID = 3 Then
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a Where a.module_id in (0,3) order by a.MENU_SEQ asc "
ElseIf intModID = 4 Then
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a Where a.module_id in (0,4) order by a.MENU_SEQ asc "
ElseIf intModID = 5 Then
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a Where a.module_id in (0,5) order by a.MENU_SEQ asc "
Else
Mysql = "select a.*, (select UserID from duseraccess where userid='" & Trim(MakeStr(strUserID)) & "' and menu_id=a.menu_id) User_id " & _
" from menutable a Where a.module_id = 0 order by a.MENU_SEQ asc "
End If

Set rs = New Recordset
rs.Open Mysql, Cnn, adOpenStatic
mObjBuffer.Initialize Len(DUAData.Buffer), rs.RecordCount

Do While Not rs.EOF
With DUAProps
.strUserID = IIf(IsNull(rs("USER_ID")), "", rs("USER_ID"))
.lngMenuId = IIf(IsNull(rs("MENU_ID")), 0, rs("MENU_ID"))
.strMenuName = IIf(IsNull(rs("MENUNAME")), "", rs("MENUNAME"))
.strMenuCaption = IIf(IsNull(rs("MENUCAPTION")), "", rs("MENUCAPTION"))
End With
LSet DUAData = DUAProps
mObjBuffer.Add DUAData.Buffer
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
getAccessDetails = mObjBuffer.GetState
Exit Function
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Function


Public Sub Add_User(ByVal Buffer As String)

On Error GoTo ACerr
SetState Buffer
Dim strSql As String



strSql = "INSERT INTO DUSERACCESS (USERID, MENU_ID ) VALUES " & _
"('" & Trim(MakeStr(DUAProps.strUserID)) & "'," & DUAProps.lngMenuId & ")"
Cnn.Execute strSql


Exit Sub
ACerr:

Err.Raise Err.Number, Err.Source, Err.Description

End Sub

Public Sub Delete_All(ByVal lngUserID As String)
Dim strSql As String
On Error GoTo DelErr
strSql = "DELETE FROM DUSERACCESS WHERE USERID= '" & Trim(lngUserID) & "'"
Cnn.Execute strSql
Exit Sub
DelErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

3.. BusinessLogic Classes and Modules Required


Modules
Name: dataProperties - Share with the Data access module(this two are same)

Public Type DUserProps

strUserID As String * 10
strDescription As String * 50
strPassword As String * 50
intDistrict As Integer
intAccessLevel As Integer
strUserIP As String * 20
strIsActive As String * 1
strAccessLevel As String * 10

End Type

Public Type DUserData
Buffer As String * 150
End Type

Public Type DUserAccessProps

lngMenuId As Long
strMenuName As String * 30
strMenuCaption As String * 50
strUserID As String * 10
End Type

Public Type DUserAccessData
Buffer As String * 94
End Type

Classes

name: Buffer

Option Explicit

Private Type BufferProps
Length As Integer
EstCount As Long
MaxCount As Long
Count As Long
End Type

Private Type BufferData
Buffer As String * 8
End Type

Private Const BUFFER_START = 9
Private mstrBuffer As String
Private mudtProps As BufferProps
Private mlngPos As Long

Public Sub Initialize(Length As Integer, EstimatedCount As Long)

With mudtProps
.Length = Length
.EstCount = EstimatedCount
.MaxCount = EstimatedCount
.Count = 0
mstrBuffer = Space$(BUFFER_START + .MaxCount * .Length)
mlngPos = BUFFER_START
End With

End Sub

Public Sub Add(Data As String)

With mudtProps
If .Count = .MaxCount Then
mstrBuffer = mstrBuffer & _
Space$(mudtProps.EstCount / 2 * mudtProps.Length)
.MaxCount = .MaxCount + mudtProps.EstCount / 2
End If

Mid$(mstrBuffer, mlngPos, .Length) = Data
mlngPos = mlngPos + .Length
.Count = .Count + 1
End With

End Sub

Public Function GetState() As String

Dim udtData As BufferData

LSet udtData = mudtProps
Mid$(mstrBuffer, 1, Len(udtData.Buffer)) = udtData.Buffer
GetState = Left$(mstrBuffer, mlngPos)

End Function

Public Sub SetState(Buffer As String)

Dim udtData As BufferData

udtData.Buffer = Mid$(Buffer, 1, Len(udtData.Buffer))
LSet mudtProps = udtData
mstrBuffer = Buffer

End Sub

Public Property Get Item(Index As Long) As String

Item = Mid$(mstrBuffer, BUFFER_START + (Index - 1) * _
mudtProps.Length, mudtProps.Length)

End Property

Public Function Count() As Long

Count = mudtProps.Count

End Function

Public Function Length() As Long

Length = mudtProps.Length

End Function

Public Property Let Item(Index As Long, Buffer As String)

Mid$(mstrBuffer, BUFFER_START + (Index - 1) * _
mudtProps.Length, mudtProps.Length) = Buffer

End Property


Name: clsMLogin


Option Explicit

Private mcolLogin As Collection
Private mflgEditing As Boolean

Private Sub Class_Initialize()

Set mcolLogin = New Collection

End Sub

Public Function Item(ByVal Index As Variant) As clslogin

Set Item = mcolLogin(Index)

End Function

Public Function Count() As Long

Count = mcolLogin.Count

End Function

Public Function NewEnum() As IUnknown

Set NewEnum = mcolLogin.[_NewEnum]

End Function


Public Sub Add(ByVal Child As clslogin)
mcolLogin.Add Item:=Child
End Sub

Public Sub Save()

Dim objchild As clslogin
Dim objdbex As clsdbexecute
Set objdbex = New clsdbexecute
On Error GoTo SaveErr
objdbex.BeginTrans
For Each objchild In mcolLogin
objchild.Add_User
objchild.DUserAccess.Save
Next
objdbex.CommitTrans
Exit Sub
SaveErr:
objdbex.RollBackTrans
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub Update(ByVal intUserID As String)

Dim objchild As clslogin
Dim objdbex As clsdbexecute
Set objdbex = New clsdbexecute
On Error GoTo UErr
objdbex.BeginTrans
For Each objchild In mcolLogin
objchild.Modify_User (intUserID)
objchild.DUserAccess.Update (intUserID)
Next
objdbex.CommitTrans
Exit Sub
UErr:
objdbex.RollBackTrans
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Private Sub SetState(Buffer As String)

Dim objBuffer As New Buffer
Dim objchild As clslogin
Dim lngIndex As Long
Dim LdtData As DUserData
Dim LdtProps As DUserProps
Dim objLAccess As clsMDUserAccess
On Error GoTo SetErr
With objBuffer
.SetState Buffer
For lngIndex = 1 To .Count
Set objchild = New clslogin
LdtData.Buffer = .Item(lngIndex)
LSet LdtProps = LdtData
With objchild
.AccessLevel = Trim(LdtProps.intAccessLevel)
.Description = Trim(LdtProps.strDescription)
.District = Trim(LdtProps.intDistrict)
.IsActive = Trim(LdtProps.strIsActive)
.Password = Trim(LdtProps.strPassword)
.User_ID = Trim(LdtProps.strUserID)
.User_IP = Trim(LdtProps.strUserIP)


Set objLAccess = New clsMDUserAccess
objLAccess.getUser .User_ID, .AccessLevel
.DUserAccess = objLAccess

mcolLogin.Add objchild
Set objchild = Nothing
End With

Next

End With

Set objBuffer = Nothing
Exit Sub
SetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub


Public Sub getLoginDetails(ByVal strUName As String, strPass As String, intmod As Integer)
Dim objdb As clsdbLogin
Set objdb = New clsdbLogin
On Error GoTo GetErr
SetState objdb.getLoginDetails(strUName, strPass, intmod)
Set objdb = Nothing
Exit Sub
GetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub


Public Function getPassword(ByVal strUserName As String, ByVal intmod As Integer) As String
Dim objdb As clsdbLogin
Set objdb = New clsdbLogin
On Error GoTo GetErr
SetState objdb.getLoginDetails(strUserName, , intmod)
Set objdb = Nothing
Exit Function
GetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Function



Public Function getUser(ByVal strFilter As String) As String
Dim objdb As clsdbLogin
Set objdb = New clsdbLogin
On Error GoTo GetErr
SetState objdb.searchUser(strFilter)
Set objdb = Nothing
Exit Function
GetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Function


Name: clsLogin


Private LProps As DUserProps
'local variable(s) to hold property value(s)
Private objDUserAccess As clsMDUserAccess 'local copy


Public Property Let DUserAccess(ByVal vData As clsMDUserAccess)
Set objDUserAccess = vData
End Property


Public Property Get DUserAccess() As clsMDUserAccess
Set DUserAccess = objDUserAccess
End Property


Public Property Let IsActive(ByVal vData As String)
LProps.strIsActive = vData
End Property


Public Property Get IsActive() As String
IsActive = LProps.strIsActive
End Property


Public Property Let User_IP(ByVal vData As String)
LProps.strUserIP = vData
End Property


Public Property Get User_IP() As String
User_IP = LProps.strUserIP
End Property


Public Property Let AccessLevel(ByVal vData As Integer)
LProps.intAccessLevel = vData
End Property


Public Property Get AccessLevel() As Integer
AccessLevel = LProps.intAccessLevel
End Property

Public Property Let AccessLevelName(ByVal vData As String)
LProps.strAccessLevel = vData
End Property


Public Property Get AccessLevelName() As String
AccessLevelName = LProps.strAccessLevel
End Property


Public Property Let District(ByVal vData As Integer)
LProps.intDistrict = vData
End Property


Public Property Get District() As Integer
District = LProps.intDistrict
End Property

Public Property Let User_ID(ByVal vData As String)
LProps.strUserID = vData
End Property


Public Property Get User_ID() As String
User_ID = LProps.strUserID
End Property



Public Property Let Description(ByVal vData As String)
LProps.strDescription = vData
End Property


Public Property Get Description() As String
Description = LProps.strDescription
End Property

Public Property Let Password(ByVal vData As String)
LProps.strPassword = vData
End Property


Public Property Get Password() As String
Password = LProps.strPassword
End Property

Private Function GetState() As String

Dim LData As DUserData
LSet LData = LProps
GetState = LData.Buffer

End Function

Private Sub SetState(Buffer As String)

Dim LData As DUserData
LData.Buffer = Buffer
LSet LProps = LData

End Sub

Public Sub Add_User()

Dim objdb As clsdbLogin

On Error GoTo AddErr
Set objdb = New clsdbLogin

objdb.Add_User (GetState)
Exit Sub
AddErr:
Err.Raise Err.Number, Err.Source, Err.Description

End Sub


Public Sub Modify_User(ByVal intUserID As String)
Dim objdb As clsdbLogin
On Error GoTo AddErr
Set objdb = New clsdbLogin
objdb.Modify_User GetState, intUserID
Exit Sub
AddErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub ChangePassword(ByVal strPass As String, strUserID As String)
Dim objdb As clsdbLogin
On Error GoTo AddErr
Set objdb = New clsdbLogin
objdb.ChangePassword strPass, strUserID
Exit Sub
AddErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub



Name: clsMDUserAccess


Option Explicit

Private mcolLoginAccess As Collection
Private mflgEditing As Boolean

Private Sub Class_Initialize()

Set mcolLoginAccess = New Collection

End Sub

Public Function Item(ByVal Index As Variant) As clsDUserAccess

Set Item = mcolLoginAccess(Index)

End Function

Public Function Count() As Long

Count = mcolLoginAccess.Count

End Function

Public Function NewEnum() As IUnknown

Set NewEnum = mcolLoginAccess.[_NewEnum]

End Function


Public Sub Add(ByVal Child As clsDUserAccess)
mcolLoginAccess.Add Item:=Child
End Sub

Public Sub Save()

Dim objchild As clsDUserAccess
On Error GoTo SaveErr
Dim i As Integer
i = 1

For Each objchild In mcolLoginAccess
If i = 1 Then
objchild.Delete_All (objchild.UserID)
End If
objchild.Save
i = i + 1
Next
Exit Sub
SaveErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub Update(ByVal intUserID As String)

Dim objchild As clsDUserAccess

On Error GoTo UErr
Set objchild = New clsDUserAccess
objchild.Delete_All (intUserID)
Call Save

Exit Sub
UErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Function getUser(ByVal strUserID As String, intModID As Integer) As String
Dim objdb As clsdbDUserAccess
Set objdb = New clsdbDUserAccess
On Error GoTo GetErr
SetState objdb.getAccessDetails(strUserID, intModID)
Set objdb = Nothing
Exit Function
GetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Function

Private Sub SetState(Buffer As String)

Dim objBuffer As New Buffer
Dim objchild As clsDUserAccess
Dim lngIndex As Long
Dim DLAData As DUserAccessData
Dim DLAProps As DUserAccessProps
On Error GoTo SetErr
With objBuffer
.SetState Buffer
For lngIndex = 1 To .Count
Set objchild = New clsDUserAccess
DLAData.Buffer = .Item(lngIndex)
LSet DLAProps = DLAData
With objchild
.UserID = Trim(DLAProps.strUserID)
.MenuID = Trim(DLAProps.lngMenuId)
.MenuName = Trim(DLAProps.strMenuName)
.MenuCaption = Trim(DLAProps.strMenuCaption)
mcolLoginAccess.Add objchild
Set objchild = Nothing
End With

Next

End With

Set objBuffer = Nothing
Exit Sub
SetErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub


Name: clsDuserAccess

'local variable(s) to hold property value(s)
Private DUAProps As DUserAccessProps
Public Property Let MenuName(ByVal vData As String)

DUAProps.strMenuName = vData
End Property


Public Property Get MenuName() As String
MenuName = DUAProps.strMenuName
End Property

Public Property Let MenuCaption(ByVal vData As String)
DUAProps.strMenuCaption = vData
End Property


Public Property Get MenuCaption() As String
MenuCaption = DUAProps.strMenuCaption
End Property



Public Property Let MenuID(ByVal vData As Long)
DUAProps.lngMenuId = vData
End Property


Public Property Get MenuID() As Long
MenuID = DUAProps.lngMenuId
End Property



Public Property Let UserID(ByVal vData As String)
DUAProps.strUserID = vData
End Property


Public Property Get UserID() As String
UserID = DUAProps.strUserID
End Property


Private Function GetState() As String

Dim DUAData As DUserAccessData
LSet DUAData = DUAProps
GetState = DUAData.Buffer

End Function

Private Sub SetState(Buffer As String)

Dim DUAData As DUserAccessData
DUAData.Buffer = Buffer
LSet DUAProps = DUAData

End Sub


Public Sub Save()

Dim objchild As clsdbDUserAccess
On Error GoTo SaveErr
Set objchild = New clsdbDUserAccess
'For Each objChild In mcolLoginAccess
objchild.Add_User GetState
' Next
Exit Sub
SaveErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub Delete_All(ByVal lngUserID As String)
Dim objdbChild As clsdbDUserAccess
On Error GoTo ModifyErr
Set objdbChild = New clsdbDUserAccess
objdbChild.Delete_All (lngUserID)
Exit Sub
ModifyErr:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub



4.. Forms Required

Name: frmCreateUserAccess
Picture:













Option Explicit
Dim blneditmode As Boolean
Dim obj As clslogin
Dim objM As clsMLogin
Private Function GetFilter() As String
On Error GoTo FErr
Dim strWSql As String
Dim intDis As Integer
intDis = Val(Me.cboDistrictID.Text)
strWSql = ""
If Trim(Me.txtUserName.Text) <> "" Then
strWSql = "Where" & strWSql & " Upper(userid) like '" & UCase(Replace(Trim(Me.txtUserName.Text), "'", "''")) & "%'and district= " & intDis & " and"

Else
strWSql = "Where" & strWSql & " district= " & intDis & " and"
End If


If strWSql <> "" Then
strWSql = Mid(strWSql, 1, Len(strWSql) - 3)
End If
GetFilter = strWSql
Exit Function
FErr:
MsgBox Err.Description, vbInformation
End Function



Private Sub cboDistrict_Click()
Me.cboDistrictID.ListIndex = Me.cboDistrict.ListIndex
End Sub

Private Sub cboDistrictID_Click()
Me.cboDistrict.ListIndex = Me.cboDistrictID.ListIndex
End Sub

Private Sub cboRole_Click()
cboRoleID.ListIndex = cboRole.ListIndex
End Sub

Private Sub cboRoleID_Click()
cboRole.ListIndex = cboRoleID.ListIndex
End Sub

Private Sub chkWallPaper_Click()
On Error GoTo ErrSetWallPaper

If chkWallPaper Then
grdAssign.WallPaper = imgWallPaper

Else
grdAssign.WallPaper = Nothing

End If
Exit Sub

ErrSetWallPaper:
MsgBox "An Error Occurred while setting wallpaper on the grid" & vbCrLf & "Error: " & Err.Description, vbInformation, "User Access"
End Sub

Private Sub cmdCancel_Click()

Me.txtUserName.Text = ""
Me.txtPassword.Text = ""
Me.txtPassword.Enabled = True
Me.txtDesc.Text = ""
Me.cboRoleID.ListIndex = -1
Me.txtIP.Text = ""
Me.txtUserName.BackColor = vbWhite
Me.txtPassword.BackColor = vbWhite
Me.txtDesc.BackColor = vbWhite
Me.cboRole.BackColor = vbWhite
Me.txtIP.BackColor = vbWhite
Me.grdAssign.Rows = 1
blneditmode = False

End Sub

Private Sub cmdCancel_MouseMove
(Button As Integer, Shift As Integer, X As Single, Y As Single)

lblHelp = ">> " & Me.cmdCancel.ToolTipText & " <<" cmdCancel.FontBold = True End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblHelp = ">> " & Me.cmdExit.ToolTipText & " <<" cmdExit.FontBold = True End Sub Private Sub cmdSave_Click() Dim blnv As Boolean Dim DPASS As String Dim ObjLogin As clslogin Dim objMlogin As clsMLogin Dim objA As clsDUserAccess Dim objMA As clsMDUserAccess Dim UserID As String Dim i As Integer On Error GoTo SaveErr Set ObjLogin = New clslogin Set objMlogin = New clsMLogin objMlogin.getUser (GetFilter) blnv = validatealls If blnv = True Then MsgBox "Please Enter Valid Information here!!", vbInformation Exit Sub End If 'DPASS = DECRIPT(Me.txtPassword.Text) DPASS = UCase(Trim(Me.txtPassword.Text)) ObjLogin.Password = DPASS ObjLogin.User_ID = UCase(Trim(Me.txtUserName.Text)) ObjLogin.AccessLevel = Me.cboRoleID.Text ObjLogin.User_IP = txtIP.Text ObjLogin.District = Val(Me.cboDistrictID.Text) ObjLogin.Description = txtDesc.Text If Me.chkActive.Value = 1 Then ObjLogin.IsActive = "Y" Else ObjLogin.IsActive = "N" End If Set objMA = New clsMDUserAccess If blneditmode = False Then If objMlogin.Count > 0 Then
MsgBox "User Already defined ", vbInformation, "Enter New User Name and Try again"
Me.txtUserName.SetFocus

Exit Sub
End If

If MsgBox("Sure to Save this User", vbQuestion + vbYesNo, "Confirmation!") = vbYes Then



For i = 1 To grdAssign.Rows - 1
Set objA = New clsDUserAccess
If grdAssign.Cell(flexcpChecked, i, 1) = 1 And grdAssign.Cell(flexcpText, i, 2) <> "" Then
objA.MenuID = CLng(grdAssign.Cell(flexcpText, i, 2))
objA.MenuName = Trim(grdAssign.Cell(flexcpText, i, 3))
objA.UserID = Trim(ObjLogin.User_ID)
End If
objMA.Add objA
Next
ObjLogin.DUserAccess = objMA
Set objMlogin = New clsMLogin
objMlogin.Add ObjLogin
objMlogin.Save
Call cmdSearch_Click
MsgBox "User Added Successful!!", vbOKOnly
Else
Set ObjLogin = Nothing
Set objMlogin = Nothing
Call cmdCancel_Click
Exit Sub

End If
Else

If MsgBox("Sure to Modify this User", vbQuestion + vbYesNo, "Confirmation!") = vbYes Then

ObjLogin.User_ID = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 0))

For i = 1 To grdAssign.Rows - 1

If grdAssign.Cell(flexcpChecked, i, 1) = 1 And grdAssign.Cell(flexcpText, i, 2) <> "" Then
Set objA = New clsDUserAccess
objA.MenuID = CLng(grdAssign.Cell(flexcpText, i, 2))
objA.MenuName = Trim(grdAssign.Cell(flexcpText, i, 3))
objA.UserID = Trim(ObjLogin.User_ID)
objMA.Add objA
End If

Next

ObjLogin.DUserAccess = objMA

Set objMlogin = New clsMLogin
objMlogin.Add ObjLogin
objMlogin.Update (ObjLogin.User_ID)
Call cmdSearch_Click
MsgBox "User Modify Successful!!", vbOKOnly
Else

Set ObjLogin = Nothing
Set objMlogin = Nothing
Call cmdCancel_Click
Exit Sub

End If
End If

Call cmdCancel_Click

Set ObjLogin = Nothing
Set objMlogin = Nothing
Set objMA = Nothing
Set objA = Nothing
Exit Sub
SaveErr:

Set objMA = Nothing
Set objA = Nothing
Set ObjLogin = Nothing
Set objMlogin = Nothing
MsgBox Err.Description, vbInformation
End Sub

Private Sub cmdSave_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

lblHelp = ">> " & Me.cmdSave.ToolTipText & " <<" cmdSave.FontBold = True End Sub Private Sub cmdSearch_Click() On Error GoTo CmdErr Set obj = New clslogin Set objM = New clsMLogin objM.getUser (GetFilter) Dim i As Integer grdSearch.Rows = 1 If objM.Count = 0 Then MsgBox "No Data Found", vbInformation Exit Sub End If For i = 1 To objM.Count Set obj = objM.Item(i) grdSearch.AddItem obj.User_ID & vbTab & Trim(obj.Password) & vbTab & _ Trim(obj.Description) & vbTab & Trim(obj.AccessLevel) & vbTab & Trim(obj.User_IP) & vbTab & Trim(obj.IsActive) Next blneditmode = False Set obj = Nothing 'Set objM = Nothing Exit Sub CmdErr: Set obj = Nothing Set objM = Nothing MsgBox Err.Description, vbInformation End Sub Private Function validatealls() As Boolean Dim bln As Boolean On Error GoTo Errz If isblank(txtUserName) = True Then bln = True ElseIf isblank(txtPassword) = True Then bln = True ElseIf isblank(txtIP) = True Then bln = True ElseIf Me.cboRoleID.Text = "" Then bln = True cboRole.BackColor = &HC0C0FF Else cboRole.BackColor = vbWhite End If validatealls = bln Exit Function Errz: validatealls = False MsgBox Err.Description End Function Private Sub cmdSearch_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblHelp = ">> " & Me.cmdSearch.ToolTipText & " <<" cmdSearch.FontBold = True End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}", True SendKeys "{home}+{end}" End If End Sub Private Sub Form_Load() frmCreateUserAccess.Move 20, 60 blneditmode = False Dim objRole As clsRole Dim objDis As clsDistrict On Error GoTo LErr: Set objRole = New clsRole Call loadCbo(cboRole, objRole.GetRole, 1, 0, cboRoleID) Set objDis = New clsDistrict Call loadCbo(Me.cboDistrict, objDis.GetDistrict, 1, 0, Me.cboDistrictID) 'Me.cboDistrictID.Text = 26 Me.cboDistrictID.Text = 1 Exit Sub LErr: MsgBox Err.Description End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSave.FontBold = False cmdCancel.FontBold = False cmdExit.FontBold = False cmdSearch.FontBold = False lblHelp = "" End Sub Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSave.FontBold = False cmdCancel.FontBold = False cmdExit.FontBold = False lblHelp = "" End Sub Private Sub frameAccessLevel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSave.FontBold = False cmdCancel.FontBold = False cmdExit.FontBold = False cmdSearch.FontBold = False lblHelp = "" End Sub Private Sub frameUser_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) cmdSave.FontBold = False cmdCancel.FontBold = False cmdExit.FontBold = False cmdSearch.FontBold = False lblHelp = "" End Sub Private Sub grdAssign_Click() Dim i Dim intcount As Integer Dim intFirstRow As Integer Dim intLastRow As Integer Dim intOutLineLevel As Integer On Error GoTo aerr intOutLineLevel = grdAssign.RowOutlineLevel(grdAssign.Row) intFirstRow = 0 intLastRow = 0 intcount = 0 For i = grdAssign.Row To grdAssign.Rows - 1 If grdAssign.RowOutlineLevel(i) = intOutLineLevel Or grdAssign.RowOutlineLevel(i) < intcount =" intcount" intcount =" 1" intfirstrow =" i" intcount =" 2" intlastrow =" i" intlastrow =" 0"> 4 Or intOutLineLevel = 4 Then
intLastRow = grdAssign.Rows
End If
End If


End If

Next
For i = intFirstRow To intLastRow - 1
Me.grdAssign.Col = 1

Me.grdAssign.Row = i
If Me.grdAssign.CellChecked = flexChecked Then
Me.grdAssign.CellChecked = flexUnchecked
Else
Me.grdAssign.CellChecked = flexChecked
End If

Next

Exit Sub
aerr:
MsgBox Err.Description, vbInformation
End Sub

Private Sub grdSearch_Click()

Dim bln As Boolean

On Error GoTo SErr


If grdSearch.Rows > 1 Then
GridToText
Else
Exit Sub
End If
If grdSearch.Cell(flexcpBackColor, grdSearch.Row, 0, grdSearch.Row, grdSearch.Cols - 1) <> vbRed Then
bln = grdColorEdit(grdSearch)
If bln Then

Load_Access
chkWallPaper.Value = 1

End If
Else
MsgBox "This is Inactive user!! Please Make user Active First", vbInformation, "User Access Information"

End If

blneditmode = True
Exit Sub
SErr:
MsgBox "Err while clicking" & vbCrLf & "Error: " & Err.Description, vbInformation, "Access level Click"
End Sub

Private Sub GridToText()
Dim strAcc As String
On Error GoTo ErrG
Me.txtUserName.Text = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 0))
'Me.txtPassword.Text = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 1))
Me.txtPassword.Text = "N/A"
Me.txtDesc.Text = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 2))
Me.cboRoleID.Text = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 3))
Me.txtIP.Text = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 4))
strAcc = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 5))
' Me.txtPassword.Enabled = False
If strAcc = "Y" Then
Me.chkActive.Value = 1
Else
Me.chkActive.Value = 0
End If

Exit Sub
ErrG:

MsgBox Err.Description
End Sub

Private Sub Load_Access()
Dim clsMD As clsMDUserAccess
Dim clsD As clsDUserAccess
Set clsMD = New clsMDUserAccess
Set clsD = New clsDUserAccess
Dim strUserID As String
Dim intFirst As Integer
Dim strFirst As String
Dim intSecond As Integer
Dim strSecond As String
Dim intThird As Integer
Dim strThird As String
Dim intFourth As Integer
Dim strFourth As String
Dim intlen As Integer
Dim strLen As String
Dim i As Integer
Dim intCurF As Integer
Dim intCurS As Integer
Dim intCurT As Integer
Dim intCurFo As Integer
intCurF = 0
intCurS = 0
intCurT = 0
intCurFo = 0
On Error GoTo ErrLoadBeds

Me.grdAssign.Rows = 1
Me.grdAssign.Row = 0


'initialize tree control
With grdAssign

' structure

.Cols = 14
.Rows = 0
.FixedCols = 0
.FixedRows = 0
'.Left = 50

' appearance
.GridLines = flexGridNone

.BackColorBkg = .BackColor
.SheetBorder = .BackColor
.ExtendLastCol = True
.Redraw = flexRDBuffered
.outlinecol =" 0"
.outlinebar =" flexOutlineBarCompleteLeaf"
.ellipsis =" flexEllipsisEnd"
.allowselection =" False"
.highlight =" flexHighlightWithFocus"
.scrolltrack =" True"
.autosearch =" flexSearchFromCursor"
.cellchecked =" flexUnchecked"
strUserID = Trim(grdSearch.Cell(flexcpText, grdSearch.Row, 0))
.redraw =" flexRDNone"
.tooltiptext = "Click To Select the Desired Access Level for the user"
.strfirst = "Module A"
obj = objM.Item(grdSearch.Row)
clsmd = obj.DUserAccess
i = 1
clsd = clsMD.Item(i)
strlen = CStr(clsD.MenuID)
intlen = Len(strLen)
If intlen = 1 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = 0
intThird = 0
intFourth = 0

ElseIf intlen = 2 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = 0
intFourth = 0

ElseIf intlen = 3 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = CInt(Mid(strLen, 3, 1))
intFourth = 0
ElseIf intlen = 4 Then
intFirst = CInt(Mid(strLen, 1, 1))
intSecond = CInt(Mid(strLen, 2, 1))
intThird = CInt(Mid(strLen, 3, 1))
intFourth = CInt(Mid(strLen, 4, 1))

End If
If intCurF <> intFirst Then
intCurS = 0
intCurT = 0
intCurFo = 0
.AddItem Trim(strFirst) & vbTab & ""
.Cell(flexcpForeColor, .Rows - 1) = &HC00000 'vbBlue
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 1
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurF = intFirst

End If
If intCurS <> intSecond Then
intCurT = 0
intCurFo = 0
.AddItem Trim(clsD.MenuCaption) & vbTab & "" & vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)
.Cell(flexcpForeColor, .Rows - 1) = &HC00000 'vbBlue
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 2
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurS = intSecond
End If


If intCurT <> intThird Then
intCurFo = 0
.AddItem CStr(clsD.MenuCaption) & vbTab & "" & vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)

.Cell(flexcpForeColor, .Rows - 1) = &H5172D2
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 3
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurT = intThird
End If


If intCurFo <> intFourth Then
.AddItem CStr(clsD.MenuCaption) & vbTab & "" & vbTab & clsD.MenuID & vbTab & Trim(clsD.MenuName)

.Cell(flexcpForeColor, .Rows - 1) = &HC000&
.IsSubtotal(.Rows - 1) = True
.RowOutlineLevel(.Rows - 1) = 4
If IsNull(clsD.UserID) Or Trim(clsD.UserID) = "" Then
.Cell(flexcpChecked, .Rows - 1, 1) = False
Else
.Cell(flexcpChecked, .Rows - 1, 1) = True
End If
intCurFo = intFourth
End If

Next

.OutlineCol = 0
.OutlineBar = flexOutlineBarCompleteLeaf

.Row = 0
.Redraw = flexRDBuffered

.MergeCol(0) = True
.ColWidth(0) = 3750

.ColWidth(1) = 20
.ColWidth(2) = 0
.ColWidth(3) = 0
.ColWidth(4) = 0
.ColWidth(5) = 0
.ColWidth(6) = 0
.ColWidth(7) = 0
.ColWidth(8) = 0
.ColWidth(9) = 0
.ColWidth(10) = 0
.ColWidth(11) = 0
.ColWidth(12) = 0
.ColWidth(13) = 0


End With
Exit Sub

ErrLoadBeds:
MsgBox "Err while loading Menus" & vbCrLf & "Error: " & Err.Description, vbInformation, "Access level Assignment"

End Sub

Read more!