CompactDatabaseReminder

From 40tude Dialog Wiki

Original by by matija krnic (matija.krnic -at- zg.htnet.hr)
Revised version for Dialog Beta 37 (2.0.14.1) by Lars Biskupek (l.biskupek -at- gmx.de)

---

// an onStartup script that reminds you to compact your database :)
// written by matija krnic (matija.krnic -at- zg.htnet.hr)
// this script only works properly on NTFS file systems, as FAT doesn't
// have the "last created" date/time, just the "last modified" one.
// there's a workaround, but it'll fail each time you set the default
// group options. if you don't touch them (which is, i guess, what most
// people do since you don't need to alter them after you've configured
// them once), the script works normally.

// changed by Lars Biskupek from an OnShutdown to an OnStartup-script 
// and made use of the new DoLater-comand to make it work under Beta 37

program OnStartup;
        
const
  // the path to the 'default.ini' file in your dialog's data folder
  myDialogDataINI = 'c:\programe files\40tude dialog\data\default.ini';

  // set this to true if dialog's installed on a FAT partition
  hackFAT = false;
  
  // the time that needs to pass between the last compaction date and
  // the current time. the number is specified in days and defaults to 7,
  // but fractions are possible: 7.5 would warn you if seven and a half
  // days passed since the last time the database was compacted.
  remindAfter = 7;

  // the text in the message box that pops up when it's time to compact.
  // the '%days%' variable will contain the number specified above.  
  // the '%lastcompact%' variable will contain the date and time
  // the database was last compacted on.
  mbReminderWarning = 'Your database was last compacted on %lastcompact% and it''s already been more than %days% day(s) since. Compact now?';
  
  // message box caption
  mbCaption = 'Compact database reminder';



// ----------------------------------------------------------------------
// nothing to change down below, go away! ;)
// ----------------------------------------------------------------------


type
  // this holds the date and time for a file
  tFileTime = record
    dwLowDateTime: integer;
    dwHighDateTime: integer;
  end;

  // and this holds the actual, readable stuff
  tSystemTime = record
    wYear: Word;
    wMonth: Word;
    wDayOfWeek: Word;
    wDay: Word;
    wHour: Word;
    wMinute: Word;
    wSecond: Word;
    wMilliseconds: Word;
  end;


const
  // createFile() constants
  GENERIC_READ = $80000000;
  FILE_SHARE_READ = $00000001;
  FILE_ATTRIBUTE_NORMAL = $00000080;
  OPEN_EXISTING = 3;

  // message box constants
  MB_YESNO = 4; 
  IDYES = 6;
  IDNO = 7;

  
var
  // holds the file handle
  fHandle : THandle;      

  // tFileTime variables; we only use the creation time in this script
  myCreationTime, myLastAccessTime, myLastWriteTime : tFileTime;
  
  // the original file date and time
  myUTCSystemTime : tSystemTime;
  
  // file date and time with time zone compensation
  mySystemTime : tSystemTime;
  
  // these will hold the date and time values in pascal-usable form
  myFileDate, myFileTime, myFileDateTime : tDateTime;
  
  // the final messagebox string
  myReminderWarning : string;


// imported functions. god bless delphi's RTL source and the wonders of copy and paste.
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: integer; lpSecurityAttributes: pchar; dwCreationDisposition, dwFlagsAndAttributes: integer; hTemplateFile: THandle): THandle; external 'CreateFileA@kernel32.dll stdcall';
function CloseHandle(hObject: THandle): boolean; external 'CloseHandle@kernel32.dll stdcall';
function GetFileTime(hFile: integer; var lpCreationTime, lpLastAccessTime, lpLastWriteTime: tFileTime): boolean; external 'GetFileTime@kernel32.dll stdcall';
function FileTimeToSystemTime(lpFileTime: TFileTime; var lpSystemTime: TSystemTime): boolean; external 'FileTimeToSystemTime@kernel32.dll stdcall';
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: pchar; var lpUniversalTime, lpLocalTime: TSystemTime): boolean; external 'SystemTimeToTzSpecificLocalTime@kernel32.dll stdcall';
function MessageBox(hWnd: longword; lpText, lpCaption: PChar; uType: longword): Integer; external 'MessageBoxA@user32.dll stdcall';

procedure DatabaseReminder;
Begin
  // we need a special file handle, normal ones won't do
  fHandle := createFile(myDialogDataINI, GENERIC_READ, FILE_SHARE_READ, '', OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  // obtain the file creation, access and modified times
  getFileTime(fHandle, myCreationTime, myLastAccessTime, myLastWriteTime);
  closeHandle(fHandle); 
  
  // FAT file system "workaround"
  if hackFAT
    // transform last modified file time into system time
    then fileTimeToSystemTime(myLastWriteTime, myUTCSystemTime)
    // transform creation file time into system time
    else fileTimeToSystemTime(myCreationTime, myUTCSystemTime);
  
  // compensate for the local time zone
  systemTimeToTzSpecificLocalTime('', myUTCSystemTime, mySystemTime);

  // encode the system time into two tDateTime structures and merge them  
  myFileDate := encodeDate(mySystemTime.wYear, mySystemTime.wMonth, mySystemTime.wDay);
  myFileTime := encodeTime(mySystemTime.wHour, mySystemTime.wMinute, mySystemTime.wSecond, mySystemTime.wMilliseconds);
  myFileDateTime := myFileDate + myFileTime;

  // check the number of days that have passed between the current date/time
  // and the last compact date
  if (now - myFileDateTime) >= remindAfter then    
  begin
    // replace the '%date%' in the reminder warning text with the actual number
    // and the '%lastcompact%' with the string-formatted last compact date
    myReminderWarning := stringReplace(mbReminderWarning, '%days%', floatToStrF(remindAfter, ffGeneral, 15, 1), [rfReplaceAll]);
    myReminderWarning := stringReplace(myReminderWarning, '%lastcompact%', dateTimeToStr(myFileDateTime), [rfReplaceAll]);

    // pop up a message box and see if the user wants to compact
    if (MessageBox(0, myReminderWarning, mbCaption, MB_YESNO) = IDYES) 
      then ADoLater('CompactDatabase');                                                 
  end;    

End;

procedure OnStartup;  
begin          
  DatabaseReminder;
end;


begin
  
end.

---

Script by matija (modified by Bisku)