setup.pas

生物信息学中的遗传数据分析的delphi源码。

(*

   A simple Windows based installation program.


    1 May 1992 This version completed, closely based on code in
               Richter's "Windows 3: A developer's guide.

    5 May 1992 Debugged, made more generally useful so that could
               be used for other programs.

               There is no error checking when reading information file.

   28 Jul 1992 No longer Enables/Disables Program manager window as
               program failed to reenable it.

   11 Aug 1992 Copies .INI file(s) do Windows directory

   Usage
   =====

   1. Create a setup information file called "SETUP.INF" on the first
      distrbution disk.

   2. Use File | Run command in program manager to run a:setup.

   3. SETUP.INF has this format:

      [Application]
      ; Application information
      AppName=COMPONENT
      DefDir=c:\cpw
      SpaceNeeded=900000
      DefPMGroup=COMPONENT

      [Disks]
      ; List of diskettes needed to install COMPONENT (2 x 720K 3.5")
      1=DISK#1
      .
      .
      .

      [Files]
      ; file name, disk#, include in PM goup (Y/N),
      ; title in PM group, use Windows icon (Y/N), file containing icon

      file, disk#, N
      file, disk#, Y, name, Y/N, file

      [End]


*)


{$C PRELOAD FIXED}
{$M 16384, 8192}

program Setup2;

{$R setup2.res}

{$UNDEF BWCC}



uses
  WinCrt,
   WinDos,
   WinTypes,
   WinProcs,
   WObjects,
   Strings,
   Meterco;

const
	{ Dialog resource ids }
	DLG_WELCOME=1;
	DLG_STATUS=2 ;
	DLG_INSERTDISK=3;

   { DLL error }
   em_DLLNotFound = 1;

   id_Meter       = 100;
   id_DestPath    = 101;
   id_DiskName    = 102;
   id_StatLine1   = 103;
   id_StatLine2   = 104;
   id_SrcPath     = 105;
   id_FileMeter   = 108;


   MAXFILES = 30;  { Total number of files }
   MAXDISKS =  4;  { Total number of disks }

type
   FName = array[0..fsPathName] of char;

   { File information }
   FileInfo = record
      Disk    : byte;
      Name    : FName;
      InPM    : Boolean;
      PMText  : FName;
      PMIcon  : FName;
      WinIcon : Boolean;
      end;
   FileList = array[1..MAXFILES] of FileInfo;

var
   F: FileList;
   Disk : array[1..MAXDISKS] of array[0..20] of char;
   infile : text;
   SourcePath,
   DestPath: array[0..fsPathName] of char;
   hDlgRes        : THandle;
   WasCancelled   : Boolean;
   Files, Disks   : integer;
   szAppName      : array[0..50] of char;
   szGroupName    : array[0..50] of char;
   szDefDir       : array[0..50] of char;
   SpaceNeeded    : longint;

type
  MyApplication = object(TApplication)
     Lib: THandle;
     constructor Init (AName:PChar);
     destructor Done;virtual;
     procedure InitMainWindow; virtual;
     procedure Error(ErrorCode: Integer);virtual;
  end;

  PStatusDlg = ^StatusDlg;
  StatusDlg = object(TDialog)
     procedure Cancel (var Msg:TMessage);
        virtual id_First + id_Cancel;
     end;


  { Dialog that prompts for diskette }
  PInsertDlg = ^InsertDlg;
  InsertDlg = object(TDialog)
     DiskName, Path: PChar;
     constructor Init (AParent:PWindowsObject; ATitle, ADiskName,APath:PChar);
     procedure SetUpWindow;virtual;
     procedure OK (var Msg:TMessage);
        virtual id_First + id_OK;
     procedure IDSrcPath (var Msg:TMessage);
        virtual id_First + id_SrcPath;
     end;


  { Main window }
  PWelcomeDlg = ^WelcomeDlg;
  WelcomeDlg = object(TDlgWindow)
	  Path: PChar;
     PS, PI             : PDialog;
     ServerWindow   : HWnd;
     PendingMessage : Word;
     Installing     : Boolean;


     constructor Init (AParent:PWindowsObject; ATitle, APath:PChar);
     function GetClassName:PChar;virtual;
     procedure GetWindowClass (var AWndClass: TWndClass);virtual;
     procedure SetUpWindow;virtual;
     procedure IDDestPath (var Msg:TMessage);
        virtual id_First + id_DestPath;
     procedure OK (var Msg:TMessage);
        virtual id_First + id_OK;
     procedure Cancel (var Msg:TMessage);
        virtual id_First + id_Cancel;

     function InitiateDDE:integer;
     procedure TerminateDDE;
     function CreateGroup:Boolean;
     procedure WMDDEAck(var Msg: TMessage);
        virtual wm_First + wm_DDE_Ack;
     procedure WMDDETerminate(var Msg: TMessage);
        virtual wm_First + wm_DDE_Terminate;
     procedure WMDestroy(var Msg: TMessage);
        virtual wm_First + wm_Destroy;
     function CopyFile (FileName:PChar):integer;
     end;


   { zero if O.K. }
   function WelcomeDlg.CopyFile (FileName:PChar):integer;
   const
      wBuffer = 10240;
   var
      FromF,
      ToF        : File;
      Buf        : array[0..wBuffer] of char;
      NumRead,
      NumWritten : word;
      Result     : integer;
      Time       : longint;
      APath      : array[0..fsPathName] of char;
      Size       : longint;
      K          : Boolean;
      PMsg       : TMsg;
   begin
      CopyFile := -1;
      SendDlgItemMessage (PS^.HWindow, id_FileMeter,
         mm_SetPartsComplete, 0, 0);

      { Open source file and create destination file. }
      StrCopy (APath, SourcePath);
      StrCat (APath, FileName);
      Assign (FromF, APath);
      {$I-} Reset (FromF, 1); {$I+}
      Result := IOResult;
      if (Result <> 0) then Exit;

      if StrPos (FileName, '.INI') <> NIL then
         { Copy any *.INI files to the windows directory }
         GetWindowsDirectory (APath, SizeOf(APath)-1)
      else
         StrCopy (APath, DestPath);

      StrCat (APath,'\');
      StrCat (APath, FileName);
      Assign (ToF, APath);

      {$I-}Rewrite (ToF, 1); {$I+}
      Result := IOResult;
      if (Result <> 0) then Exit;


      { To show user how much of file has been
        copied we need to know how big the file is. }
      K := False;
      Size := FileSize (FromF);
      if Size > 1024 then begin
         Size := Size div 1024;
         K    := True;
         end;

      { Set meter }
      SendDlgItemMessage (PS^.HWindow, id_FileMeter, mm_SetPartsInJob, Size, 0);
      Size := 0;
      repeat
         {$I-} BlockRead (FromF, Buf, SizeOf(Buf), NumRead); {$I+}
         Result := IOResult;
         if (Result <> 0) then Exit;
         {$I-} BlockWrite (ToF, Buf, NumRead, NumWritten); {$I+}
         Result := IOResult;
         if (Result <> 0) then Exit;

         { Update meter }
         if K then
            Size := Size + (NumRead div 1024)
         else Size := Size + NumRead;
         SendDlgItemMessage (PS^.HWindow, id_FileMeter,
            mm_SetPartsComplete, Size, 0);

         while PeekMessage (PMsg, 0, 0, 0, pm_Remove) do begin
            TranslateMessage (PMsg);
            DispatchMessage (PMsg);
            end;
         if WasCancelled then
            NumRead := 0; { force end }

      until (NumRead = 0) or (NumWritten <> NumRead);

      if not WasCancelled then begin
         { Set time and date stamp }
         GetFTime (FromF, Time);
         SetFTime (ToF, Time);
         end;

      {$I-}Close (FromF); {$I+}
      Result := IOResult;
      if (Result <> 0) then Exit;
      {$I-} Close (ToF); {$I+}
      Result := IOResult;
      if (Result <> 0) then Exit;

      if WasCancelled then
         CopyFile := -1
      else CopyFile := Result;
   end;


procedure StatusDlg.Cancel(var Msg:TMessage);
begin
   WasCancelled := True;
   Msg.Result   := 0;
end;

{-----------------------------Init-----------------------------------------}

constructor InsertDlg.Init (AParent:PWindowsObject; ATitle, ADiskName,
                                                            APath:PChar);
begin
   TDialog.Init (AParent, ATitle);
   DiskName := ADiskName;
   Path     := APath;
end;

{-----------------------------SetUpWindow----------------------------------}

procedure InsertDlg.SetUpWindow;
begin
   TDialog.SetUpWindow;
   SetDlgItemText (HWindow, id_DiskName, DiskName);
   SetDlgItemText (HWindow, id_SrcPath, Path);
   MessageBeep(0);
end;

{-----------------------------IDSrcPath------------------------------------}

procedure InsertDlg.IDSrcPath (var Msg:TMessage);
begin
   EnableWindow (GetDlgItem (HWindow, id_OK),
      (SendMessage (GetDlgItem (HWindow, id_SrcPath),
      em_LineLength, 0, 0) <> 0));
end;

{-----------------------------OK-------------------------------------------}

procedure InsertDlg.OK (var Msg:TMessage);
begin
   GetDlgItemText (HWindow, id_SrcPath, SourcePath, SizeOf(SourcePath));
   TDialog.OK (Msg);
end;

{-----------------------------Init-----------------------------------------}

constructor WelcomeDlg.Init (AParent:PWindowsObject; ATitle, APath:PChar);
begin
   TDlgWindow.Init (AParent, ATitle);
   Path           := APath;
   ServerWindow   := 0;
   PendingMessage := 0;
   WasCancelled   := False;
   Installing     := False;
end;

{-----------------------------SetUpWindow----------------------------------}

procedure WelcomeDlg.SetUpWindow;
begin
   TDlgWindow.SetUpWindow;
   SetDlgItemText (HWindow, id_DestPath, Path);

	hDlgRes := FindResource (HInstance, MakeIntResource (DLG_INSERTDISK),
								    rt_Dialog);
   hDlgRes := LoadResource (HInstance, hDlgRes);
   LockResource (hDlgRes);

   PS := new(PStatusDlg, Init (@Self, MakeIntResource (DLG_STATUS)));
   if not PS^.Create then
      MessageBox (HWindow, 'Failed', 'Create', mb_IconInformation);
end;

{-----------------------------IDDestPath-----------------------------------}

{ Enable OK button if user has typed in a path. }
procedure WelcomeDlg.IDDestPath (var Msg:TMessage);
begin
   EnableWindow (GetDlgItem (HWindow, id_OK),
      (SendMessage (GetDlgItem (HWindow, id_DestPath),
      em_LineLength, 0, 0) <> 0));
end;


function WelcomeDlg.GetClassName:PChar;
begin
   GetClassName := 'WelcomeDlg';
end;

procedure WelcomeDlg.GetWindowClass (var AWndClass: TWndClass);
begin
   TDlgWindow.GetWindowClass (AWndClass);
   AWndClass.hIcon := LoadIcon (HInstance, 'ICON_1');
end;

{-----------------------------Cancel---------------------------------------}

procedure WelcomeDlg.Cancel (var Msg:TMessage);
begin
   TDialog.Cancel (Msg);
end;

{-----------------------------OK-------------------------------------------}

procedure WelcomeDlg.OK (var Msg:TMessage);
type
   STATES = (st_ERROR, st_CANCELLED, st_OK, st_RETRY);
var
   Error, Result, i, ThisDisk:integer;
   PMsg    : TMsg;
   hDlgRes : THandle;
   AMsg    : array[0..128] of char;
   State   : STATES;
   Arg     : array[0..2] of PChar;
   dwDiskFree : longint;
   ReOpenBuff : TOFStruct;
   szDrive : array[0..3] of char;
   szNumber1, szNumber2   : array[0..20] of char;
begin
{   InitiateDDE;
   TerminateDDE;}

   WasCancelled := False;

   { Get path name }
   GetDlgItemText (HWindow, id_DestPath, AMsg, SizeOf(AMsg));
   OpenFile (AMsg, ReOpenBuff, of_Parse);
   StrCopy (DestPath, ReOpenBuff.szPathName);



   { 0. check for space on disk }
   dwDiskFree := DiskFree(ord(DestPath[0]) - ord('A') + 1);
   if (dwDiskFree < SpaceNeeded) then begin
      StrLCopy (szDrive, DestPath, 2);
      Str (dwDiskFree, szNumber1);
      Str (Spaceneeded, szNumber2);
      Arg[0] := @szDrive;
      Arg[1] := @szNumber1;
      Arg[2] := @szNumber2;
      wvsprintf (AMsg, 'Drive %s contains only %s bytes of free disk space. Setup requires  %s bytes.',Arg);
      StrCat (AMsg, #13);
      StrCat (AMsg, 'Please select another drive.');
      MessageBox (HWindow,AMsg, 'Setup',mb_IconInformation or mb_OK or mb_TaskModal);
      Exit;
      end;


   { 1. Create destination directory }
   SetCurDir (DestPath);
   if (DosError <> 0) then begin
      { directory doesn't exist so create it...}
      CreateDir (DestPath);
      if (DosError <> 0) then begin
         StrCopy (AMsg, 'The directory cannot be created.');
         StrCat (AMsg, ' Enter another directory or try another drive.');
         MessageBox (HWindow, AMsg, 'SetUp',
            mb_IconInformation or mb_OK);
         Exit;
         end
      else SetCurDir (DestPath);
      end;


   { 2. Copy the files }
   State      := st_OK;

   PS^.Show (sw_Show);
   EnableWindow(HWindow, False);

   SendDlgItemMessage (PS^.HWindow, id_Meter, mm_SetPartsComplete, 0, 0);
   SendDlgItemMessage (PS^.HWindow, id_Meter, mm_SetPartsInJob, Files, 0);

   i := 0;
   ThisDisk := 1;
   while (i < Files) and (State = st_OK) do begin
      { Let other apps process messages. }
      while PeekMessage (PMsg, 0, 0, 0, pm_Remove) do begin
         TranslateMessage (PMsg);
         DispatchMessage (PMsg);
         end;

      Inc (i);
      if (ThisDisk <> F[i].Disk) then begin
         ThisDisk := F[i].Disk;
         { Prompt for new disk}
         if Application^.ExecDialog (new (PInsertDlg,
				Init(PS, MakeIntResource(DLG_INSERTDISK),
				      Disk[F[i].Disk], SourcePath)))
            = id_Cancel then
            State := st_CANCELLED;
         end;

      if (State = st_OK) then begin
         { Copy file. }
         SetDlgItemText (PS^.HWindow, id_StatLine2, StrUpper(F[i].Name));

         if (CopyFile (F[i].Name) <> 0) then begin
            if WasCancelled then
               State := st_CANCELLED
            else begin
               { Error copying file...}
               StrCopy (AMsg, 'Unable to copy file: ');
               StrCat  (AMsg, SourcePath);
               StrCat  (AMsg, StrUpper(F[i].Name));
               Result := MessageBox (HWindow, AMsg, 'SetUp',
                           mb_IconInformation or mb_RetryCancel);