home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Learn_abou623163152002.psc / modGeneral.bas < prev   
Encoding:
BASIC Source File  |  2002-03-14  |  8.5 KB  |  279 lines

  1. Attribute VB_Name = "modGeneral"
  2. Option Explicit
  3.  
  4. ' The object declaration
  5. Public g_objFileSystem As Scripting.FileSystemObject
  6. Public g_objTextStream As Scripting.TextStream
  7.  
  8. ' File name wher the information is stored.
  9. Public Const g_sFileName = "FileSystemDemo.txt"
  10.  
  11. Public Enum SeperateInfo
  12.     RightSide = 1
  13.     LeftSide = 2
  14. End Enum
  15.  
  16. ' Just to make the coding easy declare these enum
  17. Public Enum FileMode
  18.     ReadMode = 1
  19.     AppendMode = 2
  20.     WriteMode = 3
  21. End Enum
  22.  
  23. ' Topic Info
  24. Public Type TopicInfo
  25.     bCodeSampleAvailable As Boolean
  26.     sTopicTitle As String
  27.     sTopicDescription As String
  28. End Type
  29.  
  30. Public g_arrTopics() As TopicInfo
  31. Public g__iNumTopics As Integer
  32.  
  33.  
  34. Public Function OpenTextFile(sFileName As String, iMode As FileMode) As Boolean
  35. ' This function will open the text file using the OpenTextfile Method.
  36.  
  37. On Error GoTo ErrOpen
  38.  
  39. ' iMode = 1 means open for Read ; iMode = 2 means open for Append ; iMode = 3 means open for write
  40. ' Open file for Read or Append
  41.     
  42.     Select Case iMode
  43.         
  44.         Case 1
  45.             Set g_objTextStream = g_objFileSystem.OpenTextFile(sFileName, ForReading, False, TristateFalse)
  46.         Case 2
  47.             Set g_objTextStream = g_objFileSystem.OpenTextFile(sFileName, ForAppending)
  48.         Case 3
  49.             Set g_objTextStream = g_objFileSystem.OpenTextFile(sFileName, ForWriting)
  50.     End Select
  51.     
  52.     OpenTextFile = True
  53.     Exit Function
  54.     
  55. ErrOpen:
  56.  
  57.     Debug.Print "Err Open file : " + Err.Description
  58.     
  59. End Function
  60.  
  61.  
  62. Public Function ReadAndFillArray() As Boolean
  63.  
  64. ' Read the file and fill the data in the array
  65.  
  66. On Error GoTo ErrRead
  67. Dim sFileName As String
  68. Dim sFromFile As String
  69. Dim bStart As Boolean
  70.  
  71. Dim bTopicFirstLine As Boolean
  72. Dim sDescriptionText As String
  73.  
  74. Dim iTopicCount As Integer      ' keep track the Topic title information
  75. Const Topic = "#Topic"
  76.     
  77.     sFileName = App.Path + "\" + g_sFileName
  78.     
  79.     ' Check if the file exists
  80.     If Dir(sFileName, vbNormal) = "" Then
  81.         MsgBox "Source file : " + sFileName + " doesnot exist. "
  82.         Exit Function
  83.     End If
  84.     
  85.     If Not OpenTextFile(sFileName, ReadMode) Then
  86.         MsgBox "Cannot open the file : " + sFileName
  87.         Exit Function
  88.     End If
  89.         
  90.     ' Till we get the end of file or #End mark in the file, read the file
  91.     ' Skip the description portion
  92.     
  93.     Do While Not g_objTextStream.AtEndOfStream
  94.         
  95.         ' Read the line from the text file
  96.         sFromFile = g_objTextStream.ReadLine
  97.         
  98.         Debug.Print sFromFile       ' Just to view the information in debug window
  99.         
  100.         ' Just check the line before entering into the fn
  101.         'If LCase(sFromFile) = LCase("#Start") Then bStart = True
  102.         
  103.         If bStart = False Then  ' Just leave the comment portion
  104.             
  105.             If LCase(sFromFile) = LCase("#Start") Then bStart = True
  106.             
  107.             If bStart Then  ' Line start has appeared in the file
  108.             
  109.                 ' Get the topics count and set to the number of topics variable
  110.                 g__iNumTopics = CInt(g_objTextStream.ReadLine)
  111.                 
  112.                 ' Redim the array to hold the content from file
  113.                 If g__iNumTopics = 0 Then
  114.                     
  115.                     MsgBox "No topics found "
  116.                     Exit Function
  117.                 
  118.                 Else        ' g_iNumTopics = 0 Else
  119.                 
  120.                     ReDim Preserve g_arrTopics(g__iNumTopics)
  121.                     ' set the flag to start reading the topic info
  122.                     sDescriptionText = ""
  123.                 
  124.                 End If  ' g_iNumTopics = 0 End if
  125.             
  126.             End If  ' bStart End if
  127.             
  128.         Else
  129.             
  130.             ' Here we have to track the start of topic, first line of topic and skip line
  131.             If Left(LCase(sFromFile), 9) = LCase("#SkipLine") Then GoTo LineSkipped
  132.             
  133.             ' Is the line reperesent the next topic start
  134.             If sFromFile = Topic + Trim$(Str(iTopicCount + 1)) Then
  135.                 
  136.                 iTopicCount = iTopicCount + 1
  137.                 
  138.                 ' Get the first line from the topic. Get the topic and code sample available flag.
  139.                 
  140.                 ' Before refreshing the Description Text put that to the previous array element's info
  141.                 If iTopicCount > 1 Then     ' For the first item we won't have the previous item.
  142.                     g_arrTopics(iTopicCount - 1).sTopicDescription = sDescriptionText
  143.                 End If
  144.                 
  145.                 sDescriptionText = ""
  146.                 
  147.                 sFromFile = g_objTextStream.ReadLine
  148.                 
  149.                 ' If the char "|" found in the line then get the topic title and code sample available flag.
  150.                 If CharFound(sFromFile, "|") Then
  151.                     g_arrTopics(iTopicCount).sTopicTitle = SeperateString(sFromFile, "|", LeftSide)
  152.                     g_arrTopics(iTopicCount).bCodeSampleAvailable = IIf(CBool(SeperateString(sFromFile, "|", RightSide)) = True, True, False)
  153.                 Else
  154.                     g_arrTopics(iTopicCount).sTopicTitle = sFromFile
  155.                 End If
  156.             
  157.             Else        ' The line doesnot represent any topic
  158.                 
  159.                 ' If not the end of file info then add the string to the description
  160.                 
  161.                 If LCase(sFromFile) = LCase("#End") Then
  162.                     ' We don't want any information afterwards
  163.                     g_arrTopics(iTopicCount).sTopicDescription = sDescriptionText
  164.                     
  165.                     ' We got the needed data from the file. Exit
  166.                     ReadAndFillArray = True
  167.                     Exit Function
  168.                 
  169.                 Else    ' If not end then keep on add the content to the description text
  170.                     
  171.                     If sDescriptionText = "" Then
  172.                         sDescriptionText = sFromFile
  173.                     Else
  174.                         sDescriptionText = sDescriptionText + vbCrLf + sFromFile
  175.                     End If
  176.                 End If
  177.                 
  178.             End If ' End if of sFromFile = any topic
  179.             
  180. LineSkipped:
  181.  
  182.         End If
  183.         
  184.     Loop
  185.     
  186.     ReadAndFillArray = True
  187.  
  188. ErrRead:
  189.  
  190. End Function
  191.  
  192. '#SkipLine
  193. '#End
  194.  
  195.  
  196. Public Function CharFound(ByVal sSearchString As String, ByVal sSearchChar As String) As Boolean
  197. ' This function will return True if the Specified character is found in the string
  198. Dim charpos As Integer
  199. On Error GoTo ErrHandler
  200.  
  201.     charpos = InStr(1, sSearchString, sSearchChar, vbTextCompare)
  202.     
  203.     If charpos > 0 Then
  204.         CharFound = True
  205.     Else
  206.         CharFound = False
  207.     End If
  208.     
  209. Exit Function
  210.  
  211. ErrHandler:
  212.     CharFound = False
  213. End Function
  214.  
  215. Public Function SeperateString(ByVal sInText As String, ByVal Pattern As String, ByVal RightOrLeft As SeperateInfo)
  216.  
  217. On Error GoTo ErrSep
  218. ' This function will extract the  string to the left or right of the pattern string
  219.     
  220.     Dim DotPos As Integer
  221.     Dim Loc As Boolean
  222.     Dim TextLength As Integer
  223.  
  224.     TextLength = Len(sInText)
  225.     
  226.     Select Case UCase(RightOrLeft)
  227.         Case 2      ' Left
  228.             
  229.             DotPos = InStr(1, sInText, Pattern, vbTextCompare)
  230.             SeperateString = ""
  231.             If DotPos > 0 Then
  232.                 SeperateString = Left(sInText, DotPos - 1)
  233.             Else    ' Return blank string
  234.                 SeperateString = ""
  235.                 'SeperateString = sInText
  236.             End If
  237.             
  238.         Case 1  ' Right
  239.             
  240.             DotPos = InStr(1, sInText, Pattern, vbTextCompare)
  241.             SeperateString = ""
  242.             If DotPos > 0 Then
  243.                 SeperateString = Right(sInText, TextLength - (DotPos + (Len(Pattern) - 1)))
  244.             Else    ' Return blank string
  245.                 SeperateString = ""
  246.                 'SeperateString = sInText
  247.             End If
  248.     
  249.     End Select
  250.     
  251. ErrSep:
  252.  
  253. End Function
  254.  
  255.  
  256. Public Function GetFileName(sFileName As String) As String
  257. ' Get the file name
  258. On Error GoTo ErrGet
  259. Dim arrTmp() As String
  260.  
  261. Dim sTemp As String
  262. Dim iLastElement As Integer
  263.  
  264.     If sFileName = "" Then Exit Function
  265.  
  266.     arrTmp = Split(sFileName, "\")
  267.     iLastElement = UBound(arrTmp)
  268.     
  269.     sTemp = arrTmp(iLastElement)
  270.     
  271.     GetFileName = sTemp
  272.     
  273.     Exit Function
  274.  
  275. ErrGet:
  276.     Debug.Print "Get File Name : " + Err.Description
  277. End Function
  278.  
  279.