الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

مشكلة في تفقيط مسار البرنامج

بدأه هرمان في 7 أكتوبر 2009 · 6 رد · 562 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

الاخوة لدي مشكلة حيرتني وهي كيف احول المسار من مثلاً c:\atiyh\a1.doc إلى c:\atiyh علماً بان المسار متغير ولكم مني جزيل الشكر

____.rar

#2

السلام عليكم...

أرجو التوضيح: هل تقصد الحصول على مسار المجلد الذي يوجد به الملف؟

و السلام.

وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ

صدق الله العظيم

#3

نعم اريد الحصول على مسار المجلد الذي يوجد به الملف

#4

السلام عليكم...

هذه مجموعة دوال كنت كتبتها من مدة لمعالجة الوصول إلى الملفات. انسخها و ضعها في وحدة برمجية (Module) و استخدم ما بلزمك منها:

  1.  
  2. ' الحصول على اسم الملف (و امتداده إذا كان موجوداً) من مسار محدد
  3. Public Function ExtractFileName(ByVal APath As String) As String
  4.     Dim Index As Long
  5.     Dim LastSlashPos As Long
  6.     Dim AChar As String
  7.     Dim ThePath As String
  8.  
  9.     ThePath = Trim(APath)
  10.     If ThePath = "" Then
  11.         ExtractFileName = ""
  12.     Else
  13.         LastSlashPos = InStrRev(ThePath, "")
  14.         If LastSlashPos = 0 Then
  15.             ExtractFileName = ThePath
  16.         Else
  17.             ExtractFileName = Mid(ThePath, LastSlashPos + 1)
  18.         End If
  19.     End If
  20. End Function
  21.  
  22. ' الحصول على مسار المجلد المحتوي على الملف أو المجلد - أي الحصول على مسار المجلد الأب
  23. Public Function ExtractFilePath(ByVal APath As String) As String
  24.     Dim Index As Long
  25.     Dim LastSlashPos As Long
  26.     Dim AChar As String
  27.     Dim ThePath As String
  28.  
  29.     ThePath = Trim(APath)
  30.     If ThePath = "" Then
  31.         ExtractFilePath = ""
  32.     Else
  33.         LastSlashPos = InStrRev(ThePath, "")
  34.         If LastSlashPos = 0 Then
  35.             ExtractFilePath = ""
  36.         Else
  37.             ExtractFilePath = Left(ThePath, LastSlashPos)
  38.         End If
  39.     End If
  40. End Function
  41.  
  42. ' الحصول على امتداد الملف
  43. Public Function ExtractFileExt(ByVal APath As String) As String
  44.     Dim Index As Long
  45.     Dim LastDotPos As Long
  46.     Dim AChar As String
  47.     Dim ThePath As String
  48.  
  49.     ThePath = Trim(APath)
  50.     If ThePath = "" Then
  51.         ExtractFileExt = ""
  52.     Else
  53.         LastDotPos = InStrRev(ThePath, ".")
  54.         If LastDotPos = 0 Then
  55.             ExtractFileExt = ""
  56.         Else
  57.             ExtractFileExt = Mid(ThePath, LastDotPos + 1, Len(ThePath))
  58.         End If
  59.     End If
  60. End Function
  61.  
  62. ' استبدال امتداد الملف بامتداد آخر أو حذف الامتداد
  63. Public Function ReplaceFileExt(ByVal APath As String, ByVal NewExt As String) As String
  64.     Dim Index As Long
  65.     Dim LastDotPos As Long
  66.     Dim AChar As String
  67.     Dim ThePath As String
  68.  
  69.     ThePath = Trim(APath)
  70.     If ThePath = "" Then
  71.         ReplaceFileExt = ""
  72.     Else
  73.         LastDotPos = InStrRev(ThePath, ".")
  74.         If LastDotPos = 0 Then
  75.             If NewExt = "" Then
  76.                 ReplaceFileExt = ThePath
  77.             Else
  78.                 ReplaceFileExt = ThePath & "." & NewExt
  79.             End If
  80.         ElseIf NewExt = "" Then
  81.             ReplaceFileExt = Left(ThePath, LastDotPos - 1)
  82.         Else
  83.             ReplaceFileExt = Left(ThePath, LastDotPos) & NewExt
  84.         End If
  85.     End If
  86. End Function
  87.  
  88. ' الحصول على الاسم الأساسي للملف - من غير امتداد
  89. Public Function ExtractFileBaseName(ByVal APath As String) As String
  90.     Dim Index As Long
  91.     Dim LastSlashPos As Long
  92.     Dim AChar As String
  93.     Dim ThePath As String
  94.     Dim FName As String
  95.  
  96.     ThePath = Trim(APath)
  97.     If ThePath = "" Then
  98.         ExtractFileBaseName = ""
  99.     Else
  100.         ThePath = ExtractFileName(ThePath)
  101.         ExtractFileBaseName = ReplaceFileExt(ThePath, "")
  102.     End If
  103. End Function
  104.  
  105. ' التأكد من وجود ملف
  106. Public Function FileExists(ByVal APath As String) As Boolean
  107.     Dim Result As String
  108.  
  109.     Result = Dir(APath, vbNormal Or vbArchive Or vbReadOnly Or vbHidden Or vbSystem)
  110.     If Result = "" Then
  111.         FileExists = False
  112.     Else
  113.         FileExists = True
  114.     End If
  115. End Function
  116.  
  117. ' التأكد من وجود دليل أو مجلد
  118. Public Function DirectoryExists(ByVal APath As String) As Boolean
  119.     Dim Result As String
  120.  
  121.     Result = Dir(APath, vbDirectory Or vbHidden)
  122.     If Result = "" Then
  123.         DirectoryExists = False
  124.     Else
  125.         DirectoryExists = True
  126.     End If
  127. End Function
  128.  

نرجو الاستفادة و السلام.

      
      

      
وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ
صدق الله العظيم

    

  

    
    

      
#5
        
        

      
لا استيطيع طبيق هذه الوحدة النمطية امل تطبيقها على المثال وشكراً

      
      

      
    

  

    
    

      
#6
        
        

      
السلام عليكم...
انسخ الكود التالي و ألصقه في صفحة كود الـ Form ثم شغل البرنامج:
  1.  
  2. Private Function ExtractFilePath(ByVal APath As String) As String
  3.     Dim Index As Long
  4.     Dim LastSlashPos As Long
  5.     Dim AChar As String
  6.     Dim ThePath As String
  7.  
  8.     ThePath = Trim(APath)
  9.     If ThePath = "" Then
  10.         ExtractFilePath = ""
  11.     Else
  12.         LastSlashPos = InStrRev(ThePath, "")
  13.         If LastSlashPos = 0 Then
  14.             ExtractFilePath = ""
  15.         Else
  16.             ExtractFilePath = Left(ThePath, LastSlashPos)
  17.         End If
  18.     End If
  19. End Function
  20.  
  21. Private Sub Command1_Click()
  22.     Text2.Text = ExtractFilePath(Text1.Text)
  23. End Sub
  24.  
  25.  

نرجو الاستفادة و السلام.

      
تم تعديل هذه المشاركة بواسطة najy_zl في 8 أكتوبر 2009 في 16:51

      

      
وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ
صدق الله العظيم

    

  

    
    

      
#7
        
        

      
الف شكر هذا هو المطلوب

      
      

      
    

  

    
    
    
 مواضيع مشابهة