Author: Jonas Bilinkevicius
How to convert a string to DateTime using a format mask
Answer:
1 unit FileNameRoutines2;
2
3 interface
4
5 {DATE-TIME NAME CONVERTER OBJ}
6
7 type
8 tDateTimeNameConverterObj = class
9 private
10 fDefiningTemplate: string;
11 fOpnBrk,
12 fClsBrk: char;
13 fSearchTemplate: string;
14 fConstructionTemplate: string;
15 NYrC: integer;
16 YrCs: array[0..3] of integer; {Indexes w/in constr template.}
17 NMoC: integer;
18 MoCs: array[0..3] of integer;
19 NDaC: integer;
20 DaCs: array[0..3] of integer;
21 NHrC: integer;
22 HrCs: array[0..3] of integer;
23 NMiC: integer;
24 MiCs: array[0..3] of integer;
25 NSeC: integer;
26 SeCs: array[0..3] of integer;
27 public
28 constructor CreateFromDateTimeNameTemplate(const aBrackets, aDateTimeNameTemp:
29 string);
30 property DefiningTemplate: string read fDefiningTemplate;
31 property SearchTemplate: string read fSearchTemplate;
32 property ConstructionTemplate: string read fConstructionTemplate;
33 function DateTimeToName(aDateTime: tDateTime): string;
34 function NameToDateTime(const aName: string): tDateTime;
35 function IsValidDateTimeName(const aName: string; var aDateTime: tDateTime):
36 integer;
37 end;
38
39 type
40 tDateTimeNameConverterObj2 = class
41 private
42 fDefiningTemplate: string;
43 fOpnBrk,
44 fClsBrk: char;
45 fSearchTemplate: string;
46 fConstructionTemplate: string;
47 NYrC: integer;
48 YrCs: array[0..3] of integer; {Indexes w/in constr template.}
49 NMoC: integer;
50 MoCs: array[0..3] of integer;
51 NDaC: integer;
52 DaCs: array[0..3] of integer;
53 NHrC: integer;
54 HrCs: array[0..3] of integer;
55 NMiC: integer;
56 MiCs: array[0..3] of integer;
57 NSeC: integer;
58 SeCs: array[0..3] of integer;
59 procedure SetDefiningTemplate(const aDefiningTemplate: string);
60 public
61 constructor Create(const aBrackets: string);
62 property DefiningTemplate: string read fDefiningTemplate write
63 SetDefiningTemplate;
64 property SearchTemplate: string read fSearchTemplate;
65 property ConstructionTemplate: string read fConstructionTemplate;
66 function DateTimeToName(aDateTime: tDateTime): string;
67 function NameToDateTime(const aName: string): tDateTime;
68 function IsValidDateTimeName(const aName: string; var aDateTime: tDateTime):
69 integer;
70 end;
71
72 implementation
73
74 uses
75 SysUtils;
76
77 { tDateTimeNameConverterObj }
78
79 constructor tDateTimeNameConverterObj.CreateFromDateTimeNameTemplate
80 (const aBrackets, aDateTimeNameTemp: string);
81 var
82 c: char;
83 i: integer;
84 InDate: boolean;
85 begin
86 fOpnBrk := aBrackets[1];
87 fClsBrk := aBrackets[2];
88 fDefiningTemplate := aDateTimeNameTemp;
89 fConstructionTemplate := '';
90 InDate := false;
91 for i := 1 to length(fDefiningTemplate) do
92 begin
93 c := fDefiningTemplate[i];
94 if not InDate then
95 if c = fOpnBrk then
96 begin
97 InDate := true;
98 fSearchTemplate := fSearchTemplate + '*';
99 end
100 else
101 begin {copy name characters}
102 fConstructionTemplate := fConstructionTemplate + c;
103 fSearchTemplate := fSearchTemplate + c;
104 end
105 else
106 if c = fClsBrk then
107 InDate := false
108 else
109 begin
110 fConstructionTemplate := fConstructionTemplate + c;
111 case UpCase(c) of
112 'Y':
113 begin
114 if NYrC < 4 then
115 YrCs[NYrC] := length(fConstructionTemplate);
116 Inc(NYrC);
117 end;
118 'M':
119 begin
120 if NMoC < 4 then
121 MoCs[NMoC] := length(fConstructionTemplate);
122 Inc(NMoC);
123 end;
124 'D':
125 begin
126 if NDaC < 4 then
127 DaCs[NDaC] := length(fConstructionTemplate);
128 Inc(NDaC);
129 end;
130 'H':
131 begin
132 if NHrC < 2 then
133 HrCs[NHrC] := length(fConstructionTemplate);
134 Inc(NHrC);
135 end;
136 'N':
137 begin
138 if NMiC < 2 then
139 MiCs[NMiC] := length(fConstructionTemplate);
140 Inc(NMiC);
141 end;
142 'S':
143 begin
144 if NSeC < 2 then
145 SeCs[NSeC] := length(fConstructionTemplate);
146 Inc(NSeC);
147 end;
148 end;
149 end;
150 end;
151 if ((NYrC <> 2) and (NYrC <> 4)) or ((NMoC <> 0) and (NMoC <> 2)) or ((NMoC = 0)
152 and
153 (NDaC < 3)) or ((NMoC <> 0) and (NDaC <> 0) and (NDaC <> 2)) or ((NHrC <> 0) and
154 (NHrC <> 2)) or ((NMiC <> 0) and (NMiC <> 2)) or ((NSeC <> 0) and (NSeC <> 2))
155 then
156 raise Exception.Create(Format('Bad date template (%d, %d, %d, %d, %d, %d)',
157 [NYrC, NMoC, NDaC, NHrC, NMiC, NSeC]));
158 end;
159
160 function tDateTimeNameConverterObj.IsValidDateTimeName(const aName: string;
161 var aDateTime: tDateTime): integer;
162
163 procedure XX(i: integer; var n: word);
164 var
165 c: Char;
166 begin
167 c := aName[i];
168 if c in ['0'..'9'] then
169 n := 10 * n + (ord(c) - ord('0'))
170 else
171 Result := i;
172 end;
173
174 var
175 i: Integer;
176 y, y2, y0, m, m2, d, d2, h, n, s: Word;
177 begin
178 y := 0;
179 m := 0;
180 d := 0;
181 h := 0;
182 n := 0;
183 s := 0;
184 for i := 0 to NYrC - 1 do
185 XX(YrCs[i], y);
186 for i := 0 to NMoC - 1 do
187 XX(MoCs[i], m);
188 for i := 0 to NDaC - 1 do
189 XX(DaCs[i], d);
190 for i := 0 to NHrC - 1 do
191 XX(HrCs[i], h);
192 for i := 0 to NMiC - 1 do
193 XX(MiCs[i], n);
194 for i := 0 to NSeC - 1 do
195 XX(SeCs[i], s);
196 if m = 0 then
197 m := 1;
198 if d = 0 then
199 d := 1;
200 try
201 if NYrC = 2 then
202 begin {do the Y100 stuff}
203 DecodeDate({Current} Date, y2, m2, d2);
204 y0 := 100 * (y2 div 100);
205 y := y + y0;
206 if y < y2 - 50 then
207 y := y + 100;
208 end;
209 aDateTime := EncodeDate(y, m, d) + EncodeTime(h, n, s, 0);
210 Result := 0;
211 except
212 on Exception do
213 aDateTime := 0;
214 end;
215 end;
216
217 function tDateTimeNameConverterObj.NameToDateTime(const aName: string): tDateTime;
218 begin
219 if IsValidDateTimeName(aName, Result) <> 0 then
220 raise Exception.Create('Filename (' + aName + ') does not contain valid date.');
221 end;
222
223 function tDateTimeNameConverterObj.DateTimeToName(aDateTime: tDateTime): string;
224 var
225 Y, M, D, H, N, S, X: Word;
226 str: string[5];
227 i: integer;
228 begin
229 Result := fConstructionTemplate;
230 DecodeDate(aDateTime, Y, M, D);
231 DecodeTime(aDateTime, H, N, S, X);
232 str := IntToStr(10000 + Y);
233 for i := 0 to NYrC - 1 do
234 Result[YrCs[i]] := str[i + 6 - NYrC];
235 str := IntToStr(10000 + M);
236 for i := 0 to NMoC - 1 do
237 Result[MoCs[i]] := str[i + 6 - NMoC];
238 str := IntToStr(10000 + D);
239 for i := 0 to NDaC - 1 do
240 Result[DaCs[i]] := str[i + 6 - NDaC];
241 str := IntToStr(10000 + H);
242 for i := 0 to NHrC - 1 do
243 Result[HrCs[i]] := str[i + 6 - NHrC];
244 str := IntToStr(10000 + N);
245 for i := 0 to NMiC - 1 do
246 Result[MiCs[i]] := str[i + 6 - NMiC];
247 str := IntToStr(10000 + S);
248 for i := 0 to NSeC - 1 do
249 Result[SeCs[i]] := str[i + 6 - NSeC];
250 end;
251
252 { tDateTimeNameConverterObj2 }
253
254 constructor tDateTimeNameConverterObj2.Create(const aBrackets: string);
255 begin
256 fOpnBrk := aBrackets[1];
257 fClsBrk := aBrackets[2];
258 end;
259
260 procedure tDateTimeNameConverterObj2.SetDefiningTemplate(const aDefiningTemplate:
261 string);
262 var
263 c: Char;
264 i: integer;
265 InDate: boolean;
266 begin
267 fDefiningTemplate := aDefiningTemplate;
268 fConstructionTemplate := '';
269 fSearchTemplate := '';
270 fConstructionTemplate := '';
271 NYrC := 0;
272 NMoC := 0;
273 NDaC := 0;
274 NHrC := 0;
275 NMiC := 0;
276 NSeC := 0;
277 InDate := false;
278 for i := 1 to length(fDefiningTemplate) do
279 begin
280 c := fDefiningTemplate[i];
281 if not InDate then
282 if c = fOpnBrk then
283 begin
284 InDate := true;
285 fSearchTemplate := fSearchTemplate + '*';
286 end
287 else
288 begin {copy name characters}
289 fConstructionTemplate := fConstructionTemplate + c;
290 fSearchTemplate := fSearchTemplate + c;
291 end
292 else if c = fClsBrk then
293 InDate := false
294 else
295 begin
296 fConstructionTemplate := fConstructionTemplate + c;
297 case UpCase(c) of
298 'Y':
299 begin
300 if NYrC < 4 then
301 YrCs[NYrC] := length(fConstructionTemplate);
302 Inc(NYrC);
303 end;
304 'M':
305 begin
306 if NMoC < 4 then
307 MoCs[NMoC] := length(fConstructionTemplate);
308 Inc(NMoC);
309 end;
310 'D':
311 begin
312 if NDaC < 4 then
313 DaCs[NDaC] := length(fConstructionTemplate);
314 Inc(NDaC);
315 end;
316 'H':
317 begin
318 if NHrC < 2 then
319 HrCs[NHrC] := length(fConstructionTemplate);
320 Inc(NHrC);
321 end;
322 'N':
323 begin
324 if NMiC < 2 then
325 MiCs[NMiC] := length(fConstructionTemplate);
326 Inc(NMiC);
327 end;
328 'S':
329 begin
330 if NSeC < 2 then
331 SeCs[NSeC] := length(fConstructionTemplate);
332 Inc(NSeC);
333 end;
334 end;
335 end;
336 end;
337 if ((NYrC <> 2) and (NYrC <> 4)) or ((NMoC <> 0) and (NMoC <> 2)) or ((NMoC = 0)
338 and
339 (NDaC < 3)) or ((NMoC <> 0) and (NDaC <> 0) and (NDaC <> 2)) or ((NHrC <> 0) and
340 (NHrC <> 2)) or ((NMiC <> 0) and (NMiC <> 2)) or ((NSeC <> 0) and (NSeC <> 2))
341 then
342 raise Exception.Create(Format('Bad date template (%d, %d, %d, %d, %d, %d)',
343 [NYrC, NMoC, NDaC, NHrC, NMiC, NSeC]));
344 end;
345
346 function tDateTimeNameConverterObj2.IsValidDateTimeName(const aName: string;
347 var aDateTime: tDateTime): integer;
348
349 procedure XX(i: integer; var n: word);
350 var
351 c: Char;
352 begin
353 c := aName[i];
354 if c in ['0'..'9'] then
355 n := 10 * n + (ord(c) - ord('0'))
356 else
357 Result := i;
358 end;
359
360 var
361 i: integer;
362 y, y2, y0, m, m2, d, d2, h, n, s: Word;
363 begin
364 y := 0;
365 m := 0;
366 d := 0;
367 h := 0;
368 n := 0;
369 s := 0;
370 for i := 0 to NYrC - 1 do
371 XX(YrCs[i], y);
372 for i := 0 to NMoC - 1 do
373 XX(MoCs[i], m);
374 for i := 0 to NDaC - 1 do
375 XX(DaCs[i], d);
376 for i := 0 to NHrC - 1 do
377 XX(HrCs[i], h);
378 for i := 0 to NMiC - 1 do
379 XX(MiCs[i], n);
380 for i := 0 to NSeC - 1 do
381 XX(SeCs[i], s);
382 if m = 0 then
383 m := 1;
384 if d = 0 then
385 d := 1;
386 try
387 if NYrC = 2 then
388 begin {do the Y100 stuff}
389 DecodeDate({Current} Date, y2, m2, d2);
390 y0 := 100 * (y2 div 100);
391 y := y + y0;
392 if y < y2 - 50 then
393 y := y + 100;
394 end;
395 aDateTime := EncodeDate(y, m, d) + EncodeTime(h, n, s, 0);
396 Result := 0;
397 except
398 on Exception do
399 aDateTime := 0;
400 end;
401 end;
402
403 function tDateTimeNameConverterObj2.NameToDateTime(const aName: string): tDateTime;
404 begin
405 if IsValidDateTimeName(aName, Result) <> 0 then
406 raise Exception.Create('Filename (' + aName + ') does not contain valid date.');
407 end;
408
409 function tDateTimeNameConverterObj2.DateTimeToName(aDateTime: tDateTime): string;
410 var
411 Y, M, D, H, N, S, X: Word;
412 str: string[5];
413 i: integer;
414 begin
415 Result := fConstructionTemplate;
416 DecodeDate(aDateTime, Y, M, D);
417 DecodeTime(aDateTime, H, N, S, X);
418 str := IntToStr(10000 + Y);
419 for i := 0 to NYrC - 1 do
420 Result[YrCs[i]] := str[i + 6 - NYrC];
421 str := IntToStr(10000 + M);
422 for i := 0 to NMoC - 1 do
423 Result[MoCs[i]] := str[i + 6 - NMoC];
424 str := IntToStr(10000 + D);
425 for i := 0 to NDaC - 1 do
426 Result[DaCs[i]] := str[i + 6 - NDaC];
427 str := IntToStr(10000 + H);
428 for i := 0 to NHrC - 1 do
429 Result[HrCs[i]] := str[i + 6 - NHrC];
430 str := IntToStr(10000 + N);
431 for i := 0 to NMiC - 1 do
432 Result[MiCs[i]] := str[i + 6 - NMiC];
433 str := IntToStr(10000 + S);
434 for i := 0 to NSeC - 1 do
435 Result[SeCs[i]] := str[i + 6 - NSeC];
436 end;
437
438 end.
|
