Power-Programmierung/CD1.mdf/lan/netcraft/nettts.pas

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.