Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to convert a string to DateTime using a format mask Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
18-Oct-02
Category
Algorithm
Language
Delphi 2.x
Views
116
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC