home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / A_fast_met2161158282009.psc / RemDupes / modGeneral.bas < prev    next >
BASIC Source File  |  2009-08-22  |  7KB  |  136 lines
  1. Attribute VB_Name = "modGeneral"
  2. Option Explicit
  3.  
  4. Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
  5.  
  6. Public Function FileExists(Path As String) As Boolean
  7.     FileExists = CBool(PathFileExists(Path))
  8. End Function
  9.  
  10. Public Sub BinOpen(Path As String, Buffer As String)
  11.     Dim FF As Integer: FF = FreeFile
  12.     
  13.     Open Path For Binary Access Read As FF
  14.         Buffer = Space$(LOF(FF))
  15.         Get FF, , Buffer
  16.     Close FF
  17. End Sub
  18.  
  19. 'Faster Split - @Merri
  20. Public Sub QuickSplit(Expression As String, ResultSplit() As String, Optional Delimiter As String = " ", Optional ByVal Limit As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare, Optional ByRef IgnoreDelimiterWithin As String = vbNullString)
  21.     Dim lngA As Long, lngB As Long, lngCount As Long, lngDelLen As Long, lngExpLen As Long, lngIgnLen As Long, lngResults() As Long
  22.     lngExpLen = LenB(Expression)
  23.     lngDelLen = LenB(Delimiter)
  24.     If lngExpLen > 0 And lngDelLen > 0 And (Limit > 0 Or Limit = -1&) Then
  25.         lngIgnLen = LenB(IgnoreDelimiterWithin)
  26.         If lngIgnLen Then
  27.             lngA = InStrB(1, Expression, Delimiter, Compare)
  28.             Do Until (lngA And 1) Or (lngA = 0)
  29.                 lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  30.             Loop
  31.             lngB = InStrB(1, Expression, IgnoreDelimiterWithin, Compare)
  32.             Do Until (lngB And 1) Or (lngB = 0)
  33.                 lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
  34.             Loop
  35.             If Limit = -1& Then
  36.                 ReDim lngResults(0 To (lngExpLen \ lngDelLen))
  37.                 Do While lngA > 0
  38.                     If lngA + lngDelLen <= lngB Or lngB = 0 Then
  39.                         lngResults(lngCount) = lngA
  40.                         lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
  41.                         Do Until (lngA And 1) Or (lngA = 0)
  42.                             lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  43.                         Loop
  44.                         lngCount = lngCount + 1
  45.                     Else
  46.                         lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
  47.                         Do Until (lngB And 1) Or (lngB = 0)
  48.                             lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
  49.                         Loop
  50.                         If lngB Then
  51.                             lngA = InStrB(lngB + lngIgnLen, Expression, Delimiter, Compare)
  52.                             Do Until (lngA And 1) Or (lngA = 0)
  53.                                 lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  54.                             Loop
  55.                             If lngA Then
  56.                                 lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
  57.                                 Do Until (lngB And 1) Or (lngB = 0)
  58.                                     lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
  59.                                 Loop
  60.                             End If
  61.                         End If
  62.                     End If
  63.                 Loop
  64.             Else
  65.                 ReDim lngResults(0 To Limit - 1)
  66.                 Do While lngA > 0
  67.                     If lngA + lngDelLen <= lngB Or lngB = 0 Then
  68.                         lngResults(lngCount) = lngA
  69.                         lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
  70.                         Do Until (lngA And 1) Or (lngA = 0)
  71.                             lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  72.                         Loop
  73.                         lngCount = lngCount + 1
  74.                         If lngCount = Limit Then Exit Do
  75.                     Else
  76.                         lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
  77.                         Do Until (lngB And 1) Or (lngB = 0)
  78.                             lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
  79.                         Loop
  80.                         If lngB Then
  81.                             lngA = InStrB(lngB + lngIgnLen, Expression, Delimiter, Compare)
  82.                             Do Until (lngA And 1) Or (lngA = 0)
  83.                                 lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  84.                             Loop
  85.                             If lngA Then
  86.                                 lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
  87.                                 Do Until (lngB And 1) Or (lngB = 0)
  88.                                     lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
  89.                                 Loop
  90.                             End If
  91.                         End If
  92.                     End If
  93.                 Loop
  94.             End If
  95.         Else
  96.             lngA = InStrB(1, Expression, Delimiter, Compare)
  97.             Do Until (lngA And 1) Or (lngA = 0)
  98.                 lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  99.             Loop
  100.             If Limit = -1& Then
  101.                 ReDim lngResults(0 To (lngExpLen \ lngDelLen))
  102.                 Do While lngA > 0
  103.                     lngResults(lngCount) = lngA
  104.                     lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
  105.                     Do Until (lngA And 1) Or (lngA = 0)
  106.                         lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  107.                     Loop
  108.                     lngCount = lngCount + 1
  109.                 Loop
  110.             Else
  111.                 ReDim lngResults(0 To Limit - 1)
  112.                 Do While lngA > 0 And lngCount < Limit
  113.                     lngResults(lngCount) = lngA
  114.                     lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
  115.                     Do Until (lngA And 1) Or (lngA = 0)
  116.                         lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
  117.                     Loop
  118.                     lngCount = lngCount + 1
  119.                 Loop
  120.             End If
  121.         End If
  122.         ReDim Preserve ResultSplit(0 To lngCount)
  123.         If lngCount = 0 Then
  124.             ResultSplit(0) = Expression
  125.         Else
  126.             ResultSplit(0) = LeftB$(Expression, lngResults(0) - 1)
  127.             For lngCount = 0 To lngCount - 2
  128.                 ResultSplit(lngCount + 1) = MidB$(Expression, lngResults(lngCount) + lngDelLen, lngResults(lngCount + 1) - lngResults(lngCount) - lngDelLen)
  129.             Next lngCount
  130.             ResultSplit(lngCount + 1) = RightB$(Expression, lngExpLen - lngResults(lngCount) - lngDelLen + 1)
  131.         End If
  132.     Else
  133.         ResultSplit = VBA.Split(vbNullString)
  134.     End If
  135. End Sub
  136.