home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 August / CICA.cdr / unzipped / util / wtch11 / wtouch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-13  |  7.3 KB  |  265 lines
  1. {****  WTouch 1.1 Copyright 1992 Doug Overmyer ********}
  2. program WTouch;
  3. {$R wtouch.RES}
  4. uses WinTypes, WinProcs, WObjects, StdDlgs,Strings,windos,commdlg,
  5.         win31,sclptext;
  6. const
  7.   WT_Name =  'WTouch';
  8.   id_StH       = 101;
  9.   id_STJ       = 201;
  10.   idm_WTChange = 301;
  11.   idm_WTShowHide=302;
  12.   id_Ec1       = 401;
  13.   id_Ec2       = 402;
  14.   id_Ec3       = 403;
  15.   id_Ec4       = 404;
  16.   id_Ec5       = 405;
  17.   id_Ec6       = 406;
  18.   id_About     = 501;
  19.   id_CMGetFiles =601;
  20.   id_CMGetDateTime = 602;
  21.   id_CMDOIT =    603;
  22.   id_CMExit =    610;
  23. {**********************  TYPES      ******************************}
  24. type
  25.   TWTApp = object(TApplication)
  26.   procedure InitMainWindow; virtual;
  27. end;
  28. type
  29. DTRec= Record
  30.     Yr,Mo,Dy,Hr,Mn,Ss:Array[0..4] of Char;
  31. end;
  32. PWTWindow = ^TWTWindow;
  33. TWTWindow = object(TWindow)
  34.   StH,StJ:PSText;
  35.   FilesBuf:PChar;
  36.   DT:TDateTime;
  37.   DTTfRec:DTRec;
  38.      CurDtTime:LongInt;
  39.   constructor Init(ATitle: PChar);
  40.   destructor Done; virtual;
  41.   procedure SetupWindow;virtual;
  42.   procedure CMGetFiles(Var Msg:TMessage);virtual cm_First+id_CMGetFiles;
  43.   procedure CMGetDateTime(var Msg:TMessage);virtual cm_First+id_CMGetDateTime;
  44.   procedure CMDOIT(Var Msg:TMessage);virtual cm_First+id_CMDOIT;
  45.   procedure CMExxit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  46.   procedure SetHeader(Msg:Pchar);
  47.   procedure GetDefaultDT;
  48.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  49. end;
  50. {*********************  Functions  *******************************}
  51. function StrTok(P:PChar;C:Char):PChar;
  52. const
  53.     Next:Pchar = nil;
  54. begin
  55.     if P = NIL then P := Next;
  56.   if P <> NIL then
  57.       begin
  58.       Next := StrScan(P,C);
  59.       If Next <> NIL then
  60.           begin
  61.         Next^ := #0;
  62.         Next := Next+1;
  63.           end;
  64.       end;
  65.   StrTok := P;
  66. end;
  67. {**********************  METHODS    ******************************}
  68. procedure TWTApp.InitMainWindow;
  69. begin
  70.   MainWindow := New(PWTWindow, Init(WT_Name));
  71. end;
  72. {**********************  TWTWindow  *******************************}
  73. constructor TWTWindow.Init(ATitle: PChar);
  74. var
  75.   Indx:Integer;
  76. begin
  77.   TWindow.Init(nil, ATitle);
  78.   with Attr do
  79.     begin
  80.     X := 50; Y := 50; W := 305; H := 100;
  81.          Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  82.     Menu := LoadMenu(hInstance,'WT_Menu');
  83.     end;
  84.   StH := New(PSText,Init(@Self,id_StH,'',15,30,275,20,sr_Recessed,
  85.               dt_Center or dt_VCenter or dt_SingleLine));
  86.   StJ := New(PSText,Init(@Self,id_StJ,'',35,5,235,20,sr_Recessed,
  87.               dt_Center or dt_VCenter or dt_SingleLine));
  88.   GetMem(FilesBuf,4096);
  89.   StrCopy(FilesBuf,'');
  90. end;
  91.  
  92. destructor TWTWindow.Done;
  93. begin
  94.     FreeMem(FilesBuf,4096);
  95.   TWindow.Done;
  96. end;
  97.  
  98. procedure TWTWindow.SetupWindow;
  99. var
  100.   SysMenu:HMenu;
  101. begin
  102.   TWindow.SetupWindow;
  103.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'WT_Icon'));
  104.   SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  105.   Sysmenu := GetSystemMenu(hWindow,false);
  106.   AppendMenu(SysMenu,MF_Separator,0,nil);
  107.   AppendMenu(Sysmenu,0,id_About,'About...');
  108.   GetDefaultDT;
  109. end;
  110.  
  111. procedure TWTWindow.GetDefaultDT;
  112. var
  113.  Fil:Word;
  114. begin 
  115.     GetDate(DT.Year, DT.Month,DT.Day,fil);
  116.   GetTime(DT.Hour,DT.Min,DT.Sec,fil);
  117.   with DT, DTTfRec do
  118.       begin
  119.       Str(Year,Yr); Str(Month,Mo);Str(Day,Dy);
  120.       Str(Hour,Hr); Str(Min,Mn);Str(Sec,Ss);
  121.     end;
  122.   SetHeader('');
  123. end;
  124.  
  125. procedure TWTWindow.SetHeader(Msg:PChar);
  126. var
  127.  Buf:Array[0..200] of Char;
  128. begin
  129.   wvsprintf(Buf,'New Date/Time:',DT);
  130.   StJ^.SetText(Buf);
  131.   wvsprintf(Buf,'YMD:%04u/%02u/%02u   H:M:S %02u:%02u:%02u',DT);
  132.   StH^.SetText(Buf);
  133. end;
  134.  
  135. procedure TWTWindow.CMGetFiles(var Msg:TMessage);
  136. const
  137.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  138. var
  139.   Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  140.     szDirName:Array[0..256] of Char;
  141.   szFile,szFileTitle:Array[0..512] of Char;
  142.   OFN:TOpenFileName;
  143.   P:PChar;
  144. begin
  145.     StrCopy(FilesBuf,'');
  146.   OFN.lStructSize := sizeof(TOpenFileName);
  147.   OFN.hWndOwner := HWindow;
  148.   OFN.lpStrFilter := @szFilter;
  149.   OFN.lpStrCustomFilter := nil;
  150.   OFN.nMaxCustFilter := 0;
  151.   OFN.nFilterIndex := LongInt(1);
  152.   OFN.lpStrFile := FilesBuf;
  153.   OFN.nMaxFile := 4096;
  154.   OFN.lpstrfileTitle := szFileTitle;
  155.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  156.   OFN.lpstrInitialDir := NIL;
  157.   OFN.lpStrTitle := 'Select Files';
  158.   OFN.flags := OFN_ALLOWMULTISELECT;
  159.   OFN.nFileOffset := 0;
  160.   OFN.nFileExtension := 0;
  161.   OFN.lpstrDefext := nil;
  162.   GetOpenFileName(OFN)
  163. end;
  164.  
  165. procedure TWTWindow.CMGetDateTime(var Msg:TMessage);
  166. var
  167.     Ec1,Ec2,Ec3,Ec4,Ec5,Ec6:PEdit;
  168.   Dlg1:PDialog;
  169.   Error:Integer;
  170. begin
  171.     Dlg1 := New(PDialog,Init(@Self,'WT_DT'));
  172.   New(Ec1,InitResource(Dlg1,id_Ec1,5));
  173.   New(Ec2,InitResource(Dlg1,id_Ec2,5));
  174.   New(Ec3,InitResource(Dlg1,id_Ec3,5));
  175.   New(Ec4,InitResource(Dlg1,id_Ec4,5));
  176.   New(Ec5,InitResource(Dlg1,id_Ec5,5));
  177.   New(Ec6,InitResource(Dlg1,id_Ec6,5));
  178.   Dlg1^.TransferBuffer := @DTTfRec;
  179.   Application^.ExecDialog(Dlg1);
  180.     with DTTfRec,DT do
  181.   begin
  182.      val(Yr,Year,Error);val(Mo,Month,Error);val(Dy,Day,Error);
  183.   val(Hr,Hour,Error);val(Mn,Min,Error);val(Ss,Sec,Error);
  184.   end;
  185.   If (DT.Year > 1999) or (Dt.Month > 12) or (DT.Day > 31) or
  186.        (DT.Hour > 23) or (Dt.Min > 59) or (Dt.Sec > 59) or
  187.      (DT.Year < 1980) then
  188.      begin
  189.      Messagebox(HWindow,'Impossible Date/Time - Try again',
  190.          'Error',mb_IconExclamation);
  191.      GetDefaultDT;
  192.      end;
  193.     SetHeader('');
  194. end;
  195.  
  196. procedure TWTWindow.CMDOIT(var Msg:TMessage);
  197. var
  198.  Path,PathName:Array[0..69] of Char;
  199.  FName:Array[0..18] of Char;
  200.  pResult:PChar;
  201.  Files:PStrCollection;
  202.  Indx,Error:Integer;
  203.  F:File;
  204.  M1:Array[0..50] of Char;
  205. begin
  206.   PackTime(DT,CurDtTime);
  207.     if StrLen(FilesBuf) = 0 then                {0 files - no cigar}
  208.       begin
  209.       MessageBox(HWindow,'Please select files first','Now get this...',mb_IconExclamation);
  210.     Exit;
  211.     end;
  212.     Files := New(PStrCollection,Init(10,10));
  213.     pResult := StrScan(FilesBuf,' ');
  214.   if pResult = NIL then                       {1 file only}
  215.       Files^.Insert(StrNew(FilesBuf))
  216.   else                                        {2 or more  }
  217.       begin
  218.     pResult := StrTok(FilesBuf,' ');          {get the path}
  219.     StrCopy(Path,pResult);
  220.     SetCurDir(Path);                          {chdir there}
  221.     pResult := StrTok(NIL,' ');               {get the 1st filename}
  222.     while pResult <> NIL do
  223.         begin
  224.       FileExpand(PathName,pResult);           {expand file name}
  225.         Files^.Insert(StrNew(PathName));        {store it in collection}
  226.         pResult := StrTok(NIL,' ');             {get next file name}
  227.         end;
  228.     end;
  229.   for Indx := 0 to (Files^.Count -1) do       {process the selected files}
  230.       begin
  231.     pResult := Files^.At(Indx);
  232.     Assign(F,PResult);
  233.     Reset(F);
  234.     SetFTime(F,CurDtTime);
  235.     Close(F);
  236.     end;
  237.   wvsprintf(M1,'%i Files were changed',Files^.Count);
  238.   MessageBox(HWindow,M1,'WTouch',0);
  239.   Dispose(Files,Done);                         {clean up collection}
  240. end;
  241.  
  242. procedure TWTWindow.CMExxit(var Msg:TMessage);
  243. begin
  244.     CloseWindow;
  245. end;
  246.  
  247. procedure    TWTWindow.WMSysCommand(var Msg:TMessage);
  248. begin
  249.     case Msg.Wparam of
  250.         id_About:
  251.              application^.ExecDialog(New(PDialog,Init(@Self,'WT_About')));
  252.        else
  253.            DefWndProc(Msg);
  254.        end;
  255. end;
  256.  
  257. {**********************  MainLine   *******************************}
  258. var
  259.   WTApp: TWTApp;
  260. begin
  261.   WTApp.Init(WT_Name);
  262.   WTApp.Run;
  263.   WTApp.Done;
  264. end.
  265.