Author: Stewart Moss
Here is a useful base class to create derived classes to import data from any flat
file format you can think of...
Answer:
1
2 {-----------------------------------------------------------------------------
3 Unit Name: classParentDataManipulator
4 Author: StewartM (Stewart Moss)
5
6 Documentation Date: 23, 08, 2002 (14:39,)
7
8 Version 1.0
9 -----------------------------------------------------------------------------
10
11 Compiler Directives:
12
13 Purpose:
14
15 Dependancies:
16
17 Description:
18
19 Parent Class for data manipulation
20 Creates the basic skelton for adding data manipulation sub-classes
21
22 Each of the inherited classes must override the ProcessData method and provide
23 their own properties specific to the class (ie Invoice Number etc...)
24
25 Very useful class.
26
27 inheritance Diagram
28
29 + -- TParentDataProcessor // base class
30 +
31 |
32 + --- TDerivedImporter // sub class
33
34 Notes:
35
36 History:
37
38 Copyright 2002 by Stewart Moss.
39 All rights reserved.
40 -----------------------------------------------------------------------------}
41
42 unit classParentDataManipulator;
43
44 interface
45
46 uses Sysutils, Classes;
47
48 type
49 TParentDataProcessor = class(TObject)
50 private
51 StringIn: string;
52 LineCounter: Integer;
53
54 public
55 FieldNames,
56 FieldValues,
57 MultiFieldNames,
58 MultiFieldValues: TStringList;
59
60 FormName,
61 FileName: string;
62 Delimiters: string;
63 // A list of delimiters (ie ',/[];:') used in inherited ProcessData()
64
65 constructor create;
66 destructor Destroy; override;
67 procedure ProcessFile;
68
69 function DataAtPos(S: string; StartP, EndP: Integer): string;
70 // Returns the data from "StartP" to "EndP" in String "S"
71
72 function ExpandTabs(s: string): string;
73 // ExpandTabs to 8 Spaces
74
75 procedure ProcessData(StrIn: string; LineNumber: Integer); virtual;
76 // Virtual method for override in sub-classes
77
78 procedure FieldAdd(FieldName, Data: string; GenException: Boolean);
79 // Adds FieldName and FieldValue to Strings and can generate exception if
80 // string is empty when required
81
82 procedure MultiFieldAdd(FieldName, Data: string; GenException: Boolean);
83 // Adds FieldName and FieldValue to Multi Field Strings and can generate
84 exception
85 // if string is empty when required
86
87 end;
88
89 TProcessException = Exception;
90
91 implementation
92
93 var
94 F: text;
95 // Exception: TProcessException;
96
97 { TDataProcessor }
98
99 constructor TParentDataProcessor.create;
100 begin
101 inherited create;
102 FieldNames := TStringList.Create;
103 FieldValues := TStringList.Create;
104 MultiFieldNames := TStringList.Create;
105 MultiFieldValues := TStringList.Create;
106 FieldNames.Clear;
107 FieldValues.Clear;
108 MultiFieldNames.Clear;
109 MultiFieldValues.Clear;
110 end;
111
112 procedure TParentDataProcessor.ProcessFile;
113 begin
114 if Filename = '' then
115 raise Exception.Create('No Filename specified');
116
117 try
118 AssignFile(F, Filename);
119 Reset(f);
120 except
121 try
122 CloseFile(F);
123 except
124 end;
125 raise Exception.Create('Could not open file ' + FileName);
126 end;
127
128 LineCounter := 0;
129
130 while not eof(f) do
131 begin
132 Inc(LineCounter);
133
134 try
135 Readln(f, StringIn);
136 except
137 try
138 CloseFile(f);
139 except // swallow CloseFile errors
140 end;
141
142 raise Exception.Create('Could not read from file. Line number ' +
143 IntToStr(LineCounter));
144 end;
145
146 StringIn := ExpandTabs(StringIn);
147 // Exapnd Tabs to 8 Spaces
148
149 ProcessData(StringIn, LineCounter);
150 // Execute virutal method in sub-classes passing current line and LineNumber
151 end;
152
153 try
154 closefile(f);
155 except
156 raise Exception.Create('Could not close file ' + FileName);
157 end;
158 end;
159
160 procedure TParentDataProcessor.ProcessData(StrIn: string; LineNumber: Integer);
161 // Virtual method for override in sub-classes
162 begin
163 //
164 end;
165
166 destructor TParentDataProcessor.Destroy;
167 begin
168 FieldNames.Free;
169 FieldValues.Free;
170 MultiFieldNames.Free;
171 MultiFieldValues.Free;
172 end;
173
174 function TParentDataProcessor.DataAtPos(S: string; StartP,
175 EndP: Integer): string;
176 begin
177 // Returns the data from "StartP" to "EndP" in String "S"
178 Result := trim(Copy(S, StartP, EndP - StartP));
179 end;
180
181 function TParentDataProcessor.ExpandTabs(s: string): string;
182 begin
183 // ExpandTabs to 8 Spaces
184 Result := StringReplace(S, #09, ' ', [rfReplaceAll]);
185 end;
186
187 procedure TParentDataProcessor.FieldAdd(FieldName, Data: string;
188 GenException: Boolean);
189 begin
190 // Adds FieldName and FieldValue to Strings and can generate exception if
191 // string is empty
192 if (GenException) and (Data = '') then
193 raise Exception.create('-- No ' + FieldName + ' Specified --');
194 Fieldnames.add(FieldName);
195 FieldValues.add(Data);
196 end;
197
198 procedure TParentDataProcessor.MultiFieldAdd(FieldName, Data: string;
199 GenException: Boolean);
200
201 var
202 loop: integer;
203 flag: Boolean;
204 begin
205 // Adds FieldName and FieldValue to Multi Field Strings and can generate
206 exception
207 // if string is empty
208
209 if (GenException) and (Data = '') then
210 raise Exception.create('-- No Multiple Field - ' + FieldName + ' Specified --');
211
212 flag := false;
213 loop := 0;
214 while (loop < MultiFieldNames.count) and not flag do
215 begin
216 if MultiFieldNames.Strings[loop] = FieldName then
217 flag := true;
218 inc(Loop);
219 end;
220
221 dec(loop);
222
223 if Flag then
224 MultiFieldValues.Strings[loop] := MultiFieldValues.Strings[loop] + ';' + Data
225 else
226 begin
227 MultiFieldNames.add(FieldName);
228 MultiFieldValues.add(Data);
229 end;
230 end;
231
232 end.
|
