home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / POPDOS.LZH / PDMAIN.PAS next >
Encoding:
Pascal/Delphi Source File  |  1990-07-24  |  14.2 KB  |  475 lines
  1. {$A-,B-,E-,F-,I-,N-,O-,R-,S-,V-}
  2.  
  3. {$I OPDEFINE.INC}
  4.  
  5. {*********************************************************}
  6. {*                    PDMAIN.PAS 1.03                    *}
  7. {*        Copyright (c) TurboPower Software 1990.        *}
  8. {*                 All rights reserved.                  *}
  9. {*********************************************************}
  10.  
  11. unit PdMain;
  12.   {-Main unit for pop-to-dos TSR}
  13.  
  14. interface
  15.  
  16. uses
  17.   Dos,
  18.   OpInline,
  19.   OpString,
  20.   OpDos,
  21.   OpCrt,
  22.   {$IFDEF UseMouse}
  23.   OpMouse,
  24.   {$ENDIF}
  25.   {$IFDEF SupportXms}        {!!.03}
  26.   OpXms,                     {!!.03}
  27.   {$ENDIF}                   {!!.03}
  28.   OpSwap1;
  29.  
  30. var
  31.   {Variables provide indirect access to OPEXEC unit}
  32.   ExecUseEmsIfAvailableP : ^Boolean;
  33.   ExecUseXmsIfAvailableP : ^Boolean;           {!!.03}
  34.   ExecUseEmsOverXmsP     : ^Boolean;           {!!.03}
  35.   ExecHideSwapFileP : ^Boolean;
  36.   ExecDosSwap : function(Command : String;
  37.                          UseSecond : Boolean;
  38.                          EDP : Pointer;
  39.                          SwapName : PathStr) : Integer;
  40.  
  41. procedure PopDosInit;
  42.   {-Install or unload POPDOS}
  43.  
  44.   {=================================================================}
  45.  
  46. implementation
  47.  
  48. const
  49.   {Default options and names}
  50.  
  51.   ModuleName : String[6] = 'POPDOS';
  52.   Version : String[4] = '1.03';
  53.  
  54.   Hotkey : Word = $0844;          {Alt F10}
  55.   HotkeyStr : String[15] = '<Alt><F10>'; {Text string for hot key}
  56.   SwapDir : String[67] = 'C:\';   {Drive and directory for swap files}
  57.   ShowSwapMsg : Boolean = True;   {True to display message while TSR swaps}
  58.   ManageMouse : Boolean = True;   {True to save/restore mouse state around exec}
  59.   ParasForDos : Word = $FFFF;     {All available memory}
  60.  
  61.   SwapName1 = '!POPDOS1.SWP';     {Swap file names, when used}
  62.   SwapName2 = '!POPDOS2.SWP';
  63.   DosSwapName = '!POPDOS3.SWP';
  64.  
  65.   MinBytesForDos = 30000;         {Minimum bytes to allow for shell}
  66.  
  67. type
  68.   UserDataFlags = array[1..4] of Boolean;
  69. const
  70.   DisableFlag = 1;
  71.   ShellActiveFlag = 2;
  72.  
  73. var
  74.   ParasToKeep : Word;
  75.   OrigAttr : Byte;
  76.   {$IFDEF UseMouse}
  77.   MSP : MouseStatePtr;
  78.   MSPsize : Word;
  79.   {$ENDIF}
  80.  
  81.   procedure Beep;
  82.     {-Notify of errors}
  83.   begin
  84.     Write(^G);
  85.   end;
  86.  
  87.   procedure Abort(Msg : String);
  88.     {-Write message and halt}
  89.   begin
  90.     WriteLn(Msg);
  91.     Halt;
  92.   end;
  93.  
  94.   {$F+}
  95.   procedure PopupEntryPoint;
  96.     {-Routine activated by hotkey}
  97.   var
  98.     Status : Integer;
  99.     SaveMode : Word;
  100.     X : Byte;
  101.     Y : Byte;
  102.     StartLine : Byte;
  103.     EndLine : Byte;
  104.     KW : Word;
  105.     Covers : Pointer;
  106.   begin
  107.     {Assure it's ok to pop to DOS right now}
  108.     ReinitCrt;
  109.     if (DosBusyFlag <> 0) or WasCommandActive or not InTextMode then begin
  110.       Beep;
  111.       Exit;
  112.     end;
  113.  
  114.     {Save video state}
  115.     if not SaveWindow(1, 1, ScreenWidth, ScreenHeight, True, Covers) then begin
  116.       Beep;
  117.       Exit;
  118.     end;
  119.     SaveMode := LastMode;
  120.     WhereXYdirect(X, Y);
  121.     StartLine := CursorStartLine;
  122.     EndLine := CursorEndLine;
  123.  
  124.     {Save mouse state and reinitialize mouse}
  125.     {$IFDEF UseMouse}
  126.     if MouseInstalled then begin
  127.       SaveMouseState(MSP, False);
  128.       InitializeMouse;
  129.     end;
  130.     {$ENDIF}
  131.  
  132.     {Prepare the screen}
  133.     NormalCursor;
  134.     TextAttr := OrigAttr;
  135.     ClrScr;
  136.     WriteLn('Type EXIT to return to application');
  137.  
  138.     {Shell to DOS}
  139.     UserDataFlags(CSSwapData^.ThisIFC.UserData)[ShellActiveFlag] := True;
  140.     Status := ExecDosSwap('', True, nil, SwapDir+DosSwapName);
  141.     UserDataFlags(CSSwapData^.ThisIFC.UserData)[ShellActiveFlag] := False;
  142.     if Status <> 0 then begin
  143.       Beep;
  144.       Write('Exec error ', Status);
  145.       KW := ReadKeyWord;
  146.     end;
  147.  
  148.     {Restore the screen}
  149.     ReinitCrt;
  150.     if LastMode <> SaveMode then
  151.       TextMode(SaveMode);
  152.     RestoreWindow(1, 1, ScreenWidth, ScreenHeight, True, Covers);
  153.     SetCursorSize(StartLine, EndLine);
  154.     GoToXYAbs(X, Y);
  155.  
  156.     {Restore mouse}
  157.     {$IFDEF UseMouse}
  158.     if MouseInstalled then
  159.       RestoreMouseState(MSP, False);
  160.     {$ENDIF}
  161.   end;
  162.  
  163.   procedure ExternalIfc;
  164.     {-Dispatches external requests}
  165.   begin
  166.     with CSSwapData^.ThisIFC do
  167.       {Try to remove the TSR and set flag indicating success}
  168.       UserDataFlags(UserData)[DisableFlag] := DisableTSR;
  169.   end;
  170.   {$F-}
  171.  
  172.   procedure TryToUnload;
  173.     {-Try to remove TSR from memory}
  174.   var
  175.     IfcP : IfcPtr;
  176.     SaveMsgOn : Boolean;
  177.   begin
  178.     {Find previous copy of TSR}
  179.     IfcP := ModulePtrByName(ModuleName);
  180.     if IfcP = nil then
  181.       Abort(ModuleName+' is not currently resident');
  182.  
  183.     {Undo interrupt vectors grabbed by the transient copy of POPDOS}
  184.     RestoreAllVectors;
  185.  
  186.     with IfcP^ do begin
  187.       {Disable swapping message}
  188.       CSDataPtr^.SwapMsgOn := False;
  189.  
  190.       if UserDataFlags(UserData)[ShellActiveFlag] then
  191.         {Shell already active, can't disable now}
  192.         UserDataFlags(UserData)[DisableFlag] := False
  193.       else
  194.         {Tell resident copy to unload itself}
  195.         CmdEntryPtr;
  196.  
  197.       {Check result and halt}
  198.       if UserDataFlags(UserData)[DisableFlag] then
  199.         Abort(ModuleName+' unloaded')
  200.       else begin
  201.         Abort('Unable to unload '+ModuleName);
  202.         CSDataPtr^.SwapMsgOn := ShowSwapMsg;
  203.       end;
  204.     end;
  205.   end;
  206.  
  207.   procedure WriteHelp;
  208.     {-Write list of command line options}
  209.   begin
  210.     WriteLn;
  211.     WriteLn('Command line options:');
  212.     WriteLn('  /1         single swap file');
  213.     WriteLn('  /A         visible attribute for swap files');
  214.     WriteLn('  /D         force disk swapping even if EMS/XMS available');
  215.     WriteLn('  /F kbytes  specify approx. kbytes free within DOS shell (default all)');
  216.     WriteLn('  /H hexkey  specify TSR hot key in hex (see POPDOS.DOC)');
  217.     {$IFDEF UseMouse}
  218.     WriteLn('  /K         kill mouse management code');
  219.     {$ENDIF}
  220.     WriteLn('  /M         disable swap message');
  221.     WriteLn('  /S path    specify drive and directory for swap files');
  222.     WriteLn('  /U         unload TSR');
  223.     {$IFDEF SupportXms}                                 {!!.03}
  224.     WriteLn('  /X         use XMS memory for swap');    {!!.03}
  225.     {$ENDIF}                                            {!!.03}
  226.     WriteLn('  /?         show these command line options');
  227.     Halt;
  228.   end;
  229.  
  230.   function ValidSwapPath(Path : String;
  231.                          ParasToKeep : LongInt;
  232.                          SingleFile : Boolean) : Boolean;
  233.     {-Return True if Path is valid and has sufficient free space}
  234.   var
  235.     E : Word;
  236.     Size : LongInt;
  237.     Drive : Char;
  238.     F : file;
  239.   begin
  240.     ValidSwapPath := False;
  241.  
  242.     {Attempt to create first swap file}
  243.     Assign(F, Path+SwapName1);
  244.     Rewrite(F, 1);
  245.     E := IoResult;
  246.     case E of
  247.       0 : begin
  248.             Close(F);
  249.             E := IoResult;
  250.           end;
  251.       5 : ;                       {Existing file, access denied}
  252.     else
  253.       Exit;
  254.     end;
  255.  
  256.     {Assure adequate disk space on swap drive}
  257.     if (Length(Path) < 2) or (Path[2] <> ':') then
  258.       Drive := DefaultDrive
  259.     else
  260.       Drive := Upcase(Path[1]);
  261.     Size := SwapSize(ParasToKeep);
  262.     if not SingleFile then
  263.       Size := Size+Size;
  264.     if DiskFree(Byte(Drive)-Byte('A')+1) >= Size then
  265.       ValidSwapPath := True;
  266.   end;
  267.  
  268.   procedure ParseCommandLine;
  269.     {-Evaluate command line options}
  270.   var
  271.     I : Word;
  272.     Code : Word;
  273.     BytesForDos : LongInt;
  274.     ParasRequested : LongInt;
  275.     SingleFile : Boolean;
  276.     S : String[127];
  277.  
  278.     procedure BadOption;
  279.     begin
  280.       Abort(S);
  281.     end;
  282.  
  283.   begin
  284.     SingleFile := False;
  285.  
  286.     I := 1;
  287.     while I <= ParamCount do begin
  288.       S := StUpcase(ParamStr(I));
  289.       if (S[1] = '/') and (Length(S) = 2) then
  290.         case S[2] of
  291.           '1' :                   {Single swap file}
  292.             begin
  293.               SetSingleSwapFile(True);
  294.               SingleFile := True;
  295.             end;
  296.  
  297.           'A' :                   {Visible swap file attribute}
  298.             begin
  299.               SetSwapFileAttr(False);
  300.               ExecHideSwapFileP^ := False;
  301.             end;
  302.  
  303.           'D' :                   {Force disk swapping}
  304.             begin
  305.               SwapUseEms := False;
  306.               ExecUseEmsIfAvailableP^ := False;
  307.               {$IFDEF SupportXms}                {!!.03}
  308.               SwapUseXms := False;               {!!.03}
  309.               ExecUseXmsIfAvailableP^ := False;  {!!.03}
  310.               {$ENDIF}                           {!!.03}
  311.             end;
  312.  
  313.           'F' :                   {Specify free kbytes in DOS shell}
  314.             if I = ParamCount then
  315.               BadOption
  316.             else begin
  317.               Inc(I);
  318.               S := StUpcase(ParamStr(I));
  319.               Val(S, BytesForDos, Code);
  320.               if Code <> 0 then
  321.                 BadOption;
  322.               BytesForDos := 1024*BytesForDos;
  323.               if BytesForDos < MinBytesForDos then
  324.                 BytesForDos := MinBytesForDos
  325.               else if BytesForDos > $FFFF*$10 then
  326.                 BytesForDos := $FFFF*$10;
  327.               ParasForDos := BytesForDos div $10;
  328.             end;
  329.  
  330.           'H' :                   {Set hot key (in hex)}
  331.             if I = ParamCount then
  332.               BadOption
  333.             else begin
  334.               Inc(I);
  335.               S := StUpcase(ParamStr(I));
  336.               if S[1] <> '$' then
  337.                 S := '$'+S;
  338.               Val(S, Hotkey, Code);
  339.               if Code <> 0 then
  340.                 BadOption;
  341.             end;
  342.  
  343.           {$IFDEF UseMouse}
  344.           'K' :                   {Disable mouse management code}
  345.             ManageMouse := False;
  346.           {$ENDIF}
  347.  
  348.           'M' :                   {Disable swap message}
  349.             ShowSwapMsg := False;
  350.  
  351.           'S' :                   {Set swap path}
  352.             if I = ParamCount then
  353.               BadOption
  354.             else begin
  355.               Inc(I);
  356.               S := StUpcase(ParamStr(I));
  357.               if Length(S) > 66 then
  358.                 BadOption;
  359.               SwapDir := AddBackSlash(S);
  360.             end;
  361.  
  362.           'U' :                   {Unload TSR}
  363.             TryToUnload;
  364.  
  365.           {$IFDEF SupportXms}                         {!!.03}
  366.           'X' :                   {Use XMS for swap}  {!!.03}
  367.             begin                                     {!!.03}
  368.               SwapUseXms := True;                     {!!.03}
  369.               EmsOverXms := False;                    {!!.03}
  370.               ExecUseXmsIfAvailableP^ := True;        {!!.03}
  371.               ExecUseEmsOverXmsP^ := False;           {!!.03}
  372.             end;                                      {!!.03}
  373.           {$ENDIF}                                    {!!.03}
  374.  
  375.           '?' :                   {Show command line options}
  376.             WriteHelp;
  377.  
  378.         else
  379.           BadOption;
  380.         end
  381.       else
  382.         BadOption;
  383.  
  384.       Inc(I);
  385.     end;
  386.  
  387.     {$IFDEF UseMouse}
  388.     if not ManageMouse then
  389.       MouseInstalled := False;
  390.     if MouseInstalled then begin
  391.       {Allocate the buffer used to save the state of the mouse}
  392.       MSPsize := MouseStateBufferSize;
  393.  
  394.       {If the size is 0 or > 1000, assume that it's not safe to use the mouse}
  395.       if (MSPsize = 0) or (MSPsize > 1000) then
  396.         MouseInstalled := False
  397.       else
  398.         GetMem(MSP, MSPsize);
  399.     end;
  400.     {$ENDIF}
  401.  
  402.     {Compute actual paragraphs to keep. 256 is approx size of COMMAND.COM}
  403.     ParasRequested := LongInt(ParasForDos)+CSeg-PrefixSeg+256;
  404.     if ParasRequested > MaxParagraphsToKeep then
  405.       {MaxParagraphsToKeep is all available memory}
  406.       ParasToKeep := MaxParagraphsToKeep
  407.     else if ParasRequested < ParagraphsToKeep then
  408.       {ParagraphsToKeep is the memory we've already allocated}
  409.       ParasToKeep := ParagraphsToKeep
  410.     else
  411.       ParasToKeep := ParasRequested;
  412.  
  413.     {$IFDEF SupportXms}                                  {!!.03}
  414.     if not (WillSwapUseEms(ParasToKeep) or               {!!.03}
  415.        WillSwapUseXms(ParasToKeep)) then                 {!!.03}
  416.     {$ELSE}                                              {!!.03}
  417.     if not WillSwapUseEms(ParasToKeep) then
  418.     {$ENDIF}                                             {!!.03}
  419.       {Assure swap drive is valid}
  420.       if not ValidSwapPath(SwapDir, ParasToKeep, SingleFile) then
  421.         Abort('Swap file path is invalid or drive has insufficient free space');
  422.   end;
  423.  
  424.   procedure PopDosInit;
  425.     {-Main routine to install POPDOS}
  426.   begin
  427.     OrigAttr := NormalAttr;
  428.     WriteLn(ModuleName, ', by TurboPower Software, Version ', Version);
  429.  
  430.     if OpDos.DosVersion < $0300 then
  431.       Abort('Requires DOS version 3.00 or later');
  432.  
  433.     {Get command line options}
  434.     ParseCommandLine;
  435.  
  436.     {Check for previous installation}
  437.     if ModuleInstalled(ModuleName) then
  438.       Abort(ModuleName+' already installed');
  439.  
  440.     {Use last line of display for swap message}
  441.     case CurrentDisplay of                              {!!.03}
  442.       MCGA, EGA, VGA : SetSwapMsgRow($FF);              {!!.03}
  443.     end;                                                {!!.03}
  444.  
  445.     {Define hotkey, install module, set swapping message}
  446.     if not DefinePop(Hotkey, PopupEntryPoint, Ptr(SSeg, SPtr)) then
  447.       Abort('Error defining popup procedure');
  448.     InstallModule(ModuleName, ExternalIfc);
  449.     if ShowSwapMsg then
  450.       {$IFDEF SupportXms}                                  {!!.03}
  451.       if (WillSwapUseEms(ParasToKeep) or                   {!!.03}
  452.          WillSwapUseXms(ParasToKeep)) and                  {!!.03}
  453.          (ParasToKeep div OneMs < 100) then                {!!.03}
  454.       {$ELSE}                                              {!!.03}
  455.       if WillSwapUseEms(ParasToKeep) and (ParasToKeep div OneMs < 100) then
  456.       {$ENDIF}                                             {!!.03}
  457.         {XMS or EMS swapping will be fast enough to make swap message unneeded}
  458.         ShowSwapMsg := False;
  459.     SetSwapMsgOn(ShowSwapMsg);
  460.  
  461.     {Set flag indicating shell not active}
  462.     with CSSwapData^.ThisIFC do
  463.       UserDataFlags(UserData)[ShellActiveFlag] := False;
  464.  
  465.     {Go resident}
  466.     WriteLn('Going resident, ', HotkeyStr, ' to pop to DOS...');
  467.     PopupsOn;
  468.     StayResSwap(ParasToKeep, 0,
  469.                 SwapDir+SwapName1, SwapDir+SwapName2,
  470.                 True);
  471.     WriteLn('Error going resident');
  472.   end;
  473.  
  474. end.
  475.