VB - ملء TreeView مع أقراص النظام والدلائل الخاصة بهم

إليك روتين يمكن أن يملأ TreeView بأقراص النظام وأدلةها.

وصف

كانت المشكلة هي العثور على مفتاح العقد ، حيث يتم أحيانًا نشر مفتاح مرتين ، ثم وجدت حلاً:

  • استخدم المسار الكامل كمفتاح وبهذه الطريقة ، من المؤكد أنه لن يكون هناك تكرار.
  • لم أتمكن من اختبار محركات أقراص الشبكة
  • ألغيت أدلة النظام ، وهدفي هو جعل استكشاف الصورة (متاحًا للتنزيل).
  • الروتين متكرر وقصير نسبيا.
  • لا تتفاجأ من الوقت الذي تستغرقه (وفقًا لنظامك) ، ولكن الروتين يكون بنفس سرعة مستكشف Windows تقريبًا باستثناء أنه لا يتم تشغيله تلقائيًا مثل بدء التشغيل.
  • يمكنك تحميل المشروع استغلال صورة كاملة في VB6.
  • عند النقر فوق صورة ، تعرض الرسالة الرقم والمسار الكامل للصورة.
  • يمكنك أيضًا تغيير المرشحات للسماح بعرض الصور الأخرى.

يحتوي المشروع على OCX و DLL مخصص ، يجب عليك:

  • بفك المجلد.
  • لا تنقر على المشروع ، انتقل إلى أيقونة VB6 ، انقر بزر الماوس الأيمن على الأيقونة وافتح كمسؤول.
  • في الافتتاح ، انقر فوق "موجود" وافتح مشروع LN_Explorateur.vpb
  • تعديل عرض TreeView عن طريق تحريك الخط الأحمر (انقر على الخط وحركه).
    • قم بتغيير حجم الصور المصغرة باستخدام المفتاح "S".

يتم تنفيذ عرض الصورة مع تخفيض Gdi + dll إلى أبسط تعبير له.

  • أعتقد أن الروتين يمكن نقله بسهولة إلى VB.Net

الشفرة

الخيار صريح

 Sub Initialise_TreeDir (TreeDir باسم TreeView) Dim ExpDr، Rep، Drv، S As String، N، D، a، r، Unite Dim Cle As String، sCle As String، Num As Integer، Sr As Integer Dim nodX Num = 64 تعيين ExpDr = CreateObject ("Scripting.FileSystemObject") تعيين Drv = ExpDr.Drives لكل D في Drv S = D.DriveLetter '& ":" If D.DriveType = 3 ، ثم Réseaux N = D.ShareName ElseIf D.DriveType = 1 ثم 'DD externe N = "- Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (،، Cle، S & N ، 6) AjoutRep S، Cle، TreeDir ElseIf D.DriveType = 2 Then 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (،، Cle ، S & "- (" & N & ")"، 2) AjoutRep S، Cle، TreeDir ElseIf D.DriveType = 4 Then 'DVD On Error Resume Next N = D.VolumeName If Err = 71 Then N = "Lecteur DVD - (vide) "Else N =" Lecteur DVD - ("& N &") "End If Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Set nodX = TreeDir.Nodes .Add (،، Cle، S & N، 3) Else Stop End If S = "" D = "" المجموعة التالية nodX = Nothing Set ExpDr = Nothing Set Drv = Nothing End Sub Sub AjoutRep (Chem As String، Cle As String، TreeDir As TreeView) Dim Rep، sRp، Obj، sRep، sR2 Dim sCle As String، Num As Integer ، Sr كـ عدد صحيح خافت nodX مثل عقدة Dim NbsR كـ عدد صحيح ، S As String Sr = 9 Chem = Chem & IIf (يمين (Chem، 1) = "\"، ""، "\") تعيين Obj = CreateObject ("Scripting .FileSystemObject ") Set Rep = Obj.Getfolder (Chem) If Left (Rep.Name، 1) =" $ "ثم GoTo Passe2 Set sRep = Rep.subfolders لكل sRp في sRep S = UCase (sRp.Name) في حالة اليسار (S، 1) = "$" أو S = "WINDOWS" أو sRp.Attributes> 100 أو sRp.Attributes = 19 _ أو Left (S، 6) = "SYSTEM" أو Left (S، 7) = "PROGRAM" أو Left (S، 4) = "USER" _ أو Left (S، 6) = "DRIVER" أو Left (S، 5) = "TOOLS" ثم GoTo Passe On Error استئناف المجموعة التالية sR2 = sRp.subfolders NbsR = sR2 .Count If Err 0 ثم Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" On Error GoTo 0 'Debug.Print sRp.Name؛ ""؛ كلي. ""؛ sCle Set nodX = TreeDir.Nodes.Add (Cle، tvwChild، sCle، sRp.Name، 5، 4) If NbsR> 0 Then AjoutRep sRp.Path، sCle، TreeDir End If Passe: Next Passe2: Set Obj = Nothing Set Rep = Nothing Set sRep = Nothing Set nodX = Nothing Set sR2 = Nothing End Sub 

التنزيلات

  • LINK1
  • LINK2

قروض

المقال السابق المقالة القادمة

نصائح الأعلى