home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lan
/
netcraft
/
nettts.pas
< prev
Wrap
Pascal/Delphi Source File
|
1988-06-10
|
6KB
|
265 lines
{*********************************************************************
NETTTS - A unit of NetWare Application Program Interfaces
Relating to Transaction Tracking System Services
for Turbo Pascal 4.0 and Advanced NetWare (any verison)
Copyright (c) 1988, Richard S. Sadowsky
All rights reserved
version .6 4/22/88 by Richard S. Sadowsky 74017,1670
**********************************************************************}
Unit NetTTS;
{$I-,V-,S+,R+}
interface
uses Dos;
var
NovRegs : Registers; { register type for DOS/Novell calls }
function TTSAbort : Byte;
{ Return code:
00h - success
FDh - TTS Disabled
FEh - Transaction ends records locked (trans aborted, but recs left locked)
FFh - no explicit transaction active
}
function TTSBegin : Byte;
{ return code:
00h - Success
96h - Out of Dynamic Workspace
FEh - Implicit transaction active (active implicit turned into explicit)
FFh - Explicit Transaction active
}
function TTSEnd(var ID : LongInt) : Byte;
{ return code:
00h - Success
FDh - TTS Disabled
FEh - Tranaction ends records locked
FFh - No Explicit transaction active
}
function TTSStatus(ID : LongInt) : Boolean;
{ returns TRUE if referenced transaction has been committed to disk }
function TTSGetAppThresh(var Logical,Physical : Byte) : Boolean;
function TTSGetWSThresh(var Logical,Physical : Byte) : Boolean;
function TTSAvailable : Boolean;
function TTSDisable : Boolean;
function TTSEnable : Boolean;
function HiLong(Long : LongInt) : Word;
{ This inline directive is similar to Turbo's Hi() function, except }
{ it returns the high word of a LongInt }
Inline(
$5A/ {pop dx ; low word of long}
$58); {pop ax ; hi word of long}
function LowLong(Long : LongInt) : Word;
{ This inline directive is similar to Turbo's Lo() function, except }
{ it returns the Low word of a LongInt }
Inline(
$5A/ {pop dx ; low word of long}
$58/ {pop ax ; hi word of long}
$89/$D0); {mov ax,dx ; return lo word as function result in Ax}
function MakeLong(HiWord,LoWord : Word) : LongInt;
{takes hi and lo words and makes a longint }
Inline(
$58/ { pop ax ; pop low word into AX }
$5A); { pop dx ; pop high word into DX }
implementation
function TTSAbort : Byte;
{ Return code:
00h - success
FDh - TTS Disabled
FEh - Transaction ends records locked (trans aborted, but recs left locked
FFh - no explicit transaction active
}
begin
with NovRegs do begin
AX := $C703;
MsDos(NovRegs);
if Flags and FCarry <> 0 then
TTSAbort := AL
else
TTSAbort := 0;
end;
end;
function TTSBegin : Byte;
{ return code:
00h - Success
96h - Out of Dynamic Workspace
FEh - Implicit transaction active (active implicit turned into explicit)
FFh - Explicit Transaction active
}
begin
with NovRegs do begin
AX := $C700;
MsDos(NovRegs);
if Flags and FCarry <> 0 then
TTSBegin := AL
else
TTSBegin := 0;
end
end;
function TTSEnd(var ID : LongInt) : Byte;
{ return code:
00h - Success
FDh - TTS Disabled
FEh - Tranaction ends records locked
FFh - No Explicit transaction active
}
begin
with NovRegs do begin
AX := $C701;
MsDos(NovRegs);
ID := MakeLong(CX,DX);
if Flags and FCarry <> 0 then
TTSEnd := AL
else
TTSEnd := 0;
end
end;
function TTSGetAppThresh(var Logical,Physical : Byte) : Boolean;
begin
with NovRegs do begin
AX := $C705;
MsDos(NovRegs);
TTSGetAppThresh := AL = 0;
Logical := CL;
Physical := CH;
end;
end;
function TTSGetWSThresh(var Logical,Physical : Byte) : Boolean;
begin
with NovRegs do begin
AX := $C707;
MsDos(NovRegs);
TTSGetWSThresh := AL = 0;
Logical := CL;
Physical := CH;
end;
end;
function TTSAvailable : Boolean;
begin
with NovRegs do begin
AX := $C702;
MsDos(NovRegs);
TTSAvailable := AL = 1;
end
end;
function TTSSetAppThresh(Logical,Physical : Byte) : Byte;
begin
with NovRegs do begin
AX := $C706;
CL := Logical;
CH := Physical;
MsDos(NovRegs);
TTSSetAppThresh := AL;
end;
end;
function TTSSetWSThresh(Logical,Physical : Byte) : Byte;
begin
with NovRegs do begin
AX := $C708;
CL := Logical;
CH := Physical;
MsDos(NovRegs);
TTSSetWSThresh := AL;
end;
end;
function TTSStatus(ID : LongInt) : Boolean;
{ returns TRUE if referenced transaction has been committed to disk }
begin
with NovRegs do begin
AH := $C7;
AL := $04;
CX := HiLong(ID);
DX := LowLong(ID);
MsDos(NovRegs);
TTSStatus := AL = 0;
end
end;
function TTSDisable : Boolean;
var
Reply : Word;
Request : Record
Len : Word;
SubF : Byte;
end;
begin
Reply := 0;
with Request do begin
Len := 1;
SubF := $CF;
end;
with NovRegs do begin
AX := $E300;
DS := Seg(Request);
SI := Ofs(Request);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
TTSDisable := AL = 0;
end
end;
function TTSEnable : Boolean;
var
Reply : Word;
Request : Record
Len : Word;
SubF : Byte;
end;
begin
Reply := 0;
with Request do begin
Len := 1;
SubF := $D0;
end;
with NovRegs do begin
AX := $E300;
DS := Seg(Request);
SI := Ofs(Request);
ES := Seg(Reply);
DI := Ofs(Reply);
MsDos(NovRegs);
TTSEnable := AL = 0;
end
end;
end.