Stars of Shareware: Programmierung/SOURCE.mdf/programm/windows/c/mobjm260/install.pa_/install.pa

Text File | 1994-09-06 | 9.3 KB | 312 lines

(*********************************************************************)
(*                                                                   *)
(*          Microworks ObjectMate 2.6                                                        *)
(*                                                                   *)
(*     Windows Interface Develpment Kit for the Borland Languages.   *)
(*                                                                   *)
(*         INSTALL.PAS : Installation Initialization Program                 *)
(*                                                                                                                             *)
(*     Copyright 1992-94 Microworks Sydney, Australia.                 *)
(*                                                                   *)
(*********************************************************************)

(* Install is the installation initialization program. It expands the main
 * installation program MWINSTAL.EX_ into the Windows system subdirectory
 * and checks to see if there is an old version of SFX200.DLL. If it finds
 * one, or if SFX200.DLL is not found, it copies the new version into the
 * Windows system subdirectory. Like MWInstal, Install is a generic Windows
 * program to ensure the smallest possible executable file size.
 *
 * Files must be compressed with COMPRESS.EXE using the /r option followed by the
 * the files full path name. You can compress whole directories or all files with
 * the same extension using wild cards. For example, 'compress /r c:\temp\*.*'
 * compresses all the files in the c:\temp directory.
 *
 * When you compress a file with compress using the /r option, the original filename
 * is stored in the compressed file and is the file name returned by GetExpandedName.
 * You can specify the compressed file name at the time of compression but if you do
 * the original file name is not stored in the compressed file and must be specifed
 * at the time of expansion.
 *)

program Install;

uses WinTypes, WinProcs, WinDos, Win31, ShellAPI, LZExpand;

{$R Install.res}

const

        { Current SFX200.DLL version number -> 2.6 }
    SFXVERSION = $0260;

var

    GetSFXVersion : function : Word;
    FromDir       : array[0..fsDirectory] of Char;
    ExpandLib     : THandle;
    SplashWnd     : HWnd;

{********** CenterWindow **********}

procedure CenterWindow(hWndCenter: HWnd);
var
    Center     : TRect;
    Desktop    : TRect;
    X, Y, W, H : Integer;
begin
    GetWindowRect(GetDesktopWindow, Desktop);
    GetWindowRect(hWndCenter, Center);
    W := (Center.right - Center.left);
    H := (Center.bottom - Center.top);
    X := ((Desktop.right - Desktop.left) - W) div 2;
    Y := ((Desktop.bottom - Desktop.top) - H) div 2;
    MoveWindow(hWndCenter, X, Y, W, H, TRUE);
end;

{********** ErrorMsg **********}

procedure ErrorMsg(Msg: PChar);
begin
    MessageBeep(MB_ICONSTOP);
    MessageBox(GetActiveWindow, Msg, 'Installation Error', MB_ICONSTOP);
end;

{********** ExpandFile **********}

function ExpandFile(Dir, FileName: PChar): BOOL;
var
    Src, Dest       : array[0..fsPathName] of Char;
    ExpandedFile    : array[0..fsFileName] of Char;
    ExpandedExt     : array[0..fsExtension] of Char;
    FileStr         : PChar;
    OFSrc, OFDst    : TOFStruct;
    InFile, OutFile : Integer;
begin
    ExpandFile := FALSE;

    (* Get the expanded file name
     *)
    lstrcat(lstrcpy(Src, FromDir), FileName);
    if GetExpandedName(Src, Dest) = -1 then
    begin
        FileStr := Src;
        wvsprintf(Dest, 'Unable to expand the file %s. It''s missing!', FileStr);
        ErrorMsg(Dest);
        Exit;
    end;

    (* Extract the expanded file name and extension and append them to the
     * supplied installation dir.
     *)
    FileSplit(Dest, nil, ExpandedFile, ExpandedExt);
    lstrcat(lstrcat(lstrcpy(Dest, Dir), ExpandedFile), ExpandedExt);

    (* Open source file
     *)
    InFile := LZOpenFile(Src, OFSrc, OF_READ);
    if InFile = -1 then
    begin
        ErrorMsg('Unable to open compressed file. Ensure that compressed installation ' +
                         'files are in the same directroy as install.exe and run Install again.');
        Exit;
    end;

    (* Open destination file
     *)
    OutFile := LZOpenFile(Dest, OFDst, OF_CREATE);
    if OutFile = -1 then
    begin
        ErrorMsg('Unable to create uncompressed file.');
        Exit;
    end;

    (* Expand file
     *)
    LZCopy(InFile, OutFile);
    LZClose(InFile);
    LZClose(OutFile);
    ExpandFile := TRUE;
end;

{********** HourGlass **********}

procedure HourGlass(On: Boolean);
const
    CursorSave: HCursor = 0;
begin
    if On then
        CursorSave := SetCursor(LoadCursor(0, IDC_WAIT))
    else
        SetCursor(CursorSave);
end;

{********** SplashDlgProc **********}

function SplashDlgProc (Dlg: HWnd; Message, wParam: Word; lParam: Longint): BOOL; export;
begin
    SplashDlgProc := TRUE;

    case Message of

        WM_INITDIALOG:
        begin
            CenterWindow(Dlg);
            Exit;
        end;

        WM_CTLCOLOR:
        begin
            case HIWORD(lParam) of
                CTLCOLOR_DLG, CTLCOLOR_STATIC:
                begin
                    SetBkMode(wParam, TRANSPARENT);
                    SplashDlgProc := BOOL(GetStockObject(LTGRAY_BRUSH));
                    Exit;
                end;
            end;
        end;

        WM_DESTROY:
        begin
            PostQuitMessage(0);
            Exit;
        end

    end;
    SplashDlgProc := FALSE;
end;

{********** DefaultProc **********}

function DefaultProc (Dlg: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
begin
    DefaultProc := DefDlgProc(Dlg, Message, wParam, lParam);
end;

procedure WinMain;
label
    LoadSFX200, NoLoadSFX200;
var
    StartApp   : array[0..fsPathName] of char;
    SystemPath : array[0..fsPathName] of Char;
    SystemDir  : array[0..fsDirectory] of Char;
    i, Usage   : Integer;
    SplashProc : TFarProc;
    SFXLib     : THandle;
    Msg        : TMsg;
    WndClass   : TWndClass;
    Version    : Word;
begin
  if HPrevInst = 0 then
  begin
        FillChar(WndClass, SizeOf(TWndClass), #0);
        WndClass.lpszClassName := 'SPLASHDIALOG';
        WndClass.lpfnWndProc   := @DefaultProc;
        WndClass.cbClsExtra    := 0;
        WndClass.cbWndExtra    := DLGWINDOWEXTRA;
        WndClass.hInstance     := HInstance;
        WndClass.hIcon         := 0;
        WndClass.hCursor       := LoadCursor(0, IDC_ARROW);
        WndClass.hbrBackground := 0;
        WndClass.lpszMenuName  := nil;
        WndClass.style         := 0;
        if not RegisterClass(WndClass) then Halt(255);
    end
    else
        Halt(255);

    (* Retrieve the full path of install.exe and use it to extract the drive and
     * directory of the files to be installed.
     *)
    GetModuleFileName(HInstance, StartApp, fsPathName - 1);
    FileSplit(StartApp, FromDir, nil, nil);
    lstrcpy(CmdLine, FromDir);
    if CmdLine[lstrlen(CmdLine) - 1] = '\' then
        CmdLine[lstrlen(CmdLine) - 1] := #0;

    (* Load lzexpand.dll to decompress the main installation program and
     * SFX200.DLL
     *)
    SetErrorMode(SEM_NOOPENFILEERRORBOX);
    ExpandLib := LoadLibrary('lzexpand.dll');
    if ExpandLib < HINSTANCE_ERROR then
    begin
        ErrorMsg('Unable to load lzexpand.dll. Make sure this file is in your ' +
                         'Windows system subdirectory and run Install again.');
        Halt(255);
    end;

    (* Load dialog splash panel so user has something to look at while install
     * copies the main installation program and SFX200.DLL into Windows system
     * subdirectory.
     *)
    SplashProc := MakeProcInstance(@SplashDlgProc, HInstance);
    SplashWnd := CreateDialog(HInstance, 'SPLASHDIALOG', 0, SplashProc);
    ShowWindow(SplashWnd, CmdShow);
    UpdateWindow(SplashWnd);
    HourGlass(TRUE);

    (* Retrieve the drive and directory name of the Windows system
     * subdirectory.
     *)
    GetSystemDirectory(SystemPath, fsPathName - 1);
    if SystemPath[lstrlen(SystemPath) - 1] <> '\' then
        lstrcat(SystemPath, '\');
    FileSplit(SystemPath, SystemDir, nil, nil);

    (* Check to see if he user has a old version of SFX200.DLL and if so,
     * if its loaded into memory remove it and load the new version  of
     * SFX200.DLL.
     *
     * If SFX200.DLL was loaded into memory prior to installation, removing it
     * will cause the programs that use it to crash when the installation is
     * finished. To prevent this from happening Windows should be restarted.
     * If SFX200.DLL was not loaded into memory prior to installation, Windows
     * doesn't need to be restarted. CmdLine is used to pass this information
     * onto MWINSTAL.EXE.
     *
     * CmdLine passes the installation path to MWINSTAL.EXE, so it knows
     * where to find the installation files. At the beginning of WinMain the
     * terminal backslash was stripped from the installation directory path.
     * If SFX200.DLL was loaded into memory prior to installation the backslash
     * re appended.
     *)
    SFXLib := LoadLibrary('SFX200.DLL');
    if SFXLib >= HINSTANCE_ERROR then
    begin
        @GetSFXVersion := GetProcAddress(SFXLib, 'GetSFXVersion');
        Version := GetSFXVersion;
        if Version < SFXVERSION then
        begin
            Usage := GetModuleUsage(SFXLib);
            if Usage > 1 then
                lstrcat(Cmdline, '\');
            for i := 0 to Usage do
                FreeLibrary(SFXLib);
            goto LoadSFX200;
        end
        else
            goto NoLoadSFX200;
    end;

    LoadSFX200:
    ExpandFile(SystemDir, 'SFX200.DL_');

    NoLoadSFX200:
    ExpandFile(SystemDir, 'MWINSTAL.EX_');
    FreeLibrary(ExpandLib);
    FreeLibrary(SFXLib);
    ShowWindow(SplashWnd, SW_HIDE);
    if (ShellExecute(0, nil, 'MWINSTAL.EXE', CmdLine, '.\', SW_NORMAL) < HINSTANCE_ERROR) then
        ErrorMsg('Unable to execute oinstall.exe. You can run oinstall.exe ' +
                         'by specifying its directory name as a command line parameter.');
    DestroyWindow(SplashWnd);
    HourGlass(FALSE);
    Halt(Msg.wParam);
end;

begin
  WinMain;
end.