home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Zipping_wi2123818172008.psc / modFiles.bas < prev    next >
BASIC Source File  |  2008-08-15  |  5KB  |  144 lines
  1. Attribute VB_Name = "modFiles"
  2. Option Explicit
  3.  
  4. 'this part is not by myself. JvB
  5.  
  6. Public Enum PathTypes
  7.     FileName = 1
  8.     JustName = 2
  9.     FileExtension = 3
  10.     FilePath = 4
  11.     Drive = 5
  12.     LastFolder = 6
  13.     FirstFolder = 7
  14.     LastFolderAndFileName = 8
  15.     DriveAndFirstFolder = 9
  16.     FullPath = 10
  17. End Enum
  18.  
  19.  
  20. 'Um einen kompletten Verzeichnispfad zu erstellen
  21. Declare Function MakePath Lib "imagehlp.dll" Alias _
  22.     "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
  23.  
  24.  
  25. Public Function GetPath(ByVal Path As String, Optional ByVal PathType As _
  26.     PathTypes = 1) As String
  27. Dim strPath As String
  28. Dim ThisType As PathTypes
  29. Dim i As Integer
  30. Dim j As Integer
  31.  
  32. strPath = Path
  33.  
  34. If InStr(strPath, "\") = 0 And InStr(strPath, ".") > 0 And InStr(strPath, ":") _
  35.     = 0 Then
  36.     ThisType = FileName
  37. ElseIf InStrRev(strPath, "\") = Len(strPath) And Len(strPath) > 3 Then
  38.     ThisType = FilePath
  39. ElseIf Len(strPath) = 3 And Mid(strPath, 2, 2) = ":\" Then
  40.     ThisType = Drive
  41. ElseIf Len(strPath) = 2 And Mid(strPath, 2, 1) = ":" Then
  42.     ThisType = Drive
  43. ElseIf InStrRev(strPath, "\") > InStrRev(strPath, ".") Then
  44.     ThisType = JustName
  45. ElseIf InStr(strPath, "\") > 0 And InStr(strPath, ".") > 0 Then
  46.     ThisType = FullPath
  47. Else
  48. '    MsgBox "Cannot determine the type of the path"
  49.     Exit Function
  50. End If
  51.  
  52. Select Case PathType
  53.     Case 1
  54.         If ThisType = FullPath Or ThisType = JustName Then
  55.             GetPath = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  56.         ElseIf ThisType = FileName Then
  57.             GetPath = strPath
  58.         End If
  59.     Case 2
  60.         If ThisType = FullPath Then
  61.             strPath = StrReverse(strPath)
  62.             i = InStr(strPath, ".") + 1
  63.             j = InStr(strPath, "\")
  64.             strPath = Mid(strPath, i, j - i)
  65.             GetPath = StrReverse(strPath)
  66.         ElseIf ThisType = FileName Then
  67.             GetPath = Left(strPath, InStrRev(strPath, ".") - 1)
  68.         ElseIf ThisType = JustName Then
  69.             GetPath = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  70.         End If
  71.     Case 3
  72.         If ThisType = FullPath Or ThisType = FileName Then
  73.             GetPath = Right(strPath, Len(strPath) - InStrRev(strPath, "."))
  74.         End If
  75.     Case 4
  76.         If ThisType = FullPath Or ThisType = JustName Then
  77.             strPath = Left(strPath, InStrRev(strPath, "\") - 1)
  78.         ElseIf ThisType = FilePath Then
  79.             strPath = Left(strPath, Len(strPath) - 1)
  80.         End If
  81.         If Left(strPath, 1) = "\" Then
  82.             strPath = Right(strPath, Len(strPath) - 1)
  83.         End If
  84.         GetPath = strPath
  85.     Case 5
  86.         If ThisType = FilePath Or ThisType = FullPath Or ThisType = Drive Or _
  87.             ThisType = JustName Then
  88.             If Mid(strPath, 2, 1) = ":" Then
  89.                 GetPath = Left(strPath, 2)
  90.             End If
  91.         End If
  92.     Case 6
  93.         If ThisType = FullPath Or ThisType = JustName Or ThisType = FilePath _
  94.             Then
  95.             strPath = Left(strPath, InStrRev(strPath, "\") - 1)
  96.             GetPath = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  97.         End If
  98.     Case 7
  99.         If Mid(strPath, 2, 1) <> ":" And Left(strPath, 1) <> "\" Then
  100.             strPath = "\" & strPath
  101.         End If
  102.         If ThisType = FullPath Or ThisType = JustName Or ThisType = FilePath _
  103.             Then
  104.             strPath = Right(strPath, Len(strPath) - InStr(strPath, "\"))
  105.             If InStr(strPath, "\") = 0 Then
  106.                 Exit Function
  107.             End If
  108.             GetPath = Left(strPath, InStr(strPath, "\") - 1)
  109.         End If
  110.     Case 8
  111.         If ThisType = FullPath Or ThisType = JustName Then
  112.             strPath = Left(strPath, InStrRev(strPath, "\") - 1)
  113.             GetPath = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
  114.             GetPath = GetPath & Right(Path, Len(Path) - InStrRev(Path, "\") + 1)
  115.         End If
  116.     Case 9
  117.         If ThisType = FullPath Or ThisType = JustName Or ThisType = FilePath _
  118.             Then
  119.             If Mid(strPath, 2, 1) = ":" Then
  120.                 strPath = Right(strPath, Len(strPath) - InStr(strPath, "\"))
  121.                 GetPath = Left(Path, 3) & Left(strPath, InStr(strPath, "\") - 1)
  122.             End If
  123.         End If
  124.     Case 10
  125.         GetPath = strPath
  126. End Select
  127.  
  128. End Function
  129.  
  130.  
  131.  
  132. Function FileExists(Path As String) As Boolean
  133.   Const NotFile = vbDirectory + vbVolume
  134.   On Error Resume Next
  135.   
  136.   FileExists = (GetAttr(Path) And NotFile) = 0
  137.   
  138. End Function
  139.  
  140. Function DirExists(Path As String) As Boolean
  141.   On Error Resume Next
  142.   DirExists = CBool(GetAttr(Path) And vbDirectory)
  143. End Function
  144.