Untitled

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JvExControls, JvComponent, JvXPCore, JvXPButtons,
  ExtCtrls, Mask, ShlObj, ActiveX, ComObj, Menus, DFTrayIcon, ImgList,
  JvComponentBase, JvTrayIcon;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    AmPmBox: TComboBox;
    TimeEdit: TMaskEdit;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Timer1: TTimer;
    button1: TJvXPButton;
    Label3: TLabel;
    PopupMenu1: TPopupMenu;
    Restore1: TMenuItem;
    Exit1: TMenuItem;
    ImageList1: TImageList;
    JvTrayIcon1: TJvTrayIcon;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure AmPmBoxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure AmPmBoxKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2Exit(Sender: TObject);
    procedure Restore1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
    sety: string;
    procedure enablecomps(s: boolean);
    procedure CreateLink(zpadpath, linkfolderpath: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
//var
//s: string;
//setdate: string;
begin
{ s := FormatDateTime('hh:mm AM/PM', Now);
 setdate := FormatDateTime('dd/mm/yy', Now);
 if (FormatDateTime('hh:mm AM/PM', Now) = s) and
     (FormatDateTime('dd/mm/yy', Now) = SetDate) then
     memo1.lines.add(FormatDateTime('dd/mm/yy', Now)); }
 if button1.caption = 'Start program' then begin
   if ampmbox.Text = 'AM' then sety := TimeEdit.text + ' AM' else sety := TimeEdit.text + ' PM';
   memo1.lines.add('['+ FormatDateTime('hh:mm AM/PM dd/mm/yy', Now) + '] Program started.');
   memo1.lines.add('Folder will be created at: ['+ sety+']');
   button1.caption := 'Stop program';
   timer1.enabled := true;
   enablecomps(false);
 end
 else begin
  button1.caption := 'Start program';
  memo1.lines.add('['+ FormatDateTime('hh:mm AM/PM dd/mm/yy', Now) + '] Program stopped.');
  timer1.interval := 5000;
  timer1.enabled := false;
  enablecomps(true);
 end;
end;

procedure tform1.enablecomps(s: boolean);
begin
  edit1.enabled := s;
  edit2.enabled := s;
  timeedit.enabled := s;
  ampmbox.enabled := s;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
dtimenow: string;
settime: string;
folder: string;
begin
  dtimenow := FormatDateTime('hh:mm AM/PM', Now);
  if dtimenow = sety then begin
    folder := IncludeTrailingPathDelimiter(edit1.text) + FormatDateTime('mmmm_dd_yyyy', Now);
    memo1.lines.add('['+ formatdatetime('hh:mm AM/PM', now)+ '] Creating folder: '+ folder);
    // create folder
    if CreateDir(folder) then begin
      memo1.lines.add('Folder created.');
      // create shortcut to folder
      try
        CreateLink(folder, edit2.text);
        memo1.lines.add('Link created.');
      except
        memo1.lines.add('Error creating link: '+edit2.text);
      end;
    end else memo1.lines.add('Error creating folder: '+folder);


    //skip an hour.
    if timer1.Interval = 5000 then timer1.Interval := 3900000 else timer1.Interval := 5000;
  end;
end;

procedure Tform1.CreateLink(zpadpath, linkfolderpath: string);
var
   IObject : IUnknown;
   ISLink : IShellLink;
   IPFile : IPersistFile;
   //InFolder : array[0..MAX_PATH] of Char;
   TargetName : String;
   LinkName : WideString;
begin
   TargetName := zpadpath;
   IObject := CreateComObject(CLSID_ShellLink) ;
   ISLink := IObject as IShellLink;
   IPFile := IObject as IPersistFile;
   with ISLink do
   begin
     SetPath(pChar(TargetName)) ;
     SetWorkingDirectory(pChar(ExtractFilePath(TargetName))) ;
   end;
   LinkName := linkfolderpath;
   IPFile.Save(PWChar(LinkName), false) ;
end;

procedure TForm1.AmPmBoxKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_UP) or (Key = VK_DOWN) or (Key = VK_LEFT) or
     (Key = VK_RIGHT) or (Key = VK_PRIOR) or (Key = VK_NEXT) then
     if AmPmBox.ItemIndex = 0 then AmPmBox.ItemIndex := 1 else AmPmBox.ItemIndex := 0;
  Key := 0;
end;

procedure TForm1.AmPmBoxKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = 'p') or (Key = 'P') then begin
    AmPmBox.ItemIndex := 1;
    AmPmBox.SelStart := 0;
  end else
  if (Key = 'a') or (Key = 'A') then begin
    AmPmBox.ItemIndex := 0;
    AmPmBox.SelStart := 0;
  end;
  Key := #0;
end;

procedure TForm1.Edit2Exit(Sender: TObject);
begin
  if pos('lnk', edit2.text) = 0 then begin
    edit2.text := 'c:\Today.lnk';
    showmessage('The link must end in: lnk');
  end;
end;

procedure TForm1.Restore1Click(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_SHOW);
  ShowWindow(Application.Handle, SW_RESTORE);
  Application.BringToFront;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  application.terminate;
end;

end.