{****  WTouch 1.1 Copyright 1992 Doug Overmyer ********}
program WTouch;
{$R wtouch.RES}
uses WinTypes, WinProcs, WObjects, StdDlgs,Strings,windos,commdlg,
		win31,sclptext;
const
  WT_Name =  'WTouch';
  id_StH       = 101;
  id_STJ       = 201;
  idm_WTChange = 301;
  idm_WTShowHide=302;
  id_Ec1       = 401;
  id_Ec2       = 402;
  id_Ec3       = 403;
  id_Ec4       = 404;
  id_Ec5       = 405;
  id_Ec6       = 406;
  id_About     = 501;
  id_CMGetFiles =601;
  id_CMGetDateTime = 602;
  id_CMDOIT =    603;
  id_CMExit =    610;
{**********************  TYPES      ******************************}
type
  TWTApp = object(TApplication)
  procedure InitMainWindow; virtual;
end;
type
DTRec= Record
	Yr,Mo,Dy,Hr,Mn,Ss:Array[0..4] of Char;
end;
PWTWindow = ^TWTWindow;
TWTWindow = object(TWindow)
  StH,StJ:PSText;
  FilesBuf:PChar;
  DT:TDateTime;
  DTTfRec:DTRec;
 	CurDtTime:LongInt;
  constructor Init(ATitle: PChar);
  destructor Done; virtual;
  procedure SetupWindow;virtual;
  procedure CMGetFiles(Var Msg:TMessage);virtual cm_First+id_CMGetFiles;
  procedure CMGetDateTime(var Msg:TMessage);virtual cm_First+id_CMGetDateTime;
  procedure CMDOIT(Var Msg:TMessage);virtual cm_First+id_CMDOIT;
  procedure CMExxit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  procedure SetHeader(Msg:Pchar);
  procedure GetDefaultDT;
  procedure	WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
end;
{*********************  Functions  *******************************}
function StrTok(P:PChar;C:Char):PChar;
const
	Next:Pchar = nil;
begin
	if P = NIL then P := Next;
  if P <> NIL then
  	begin
  	Next := StrScan(P,C);
  	If Next <> NIL then
  		begin
    	Next^ := #0;
    	Next := Next+1;
  		end;
  	end;
  StrTok := P;
end;
{**********************  METHODS    ******************************}
procedure TWTApp.InitMainWindow;
begin
  MainWindow := New(PWTWindow, Init(WT_Name));
end;
{**********************  TWTWindow  *******************************}
constructor TWTWindow.Init(ATitle: PChar);
var
  Indx:Integer;
begin
  TWindow.Init(nil, ATitle);
  with Attr do
    begin
    X := 50; Y := 50; W := 305; H := 100;
 		Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
    Menu := LoadMenu(hInstance,'WT_Menu');
    end;
  StH := New(PSText,Init(@Self,id_StH,'',15,30,275,20,sr_Recessed,
  			dt_Center or dt_VCenter or dt_SingleLine));
  StJ := New(PSText,Init(@Self,id_StJ,'',35,5,235,20,sr_Recessed,
  			dt_Center or dt_VCenter or dt_SingleLine));
  GetMem(FilesBuf,4096);
  StrCopy(FilesBuf,'');
end;

destructor TWTWindow.Done;
begin
	FreeMem(FilesBuf,4096);
  TWindow.Done;
end;

procedure TWTWindow.SetupWindow;
var
  SysMenu:HMenu;
begin
  TWindow.SetupWindow;
  SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'WT_Icon'));
  SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  Sysmenu := GetSystemMenu(hWindow,false);
  AppendMenu(SysMenu,MF_Separator,0,nil);
  AppendMenu(Sysmenu,0,id_About,'About...');
  GetDefaultDT;
end;

procedure TWTWindow.GetDefaultDT;
var
 Fil:Word;
begin 
	GetDate(DT.Year, DT.Month,DT.Day,fil);
  GetTime(DT.Hour,DT.Min,DT.Sec,fil);
  with DT, DTTfRec do
  	begin
  	Str(Year,Yr); Str(Month,Mo);Str(Day,Dy);
  	Str(Hour,Hr); Str(Min,Mn);Str(Sec,Ss);
    end;
  SetHeader('');
end;

procedure TWTWindow.SetHeader(Msg:PChar);
var
 Buf:Array[0..200] of Char;
begin
  wvsprintf(Buf,'New Date/Time:',DT);
  StJ^.SetText(Buf);
  wvsprintf(Buf,'YMD:%04u/%02u/%02u   H:M:S %02u:%02u:%02u',DT);
  StH^.SetText(Buf);
end;

procedure TWTWindow.CMGetFiles(var Msg:TMessage);
const
  szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
var
  Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
	szDirName:Array[0..256] of Char;
  szFile,szFileTitle:Array[0..512] of Char;
  OFN:TOpenFileName;
  P:PChar;
begin
	StrCopy(FilesBuf,'');
  OFN.lStructSize := sizeof(TOpenFileName);
  OFN.hWndOwner := HWindow;
  OFN.lpStrFilter := @szFilter;
  OFN.lpStrCustomFilter := nil;
  OFN.nMaxCustFilter := 0;
  OFN.nFilterIndex := LongInt(1);
  OFN.lpStrFile := FilesBuf;
  OFN.nMaxFile := 4096;
  OFN.lpstrfileTitle := szFileTitle;
  OFN.nMaxFileTitle := sizeof(szFileTitle);
  OFN.lpstrInitialDir := NIL;
  OFN.lpStrTitle := 'Select Files';
  OFN.flags := OFN_ALLOWMULTISELECT;
  OFN.nFileOffset := 0;
  OFN.nFileExtension := 0;
  OFN.lpstrDefext := nil;
  GetOpenFileName(OFN)
end;

procedure TWTWindow.CMGetDateTime(var Msg:TMessage);
var
	Ec1,Ec2,Ec3,Ec4,Ec5,Ec6:PEdit;
  Dlg1:PDialog;
  Error:Integer;
begin
	Dlg1 := New(PDialog,Init(@Self,'WT_DT'));
  New(Ec1,InitResource(Dlg1,id_Ec1,5));
  New(Ec2,InitResource(Dlg1,id_Ec2,5));
  New(Ec3,InitResource(Dlg1,id_Ec3,5));
  New(Ec4,InitResource(Dlg1,id_Ec4,5));
  New(Ec5,InitResource(Dlg1,id_Ec5,5));
  New(Ec6,InitResource(Dlg1,id_Ec6,5));
  Dlg1^.TransferBuffer := @DTTfRec;
  Application^.ExecDialog(Dlg1);
	with DTTfRec,DT do
  begin
 	val(Yr,Year,Error);val(Mo,Month,Error);val(Dy,Day,Error);
  val(Hr,Hour,Error);val(Mn,Min,Error);val(Ss,Sec,Error);
  end;
  If (DT.Year > 1999) or (Dt.Month > 12) or (DT.Day > 31) or
  	 (DT.Hour > 23) or (Dt.Min > 59) or (Dt.Sec > 59) or
     (DT.Year < 1980) then
     begin
     Messagebox(HWindow,'Impossible Date/Time - Try again',
     	'Error',mb_IconExclamation);
     GetDefaultDT;
     end;
	SetHeader('');
end;

procedure TWTWindow.CMDOIT(var Msg:TMessage);
var
 Path,PathName:Array[0..69] of Char;
 FName:Array[0..18] of Char;
 pResult:PChar;
 Files:PStrCollection;
 Indx,Error:Integer;
 F:File;
 M1:Array[0..50] of Char;
begin
  PackTime(DT,CurDtTime);
	if StrLen(FilesBuf) = 0 then                {0 files - no cigar}
  	begin
  	MessageBox(HWindow,'Please select files first','Now get this...',mb_IconExclamation);
    Exit;
    end;
	Files := New(PStrCollection,Init(10,10));
	pResult := StrScan(FilesBuf,' ');
  if pResult = NIL then                       {1 file only}
  	Files^.Insert(StrNew(FilesBuf))
  else                                        {2 or more  }
  	begin
    pResult := StrTok(FilesBuf,' ');          {get the path}
    StrCopy(Path,pResult);
    SetCurDir(Path);                          {chdir there}
    pResult := StrTok(NIL,' ');               {get the 1st filename}
    while pResult <> NIL do
    	begin
      FileExpand(PathName,pResult);           {expand file name}
    	Files^.Insert(StrNew(PathName));        {store it in collection}
    	pResult := StrTok(NIL,' ');             {get next file name}
    	end;
    end;
  for Indx := 0 to (Files^.Count -1) do       {process the selected files}
  	begin
    pResult := Files^.At(Indx);
    Assign(F,PResult);
    Reset(F);
    SetFTime(F,CurDtTime);
    Close(F);
    end;
  wvsprintf(M1,'%i Files were changed',Files^.Count);
  MessageBox(HWindow,M1,'WTouch',0);
  Dispose(Files,Done);                         {clean up collection}
end;

procedure TWTWindow.CMExxit(var Msg:TMessage);
begin
	CloseWindow;
end;

procedure	TWTWindow.WMSysCommand(var Msg:TMessage);
begin
	case Msg.Wparam of
		id_About:
 			application^.ExecDialog(New(PDialog,Init(@Self,'WT_About')));
   	else
   		DefWndProc(Msg);
   	end;
end;

{**********************  MainLine   *******************************}
var
  WTApp: TWTApp;
begin
  WTApp.Init(WT_Name);
  WTApp.Run;
  WTApp.Done;
end.
