+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم مكتبة اكواد VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=185)
+--- الموضوع : [كود] لا جديد مثال لتحققات متعددة حول موضوع مجلد وملف و حجم (/showthread.php?tid=42348)
لا جديد مثال لتحققات متعددة حول موضوع مجلد وملف و حجم - سعود - 03-09-22
بسم الله الرحمن الرحيم
دوال تحقق صرت اكررها بكل مشروع اذا كان يدور حول فكرة واحدة.
مثلا اردت تقسيم ملف الى مجلد فيجب فحص المجلد الهذف هل هو فارغ ام به ملفات:
PHP كود :
Private Function folderfiles(ByVal fo As String) As Integer
Dim dir As New IO.DirectoryInfo(fo)
Return dir.GetFiles.Count
End Function
للنتقل الى الجانب الاخر وهو الدمج فلا بد من فحص المجلد اذ يجب ان يكون به ملفات وهذا بالدالة او الاجراء السابق لكن نفحص العدد
والان ان تم ايجاد ملفات فما هو نوع الملفات اللذي يتعرف عليها البرنامج:
PHP كود :
Private Function IsFilePart(folderpath As String) As Boolean
Dim dir As New DirectoryInfo(folderpath)
For Each f As FileInfo In dir.GetFiles
Dim lastindex As Integer = f.Name.LastIndexOf(".")
Dim x As String = f.Name.Substring(lastindex + 1)
If (x.ToLower.Contains("total") And x.ToLower.Contains("part")) = False Then
Return False
Exit Function
End If
Next
Return True
End Function
لا بد للملف ان يكون اسمه يحتوي على امتداد جديد به كلمة Total وايضا كلمة part
الان ماذا بقي:
PHP كود :
Private Function IsComplete(fpath As String, ext As String) As Boolean
Dim str As String = "total([0-9]{1,})part([0-9]{1,})"
Dim reg As New Regex(str, RegexOptions.IgnoreCase)
Dim ma As Match = reg.Match(ext)
If ma.Success Then
Dim v1 As String = ma.Groups(1).Value
If Val(v1) = folderfiles(fpath) Then
Return True
Else
Return False
End If
End If
Return Nothing
End Function
الدالة او الاجراء التالي يفحص ملفات المجلد فان وجد ملفا صفريا ....
PHP كود :
Private Function IsFullFile(folderpath As String) As Boolean
Dim dir As New DirectoryInfo(folderpath)
For Each f As FileInfo In dir.GetFiles
If f.Length = 0 Then
Return False
Exit Function
End If
Next
Return True
End Function
ثم بعد كل هذا ننفذالاجراء
اخترت هذه الواجهة لاضافة ميزة الحفظ والاستمرار.