Gator is freeware    for everybody!

• Running an external application (and waiting)
• Date and time of creation/modification of a file
• Find a file
• Only numerical input in a TEdit
• Global UNIT with functions and procedures
• Set system-time and system-date
• Changing properties for all components of a certain type

The function FileAge() returns the date/time stamp of a file. The returned value is an integer number; it has to be converted to Delphi's TDateTime format (a floating point number) before you can use it. You can use the following code to test the funtions involved:

procedure TForm1.Button1Click(Sender: TObject);
var
  File_Name: string;
  DateTimeStamp: integer;
  Date_Time: TDateTime;
begin
  File_Name := 'c:\mydocuments\test.doc';
  DateTimeStamp := FileAge(File_Name);
  // FileAge returns -1 if file not found
  if DateTimeStamp < 0 then  
    ShowMessage('File not found')
  else begin
    // Convert to TDateTime format
    Date_Time := FileDateToDateTime(DateTimeStamp);
    Label1.Caption := DateToStr(Date_Time);
    Label2.Caption := TimeToStr(Date_Time);
  end;
end;

Find a file

The following procedure locates all occurrences of a given file and adds the complete path to a stringlist. Note that recursion is used: FindFiles calls itself at the end of the procedure.

Before calling FindFiles, the stringlist has to be created; afterwards, you must free the stringlist.

In StartDir you pass the starting directory, including the disk drive. In FileMask you pass the name of the file to find, or a file mask. Examples:
FindFiles('c:\', 'letter01.doc')
FindFiles('d:\', 'euroen??.dpr')
FindFiles('d:\projects', '*.dpr')

In order to test the procedure, you add some components to the form: two Edits, a Button, a TLabel and a ListBox.

implementation
....
var
  FilesList: TStringList;
...
procedure FindFiles(StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';

  { Build a list of the files (not directories) 
    in directory StartDir                       }
  IsFound :=
    FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Build a list of subdirectories 
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory) <> 0) and
         (SR.Name[1] <> '.') then
      DirList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Scan the list of subdirectories
  for i := 0 to DirList.Count-1 do
    FindFiles(DirList[i], FileMask);

  DirList.Free;
end;

procedure TForm1.ButtonFindClick(Sender: TObject);
begin
  FilesList := TStringList.Create;
  FindFiles(EditStartDir.Text, EditFileMask.Text);
  ListBox1.Items.Assign(FilesList);
  LabelCount.Caption := 'Files found: ' + IntToStr(FilesList.Count);
  FilesList.Free;
end;

For a more robust code, you should at minimum check if the limit of the stringlist is not exceeded before you add to it (or use a try...except construction). Somebody might look for *.* starting in C:\
In that case, it's best to inform the user with a warning: "Too many files. Not all occurences are listed."

---

Get 2 months of Computer Shopper absolutely FREE!	Visit FreeShop's Magazine Shop with over 200 popular titles to choose from! FreeShop has over 1000 free and trial offers of magazines and catalogs, mostly for US-citizens. Click here. Not a US resident? Then look at FreeShop's International Offers.

---

Only numerical input in a TEdit

If you want to limit the input of a TEdit to numerical strings only, you can discard the "invalid" characters in it's OnKeyPress event handler.

In order to test the following code examples, put a TEdit and a TLabel on a form. The TLabel's purpose is for monitoring what happens and to display error messages. Of course, in a real world application you could show error messages in a dialog box.

In the Edit's OnChange handler, you enter the code for displaying the text of the Edit in case a valid key is pressed:

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Label1.Caption := Edit1.Text;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  // #8 is Backspace
  if not (Key in [#8, '0'..'9']) then begin
    Label1.Caption := 'Invalid key';
    // Discard the key
    Key := #0;
  end;  
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#8, '0'..'9', DecimalSeparator]) then begin
    Label1.Caption := 'Invalid key: ' + Key
    Key := #0;
  end
  else
    if (Key = DecimalSeparator) and
       (Pos(Key, Edit1.Text) > 0) then begin
      Label1.Caption := 'Invalid Key: twice ' + Key;
      Key := #0;
    end;  
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  ErrMess: string;
begin
  ErrMess := '';
  if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
    ErrMess := 'Invalid key: ' + Key
  else if ((Key = DecimalSeparator) or (Key = '-'))
            and (Pos(Key, Edit1.Text) > 0) then
    ErrMess := 'Invalid Key: twice ' + Key
  else if (Key = '-') and (Edit1.SelStart <> 0) then
    ErrMess := 'Only allowed at beginning of number: ' + Key;
  if ErrMess <> '' then begin
    Label1.Caption := ErrMess;
    Key := #0;
  end;  
end;

How about giving that same behaviour to several TEdits on the same form? In the Object Inspector, you change the name of the event handler from Edit1KeyPress to Edit1_10KeyPress or something similar. Delphi automatically changes the name in the code editor, don't worry. Then, for each TEdit, you select it's OnKeyPress event and you select Edit1_10KeyPress from the listbox next to the event.

A global UNIT with functions and procedures

For complex projects, I advise you to put your "general" (globally used) functions and procedures in a separate unit. Such a "global" unit does not have a corresponding form. All other units that use the general routines, have to refer to your global unit through a USES-clause. An example of such a unit might look like this:

unit GlobalRoutines;

interface

uses
  SysUtils, Forms, Buttons, StdCtrls, Graphics, ..., ...;
procedure SetTime(Hour, Minute, Second, Sec100: Word);
procedure SetDate(Year, Month, Day: Word);
...
var
  Var1, Var2, Var3: string;
  DoIt: Boolean;
  ...

implementation

procedure SetTime(Hour, Min, Sec, Sec100: Word);
begin
  ...
end;

procedure SetDate(Year, Month, Day: Word);
begin
  ...
end;
...
...
end.

Note that you have to define all variables, procedures and functions that you want to call from other units, BEFORE the IMPLEMENTATION!

Set system-time and system-date

With the procedures SETTIME and SETDATE you can set the system time and date from within your Delphi application. Both procedures are written in Assembler. The Delphi-compiler contains an Assembler-compiler!

In the interface-section you define the procedures:

procedure SetTime(Hour, Min, Sec, Sec100: Word);
procedure SetDate(Year, Month, Day: Word);

{ SetTime sets the time of the operating system.
  Valid parameters: Hour 0-23, Min 0-59, Sec 0-59 and 
  Sec100 0-99 (hundreds of a second)
  If the time is not valid, the function has no effect }
procedure SetTime(Hour, Min, Sec, Sec100: Word); assembler;
asm
  MOV CH,BYTE PTR Hour
  MOV CL,BYTE PTR Min
  MOV DH,BYTE PTR Sec
  MOV DL,BYTE PTR Sec100
  MOV AH,2DH
  INT 21H
end;

{ SetDate sets the date of the operating system. Valid parameters:
  Year 1980-2099, Month 1-12 en Day 1-31
  If the date is not valid, the function has no effect }
procedure SetDate(Year, Month, Day: Word); assembler;
asm
  MOV CX,Year
  MOV DH,BYTE PTR Month
  MOV DL,BYTE PTR Day
  MOV AH,2BH
  INT 21H
end;

Changing properties for all components of a certain type

To change the font color of all the labels of a form to a certain color, call the following procedure. In the call itself, you have to replace NewColor with an existing color, e.g. SetLabelsFontColor(clRed) sets all the labels' font color to red.

procedure TForm1.SetLabelsFontColor(NewColor: TColor);
var
  i: Integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TLabel then
      TLabel(Components).Font.Color := NewColor;
end;

procedure TForm1.SetEditsColor(NewColor: TColor);
var
  i: Integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TEdit then
      TEdit(Components).Color := NewColor;
end;

⌐ Copyright 1999 
Studiebureau Festraets