home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / clipswin / mc_file.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  6.4 KB  |  230 lines
  1. DefInt A-Z
  2. Option Explicit
  3.  
  4. 'Declares for VBLIB declards
  5. '------------------------------------
  6. 'Global Variables and Constants
  7. '------------------------------------
  8. Global Routines() As String   'array of routine names
  9. Global Path$                  'application path
  10. Global OldChoice As Integer   'previously selected routine
  11. 'Global BigTab$                'used for indexing sorted listbox
  12. Global OldChoiceChanged As Integer 'flags change in current record
  13. 'Global ClipCount% As Integer  'tracks number of records
  14.  
  15. Global Const CodeStart$ = "[Code]"  'used in cFile$ to separate description and code
  16. Global Const CodeEnd$ = "[Stop]"    'end of code marker for cFile$
  17. '------------------------------------
  18. 'Module level variables used in file handling routines
  19. '------------------------------------
  20. Dim F As Integer               'file handle
  21. Dim J As Integer               'file handle
  22. Dim RecordNum As Integer       'identifies current record
  23.  
  24.  
  25.  
  26.  
  27. Sub CleanUpFiles ()
  28. Dim X%
  29. '------------------------------------
  30. 'Kill old backups
  31. 'Backup current files
  32. 'Make temp files current
  33. '------------------------------------
  34. On Error Resume Next
  35. Kill Path$ + "Titles.Bak"
  36. Kill Path$ + "ClipText.Bak"
  37. Name tFile$ As Path$ + "Titles.Bak"
  38. Name cFile$ As Path$ + "ClipText.Bak"
  39. If Left$(tFile$, 1) = Left$(Path$, 1) Then
  40.    Name Path$ + "tTmp.Asc" As tFile$
  41.    Name Path$ + "ClipTmp.Asc" As cFile$
  42. Else
  43. 'fix for saving on another drive
  44.    On Error Resume Next
  45.    FileCopy Path$ + "tTmp.Asc", tFile$
  46.    X% = DoEvents()
  47.    FileCopy Path$ + "ClipTmp.Asc", cFile$
  48.    X% = DoEvents()
  49.    Kill Path$ + "tTmp.Asc"
  50.    Kill Path$ + "ClipTmp.Asc"
  51. End If
  52. X% = DoEvents()
  53. End Sub
  54.  
  55. Sub DeleteRoutine ()
  56.  
  57. Dim X, Index 'C$, Header$
  58. '------------------------------------
  59. 'Exit if Titles listbox is empty
  60. '------------------------------------
  61. If MClipForm.Titles.ListCount = 0 Then Exit Sub
  62. '------------------------------------
  63. 'Confirm user wants to delete
  64. '------------------------------------
  65. X = MsgBox("Are you sure that you want to delete the selected clip?", 68, "Clips")
  66. If X <> 6 Then Exit Sub
  67. MClipForm.Titles.Enabled = False
  68.  
  69. '------------------------------------
  70. 'Identify record to delete
  71. '------------------------------------
  72. Index = MClipForm.Titles.ListIndex
  73. MClipForm.Titles.RemoveItem Index
  74. For X = Index To ClipCount% - 2
  75.      Title(X) = Title(X + 1)
  76.      Clip(X) = Clip(X + 1)
  77. Next
  78. Clip(X) = ""
  79. Title(X) = ""
  80. ClipCount% = ClipCount% - 1
  81. ReDim Preserve Title(ClipCount%)
  82. ReDim Preserve Clip(ClipCount%)
  83. Select Case MClipForm.Titles.ListCount
  84.      Case Is = 0
  85.           ToggleMenu False
  86.           FileDirty% = True
  87.           IgnoreChange% = True
  88.           MClipForm.ClipText = ""
  89.           IgnoreChange% = False
  90.      Case Else
  91.           FileDirty% = True
  92.           MClipForm.Titles.ListIndex = 0
  93.      End Select
  94. MClipForm.Titles.Enabled = True
  95. End Sub
  96.  
  97. Sub GetFiles ()
  98. Dim C$, X, Y, Look$, D$
  99. '------------------------------------
  100. 'Open Titles file
  101. '------------------------------------
  102. F = FreeFile
  103. 'On Error GoTo IDXNotFound
  104. Open tFile$ For Input As F
  105. '------------------------------------
  106. 'Input total records
  107. '------------------------------------
  108. Input #F, C$
  109. ClipCount% = Val(C$)
  110. If ClipCount% = 0 Then
  111.      ToggleMenu False
  112.      Close F
  113.      IgnoreChange% = True
  114.      MClipForm.ClipText = ""
  115.      IgnoreChange% = False
  116.      Exit Sub
  117. End If
  118. '------------------------------------
  119. 'Redimension Routines() array to hold
  120. 'titles of all records
  121. '------------------------------------
  122. ReDim Title(ClipCount% - 1)
  123. ReDim Clip(ClipCount% - 1)
  124. '------------------------------------
  125. 'Read  titles
  126. '------------------------------------
  127. For X = 1 To ClipCount%
  128.    Input #F, Title(X - 1)
  129.    MClipForm.Titles.AddItem Title(X - 1)
  130. Next
  131. Close F
  132. '------------------------------------
  133. 'Get Clip Text for each item
  134. F = FreeFile
  135. Open cFile$ For Input As F
  136. For X = 1 To ClipCount%
  137. '--------------------------------------------------------
  138. 'Set Look$ to select item's index tag
  139. '--------------------------------------------------------
  140. Look$ = "[" & X & "]"
  141. '--------------------------------------------------------
  142. 'Find item's header
  143. '--------------------------------------------------------
  144. Do While C$ <> Look$
  145.      Line Input #F, C$
  146. Loop
  147. '--------------------------------------------------------
  148. 'Read Text
  149. '--------------------------------------------------------
  150. D$ = ""
  151. C$ = ""
  152.  
  153. Line Input #F, C$
  154. Do While C$ <> CodeEnd$
  155.      D$ = D$ + C$ + CRLF$
  156.      Line Input #F, C$
  157. Loop
  158. Clip(X - 1) = D$
  159. Next X
  160. '--------------------------------------------------------
  161. Close F
  162. '--------------------------------------------------------
  163. 'Fix Menus and Restore standard pointer
  164. '--------------------------------------------------------
  165. ToggleMenu True
  166. Screen.MousePointer = 1
  167. '--------------------------------------------------------
  168.  
  169.  
  170.  
  171. '''
  172. BackDoor:
  173. Exit Sub
  174. '------------------------------------
  175. 'Error handling routine
  176. 'Give user chance to create a new
  177. 'index file if error trying to read old one
  178. '------------------------------------
  179. IDXNotFound:
  180. Y = MsgBox(tFile$ & " Not Found. Create new library?", 20, "VB Code Librarian")
  181. If Y <> 6 Then End
  182. ClipCount% = 0
  183. Resume BackDoor
  184. End Sub
  185.  
  186. Sub LibSave ()
  187. Screen.MousePointer = 11
  188. Dim Index, Header$, C$
  189. '------------------------------------
  190. 'Create tTmp.Asc so that CleanUpFiles doesn't clobber index
  191. '------------------------------------
  192. On Error Resume Next
  193. 'MsgBox Path
  194. Name cFile$ As Path$ + "tTmp.Asc"
  195. On Error GoTo 0
  196. 'Save Title of each item
  197. F = FreeFile
  198. Open Path$ + "tTmp.Asc" For Output Access Write As #F
  199. C$ = Trim(Str$(ClipCount%))
  200. Print #F, C$
  201. For RecordNum = 1 To ClipCount%
  202.      Print #F, Title(RecordNum - 1)
  203. Next
  204. 'Print #F, Titles(0)
  205. Close F
  206. '------------------------------------
  207. 'Save Text for each item
  208. '------------------------------------
  209.      F = FreeFile
  210.      Open Path$ + "ClipTmp.Asc" For Output Access Write As #F Len = 4096
  211.      J = FreeFile
  212.      'Open cFile$ For Input As #J
  213.      For RecordNum = 1 To ClipCount%
  214.           Header$ = "[" & RecordNum & "]"
  215.           Print #F, Header$
  216.                'Print #F, CodeStart$
  217.                Print #F, Clip(RecordNum - 1)
  218.                Print #F, CodeEnd$
  219.      Next RecordNum
  220.      'Close J
  221.      Close F
  222. '------------------------------------
  223. 'Now clean up files
  224. '------------------------------------
  225. CleanUpFiles
  226. FileDirty% = False
  227. Screen.MousePointer = 1
  228. End Sub
  229.  
  230.