PC Multimidia 1997 February/PCMULTIMIDI.iso/util/fromscr/inctrl.pas

Pascal/Delphi Source File | 1992-04-01 | 37.0 KB | 1,139 lines

{$R-,S-,L-,D-}
PROGRAM InCtrl;
USES WinTypes, WinProcs, WObjects, Strings, WinDOS, StdDlgs, WinCrt,
  FileSrch, FileReco;
{$R InCtrl}
{$D Copyright (c) 1992 by Neil J. Rubenking}
{$I INCTRL.INC}
CONST
  AppName  : PChar = 'InCtrl';
  CWinFile : PChar = 'WIN.INI';
  CWinCopy : PChar = 'WININI.$$$';
  CSysFile : PChar = 'SYSTEM.INI';
  CSysCopy : PChar = 'SYSINI.$$$';
  CommDlg  : PChar = 'COMMDLG.DLL';
  BLen = 144;
CONST {CommDlg constants}
  ofn_ReadOnly             = $00000001;
  ofn_OverWritePrompt      = $00000002;
  ofn_HideReadOnly         = $00000004;
  ofn_NoChangeDir          = $00000008;
  ofn_ShowHelp             = $00000010;
  ofn_EnableHook           = $00000020;
  ofn_EnableTemplate       = $00000040;
  ofn_EnableTemplateHandle = $00000080;
  ofn_NoValidate           = $00000100;
  ofn_AllowMultiSelect     = $00000200;
  ofn_ExtentionDifferent   = $00000400;
  ofn_PathMustExist        = $00000800;
  ofn_FileMustExist        = $00001000;
  ofn_CreatePrompt         = $00002000;
  ofn_ShareAware           = $00004000;
  ofn_NoReadOnlyReturn     = $00008000;
TYPE
  FileNameBuffer = ARRAY[0..BLen] OF Char;

  POpenFilename = ^TOpenFilename;
  TOpenFilename = RECORD
    lStructSize        : LongInt;
    hwndOwner          : HWnd;
    hInstance          : THandle;
    lpstrFilter        : PChar;
    lpstrCustomFilter  : PChar;
    nMaxCustFilter     : LongInt;
    nFilterIndex       : LongInt;
    lpstrFile          : PChar;
    nMaxFile           : LongInt;
    lpstrFileTitle     : PChar;
    nMaxFileTitle      : LongInt;
    lpstrInitialDir    : PChar;
    lpstrTitle         : PChar;
    Flags              : LongInt;
    nFileOffset        : WORD;
    nFileExtension     : WORD;
    lpstrDefExt        : PChar;
    lCustData          : LongInt;
    lpfnHook           : FUNCTION (Wnd : HWnd; Msg, wParam : Word;
                           lParam : LongInt): Bool;
    lpTemplateName     : PChar;
  END;

  TCommDlgFunc = FUNCTION (VAR OpenFile : TOpenFilename) : Bool;

  TMyApplication = OBJECT(TApplication)
    PROCEDURE InitMainWindow; virtual;
  END;

  PCanHideIcon = ^TCanHideIcon;
  TCanHideIcon = OBJECT(TStatic)
    Hidden : Boolean;
    PROCEDURE wmPaint(VAR Msg : TMessage); Virtual wm_First +
      wm_Paint;
    PROCEDURE Paint(PDC: HDC; VAR PS : TPaintStruct); Virtual;
    PROCEDURE Hide(DoIt : Boolean);
  END;

  PInstallData = ^TInstallData;
  TInstallData = RECORD
    ReptFile           : Text;
    DirList            : PStrCollection;
    FileList           : PFileRecordList;
    NumFiles, NumDirs,
    DelFiles, DelDirs,
    ChFiles,  ChDirs,
    NumSects, NumKeys,
    NumKeyCh           : Word;
  END;

  PInCtrlDialog = ^TInCtrlDialog;
  TInCtrlDialog = OBJECT(TDlgWindow)
    IData                : TInstallData;
    InstProg,  ReptName  : FileNameBuffer;
    InstProgS, ReptNameS : PStatic;
    InstProgI, ReptNameI : PCanHideIcon;
    Drives               : ARRAY['A'..'Z'] OF Boolean;
    LineBuff             : ARRAY[0..80] OF Char;
    CommDlgHandle        : THandle;
    GetOpenFileName,
    GetSaveFileName      : TCommDlgFunc;
    CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
    PROCEDURE SetUpWindow; Virtual;
    DESTRUCTOR Done; Virtual;
    FUNCTION GetClassName : PChar; Virtual;
    PROCEDURE GetWindowClass(var AWndClass : TWndClass); Virtual;
    PROCEDURE idHelp(VAR Msg : TMessage); Virtual id_First + id_Help;
    PROCEDURE idAbout(VAR Msg : TMessage); Virtual id_First +
      id_About;
    PROCEDURE idInstProgBtn(VAR Msg : TMessage); Virtual id_First +
      id_InstProgBtn;
    PROCEDURE idReptNameBtn(VAR Msg : TMessage); Virtual id_First +
      id_ReptNameBtn;
    PROCEDURE idPerform(VAR Msg : TMessage); Virtual id_First +
      id_Perform;
  END;

  FUNCTION ExistFile(Name : PChar) : Boolean;
  VAR
    F    : File;
    Attr : Word;
  BEGIN
    Assign(F, Name);
    GetFAttr(F, Attr);
    ExistFile := DosError = 0;
  END;

{--------------------------------------------------}
{ TCanHideIcon's methods                           }
{--------------------------------------------------}
  PROCEDURE TCanHideIcon.wmPaint(VAR Msg : TMessage);
  BEGIN
    IF Hidden THEN TWindow.wmPaint(Msg)
    ELSE DefWndProc(Msg);
  END;

  PROCEDURE TCanHideIcon.Paint(PDC : hDC; VAR PS : TPaintStruct);
  BEGIN
    FillRect(PDC, PS.rcPaint, GetStockObject(LtGray_Brush));
  END;

  PROCEDURE TCanHideIcon.Hide(DoIt : Boolean);
  BEGIN
    Hidden := DoIt;
    InvalidateRect(hWindow, NIL, TRUE);
  END;

{--------------------------------------------------}
{ TInCtrlDialog's methods                          }
{--------------------------------------------------}
  CONSTRUCTOR TInCtrlDialog.Init(AParent : PWindowsObject;
    AName : PChar);
  VAR SysDir : FileNameBuffer;
  BEGIN
    TDlgWindow.Init(AParent, AName);
    InstProg[0] := #0;
    ReptName[0] := #0;
    New(InstProgS, InitResource(@Self, id_InstProg, BLen));
    New(ReptNameS, InitResource(@Self, id_ReptName, BLen));
    New(InstProgI, InitResource(@Self, id_InstProgCk, 0));
    New(ReptNameI, InitResource(@Self, id_ReptNameCk, 0));
    InstProgI^.Hide(TRUE);
    ReptNameI^.Hide(TRUE);
    GetSystemDirectory(SysDir, BLen);
    StrCat(SysDir, '\');
    StrCat(SysDir, CommDlg);
    IF NOT ExistFile(SysDir) THEN CommDlgHandle := 0
    ELSE CommDlgHandle := LoadLibrary(CommDlg);
    IF CommDlgHandle >= 32 THEN
      BEGIN
        TFarProc(@GetOpenFileName) := GetProcAddress(CommDlgHandle,
          'GETOPENFILENAME');
        TFarProc(@GetSaveFileName) := GetProcAddress(CommDlgHandle,
          'GETSAVEFILENAME');
        IF (TFarProc(@GetOpenFileName) = NIL) OR
           (TFarProc(@GetSaveFileName) = NIL) THEN
          BEGIN
            FreeLibrary(CommDlgHandle);
            CommDlgHandle := 0;
          END;
      END
    ELSE CommDlgHandle := 0;
  END;

  PROCEDURE TInCtrlDialog.SetUpWindow;
  VAR
    PL    : PListBox;
    N, W  : Word;
    Drive : ARRAY[0..6] OF Char;
  BEGIN
    TDialog.SetUpWindow;
    New(PL, Init(@Self, 101, 0, 0, 0, 0));
      {-Invisible list box takes advantage of the Windows lb_Dir-}
      {-message to get a list of all drives on the system.      -}
    PL^.Attr.Style := PL^.Attr.Style AND NOT ws_Visible;
    PL := PListBox(Application^.MakeWindow(PL));
    SendMessage(PL^.hWindow, lb_Dir, $4000 + $8000,
      LongInt(PChar('*.*')));
    FillChar(Drives, SizeOf(Drives), FALSE);
    FOR N := 0 TO Pred(PL^.GetCount) DO
      BEGIN
        PL^.GetString(Drive, N);
          {-Drive now contains a string like "[-a-]" - next 2 lines-}
          {-strip the punctuation and uppercase the drive letter.  -}
        StrLCopy(drive, drive + 2, 1);
        StrUpper(drive);
        Drives[Drive[0]] :=
          GetDriveType(Ord(Drive[0])-Ord('A')) = Drive_Fixed;
        IF Drives[Drive[0]] THEN
          BEGIN
            W := GetPrivateProfileInt('Excluded drives', Drive, 0,
              'INCTRL.INI');
            IF W <> 0 THEN Drives[Drive[0]] := FALSE;
          END;
      END;
    Dispose(PL, Done);
  END;

  DESTRUCTOR TInCtrlDialog.Done;
  BEGIN
    IF CommDlgHandle <> 0 THEN FreeLibrary(CommDlgHandle);
    TDialog.Done;
  END;

  FUNCTION TInCtrlDialog.GetClassName;
  BEGIN
    GetClassName := AppName;
  END;

  PROCEDURE TInCtrlDialog.GetWindowClass(VAR AWndClass : TWndClass);
  BEGIN
    TDlgWindow.GetWindowClass(AWndClass);
    AWndClass.hIcon := LoadIcon(HInstance, AppName);
  END;

  PROCEDURE TInCtrlDialog.idHelp(VAR Msg : TMessage);
  BEGIN
    Application^.ExecDialog(New(PDialog,Init(@Self, 'InCtrlHelp')));
  END;

  PROCEDURE TInCtrlDialog.idAbout(VAR Msg : TMessage);
  BEGIN
    Application^.ExecDialog(New(PDialog,Init(@Self, 'InCtrlAbout')));
  END;

  PROCEDURE TInCtrlDialog.idInstProgBtn(VAR Msg : TMessage);
  CONST
    filter : PChar = 'All Executable'#0'*.exe;*.com;*.bat'#0+
                     'EXE'#0'*.exe'#0+
                     'COM'#0'*.com'#0+
                     'Batch'#0'*.bat'#0#0;
  VAR
    PFD              : PFileDialog;
    TOF              : TOpenFilename;
    ExistOk, Success : Boolean;
  BEGIN
    InstProgS^.GetText(InstProg, BLen);
    IF CommDlgHandle = 0 THEN
      BEGIN
        IF InstProg[0] = #0 THEN StrCopy(InstProg, '*.EXE');
        REPEAT
          ExistOk := TRUE;
          New(PFD, Init(@Self, PChar(sd_FileOpen), InstProg));
          PFD^.Caption := 'Installation Program';
          Success := Application^.ExecDialog(PFD) = IDOK;
          IF Success THEN
            BEGIN
              IF NOT ExistFile(InstProg) THEN
                 BEGIN
                   ExistOk := FALSE;
                   MessageBeep(mb_IconStop);
                   MessageBox(hWindow, 'File does not '+
                     'exist', InstProg, mb_Ok + mb_IconStop);
                 END;
            END;
        UNTIL ExistOk;
      END
    ELSE
      BEGIN
        FillChar(TOF, SizeOf(TOF), 0);
        WITH TOF DO
          BEGIN
            lStructSize   := SizeOf(TOF);
            hwndOwner     := hWindow;
            lpstrFilter   := filter;
            nFilterIndex  := 1;
            lpstrFile     := InstProg;
            nMaxFile      := BLen;
            lpstrTitle    := 'Installation Program';
            lpstrDefExt   := 'EXE';
            Flags         := ofn_FileMustExist OR ofn_HideReadOnly;
          END;
        Success := GetOpenFileName(TOF);
      END;
    IF Success THEN
      BEGIN
        StrUpper(InstProg);
        InstProgS^.SetText(InstProg);
        InstProgI^.Hide(FALSE);
          {-If the report file name has also been chosen, now is-}
          {-the time to enable the Perform button.              -}
        IF ReptName[0] <> #0 THEN
          EnableWindow(GetDlgItem(hWindow, id_Perform), TRUE);
      END;
  END;

  PROCEDURE TInCtrlDialog.idReptNameBtn(VAR Msg : TMessage);
  CONST filter : PChar = 'InCtrl Report (*.RPT)'#0'*.RPT'#0#0;
  VAR
    PFD              : PFileDialog;
    TOF              : TOpenFilename;
    ReptDir          : FileNameBuffer;
    WriteOk, Success : Boolean;
  BEGIN
    ReptNameS^.GetText(ReptName, BLen);
    GetPrivateProfileString('Directories', 'ReptDir', '',
      ReptDir, BLen, 'INCTRL.INI');
    IF ReptDir[0] <> #0 THEN
      BEGIN
        SetCurDir(ReptDir);
        IF DosError <> 0 THEN
          BEGIN
            MessageBeep(mb_IconInformation);
            MessageBox(hWindow, 'Invalid default report directory '+
              'in INCTRL.INI'^M'Using Windows directory instead.',
              ReptDir, mb_Ok + mb_IconInformation);
            ReptDir[0] := #0;
          END;
      END;
    IF ReptDir[0] = #0 THEN GetWindowsDirectory(ReptDir, BLen);
    IF CommDlgHandle = 0 THEN
      BEGIN
        IF ReptName[0] = #0 THEN StrCopy(ReptName, '*.RPT');
        SetCurDir(ReptDir);
        REPEAT
          WriteOk := TRUE;
          New(PFD, Init(@Self, PChar(sd_FileSave), ReptName));
          PFD^.Caption := 'Name for Output Report';
          Success := Application^.ExecDialog(PFD) = IDOK;
          IF Success THEN
            BEGIN
              IF ExistFile(ReptName) THEN
                 BEGIN
                   MessageBeep(mb_IconQuestion);
                   WriteOk := MessageBox(hWindow, 'File already '+
                     'exists.'^M'Replace existing file?', ReptName,
                     mb_YesNo + mb_IconInformation +
                     mb_DefButton2) = IDYES;
                 END;
            END;
        UNTIL WriteOk;
      END
    ELSE
      BEGIN
        FillChar(TOF, SizeOf(TOF), 0);
        WITH TOF DO
          BEGIN
            lStructSize     := SizeOf(TOF);
            hwndOwner       := hWindow;
            lpstrFilter     := filter;
            nFilterIndex    := 1;
            lpstrFile       := ReptName;
            nMaxFile        := BLen;
            lpstrInitialDir := ReptDir;
            lpstrTitle      := 'Name for Output Report';
            lpstrDefExt     := 'RPT';
            Flags           := ofn_HideReadOnly OR ofn_PathMustExist
                               OR ofn_OverwritePrompt;
          END;
        Success := GetSaveFileName(TOF);
      END;
    IF Success THEN
      BEGIN
        StrUpper(ReptName);
        ReptNameS^.SetText(ReptName);
        ReptNameI^.Hide(FALSE);
          {-If the install program name has also been chosen, now-}
          {-is the time to enable the Perform button.            -}
        IF InstProg[0] <> #0 THEN
          EnableWindow(GetDlgItem(hWindow, id_Perform), TRUE);
      END;
  END;

  VAR GlobalData : PInstallData;
    {-File search routines cannot be methods and hence don't have-}
    {-access to the data field IData.  This global variable is   -}
    {-simply set to *POINT* to IData.                            -}

  FUNCTION ListDir(VAR S : TSearchRec; P : PChar) : Byte; FAR;
    {-Passed to the FileSrch routines to get a list of directories.-}
  VAR Fullpath : ARRAY[0..144] OF Char;
  BEGIN
    ListDir := 0;
    IF S.Attr AND faDirectory = 0 THEN Exit;
    IF S.Name[0] = '.' THEN Exit;
    StrCopy(FullPath, P);
    StrCat(FullPath, S.Name);
    IF StrLen(FullPath) > 3 THEN StrCat(FullPath, '\');
    GlobalData^.DirList^.Insert(StrNew(fullPath));
  END;

  FUNCTION Snap(VAR S : TSearchRec; P : PChar) : Byte; FAR;
    {-Passed to the routines in the FileSrch unit. Assumes that-}
    {-DirList is initialized with a list of all directories.   -}
  VAR Indx : Integer;
  BEGIN
    Snap := 0;
      {-Ignore . and .. entries. -}
    IF S.Name[0] = '.' THEN Exit;
    Snap := 128;
    IF LowMemory THEN Exit;
    Snap := 129;
    WITH GlobalData^ DO
      BEGIN
        IF FileList^.Count = 16380 THEN Exit;
        Snap := 0;
        DirList^.Search(P, Indx);
        WITH S DO
          FileList^.Insert(New(PFileRecord, Init(Name,
            Attr AND faDirectory <> 0, Indx, Time, Size, DirList)));
      END;
  END;

  FUNCTION UnSnap(VAR S : TSearchRec; P : PChar) : Byte; FAR;
    {-Passed to the routines in the FileSrch unit-}
  VAR
    Indx     : Integer;
    PFR      : PFileRecord;
    Found    : Boolean;
  BEGIN
    UnSnap := 128;
    IF LowMemory THEN Exit;
    UnSnap := 0;
    IF S.Name[0] = '.' THEN Exit;
    WITH GlobalData^ DO
      BEGIN
        IF NOT DirList^.Search(P, Indx) THEN Found := FALSE
        ELSE
          BEGIN
            New(PFR, Init(S.Name, FALSE, Indx, 0, 0, DirList));
            Found := FileList^.Search(PFR, Indx);
            Dispose(PFR, Done);
          END;
        IF Found THEN
          BEGIN
              {-If the item is on the list of existing files, -}
              {-see if it changed.  If not changed, ditch it! -}
            PFR := FileList^.At(Indx);
            IF (PFR^.GetTime <> S.Time) OR
               (PFR^.GetSize <> S.Size) THEN
              PFR^.SetChanged
            ELSE FileList^.AtFree(Indx)
          END
        ELSE
          BEGIN
            IF S.Attr AND faDirectory <> 0 THEN
              BEGIN
                Inc(NumDirs);
                Write(ReptFile, 'DIR : ');
              END
            ELSE
              BEGIN
                Inc(NumFiles);
                Write(ReptFile, 'FILE: ');
              END;
            WriteLn(ReptFile, P, S.Name);
          END;
        END;
  END;

  PROCEDURE TInCtrlDialog.idPerform(VAR Msg : TMessage);
  CONST Mask : PChar = '?:\*.*';
  VAR
    PD                : PDialog;
    WinFile, WinCopy,
    SysFile, SysCopy  : PChar;
    W, WinDirLen      : Word;

    PROCEDURE Gasp;
    VAR Mpeek : TMsg;
    BEGIN
      WHILE PeekMessage(mPeek, 0, 0, 0, PM_Remove) DO
        BEGIN
          IF mPeek.Message = WM_QUIT THEN
            BEGIN
              Application^.Done;
              Halt;
            END;
          TranslateMessage(mPeek);
          DispatchMessage(mPeek);
        END;
    END;

    PROCEDURE WarnWait(Message : PChar);
    BEGIN
      PD := New(PDialog, Init(@Self, 'WaitWarn'));
      PD := PDialog(Application^.MakeWindow(PD));
      SetDlgItemText(pd^.hWindow, id_WaitReason, Message);
      PD^.Show(sw_ShowNormal);
        {-"Gasp" so Windows can process the messages that display-}
        {-the dialog and its controls.                           -}
      Gasp;
    END;

    PROCEDURE EndWait;
    BEGIN
      IF PD <> NIL THEN Dispose(PD, Done);
      PD := NIL;
      Gasp;
    END;

    PROCEDURE WriteHeader;
    CONST Days : PChar = 'SunMonTueWedThuFriSat';
    VAR
      StartTime : RECORD
        Month, Day, Year, Hour, Min, Sec, Hund, Dow : Word;
      END;
    BEGIN
      WITH IData, StartTime DO
        BEGIN
          GetTime(Hour, Min, Sec, Hund);
          GetDate(Year, Month, Day, Dow);
          WriteLn(ReptFile, 'INSTALLATION REPORT - ', InstProg);
          WriteLn(ReptFile);
          WriteLn(ReptFile, 'Produced by INCTRL, Copyright (c) '+
            '1992 by Neil J. Rubenking');
          StrLCopy(LineBuff, Days+(Dow*3), 3);
          Write(ReptFile, LineBuff);
          wvsprintf(LineBuff, ' %u/%u/%u  %02u:%02u:%02u.%02u',
            StartTime);
          WriteLn(ReptFile, LineBuff);
          WriteLn(ReptFile);
        END;
    END;

    PROCEDURE CreateFileNames;
    VAR C : Char;
    BEGIN
      {-First get LENGTH of Windows directory, then-}
      {-allocate appropiate size for file names.   -}
      WinDirLen := Succ(GetWindowsDirectory(@C, 0));
      GetMem(WinFile, WinDirLen + StrLen(CWinFile));
      GetMem(WinCopy, WinDirLen + StrLen(CWinCopy));
      GetMem(SysFile, WinDirLen + StrLen(CSysFile));
      GetMem(SysCopy, WinDirLen + StrLen(CSysCopy));
      GetWindowsDirectory(WinFile, WinDirLen);
      StrCat(WinFile, '\');
      StrCopy(WinCopy, WinFile);
      StrCopy(SysFile, WinFile);
      StrCopy(SysCopy, WinFile);
      StrCat(WinFile, CWinFile);
      StrCat(WinCopy, CWinCopy);
      StrCat(SysFile, CSysFile);
      StrCat(SysCopy, CSysCopy);
    END;

    PROCEDURE CopyFile(OlName, NuName : PChar);
    CONST bufSiz = 32768;
    VAR
      OldF, NewF : File;
      Buffer     : PChar;
      Actual     : Word;
    BEGIN
      GetMem(Buffer, BufSiz);
      Assign(OldF, OlName);
      Assign(NewF, NuName);
      Reset(OldF, 1);
      Rewrite(NewF, 1);
      WHILE NOT EoF(OldF) DO
        BEGIN
          BlockRead(OldF, buffer^, BufSiz, Actual);
          BlockWrite(NewF, buffer^, Actual);
        END;
      Close(NewF);
      Close(OldF);
      FreeMem(Buffer, BufSiz);
    END;

    FUNCTION ListExistingFiles : Boolean;
    CONST Root : PChar = 'x:\';
    VAR
      DriveCh   : Char;
      Err       : Byte;
    BEGIN
      WarnWait('Scanning existing files');
      DriveCh := 'A';
      Err := 0;
      WHILE (DriveCh <= 'Z') AND (Err = 0) DO
        BEGIN
          IF Drives[DriveCh] THEN
            BEGIN
                {-Put the directories for this drive-}
                {-in the DirList first.             -}
              Root[0] := DriveCh;
              IData.DirList^.Insert(StrNew(Root));
              Mask[0] := DriveCh;
              Err := AllSearcher(Mask, faAnyFile, ListDir);
                {-Now get the files for this drive.-}
              IF Err = 0 THEN
                Err := AllSearcher(Mask, faAnyFile, Snap);
            END;
          Inc(DriveCh);
        END;
      EndWait;
      ListExistingFiles := Err = 0;
      IF Err <> 0 THEN MessageBeep(mb_IconStop);
      CASE Err OF
        0   : ; {-Say nothing - all is well.-}
        128 : MessageBox(hWindow, 'INCTRL ran out of memory while '+
                'trying to list existing files.'^M'Try excluding '+
                'one or more drives from consideration.', 'ERROR',
                mb_Ok + mb_IconStop);
        129 : MessageBox(hWindow, 'INCTRL can only remember 16,380 '+
                'files.'^M'Try excluding one or more drives from '+
                'consideration.', 'ERROR', mb_Ok + mb_IconStop);
        ELSE
          wvsprintf(LineBuff, 'ERROR # %u, drive X:', Err);
          LineBuff[StrLen(LineBuff)-2] := Pred(DriveCh);
          MessageBox(hWindow, 'INCTRL encountered a DOS error '+
            'while trying to read your disk.'^M'Exit Windows '+
            'and run CHKDSK to identify the problem.', LineBuff,
            mb_Ok + mb_IconStop);
      END;
    END;

    FUNCTION ExecuteInstallProgram : Boolean;
    VAR
      InstanceID : THandle;
      InstCmd    : PChar;
      Len        : Word;
    BEGIN
      WarnWait('Executing Install program');
      ExecuteInstallProgram := FALSE;
      Len := pred(StrLen(InstProg));
        {-If it's a BAT file, execute under COMMAND.COM.-}
      IF (InstProg[Len-2] = 'B') AND
         (InstProg[Len-1] = 'A') AND
         (InstProg[Len]   = 'T') THEN
        BEGIN
          Len := Len + StrLen(GetEnvVar('COMSPEC')) + 5;
          GetMem(InstCmd, Len);
          StrCopy(InstCmd, GetEnvVar('COMSPEC'));
          StrCat(InstCmd, ' /C ');
          StrCat(InstCmd, InstProg);
          InstanceID := WinExec(InstCmd, sw_Show);
          FreeMem(InstCmd, Len);
        END
      ELSE InstanceID := WinExec(InstProg, sw_Show);
      EndWait;
      IF InstanceID < 32 THEN Exit;
      REPEAT
        Gasp;
      UNTIL GetModuleUsage(InstanceID) = 0;
      ExecuteInstallProgram := TRUE;
    END;

    PROCEDURE RecordNewFiles;
    VAR DriveCh : Char;
    BEGIN
      WriteLn(IData.ReptFile, '*** FILES AND DIRECTORIES ADDED ***');
      WarnWait('Looking for added files');
      FOR DriveCh := 'A' TO 'Z' DO
        IF Drives[DriveCh] THEN
          BEGIN
            Mask[0] := DriveCh;
            AllSearcher(Mask, faAnyFile, UnSnap);
          END;
      EndWait;
      WITH IData DO
        BEGIN
          wvsprintf(LineBuff, 'Install program added %u files and '+
            '%u directories.', NumFiles);
          WriteLn(ReptFile, LineBuff);
          WriteLn(ReptFile);
        END;
    END;

    PROCEDURE RecordChangedFiles;
    VAR W : Word;

      PROCEDURE WriteOne(Item : PFileRecord); FAR;
      BEGIN
        WITH IData DO
          IF Item^.IsChanged THEN
            BEGIN
              IF ChFiles + ChDirs = 0 THEN
                WriteLn(ReptFile, '*** FILES AND DIRECTORIES '+
                  'CHANGED ***');
              IF Item^.IsDir THEN
                BEGIN
                  Inc(ChDirs);
                  Write(ReptFile,'DIR : ');
                END
              ELSE
                BEGIN
                  Inc(ChFiles);
                  Write(ReptFile, 'FILE: ');
                END;
              WriteLn(ReptFile, Item^.GetFullName(LineBuff));
            END;
      END;

    BEGIN
      WITH IData DO
        BEGIN
          FileList^.ForEach(@WriteOne);
          IF ChFiles + ChDirs > 0 THEN
            BEGIN
              wvsprintf(LineBuff, 'Install program changed %u '+
                'files and %u directories.', ChFiles);
              WriteLn(ReptFile, LineBuff);
              WriteLn(ReptFile);
            END;
        END;
    END;

    PROCEDURE RecordDeletedFiles;
    VAR W : Word;

      PROCEDURE WriteOne(Item : PFileRecord); FAR;
      BEGIN
        WITH IData DO
          IF NOT Item^.IsChanged THEN
          BEGIN
            IF DelDirs + DelFiles = 0 THEN
              WriteLn(ReptFile, '*** FILES AND DIRECTORIES '+
                'DELETED ***');
            IF Item^.IsDir THEN
              BEGIN
                Inc(DelDirs);
                Write(ReptFile,'DIR : ');
              END
            ELSE
              BEGIN
                Inc(DelFiles);
                Write(ReptFile, 'FILE: ');
              END;
            WriteLn(ReptFile, Item^.GetFullName(LineBuff));
          END;
      END;

    BEGIN
      WITH IData DO
        BEGIN
          FileList^.ForEach(@WriteOne);
          IF DelFiles + DelDirs > 0 THEN
            BEGIN
              wvsprintf(LineBuff, 'Install program deleted %u '+
                'files and %u directories.', DelFiles);
              WriteLn(ReptFile, LineBuff);
              WriteLn(ReptFile);
            END;
        END;
    END;

    FUNCTION CleanHeap : Word;
      {-Delete all sub-allocation blocks that are empty.  Don't-}
      {-delete the block currently pointed-to by HeapList.     -}
      {-Return the number of blocks that could be deleted.     -}
    TYPE
      SubList = ^SubType;
      SubType = RECORD
        Next, Size : Word;
      END;

      HList = ^HlType;
      HLType = RECORD
        signature : ARRAY[0..1] OF Char;     {always "TP"}
        reserved  : Word;
        FreeList  : SubType; {start of internal free list}
        SubFree   : Word;  {amount free in suballoc block}
        Next      : Word;             {seg. of next block}
        DataOrg   : Byte;
      END;
    VAR
      H, WasH : HList;
      num     : Word;
    BEGIN
      Num := 0;
      IF HeapList <> 0 THEN
        BEGIN
          WasH := Ptr(HeapList, 0);
          H    := Ptr(WasH^.Next, 0);
          WHILE Seg(H^) <> HeapList DO
            BEGIN
              IF H^.SubFree = HeapBlock - 12 THEN
                BEGIN
                    {-Cut H out of the chain.-}
                  WasH^.Next := H^.Next;
                    {-Free the memory used by H.-}
                  FreeMem(H, HeapBlock);
                  H := Ptr(WasH^.Next, 0);
                  Inc(Num);
                END
              ELSE
                BEGIN
                  WasH := H;
                  H    := Ptr(WasH^.Next, 0);
                END;
            END;
        END;
      H := Ptr(HeapList, 0);
      IF (H^.Next = HeapList) AND
         (H^.SubFree = HeapBlock-12) THEN
        BEGIN
          FreeMem(H, HeapBlock);
          HeapList := 0;
          Inc(Num);
        END;
      CleanHeap := Num;
    END;

    PROCEDURE CompareFiles(NuName, OlName, Nam : PChar);
    {-Compare the Nu file with the Ol' file - the Ol' file-}
    {-is *deleted* at the end of this procedure.          -}
    VAR
      SectBuff   : ARRAY[0..80] OF Char;
      Sects      : PStrICollection;
      OldF, NewF : Text;
      Indx       : Integer;
      NSects,
      NKeyCh,
      NKeys      : Word;

      PROCEDURE CheckSections;
      VAR
        SLen : Word;
        Indx : Integer;
      {-Read the old file and store all of its section names in a-}
      {-string collection.  Read the NEW file and report any     -}
      {-sections that didn't exist in the old file.  Hang onto   -}
      {-the section list for use in the next step.               -}
      BEGIN
        WITH IData DO
          BEGIN
            WHILE NOT EoF(OldF) DO
              BEGIN
                ReadLn(OldF, SectBuff);
                SLen := StrLen(SectBuff);
                IF (SectBuff[0] = '[') AND
                   (SectBuff[pred(SLen)] = ']') THEN
                  BEGIN
                    StrLCopy(SectBuff, SectBuff+1, SLen-2);
                    IF Sects^.Search(@SectBuff, Indx) THEN
                      BEGIN
                        StrCopy(LineBuff, 'Duplicate section - ');
                        StrCat(LineBuff, SectBuff);
                        MessageBeep(mb_IconInformation);
                        MessageBox(hWindow, LineBuff, Nam,
                          mb_Ok + mb_IconInformation);
                      END
                    ELSE Sects^.Insert(StrNew(SectBuff));
                  END;
              END;
            WHILE NOT EoF(NewF) DO
              BEGIN
                ReadLn(NewF, SectBuff);
                SLen := StrLen(SectBuff);
                IF (SectBuff[0] = '[') AND
                   (SectBuff[pred(SLen)] = ']') THEN
                  BEGIN
                    StrLCopy(SectBuff, SectBuff+1, SLen-2);
                    IF NOT Sects^.Search(@SectBuff, Indx) THEN
                      BEGIN
                        Sects^.Insert(StrNew(SectBuff));
                        IF NSects = 0 THEN
                          WriteLn(ReptFile, '*** ', Nam,
                            ' SECTIONS ADDED ***');
                        Inc(NSects);
                        WriteLn(ReptFile, SectBuff);
                      END;
                  END;
              END;
            IF NSects > 0 THEN
              BEGIN
                wvsprintf(LineBuff, '%u sections added to ', NSects);
                WriteLn(ReptFile, LineBuff, Nam);
                WriteLn(ReptFile);
              END;
            Inc(NumSects, NSects);
          END;
      END;

      PROCEDURE CheckKeys;
      CONST KeyBuffSize = 16384;
      VAR
        KeyBuff  : PChar;
        DevCount,
        Indx     : Integer;

        PROCEDURE OneSect(Sect : PChar); FAR;
        {-Iterator routine, executed for each section in the-}
        {-Sects collection.                                 -}
        VAR
          Keys   : PStrICollection;
          V1, V2 : ARRAY[0..512] OF Char;
          P      : PChar;
          Indx   : Integer;

          PROCEDURE OneKey(Key : PChar); FAR;
          {-Iterator executed for each key in the current section-}
          BEGIN
            IF (StrIComp(key, 'device') = 0) AND
               (StrIComp(Sect, '386enh') = 0) THEN Exit;
            GetPrivateProfileString(Sect, Key, '', V1, 512, OlName);
            GetPrivateProfileString(Sect, Key, '', V2, 512, NuName);
            IF StrComp(V1, V2) = 0 THEN Exit;
            WITH IData DO
              BEGIN
                IF NKeyCh = 0 THEN
                  WriteLn(ReptFile, '*** KEYS CHANGED IN ', Nam,
                    ' SECTION [',Sect, '] ***');
                Inc(NKeyCh);
                Inc(NumKeyCh);
                WriteLn(ReptFile, 'BEFORE: ', key, '=', V1);
                WriteLn(ReptFile, ' AFTER: ', key, '=', V2);
              END;
          END;

        BEGIN
          NKeys := 0;
          WITH IData DO
            BEGIN
              New(Keys, Init(8, 8));
              GetPrivateProfileString(Sect, NIL, '', KeyBuff,
                KeyBuffSize, OlName);
              P := KeyBuff;
              DevCount := 0;
              WHILE P[0] <> #0 DO
                BEGIN
                  IF (StrIComp(P, 'device') = 0) AND
                     (StrIComp(Sect, '386enh') = 0) THEN
                    BEGIN
                      IF DevCount = 0 THEN Keys^.Insert(StrNew(P));
                      Inc(DevCount);
                    END
                  ELSE
                    BEGIN
                      IF Keys^.Search(P, Indx) THEN
                        BEGIN
                          StrCopy(LineBuff, 'Duplicate key [');
                          StrCat(LineBuff, sect);
                          StrCat(LineBuff, '] ');
                          StrCat(LineBuff, P);
                          MessageBeep(mb_IconInformation);
                          MessageBox(hWindow, LineBuff, Nam,
                            mb_Ok + mb_IconInformation);
                        END
                      ELSE Keys^.Insert(StrNew(P));
                    END;
                  P := StrEnd(P) + 1;
                END;
              GetPrivateProfileString(Sect, NIL, NIL, KeyBuff,
                KeyBuffSize, NuName);
              P := KeyBuff;
              WHILE P[0] <> #0 DO
                BEGIN
                  IF (StrIComp(P, 'device') = 0) AND
                     (StrIComp(Sect, '386enh') = 0) THEN
                    Dec(DevCount);
                  IF NOT Keys^.Search(P, Indx) THEN
                    BEGIN
                      IF NKeys = 0 THEN
                        WriteLn(ReptFile, '*** KEYS ADDED TO ', Nam,
                          ' SECTION [',Sect, '] ***');
                      Inc(NKeys);
                      Inc(NumKeys);
                      GetPrivateProfileString(Sect, P, NIL, V1,
                        512, NuName);
                      WriteLn(ReptFile, P,'=',V1);
                    END;
                  P := StrEnd(P) + 1;
                END;
              DevCount := -DevCount;
              IF DevCount > 0 THEN
                BEGIN
                  IF NKeys = 0 THEN
                    WriteLn(ReptFile, '*** KEYS ADDED TO ', Nam,
                      ' SECTION [',Sect, '] ***');
                  Inc(NKeys, DevCount);
                  Inc(NumKeys, DevCount);
                  WriteLn(ReptFile, devCount, ' DEVICE= lines added',
                    ' to the [386Enh] section of SYSTEM.INI');
                END;
              IF NKeys > 0 THEN
                BEGIN
                  wvsprintf(LineBuff, '%u keys added to ', NKeys);
                  WriteLn(ReptFile, LineBuff, Nam, ' section [',
                    Sect, ']');
                  WriteLn(ReptFile);
                END;
              NKeyCh := 0;
              Keys^.ForEach(@OneKey);
              IF NKeyCh > 0 THEN
                BEGIN
                  wvsprintf(LineBuff, '%u keys changed in ', NKeyCh);
                  WriteLn(ReptFile, LineBuff, Nam, ' section [',
                    Sect, ']');
                  WriteLn(ReptFile);
                END;
              Dispose(Keys, Done);
            END;
        END;
      BEGIN
        GetMem(KeyBuff, succ(KeyBuffSize));
        Sects^.ForEach(@OneSect);
        FreeMem(KeyBuff, succ(KeyBuffSize));
      END;

    BEGIN
      New(Sects, Init(8, 8));
      Assign(OldF, OlName); Reset(OldF);
      Assign(NewF, NuName); Reset(NewF);
      NSects := 0;
      CheckSections;
      CheckKeys;
      Close(NewF);
      Close(OldF);
      Erase(OldF);
      Dispose(Sects, Done);
    END;

    PROCEDURE DestroyFileNames;
    BEGIN
      FreeMem(WinFile, WinDirLen + StrLen(CWinFile));
      FreeMem(WinCopy, WinDirLen + StrLen(CWinCopy));
      FreeMem(SysFile, WinDirLen + StrLen(CSysFile));
      FreeMem(SysCopy, WinDirLen + StrLen(CSysCopy));
    END;

    PROCEDURE DisplayReport;
    VAR
      Lines : Word;
      Line  : String[80];
      Num   : Word;
      More  : Boolean;
    BEGIN
      WITH IData DO
        BEGIN
          Lines := 3;
          Reset(ReptFile);
            {-Count the lines in the report.-}
          WHILE (NOT EoF(ReptFile)) AND (Lines < 818) DO
            BEGIN
              ReadLn(ReptFile);
              Inc(Lines);
            END;
          More := NOT EoF(ReptFile);
          Close(ReptFile);
          EndWait;
            {-Set the WinCrt screen to just enough rows.-}
          ScreenSize.Y := Lines;
          AutoTracking := FALSE;
          StrCopy(WindowTitle, 'INCTRL Report - ');
          StrCat(WindowTitle, ReptName);
          Num := 0;
          InitWinCrt;
          Reset(ReptFile);
          WHILE (NOT EoF(ReptFile)) AND (Num < Lines) DO
            BEGIN
              ReadLn(ReptFile, Line);
              WriteLn(Line);
              Inc(Num);
            END;
          IF More THEN
            WriteLn('*** Use NOTEPAD to view entire report ***');
          Close(ReptFile);
        END;
    END;

  BEGIN
    FillChar(IData, SizeOf(IData), 0);
    GlobalData := @IData;
    WITH IData DO
      BEGIN
        New(FileList, Init(32,32));
        New(DirList, Init(8, 8));
        CreateFileNames;
        CopyFile(WinFile, WinCopy);
        CopyFile(SysFile, SysCopy);
        Assign(ReptFile, ReptName);
        ReWrite(ReptFile);
        WriteHeader;
        IF NOT ListExistingFiles THEN
          BEGIN
            Dispose(DirList, Done);
            Dispose(FileList, Done);
            Close(ReptFile);
            Erase(ReptFile);
            Exit;
          END;
        IF NOT ExecuteInstallProgram THEN
          BEGIN
            MessageBeep(mb_IconStop);
            MessageBox(hWindow, 'Failed to execute install program',
              InstProg, mb_Ok + mb_IconStop);
            Dispose(FileList, Done);
            Close(ReptFile);
            Erase(ReptFile);
            Exit;
          END;
        RecordNewFiles;
        RecordChangedFiles;
        RecordDeletedFiles;
        Dispose(DirList, Done);
        Dispose(FileList, Done);
        WarnWait('Comparing INI files');
          {-Corresponding EndWait is within DisplayReport-}
        CompareFiles(WinFile, WinCopy, 'WIN.INI');
        CompareFiles(SysFile, SysCopy, 'SYSTEM.INI');
        Close(ReptFile);
        DestroyFileNames;
        DisplayReport;
      END;
  END;

{--------------------------------------------------}
{ TMyApplication's method implementations:         }
{--------------------------------------------------}
  PROCEDURE TMyApplication.InitMainWindow;
  BEGIN
    MainWindow := New(PInCtrlDialog, Init(NIL, AppName));
  END;

{--------------------------------------------------}
{ Main program:                                    }
{--------------------------------------------------}
VAR MyApp: TMyApplication;
BEGIN
  IF GetWinFlags AND wf_pMODE = 0 THEN
    BEGIN
      MessageBeep(mb_IconExclamation);
      MessageBox(0, 'This application requires Standard or Enhanced'+
        'Mode Windows', 'Application Execution Error',
        mb_Ok + mb_IconExclamation);
      Halt;
    END;
  MyApp.Init(AppName);
  MyApp.Run;
  MyApp.Done;
END.