1: Option Explicit
2: '------------------------------------------------------------------------------'
3: 'Indiviudal File object'
4: Class TextFile
5:
6: 'declare Constances'
7: Private strExtension
8: Private strBaseName
9:
10: 'Class Initilize'
11: Private Sub Class_Initialize
12: strExtension = ".txt"
13: strBaseName = "Article"
14: End Sub
15:
16: 'Class Terminate'
17: 'Private Sub Class_Terminate
18:
19: 'End Sub
20: 'Declare the Instance Varibales'
21: Private strFileName
22: Private intNumber
23: Private strRead
24: Private strFinal
25:
26:
27: 'Public Property Let (Write- Statements)'
28: Public Property Let FileName(strName)
29: If IsNumeric(strName) = false Then
30: Err.Raise 91, "TextFile", "The FileName is invalid"
31: End if
32: 'set the values'
33: strFileName = CStr(strBaseName & strName & strExtension)
34: End Property
35:
36: Public Property Let FileNumber(intNum)
37: If IsNumeric(intNum) = False Then
38: Err.Raise 91, "TextFile", "The FileNumber is invalid"
39: End if
40: 'set the property Value'
41: intNumber = intNum
42: End Property
43:
44: Public Property Let Read(str)
45: strRead = str
46: End Property
47:
48: Public Property Let Final(str)
49: strFinal = str
50: End Property
51:
52: 'public Property Get (Read-Statements)'
53: Public Property Get FileName
54: FileName = strFileName
55: End Property
56: Public Property Get FileNumber
57: FileNumber = intNumber
58: End Property
59:
60: Public Property Get Extension
61: Extension = strExtension
62: End Property
63:
64: Public Property Get BaseName
65: BaseName = strBaseName
66: End Property
67:
68: Public Property Get Read
69: Read = strRead
70: End Property
71:
72: Public Property Get Final
73: Final = strFinal
74: End Property
75:
76: 'methods'
77: Public Sub DisplayEntry
78: MsgBox " File List Entry:" & vbNewLine &_
79: "Extension:" & strExtension & _
80: "BaseName:" & strBaseName & _
81: "FileName:" & strFileName & _
82: "Number:" & intNumber
83: End Sub
84: End Class
85: '------------------------------------------------------------------------------'
86: '------------------------------------------------------------------------------'
87: 'storage object for TextFile objects'
88: Class FileList
89:
90: 'Inistance Varaibles'
91: Private objDict
92:
93: 'class Initilize'
94: Private Sub Class_Initialize
95: Set objDict = CreateObject("Scripting.Dictionary")
96: End Sub
97:
98: 'class Terminate'
99: Private Sub Class_Terminate
100: Set objDict = Nothing
101: End Sub
102:
103: 'wrapper for dictionary count'
104: Public Property Get ListCount
105: ListCount = objDict.Count
106: End Property
107:
108: 'Wrapper for dictionary exists'
109: Public Function EntryExists(strFileName)
110: EntryExists = objDict.Exists(strFileName)
111: End Function
112:
113: 'Methods'
114: 'Wrapper for the dictionary add method'
115: Public Sub AddEntry(objTextfile)
116: If TypeName(objTextfile) = "TextFile" Or TypeName(objTextfile) = "ImageFiles" Then 'test if the object is the one expected'
117: objDict.Add objTextfile.FileName , objTextfile 'adds the file name as key and the object as the array value So have an array of objects'
118: Else
119: Err.Raise 3200, "FileList", "Only TextFile objects can be stored"
120: End if
121: 'use the file name as the key'
122:
123: End Sub
124:
125: 'Wrapper for RemoveAll entry'
126: Public Sub ClearAll
127: objDict.RemoveAll 'clears the dictionary'
128: End Sub
129:
130: Public Function DisplayEntry(thefile,strFileName)
131: If objDict.Exists(strFileName) Then
132: Set thefile = objDict.Item(strFileName)
133: 'DisplayEntry=Cstr(objTFile.FileName) ' returns the file name as a string'
134: Else
135: Err.Raise 32002, "FileList" , "The filename " & strFileName &"not in the list"
136: End if
137: End Function
138:
139: 'Matches index number to a key pair and returns the object'
140: Public Function MatchIndex(thefile,keynumber)
141: Dim arykey
142: Dim i
143: arykey = objDict.Keys 'array with the keys'
144: 'return the key at particular value'
145: For i = 0 to objDict.count -1
146: If i = keynumber Then
147: 'return the key which is the file name
148: Set theFile = objDict.Item(arykey(i))
149: 'Set MatchIndex = theFile
150: 'Else ' not in index'
151: 'MatchIndex = null 'return a null object'
152: End if
153: Next
154: End Function
155: End Class
156: '------------------------------------------------------------------------------'
157: '------------------------------------------------------------------------------'
158: ' Methods to Open,Create,Delete,and Iterate through Physical Files'
159: Class CreateOpenTextFile
160: 'Class Initilize'
161: Private Sub Class_Initialize
162: Set objFSO = CreateObject("Scripting.FileSystemObject")
163: Set wshSHELL = CreateObject("Wscript.Shell")
164: End Sub
165:
166: 'Class Terminate'
167: Private Sub Class_Terminate
168: Set objFSO = Nothing
169: Set wshSHELL = Nothing
170: Set objFileList = Nothing
171: End Sub
172:
173: 'Class Varaibles'
174: 'Private FileSystemObject'
175: Private objFSO
176: Private wshSHELL
177: Private objFileList
178: Private strActiveFile
179: Private strCurrentFileIndex
180:
181:
182: 'Write statements
183: Public Property Set FileLists(obj)
184: Set objFileList = obj
185: End Property
186:
187: 'read statement'
188: ' Public Property Get FileList
189: ' FileList = objFileList
190: ' End Property
191:
192: Public Property Get CurrentFileIndex
193: CurrentFileIndex = strCurrentFileIndex
194: End Property
195:
196: Public Property Get ActiveFileName
197: ActiveFileName = strActiveFile
198: End Property
199:
200: 'returns an object from the file list'
201: Public Property Get ReturnObject(ByVal number)
202: Dim thefile
203: Set thefile = New TextFile
204: Call objFileList.MatchIndex(thefile,number)
205: ReturnObject = Cstr(thefile.FileName)
206: End Property
207:
208: 'read statement'
209: Public Property Get ReturnTheObject(thefile,number)
210: Call objFileList.MatchIndex(thefile,number)
211: End Property
212:
213:
214: 'Define Public Methods'
215: Function CreateFiles(number)
216: 'data Type Test'
217: If Not IsNumeric(number) Then
218: Msgbox("Invalid Number of Files")
219: Else
220: 'constants'
221: Const ForReading = 1
222: Const ForWriting = 2
223:
224: 'varaibles'
225: Dim Filepointer 'file Pointer'
226: Dim intNumFiles 'Loop Counter'
227: Dim intCounter 'loop counter'
228: Dim blnSucessful 'return value'
229: Dim objTextFile
230:
231: 'set varaible Values'
232: intNumFiles = number
233: blnSucessful = False
234:
235: 'create the Files'
236: For intCounter = 1 to intNumFiles
237: 'Create the file object'
238: Set objTextFile = New TextFile 'declared the class'
239: objTextFile.FileName = intCounter ' only part needed'
240: objTextFile.FileNumber = intCounter ' index in the For loop'
241:
242: 'create the file'
243: Set Filepointer = objFSO.OpenTextFile(objTextFile.FileName, ForWriting, True)
244: Filepointer.Close()
245: Set Filepointer = Nothing
246: 'Check if operation completed successfully
247:
248: If objFSO.FileExists (objTextFile.FileName) Then
249: blnSucessful = True
250: 'store the file info into objFileList'
251: objFileList.AddEntry(objTextFile)
252:
253: Else
254: blnSucessful = False
255: Set objTextFile = Nothing 'remove till next instance'
256: Exit for ' stop if a file not sucessfuly created'
257: End If
258:
259: strCurrentFileIndex = intCounter
260: strActiveFile =Cstr(objTextFile.BaseName & strCurrentFileIndex & objTextFile.Extension)
261: Set objTextFile = Nothing 'remove till next instance'
262: Next
263: End if
264: CreateFiles = blnSucessful
265: End Function
266: 'Open a Text File'
267: Public Sub Open
268: 'test is file exists
269: If objFSO.FileExists(strActiveFile) Then
270: 'open file in text editor
271: wshSHELL.Run strActiveFile
272: Else
273: 'report error
274: MsgBox ("Error File NOT found Please start Process again")
275: End If
276: End Sub
277:
278: 'next file'
279: Public Function NextFile
280: 'create new TextFile object to reternve the 2 class values of BaseName and Extension'
281: Dim objTextFile
282: Set objTextFile = New TextFile 'declared the class'
283:
284: If objFSO.FileExists(objTextFile.BaseName & (strCurrentFileIndex+1) & objTextFile.Extension) Then
285: strActiveFile =Cstr(objTextFile.BaseName & (strCurrentFileIndex+1) & objTextFile.Extension)
286: 'add one increment the counter'
287: strCurrentFileIndex =(strCurrentFileIndex +1) 'increment the value'
288: NextFile = True
289: Else
290: NextFile = False
291:
292: End if
293: 'delete the object for next occurance'
294: Set objTextFile = Nothing
295: End Function
296:
297:
298: Public Function PrevFile
299: 'create new TextFile object to reternve the 2 class values of BaseName and Extension'
300: Dim objTextFile
301: Set objTextFile = New TextFile 'declared the class'
302:
303: If objFSO.FileExists(objTextFile.BaseName & (strCurrentFileIndex-1) & objTextFile.Extension) Then
304: strActiveFile =Cstr(objTextFile.BaseName & (strCurrentFileIndex-1) & objTextFile.Extension)
305: 'add one increment the counter'
306: strCurrentFileIndex =(strCurrentFileIndex -1) 'increment the value'
307: PrevFile = True
308: Else
309: PrevFile = False
310:
311: End if
312: 'delete the object for next occurance'
313: Set objTextFile = Nothing
314:
315: End Function
316:
317: 'Function to clear the disctionary and delete the files'
318: Public Function DeleteTheFiles
319: Dim intCount
320: Dim intCounter
321: 'test the index number'
322: If (objFileList.ListCount > 0) Then
323: intCounter = (objFileList.ListCount-1)
324: For intCount = 0 to intCounter
325: Dim thefile
326: Set thefile = New TextFile
327: Call objFileList.MatchIndex(thefile,intCount) 'get the physical object'
328: objFSO.DeleteFile(thefile.FileName) 'Delete the physical Files'
329: Set thefile = Nothing 'Reset for next instance'
330: Next
331: DeleteTheFiles = True
332: Else
333: DeleteTheFiles = False
334: End if
335:
336: 'clear the dict'