يرفع الى أساتذتنا المشرفين (فضلا و ليس أمرا و تفضلا منهم) للتدخل فى المرحلة الأخيرة رقم (4) : جعل الدالة GetReader و التى تعتمد على CDataSvcs يكونوا على اتصال بقاعدة بيانات SQL DB بدلا من الـ Access و بالتالى يستطيع المتغير rdr القراءة و تحميل البيانات الى الشجرة ..
لا يا صديقى العزيز ليس فايروس .. انه الملف التنفيذى الموجود ضمن فولدر البرنامج و الطبيعى أن اى مكافح فيروسات سواء تطبيق أو موقع بيرى اى ملف تنفيذى بأنه فايروس .. ع العموم جارى ازالة هذا الملف و رفع ملف بدون ملف تنفيذى
لا يا صديقى العزيز ليس فايروس .. انه الملف التنفيذى الموجود ضمن فولدر البرنامج و الطبيعى أن اى مكافح فيروسات سواء تطبيق أو موقع بيرى اى ملف تنفيذى بأنه فايروس .. ع العموم جارى ازالة هذا الملف و رفع ملف بدون ملف تنفيذى
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()
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
المديول modGlobals
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.
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.
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
كما و يجب الانتباه الى بيانات الجدول يوجد ابناء بلا اباء (عقد غير مرتبطة) وجب تصحيحها كما بالصورة
مساء الخير و السعادة على الجميع
أشكر أخى الفاضل و العضو المميز أبو ليلى
و لكن كما قال الزميل vbxprogrammer الكود الموجود بالمرفقات الذى وضعته لم يتم تعديله ووضعت الكلاسات كما هى
و هذا ليس تقليلا من جهود الزميل العزيز أبو ليلى .. حاشا لله .. بل أقدر جهده و تعبه الذى بذله لوجه الله .. لكن المشروع ما زال لا يعمل بل به العديد من الأخطاء (لا سيما الأزرار أسفل الشجرة الخاصة باضافة أو التعديل أو حذف الى آخر ذلك) ... محتاج تدخل من يستطيع من الزملاء (فضلا و ليس أمرا) ... تقبلوا جميعا خالص التحية و التقدير
السلام عليكم و رحمة الله و بركاته بالنسبة للتعديلات التي جرت على المشروع انا لم اذكر تحديداً ما تم تعديله نظراً للعجلة كما اسلفت لذا انا اوردت الكلاسات بهذا الشكل و الشيئ الاخر اني التزمت بطلب عرض العقد في الشجرة فقط. اما بالنسبة للازرار لم تظهر لدي حجم الشاشة لدي صغير. بكل الاحوال المشروع عقيم من ناحية التكويد يستخدم اسلوب بدائي و عمليات تحويل غير ضرورية و ليست في محلها يمكن بتركيز اكبر انتاج ما هو افضل . المشروع بالمرفقات تم تعديل الازرار و العملية تجري للاضافة و الحذف و التعديل .