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

    {$A-,B-,D-,E-,F+,G-,I-,L-,N-,O+,P-,R-,S-,V-,X+}
    Unit AltDos;
    Interface
    {$IFDEF VIRTUALPASCAL}
    Uses Use32,Dos;
    {$DEFINE OS2}
    {$ELSE}
    Uses Dos;
    {$ENDIF}

    {$IFNDEF OS2}
    function Execute(ExeFile,ComLine: string): boolean;
    {$ENDIF}
    Function DosShell(command:String): Integer;

    function FileExists(FileName: string): boolean;
    function DirExists(FileName: string): boolean;

    {$IFNDEF VIRTUALPASCAL}
    Procedure GetFileMode;
    Function TextFilePos(Var f : Text) : LongInt;
    Function TextFileSize(Var f : Text) : LongInt;
    Procedure TextSeek(Var f : Text; n : LongInt);
    {$ENDIF}

    procedure CopyFile(FromN,ToN: string);

    {$IFNDEF OS2}
    Function GetMemSize: Word;
    {$ENDIF}

    Implementation
    {$IFNDEF OS2}
    {$IFNDEF DPMI}
    Function DosShell;
    Var
      OldHeapEnd,
      NewHeapEnd: Word;
      Error:Integer;
    Begin
      Error:=0;
      If MemAvail<$1000
        then Error:=8;
      If Error=0
        then
          begin
            NewHeapEnd:=Seg(HeapPtr^)-PrefixSeg;
            OldHeapEnd:=Seg(HeapEnd^)-PrefixSeg;
            asm
              mov ah,4Ah
              mov bx,NewHeapEnd
              mov es,PrefixSeg
              Int 21h
              jnc @EXIT
              mov Error,ax
              @EXIT:
            end;
            If Error=0
              then
                begin
                  SwapVectors;
                  Exec(GetEnv('COMSPEC'),command);
                  SwapVectors;
                  asm
                    mov ah,4Ah
                    mov bx,OldHeapEnd
                    mov es,PrefixSeg
                    Int 21h
                    jnc @EXIT
                    mov Error,ax
                    @EXIT:
                  end;
                end;
          end;
      DosShell:=Error;
    end;     {Function}
    {$ENDIF}
    {$ENDIF}

    {$IFDEF DPMI}
    Function DosShell;
    Begin
      SwapVectors;
      Exec(GetEnv('COMSPEC'),command);
      SwapVectors;
      DosShell:=0;
    end;     {Function}
    {$ENDIF}

    {$IFDEF OS2}
    Function DosShell;
    Begin
      Exec(GetEnv('COMSPEC'),command);
      DosShell:=0;
    end;     {Function}
    {$ENDIF}

    {$IFNDEF OS2}
    function Execute;
    var
      EF  : string ;
      Dir : DirStr ;
      Name: NameStr;
      Ext : ExtStr ;
    {$IFNDEF DPMI}
      OldHeapEnd,
      NewHeapEnd: Word;
    {$ENDIF}
      Error:Integer;
    begin
      FSplit(ExeFile,Dir,Name,Ext);
      if Name+Ext='COMMAND.COM'
        then Error:=DosShell(ComLine)
        else
          begin
            if (Dir[byte(Dir[0])]='\') and (byte(Dir[0])>0)
              then Dir[byte(Dir[0])]:=';'
              else
                if (byte(Dir[0])>0)
                  then Dir:=Dir+';';
            EF:=FSearch(ExeFile,Dir+GetEnv('PATH'));
            if EF=''
              then Execute:=false
              else
                begin
    {$IFNDEF DPMI}
                Error:=0;
                If MemAvail<$1000
                  then Error:=8;
                If Error=0
                  then
                    begin
                      NewHeapEnd:=Seg(HeapPtr^)-PrefixSeg;
                      OldHeapEnd:=Seg(HeapEnd^)-PrefixSeg;
                      asm
                        mov ah,4Ah
                        mov bx,NewHeapEnd
                        mov es,PrefixSeg
                        Int 21h
                        jnc @EXIT
                        mov Error,ax
                      @EXIT:
                      end;
                     If Error=0
                       then
                         begin
    {$ENDIF}
                           SwapVectors;
                           Exec(EF,ComLine);
                           SwapVectors;
    {$IFNDEF DPMI}
                           asm
                             mov ah,4Ah
                             mov bx,OldHeapEnd
                             mov es,PrefixSeg
                             Int 21h
                             jnc @EXIT
                             mov Error,ax
                           @EXIT:
                         end;
                    end;
                end;
    {$ENDIF}
                  Execute:=true;
                end;
          end;
    end;
    {$ENDIF}

    {$IFDEF VIRTUALPASCAL}
    {$UNDEF OS2}
    {$ENDIF}

    {$IFNDEF VIRTUALPASCAL}
    Procedure GetFileMode; Assembler;
    Asm
      CLC
      CMP    ES:[DI].TextRec.Mode, fmInput
      JE     @1
      MOV    [InOutRes], 104         { 'File not opened For reading' }
      xor    AX, AX                  { Zero out Function result }
      xor    DX, DX
      STC
    @1:
    end;  { GetFileMode }

    Function TextFilePos(Var f : Text) : LongInt; Assembler;
    Asm
      LES    DI, f
      CALL   GetFileMode
      JC     @1
      xor    CX, CX                  { Get position of File Pointer }
      xor    DX, DX
      MOV    BX, ES:[DI].TextRec.handle
      MOV    AX, 4201h
      inT    21h                     { offset := offset-Bufend+BufPos }
      xor    BX, BX
      SUB    AX, ES:[DI].TextRec.Bufend
      SBB    DX, BX
      ADD    AX, ES:[DI].TextRec.BufPos
      ADC    DX, BX
    @1:
    end;  { TextFilePos }

    Function TextFileSize(Var f : Text) : LongInt; Assembler;
    Asm
      LES    DI, f
      CALL   GetFileMode
      JC     @1
      xor    CX, CX                  { Get position of File Pointer }
      xor    DX, DX
      MOV    BX, ES:[DI].TextRec.handle
      MOV    AX, 4201h
      inT    21h
      PUSH   DX                      { Save current offset on the stack }
      PUSH   AX
      xor    DX, DX                  { Move File Pointer to Eof }
      MOV    AX, 4202h
      inT    21h
      POP    SI
      POP    CX
      PUSH   DX                      { Save Eof position }
      PUSH   AX
      MOV    DX, SI                  { Restore old offset }
      MOV    AX, 4200h
      inT    21h
      POP    AX                      { Return result}
      POP    DX
    @1:
    end;  { TextFileSize }

    Procedure TextSeek(Var f : Text; n : LongInt); Assembler;
    Asm
      LES    DI, f
      CALL   GetFileMode
      JC     @2
      MOV    CX, Word Ptr n+2        { Move File Pointer }
      MOV    DX, Word Ptr n
      MOV    BX, ES:[DI].TextRec.Handle
      MOV    AX, 4200h
      inT    21h
      JNC    @1                      { Carry flag = reading past Eof }
      MOV    [InOutRes], AX
      JMP    @2
      { Force read next time }
    @1:
      MOV    AX, ES:[DI].TextRec.Bufend
      MOV    ES:[DI].TextRec.BufPos, AX
    @2:
    end;  { TextSeek }
    {$ENDIF}

    function FileExists;
    var
      SR: SearchRec;
    begin
    {$IFDEF OS2}
      FindFirst(FileName,AnyFile-Directory,SR);
    {$ELSE}
      FindFirst(FileName,AnyFile-VolumeID-Directory,SR);
    {$ENDIF}
      FileExists:=DosError=0;
    end;

    function DirExists;
    var
      SR: SearchRec;
    begin
      FindFirst(FileName,Directory,SR);
      DirExists:=DosError=0;
    end;

    procedure CopyFile;
    var
      FromF,ToF: file   ;
      NrRead,
      NrWriteln: word   ;
      Buf      : pointer;
      Block    : word   ;
    begin
      Assign(FromF,FromN);
      Assign(ToF,ToN);
      Reset(FromF,1);
      Rewrite(ToF,1);
      Block:=MaxAvail;
      GetMem(Buf,Block);
      repeat
        BlockRead(FromF,Buf^,Block,NrRead);
        BlockWrite(ToF,Buf^,NrRead,NrWriteLn);
      until (NrRead=0) or (NrWriteLn<>NrRead);
      FreeMem(Buf,Block);
      Close(FromF);
      Close(ToF);
    end;

    {$IFDEF VIRTUALPASCAL}
    {$DEFINE OS2}
    {$ENDIF}

    {$IFNDEF OS2}
    Function GetMemSize;
    Assembler;
    Asm
      Int 12h
    End;
    {$ENDIF}

    end.

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