[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]

    {
    TRISDARESA SUMARJOSO

    > I was wondering if anyone knew how to make a split screen While
    > making EXEC calls and not losing your Windows?

    > Anyone got any ideas or routines that do this? I can do it easily
    > using TTT when I just stay Within the Program, but the problems arise
    > when I do the SwapVectors and do my Exec call, all hell breaks loose.
    > Lynn.

            Here is a Unit that I've created to trap Int 29h. the Function of this
    Unit is to trap the output that Dos spits through the Int 29h (such as XCopy,
    PkZip, etc) and redirect it into a predefined Window.
            Here is the stuff:
    }

    Unit I29UnitA;

    { This Unit will trap Dos output which use Int 29h. Any other
      method of writing the scren, such as Direct Write which bypasses
      Int 29h call, will not be trapped. }

    Interface

    { Initialize the view that will be use to output the Dos output.
      Will also draw basic Window frame. }
    Procedure InitView(XX1, XY1, XX2, XY2 : Byte);
    { Clear the pre-defined view. }
    Procedure ClearView;
    { Procedure to redirect the Turbo Pascal Write and WriteLn Procedure.
      (standard OutPut only).
      Do not call this Procedure twice in the row.
      More than once call to this Procedure will result Pascal's standard
      output Procedure will not be restored properly. }
    Procedure TrapWrite;
    { Restore Pascal's Write and WriteLn Procedure into its original
      condition that was altered With TRAPWrite. (standard OutPut only). }
    Procedure UnTrapWrite;

    Implementation

    Uses
      Dos;

    Type
      VioCharType = Record
        Case Boolean Of
          True  : (Ch, Attr : Byte);
          False : (Content : Word);
        end;

      DrvFunc    = Function(Var F : TextRec) : Integer;
      VioBufType = Array [0..24, 0..79] Of VioCharType;

    Var
      OldInt29     : Pointer;
      OldExit      : Pointer;
      OldIOFunc    : DrvFunc;
      OldFlushFunc : DrvFunc;
      TrapWriteVar : Boolean;
      X1, Y1, X2,
      Y2           : Byte;
      XVio         : Byte;
      YVio         : Byte;
      VioBuffer    : ^VioBufType;
      VioCurLoc    : Word Absolute $0040:$0050;

    {$F+}
    Procedure NewInt29(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);
    Interrupt;
    begin
      VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr And Not 112;
      if (Lo(AX) = 13) Then
      begin
        XVio := X1;
        AX := 0;
      end
      else
      if (Lo(AX) = 10) Then
      begin
        Inc(YVio);
        AX := 0;
      end;
      begin
        if (XVio > X2) Then
        begin
          XVio := X1;
          Inc(YVio);
        end;
        if (YVio > Y2) Then
        begin
          Asm
            Mov   AH, 06
            Mov   AL, YVio
            Sub   AL, Y2
            Mov   CH, Y1
            Mov   CL, X1
            Mov   DH, Y2
            Mov   DL, X2
            Mov   BH, 07
            Int   10h
          end;

          YVio := Y2;
        end;

        if (Lo(AX) = 32) Then
        begin
          if (Lo(VioCurLoc) < XVio) Then
          begin
            XVio := Lo(VioCurLoc);
            VioBuffer^[YVio, XVio].Ch := Lo(AX);
          end
          else
          begin
            VioBuffer^[YVio, XVio].Ch := Lo(AX);
            Inc(XVio);
          end;
        end
        else
        begin
          VioBuffer^[YVio, XVio].Ch := Lo(AX);
          Inc(XVio);
        end;
        VioCurLoc := YVio Shl 8 + XVio;
      end;
      VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr Or 112;
    end;
    {$F-}

    {$F+}
    Procedure RestoreInt29;
    begin
      ExitProc := OldExit;
      SetIntVec($29, OldInt29);
      if TrapWriteVar Then
      begin
        TextRec(OutPut).InOutFunc := @OldIOFunc;
        TextRec(OutPut).FlushFunc := @OldFlushFunc;
      end;
    end;
    {$F-}

    Procedure HookInt29;
    begin
      GetIntVec($29, OldInt29);
      SetIntVec($29, @NewInt29);
      OldExit := ExitProc;
      ExitProc := @RestoreInt29;
    end;

    Procedure InitView(XX1, XY1, XX2, XY2: Byte);
    Var
      I    : Byte;
    begin
      X1 := XX1+1;
      Y1 := XY1+1;
      X2 := XX2-1;
      Y2 := XY2-1;
      XVio := X1;
      YVio := Y1;
      For I := XX1 To XX2 Do
      begin
        VioBuffer^[XY1, I].Ch := 205;
        VioBuffer^[XY2, I].Ch := 205;
      end;
      For I := XY1+1 To XY2-1 Do
      begin
        VioBuffer^[I, XX1].Ch := 179;
        VioBuffer^[I, XX2].Ch := 179;
      end;
      VioBuffer^[XY1, XX1].Ch := 213;
      VioBuffer^[XY2, XX1].Ch := 212;
      VioBuffer^[XY1, XX2].Ch := 184;
      VioBuffer^[XY2, XX2].Ch := 190;
      VioCurLoc := YVio Shl 8 + XVio;
    end;

    Procedure DoWriteStuff(F : TextRec);
    Var
      I    : Integer;
      Regs : Registers;
    begin
      For I := 0 To F.BufPos-1 Do
      begin
        Regs.AL := Byte(F.BufPtr^[I]);
        Intr($29, Regs);
      end;
    end;

    {$F+}
    Function NewOutputFunc(Var F : TextRec) : Integer;
    begin
      DoWriteStuff(F);
      F.BufPos := 0;
      NewOutPutFunc := 0;
    end;
    {$F-}

    {$F+}
    Function NewFlushFunc(Var F : TextRec) : Integer;
    begin
      DoWriteStuff(F);
      F.BufPos := 0;
      NewFlushFunc := 0;
    end;
    {$F-}

    Procedure TrapWrite;
    begin
      if Not TrapWriteVar Then
      begin
        With TextRec(OutPut) Do
        begin
          OldIOFunc := DrvFunc(InOutFunc);
          InOutFunc := @NewOutPutFunc;
          OldFlushFunc := DrvFUnc(FlushFunc);
          FlushFunc := @NewFlushFunc;
        end;
        TrapWriteVar := True;
      end;
    end;

    Procedure UnTrapWrite;
    begin
      if TrapWriteVar Then
      begin
        TextRec(OutPut).InOutFunc := @OldIOFunc;
        TextRec(OutPut).FlushFunc := @OldFlushFunc;
        TrapWriteVar := False;
      end;
    end;

    Procedure ClearView;
    begin
      Asm
        Mov   AH, 06
        Mov   AL, 0
        Mov   CH, Y1
        Mov   CL, X1
        Mov   DH, Y2
        Mov   DL, X2
        Mov   BH, 07
        Int   10h
      end;
      XVio := X1;
      YVio := Y1;
      VioCurLoc := YVio Shl 8 + XVio;
    end;

    Procedure CheckMode;
    Var
      MyRegs : Registers;
    begin
      MyRegs.AH := $F;
      Intr($10, MyRegs);
      Case MyRegs.AL Of
        0, 1, 2, 3  : VioBuffer := Ptr($B800, $0000);
        7           : VioBuffer := Ptr($B000, $0000);
      end;
    end;

    begin
      X1 := 0;
      Y1 := 0;
      X2 := 79;
      Y2 := 24;
      XVio := 0;
      YVio := 0;
      VioCurLoc := YVio Shl 8 + XVio;
      HookInt29;
      TrapWriteVar := False;
      CheckMode;
    end.

    Program Int29Testing;

    {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
    {$M $800,0,0}

    Uses
      Dos, Crt,
      I29UnitA;

    Var
      CmdLine      : String;
      I            : Byte;

    { Function to convert a String to upper case.
      Return the upper-case String. }

    Function Str2Upr(Str : String) : String; Assembler;
    Asm
      Push DS
      CLD
      LDS  SI, Str
      LES  DI, @Result
      LodSB
      Or   AL, AL
      Jz   @Done
      StoSB
      Xor  CH, CH
      Mov  CL, AL
     @@1:
      LodSB
      Cmp  AL, 'a'
      JB   @@2
      Cmp  AL, 'z'
      JA   @@2
      Sub  AL, 20h
     @@2:
      StoSB
      Loop @@1
     @Done:
      Pop  DS
    end;

    begin
      ClrScr;
      GotoXY(1,1);
      WriteLn('Output interceptor.');
      { Initialize redirector's area. }
      InitView(0,2,79,24);
      Repeat
              { Redirect Turbo's output into the predefined Window. }
        TrapWrite;
        Write(#0,' Please enter Dos command (Done to Exit): ');
        ReadLn(CmdLine);
        WriteLn;
        { Restore Turbo's original Output routine. }
        UnTrapWrite;
        GotoXY(1,2);
        WriteLn('Command executed : ', CmdLine);
        CmdLine := Str2Upr(CmdLine);
        if (CmdLine <> 'DONE') And (CmdLine <> '') Then
        begin
          SwapVectors;
          Exec('C:\Command.Com', '/C'+CmdLine);
          SwapVectors;
        end;
        GotoXY(1,2);
        WriteLn('Command execution done. Press anykey to continue...');
        Repeat Until ReadKey <> #0;
        ClearView;
        GotoXY(1,2);
        WriteLn('                                                   ');
      Until (CmdLine = 'DONE');
      ClrScr;
    end.

    {
    Both the testing Program and the Unit itself (expecially the Unit), is by no
    mean perfect. Use With caution. It might not wise to use such redirector
    (my int 29 Unit) in a Program that swaps itself out of memory. The above
    Programs were not optimized in anyway (so it might slow your Program a
    little). And I don't guarantee that this Program will work on your computer
    (it work Without a problem on mine). if you like this Unit, you can use it
    anyway you desire. Just remember I can guarantee nothing For this method.
    }

[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]