home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD4545452000.psc / TestModule.bas < prev    next >
Encoding:
BASIC Source File  |  2000-04-05  |  3.0 KB  |  111 lines
  1. Attribute VB_Name = "TestModule"
  2. Option Explicit
  3.  
  4. Function Result_Filename(ByVal Filename As String) As String
  5.     Dim Length As Long
  6.     Dim Temp_Str As String
  7.     Dim i As Long
  8.     Dim Done As Boolean
  9.     Dim Left_Str As String
  10.     Dim Right_Str As String
  11.     
  12.     Done = False
  13.     
  14.     Temp_Str = Filename
  15.     
  16.     Length = Len(Temp_Str)
  17.     
  18.     i = Length
  19.     
  20.     While Done = False And i <> 0
  21.     Right_Str = Right(Temp_Str, 1)
  22.     If Right_Str = " " Then
  23.     Done = True
  24.     End If
  25.     Temp_Str = Left(Temp_Str, i - 1)
  26.     i = i - 1
  27.     Wend
  28.     
  29.     Result_Filename = Right(Filename, Length - Len(Temp_Str) - 1)
  30. End Function
  31.  
  32. Function HeaderFilename(ByVal HeaderString As String) As String
  33.     HeaderString = Trim(HeaderString)
  34.     While InStr(HeaderString, " ") <> 0
  35.         HeaderString = Right(HeaderString, InStr(HeaderString, " ") + 1)
  36.     Wend
  37.     HeaderFilename = Trim(HeaderString)
  38. End Function
  39.  
  40. Sub Testcrlf()
  41. If vbCrLf = Chr(13) + Chr(10) Then MsgBox "True"
  42. End Sub
  43.  
  44.  
  45. Function SplitOffNextLine(ByRef Data As String, ByRef NextLine As String)
  46.     If InStr(Data, Chr(13)) Or InStr(Data, Chr(13) + Chr(10)) Then  'There's a cr(unix) or a crlf(dos)
  47.         If Left(Data, 1) = Chr(13) Then Data = Right(Data, Len(Data) - 1)   'kill any leading...
  48.         If Left(Data, 1) = Chr(10) Then Data = Right(Data, Len(Data) - 1)
  49.         NextLine = ""
  50.         While Left(Data, 1) <> Chr(13)
  51.             NextLine = NextLine + Left(Data, 1)
  52.             Data = Right(Data, Len(Data) - 1)
  53.         Wend
  54.         If Left(Data, 1) = Chr(13) Then Data = Right(Data, Len(Data) - 1)
  55.         If Left(Data, 1) = Chr(10) Then Data = Right(Data, Len(Data) - 1)
  56.     End If
  57. End Function
  58.  
  59. Private Function FastSplitter(ByRef Data As String, ByRef NextLine As String)
  60.     If InStr(Data, Chr(13)) Then  'There's a carriage return in the line
  61.         NextLine = ""
  62.         NextLine = Left(Data, InStr(Data, Chr(13)) - 1)
  63.         Data = Right(Data, Len(Data) - InStr(Data, Chr(13)))
  64.         If Left(Data, 1) = Chr(10) Then Data = Right(Data, Len(Data) - 1)
  65.     End If
  66. End Function
  67.  
  68. Sub testsplit()
  69.     Dim teststr As String
  70.     Dim timeholder As Single
  71.     Dim timetotal As Single
  72.     Dim theline As String
  73.     Dim i As Integer
  74.     
  75.     For i = 1 To 32000
  76.         teststr = String(25, ".") + "-" + vbCrLf + "-" + String(25, ".")
  77.         timeholder = Timer
  78.         SplitOffNextLine teststr, theline
  79.         'FastSplitter teststr, theline
  80.         'MsgBox "'" + teststr + "'"
  81.         'MsgBox "'" + theline + "'"
  82.         timetotal = timetotal + (Timer - timeholder)
  83.     Next i
  84.     MsgBox timetotal
  85. End Sub
  86.  
  87. Sub ANDtest()
  88.     Dim i, j As Integer
  89.     
  90.     i = 64
  91.     j = 65
  92.     
  93.     MsgBox Str((i And j))
  94. End Sub
  95.  
  96. Sub WriteVals()
  97.     Dim i As Byte
  98.     Dim j As Long
  99.     
  100.     Open "C:\Code\UU Class\Test Files\Priorit.uue" For Binary Access Read As #1
  101.     Open "C:\Code\UU Class\Test Files\priorit.txt" For Output As #2
  102.     
  103.     For j = 1 To 100
  104.         Get #1, , i
  105.         Print #2, i
  106.     Next j
  107.     
  108.     Close #1
  109.     Close #2
  110. End Sub
  111.