[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]