{****  WTouch 1.0 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;
  um_ReSize    = 401;
  id_About     = 501;
  id_CMGetFiles =601;
  id_CMDOIT =    602;
  id_CMExit =    610;
{**********************  TYPES      ******************************}
type
  TWTApp = object(TApplication)
  procedure InitMainWindow; virtual;
end;

PWTWindow = ^TWTWindow;
TWTWindow = object(TWindow)
  StH,StJ:PSText;
  FilesBuf:PChar;
 	CurTime:LongInt;
  constructor Init(ATitle: PChar);
  destructor Done; virtual;
  procedure SetupWindow;virtual;
  procedure IDCMGetFiles(Var Msg:TMessage);virtual cm_First+id_CMGetFiles;
  procedure IDCMDOIT(Var Msg:TMessage);virtual cm_First+id_CMDOIT;
  procedure IDCMExit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  procedure SetHeader(Msg:Pchar);
  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,'',15,5,275,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...');
  SetHeader('');
	end;

procedure TWTWindow.SetHeader(Msg:PChar);
var
 Buf:Array[0..200] of Char;
 DT:TDateTime;
 Fil:Word;
begin
	GetDate(DT.Year, DT.Month,DT.Day,fil);
  GetTime(DT.Hour,DT.Min,DT.Sec,fil);
  PackTime(DT,CurTime);
  wvsprintf(Buf,'The file Date/Time stamp will be set to...',DT);
  StJ^.SetText(Buf);
  wvsprintf(Buf,'YMD:%u/%u/%u   H:M:S %2u:%2u:%2u',DT);
  StH^.SetText(Buf);
end;

procedure TWTWindow.IDCMGetFiles(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.IDCMDOIT(var Msg:TMessage);
var
 Path,PathName:Array[0..69] of Char;
 FName:Array[0..18] of Char;
 pResult:PChar;
 Files:PStrCollection;
 Indx:Integer;
 F:File;
begin
	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,CurTime);
    Close(F);
    end;
  Dispose(Files,Done);                         {clean up collection}
end;

procedure TWTWindow.IDCMExit(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.