السلام عليكم و رحمة الله و بركاته
تصليحات على عجل
الكلاس CDataServices ضبط نص الاتصال فيه , ضع اسم السيرفر الخاص بك .
الكلاس CDataServices كامل
المديول modGlobals
الكلاس CTreeView
كما و يجب الانتباه الى بيانات الجدول يوجد ابناء بلا اباء (عقد غير مرتبطة) وجب تصحيحها كما بالصورة
النتيجة
تصليحات على عجل
الكلاس CDataServices ضبط نص الاتصال فيه , ضع اسم السيرفر الخاص بك .
PHP كود :
Public Sub New()
Try
m_cn.ConnectionString() = "Data Source = YourServer;Initial Catalog=TreeViews;Integrated Security=True"
m_cn.Open()
Catch ex As Exception
g_bOk = False
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Sub
الكلاس CDataServices كامل
PHP كود :
Option Strict On
Imports System.Data.SqlClient
Public Class CDataServices
'// PURPOSE: This class is used to abstract data services. Abstraction
'// will allow us to substitute different classes to support different
'// database types. This class supports MS Access (Jet ver 4.0).
Dim m_cn As New SqlConnection()
Public Sub New()
Try
m_cn.ConnectionString() = "Data Source = YourServer;Initial Catalog=TreeViews;Integrated Security=True"
m_cn.Open()
Catch ex As Exception
g_bOk = False
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Sub
Public Sub DeleteRecord(ByVal iRecordID As Integer)
'// PURPOSE: The following function will delete the designated record from
'// the database.
'// NOTE: The brackets '[]' are not required around the table name. They
'// are only required if the table name contains spaces. I have included
'// them as a matter of style.
Dim sSql As String
Dim cmd As SqlCommand = m_cn.CreateCommand()
Try
sSql = "DELETE FROM [TreeViewItems] WHERE uid=" & iRecordID & ";"
cmd.CommandText = sSql
cmd.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Sub
Public Function GetReader(ByVal sSql As String) As SqlDataReader
'// PURPOSE: This function will return a DataReader object for a given
'// SQL expression.
Try
Dim cmd As SqlCommand = m_cn.CreateCommand()
cmd.CommandText = sSql
Dim rdr As SqlDataReader = cmd.ExecuteReader()
Return rdr
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Function
Public Function GetScalar(ByVal sSql As String) As Integer
'// PURPOSE: This function will return a Scalar for a given SQL expression.
Try
Dim cmd As SqlCommand = m_cn.CreateCommand()
cmd.CommandText = sSql
Dim iNewRecordID As Integer
iNewRecordID = CInt(cmd.ExecuteScalar())
Return iNewRecordID
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Function
Public Sub ExecuteNonQuery(ByVal sSql As String)
'// PURPOSE: This function will execute a non-query SQL statement such
'// as an INSERT or UPDATE or DELETE statement.
Try
Dim cmd As SqlCommand = m_cn.CreateCommand()
cmd.CommandText = sSql
cmd.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Sub
End Class
PHP كود :
Option Strict On
Imports System.IO
Module modGlobals
'// PURPOSE: This module is used to create global variables, instantiate
'// global objects, and to start the application.
Public CDataSvcs As CDataServices
Public g_bOk As Boolean
Public g_myAppConsts As New CConstants()
Public g_sDbLocation As String
Public Sub Main()
'// PURPOSE: Searches for the database. Allows user to look for the
'// database if not found or to point to a different database.
'// It also launches the application if the program can establish a valid
'// connection to the database.
Dim iRet As Integer
Dim sPath As String
sPath = GetSetting(g_myAppConsts.AppName, "Database", "Location",
GetLikelyDbPath() & g_myAppConsts.DatabaseName)
g_sDbLocation = sPath
Dim fInfo As New FileInfo(g_sDbLocation)
If fInfo.Exists Then
iRet = MsgBox("Found database: " & g_sDbLocation & vbCrLf &
"Do you want to use this file?", MsgBoxStyle.YesNo Or
MsgBoxStyle.Question Or MsgBoxStyle.DefaultButton1,
g_myAppConsts.MsgCaption)
If iRet = vbNo Then
Dim fDbFind As New frmDbFind()
fDbFind.ShowDialog()
Else
g_bOk = True
End If
Else
g_sDbLocation = ""
Dim fDbFind As New frmDbFind()
fDbFind.ShowDialog()
End If
'// This means we found the database.
If g_bOk = True Then
CDataSvcs = New CDataServices()
End If
'// Only start the application if CDataSvcs initialized correctly. The
'// Constructor will set the value of g_bOk to reflect whether it
'// experienced an error or not when initializing the connection.
If g_bOk = True Then
SaveSetting(g_myAppConsts.AppName, "Database", "Location", g_sDbLocation)
'// Start the application.
System.Windows.Forms.Application.Run(New frmTreeView())
Else
'// Else considered;
End If
End Sub
Public Function GetAppPath() As String
'// PURPOSE: This function returns the path of where the application
'// is being launched. This function substitutes for the App.Path
'// property found in VB6.
Dim sPath As String
Try
sPath = System.Reflection.Assembly.GetExecutingAssembly.Location
sPath = Left(sPath, InStrRev(sPath, "\", -1, CompareMethod.Text))
Return sPath
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Function
Public Function GetLikelyDbPath() As String
'// PURPOSE: This function returns the most likely place where the database
'// file will exist. That place is the one folder level up from the
'// "\bin\" folder in the project solution.
Dim iLoc As Integer
Dim sPath As String
sPath = GetAppPath()
'// Move one folder higher then "\bin" if "\bin" exist.
iLoc = InStr(UCase(GetAppPath), "\BIN")
If iLoc > 0 Then
sPath = sPath.Substring(0, iLoc - 1) & "\"
End If
Return sPath
End Function
End Module
الكلاس CTreeView
PHP كود :
Option Strict On
Imports System.Data.OleDb
Imports System.Windows.Forms
Imports System.Data.SqlClient
Public Class CTreeView
'Dim m_cn As New OleDbConnection()
'// m_collDeletedNodes is used to store node deletions in memory. A call to
'// CTreeView.SaveNodeCollection() will commit the deletions, and other changes,
'// to the database.
Dim m_collDeletedNodes As Collection
Public Sub New()
'// Initialize the DeletedNodes collection.
m_collDeletedNodes = New Collection()
End Sub
Public Sub DeleteNode(ByVal tnStart As TreeNode)
'// PURPOSE: This function will delete the designated node (tnStart) and all
'// of its children. The deletions will be stored in a collection. This will
'// keep the deletions in memory, which configuration will allow us to rollback
'// deletions.
'// Get a reference to the start node parent.
Dim tnParent As TreeNode = tnStart.Parent
'// Delete the start node's children. This is performed via
'// recursion, which will walk through all children regardless of number or
'// arrangement. Walking through each and every child of the start node will
'// allow us to synchronize node deletions with the database. Simply calling
'// the remove function will remove the node and its children, but
'// will leave orphan records in the database.
DeleteNodeRecursive(tnStart)
'// Record the deletion of the start node.
m_collDeletedNodes.Add(tnStart)
'// Remove the start node from the TreeNodeCollection.
tnStart.Nodes.Remove(tnStart)
'// Update the image of the start node's parent if the start node parent status
'// changed from a branch to a leaf node.
If Not (tnParent Is Nothing) Then
If tnParent.GetNodeCount(False) = 0 Then
If Not (tnParent.Parent Is Nothing) Then
tnParent.ImageIndex = 3
tnParent.SelectedImageIndex = 3
End If
End If
End If
End Sub
Private Sub DeleteNodeRecursive(ByVal tnParent As TreeNode)
'// PURPOSE: This function will walk through all the child nodes for a given
'// node. It will remove all the nodes from the TreeNodeCollection and will
'// record all deletions in memory. Deletions will be committed to the
'// database when the user calls the CTreeView.SaveNodeCollection() method.
Dim tn As TreeNode = Nothing
Try
If tnParent.GetNodeCount(False) > 0 Then
tn = tnParent.Nodes(0)
Do Until tn Is Nothing
If tn.GetNodeCount(False) > 0 Then
Call DeleteNodeRecursive(tn)
End If
m_collDeletedNodes.Add(tn)
tn = tn.NextNode
Loop
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
End Try
End Sub
Public Function IsDropAllowed(ByVal tnStart As TreeNode, _
ByVal tnDrop As TreeNode) As Boolean
'// PURPOSE: This function will determine if a drop will cause a circular
'// reference. A circular reference occurs when a node is dropped onto one
'// of its children.
Dim tnCurrent As TreeNode
tnCurrent = tnDrop
Do Until tnCurrent Is Nothing
If tnCurrent Is tnStart Then
IsDropAllowed = False
Exit Function
End If
tnCurrent = tnCurrent.Parent
Loop
IsDropAllowed = True
End Function
Public Sub PopulateTree(ByRef oTv As TreeView)
With m_cn
If .State = ConnectionState.Open Then .Close()
.Open()
End With
If m_cn.State = ConnectionState.Open Then
MsgBox("Open")
ElseIf m_cn.State = ConnectionState.Closed Then
MsgBox("Closed")
End If
m_collDeletedNodes = Nothing
m_collDeletedNodes = New Collection()
Dim rdr As SqlDataReader
Dim CDataSvcs As New CDataServices
rdr = CDataSvcs.GetReader("SELECT * FROM TreeViewItems")
Dim collNodeKeys As New Collection()
Dim tnNew As TreeNode
Dim tnParent As TreeNode
While rdr.Read()
If CType(rdr.Item("bRoot"), Boolean) = True Then
tnNew = oTv.Nodes.Add(rdr.Item("sName").ToString)
With tnNew
.Tag = rdr.Item("uid").ToString
.ImageIndex = CType(rdr.Item("iImageIndex"), Integer)
.SelectedImageIndex = CType(rdr.Item("iSelectedImageIndex"), Integer)
End With
'Try
collNodeKeys.Add(tnNew, rdr.Item("uid").ToString)
'Catch ex As Exception
'MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
'End Try
Else
' Try
tnParent = CType(collNodeKeys.Item(rdr.Item("iParentID").ToString), TreeNode)
tnNew = tnParent.Nodes.Add(rdr.Item("sName").ToString)
With tnNew
.Tag = rdr.Item("uid").ToString
.ImageIndex = CType(rdr.Item("iImageIndex"), Integer)
.SelectedImageIndex = CType(rdr.Item("iSelectedImageIndex"), Integer)
End With
collNodeKeys.Add(tnNew, rdr.Item("uid").ToString)
' Catch ex As Exception
'MsgBox(ex.Message, MsgBoxStyle.Critical, g_myAppConsts.MsgCaption)
' End Try
End If
End While
rdr.Close()
End Sub
Public Sub SaveNodeCollection(ByVal tnRootNode As TreeNode)
'// PURPOSE; This method will save the TreeNodeCollection to the
'// database. It uses recursion to walk through the tree. It must
'// be called for each root node, if there is more than one root
'// node.
Dim iCntr As Integer
Dim iRecordID As Integer
Dim tn As TreeNode
'// Synch all deleted nodes with the database.
For iCntr = 1 To m_collDeletedNodes.Count
tn = CType(m_collDeletedNodes(iCntr), TreeNode)
If Trim(CType(tn.Tag, String)) <> "" Then
iRecordID = CType(tn.Tag, Integer)
CDataSvcs.DeleteRecord(iRecordID)
End If
Next
If Not (tnRootNode Is Nothing) Then
'// Clear the deleted nodes collection because the references
'// are no longer required.
m_collDeletedNodes = Nothing
m_collDeletedNodes = New Collection()
'// Save all records to the database, starting with the root node. We
'// maintain the sort order so that the nodes can be restored in the
'// order that they were read. This will prevent adding a node before
'// adding its parent.
SaveNodeToDb(tnRootNode, 1)
Call SaveNodeCollectionRecursive(tnRootNode, 1)
End If
End Sub
Private Sub SaveNodeCollectionRecursive(ByVal tnParent As TreeNode, ByRef iSort As Integer)
'// PURPOSE: This function will save all child nodes in a given order
'// starting with the root node and working out towards the child nodes.
'// This function uses recursion, and will walk through any tree structure
'// regardless of node count or arrangement.
Dim tn As TreeNode
If tnParent.GetNodeCount(False) > 0 Then
tn = tnParent.Nodes(0)
Else
tn = Nothing
End If
Do Until tn Is Nothing
iSort = iSort + 1
SaveNodeToDb(tn, iSort)
If tn.GetNodeCount(False) > 0 Then
Call SaveNodeCollectionRecursive(tn, iSort)
End If
tn = tn.NextNode
Loop
End Sub
Private Sub SaveNodeToDb(ByRef tn As TreeNode, ByVal iSort As Integer)
'// PURPOSE: The following method will save the designated node to the
'// database.
Dim bRoot As Boolean
Dim SQLFunctions As New CSQLFunctions()
Dim iNewRecordID As Integer
Dim iParentID As Integer
Dim sName As String
Dim sFullPath As String
Dim sSql As String
Dim cmd As SqlCommand = m_cn.CreateCommand()
If Not (tn.Parent Is Nothing) Then
iParentID = CType(tn.Parent.Tag, Integer)
bRoot = False
Else
iParentID = -1
bRoot = True
End If
'// Need to escape single and double quotes; otherwise, they will cause
'// exceptions when posting to the database.
sName = SQLFunctions.EscapeSpecialChars(tn.Text)
sFullPath = SQLFunctions.EscapeSpecialChars(tn.FullPath)
'// I use the tag value to determine if a record for the node exists
'// in the database and to hold the value of the primary key if the
'// the record exists in the database. If the tag value is empty, then
'// I know the record is newly created and not yet saved in the database.
If Trim(CType(tn.Tag, String)) = "" Then
'// Insert a record into the database for the node.
sSql = "INSERT INTO [TreeViewItems] (bRoot, dLastModified, iImageIndex," & _
"iParentID, iSelectedImageIndex, iSort, sName, sFullName) VALUES " & _
"(" & bRoot & ",'" & Now() & "'," & tn.ImageIndex & "," & _
iParentID & ", " & tn.SelectedImageIndex & "," & iSort & ",'" & _
sName & "', '" & sFullPath & "')"
'// Execute the INSERT statement against the database.
CDataSvcs.ExecuteNonQuery(sSql)
'// Get the record ID for the newly created record. This assumes that
'// only one person is using the database.
iNewRecordID = CDataSvcs.GetScalar("SELECT Max(uid) FROM [TreeViewItems]")
'// Place the record ID in the node's tag.
tn.Tag = CType(iNewRecordID, String)
Else
'// Update the corresponding record in the database for the node.
sSql = "UPDATE [TreeViewItems] " & _
"SET sName='" & sName & "', " & _
"bRoot=" & bRoot & ", " & _
"iImageIndex=" & tn.ImageIndex & ", " & _
"iParentID=" & iParentID & ", " & _
"iSelectedImageIndex=" & tn.SelectedImageIndex & ", " & _
"iSort=" & iSort & ", " & _
"sFullName='" & sFullPath & "' " & _
"WHERE uid=" & CType(tn.Tag, Integer)
'// Execute the INSERT statement against the database.
CDataSvcs.ExecuteNonQuery(sSql)
End If
End Sub
End Class
النتيجة
اللهم لك الحمد كما ينبغي لجلال وجهك و عظيم سلطانك
في حل و ترحال