Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/NOVFNC.ZIP/CIS.PAS

Pascal/Delphi Source File | 1987-10-02 | 20.0 KB | 530 lines

{ This is my Novell Toolbox for printing, file and record locking, }
{ logical locks, and semaphores. }

{ If you use these routines in your software, and find them of value, }
{ please send a contribution of $15 to $50 to me for funding of additional }
{ toolboxes.  If you find these routines useful and use them in a commercial }
{ application, no royalties are requested.  If you do profit from these }
{ routines, please consider a larger donation. }

{ Also please send your ideas for future toolboxes.  The current plans }
{ include Novell spooling print functions, an IPX concentrator, and of }
{ course, the elusive Novell B+ Tree routines, compatible with Borland's }
{ database toolbox, but completely networkable.  I know you want these, and }
{ if I find time, I'll finish them.  Your contributions go a long way towards }
{ finding the time to work on this stuff. }
{ Telephone support is available for my routines at Micro Networks of America }
{ in Farmington, CT [phone].  Our current consulting rate must be }
{ charged if I support you from the office, via the phone.  Other support is }
{ available for free via compuserve (Borland SIG) or via mail at home. }
{  The address for contributions and support questions is: }
{              Scott A. Lewis
               36 Maythorpe Drive
               Windsor, CT 06095

On Compuserve, send mail to 76515,135 via Easyplex or Borland's SIG.

}

{ The future toolboxes complete descriptions are as follows:

    IPX concentrator:  A PC to PC communications toolbox using Novell's
                       IPX internetwork communications.  The primary
                       application will be sharing a host communication
                       line, however, a print or modem server might be
                       easily implemented.

     Novell print spooling:  A demo program that is a simple popup spool
                             utility.  Similar to Hotprint, but with less
                             complexity.  The toolbox will include functions
                             for all of Novell's printing function calls.

     Novell B+ Trees:  I needn't explain this one, especially if you have
                       followed my LAN threads on Compuserve (Borland SIG).
                       I really have been working on this one, but it is big,
                       tough to document, and difficult to make as fast as the
                       original.  I'll get one of these days.

Send your ideas for future toolboxes !

}

TYPE
  Str80 = STRING[80];
  RecLogType = STRING[100];
  Str6 = STRING[6];
  BigStr = STRING[255];
  Reg_Type = RECORD
               CASE Byte OF
                 0 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer);
                 1 : (AL, AH, BL, BH, CL, CH, DL, DH : Byte);
             END;
  Request_Type = ARRAY[1..7] OF Byte;
  Reply_Type = ARRAY[1..90] OF Char;

VAR
  Regs : Reg_Type;
  Request_Buff : Request_Type;
  Reply_Buff : Reply_Type;
  I, J : Integer;

  FUNCTION Open_Semaphore(Sem : BigStr;
                          InitVal : Integer;
                          VAR SemHandle1 : Integer;
                          VAR SemHandle2 : Integer;
                          VAR Num_Using : Integer) : Boolean;
{ Semaphores are used for exclusion when record locking is not appropriate }
{ The value is set the first time the semaphore is opened, thereafter you }
{ must use wait semaphore or signal semaphore to change the value }
  BEGIN
    WITH Regs DO
      BEGIN
        IF (Sem[0] > #127) OR (InitVal < 0) OR (InitVal > 127) THEN
          BEGIN                        { Semaphore must not exceed 127 chars }
            Open_Semaphore := False;     { InitVal must be between 0 and 127 }
            Exit;
          END;
        AH := $C5;                                      { Semaphore function }
        AL := $0;                                    { Sub-Function 0 = open }
        DS := Seg(Sem);                               { DS:DX points to name }
        DX := Ofs(Sem);                             { Byte 0 = length 0..127 }
        CL := InitVal;                                { Initial Value 0..127 }

        MsDos(Regs);                                    { Give it to Int 21h }

        Num_Using := BL;              { Number of users using this semaphore }
        Open_Semaphore := (AL = 0);               { OK if AL comes back as 0 }
        SemHandle1 := CX;                 { CX:DX holds the semaphore handle }
        SemHandle2 := DX;
      END;                                                    { with Regs do }
  END;                                              {Function Open_Semaphore }


  FUNCTION Examine_Semaphore(SemHandle1, SemHandle2 : Integer;
                             VAR Value : Integer;
                             VAR Num_Using : Integer) : Boolean;
{ The semaphore value that comes back in CL is the count from the open call }
{ DL represents the current open count - the open count is incremented }
{ anytime  a station opens the semaphore this can be used for controlling }
{ the number of users using your software }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C5;                                 { Semaphore function call }
        AL := 1;                                  { Sub-Function 1 = examine }
        CX := SemHandle1;
        DX := SemHandle2;

        MsDos(Regs);                                        { Give it to DOS }

        Value := CX;                                 { Semaphore value in CX }
        Num_Using := DL;                       { Number using this semaphore }
        Examine_Semaphore := (AL = 0);                     { AL = 0 means OK }
      END;
  END;                                          { function Examine_Semaphore }

  FUNCTION Wait_Semaphore(SemHandle1, SemHandle2 : Integer;
                          Wait_Time : Integer) : Boolean;
{ Decrement the semaphore value and wait if it is negative.  If negative, }
{ the workstation will wait until it becomes non-negative or until a }
{ timeout occurs. }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C5;                                 { Semaphore function call }
        AL := 2;                                     { Sub-Function 2 = wait }
        BP := Wait_Time;                      { In 1/18 seconds, 0 = No wait }
        CX := SemHandle1;
        DX := SemHandle2;

        MsDos(Regs);                                        { Give it to DOS }

        Wait_Semaphore := (AL = 0);        { AL = 0 means OK, else timeout or
                                                              Invalid handle }
      END;
  END;                                             { function Wait_Semaphore }

  FUNCTION Signal_Semaphore(SemHandle1, SemHandle2 : Integer) : Boolean;

{ Increment the semaphore value and release if waiting.  If any stations }
{ are waiting, the station that has been waiting the longest will be }
{ signalled to proceed }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C5;                                 { Semaphore function call }
        AL := 3;                                   { Sub-Function 3 = signal }
        CX := SemHandle1;
        DX := SemHandle2;

        MsDos(Regs);                                        { Give it to DOS }

        Signal_Semaphore := (AL = 0);      { AL = 0 means OK, else overflow ( value > 128 ) }
                                           { or Invalid handle }
      END;
  END;                                           { function Signal_Semaphore }

  FUNCTION Close_Semaphore(SemHandle1, SemHandle2 : Integer) : Boolean;

{ Decrement the open count of a semaphore.  When the open count goes }
{ to zero, the semaphore is destroyed. }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C5;                                 { Semaphore function call }
        AL := 4;                                    { Sub-Function 4 = close }
        CX := SemHandle1;
        DX := SemHandle2;

        MsDos(Regs);                                        { Give it to DOS }

        Close_Semaphore := (AL = 0);  { AL = 0 means OK, else Invalid handle }
      END;
  END;                                            { function Close_Semaphore }

  FUNCTION Set_Lock_Mode : boolean;
{ Note that if other applications are running that were written for Netware }
{ 4.61 or older, this should be set back to old compatibility mode before we }
{ exit.   This can be done by using this call with AL = 00h }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C6;                                      { Lock mode function }
        AL := 1;                                     { We want extended mode }
      END;
  END;

(* THE FOLLOWING PROCEDURES ARE FOR LOGGING AND LOCKING/RELEASING FILE SETS *)
(* File locking by set can be very effective in avoiding deadly embrace *)

  FUNCTION Lock_File_Set(Mode : Byte; Timeout : Byte) : Boolean;
{ Lock a set of files that were logged by function $EB log asciiz file }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $CB;                                  { Lock File Set Function }
        DL := Mode;                                  { 0 = No Wait, 1 = wait }
        BP := Timeout;                     { in 1/18 seconds ... 0 = No Wait }

        MsDos(Regs);                                        { Give it to DOS }

        Lock_File_Set := (AL = 0);  { Al = 0 means OK FF = Fail FE = Timeout }
      END;

  END;                 { function Lock_File_Set(Mode : Byte; Timeout : Byte) }

Procedure Release_File_Set;
{ Release lock on set of files in logged table, files remain logged }
{ These files remain open but cannot be accessed without an error }
{ To reuse them, send another lock file set }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $CD;                               { Release file set function }
        MsDos(Regs);
      END;
  END;                                          { function Release_File_Set  }

FUNCTION Clear_File_Set : Boolean;
{ Unlock and UnLog the entire personal file set (all files are closed) }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $CF;                               { Release File Set Function }
        MsDos(Regs);
        Clear_File_Set := (AL = 0);  { Al = 0 means OK }
      END;
  END;                                             { function Clear_File_Set }

  FUNCTION Log_File(FName : Str80; Mode : Byte; Timeout : Byte) : Boolean;
  VAR
    Asciiz : STRING[80];
{ This function allows a station to log files fro later personal use }
{ After the desired files are logged, function CBh can be used to lock }
{ the entire set of files }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $EB;                              { Log Asciiz string function }
        AL := Mode;                           { 0 = Log Only, 1 Log and Lock }
        BP := Timeout;                        { in 1/18 seconds, 0 = No wait }
        Asciiz := FName+#0;                { Terminate with a nul for asciiz }
        DS := Seg(Asciiz);
        DX := Ofs(Asciiz[1]);

        MsDos(Regs);

        Log_File := (AL = 0);
      END;
  END;                                                   { function Log_File }

  FUNCTION Release_File(FName : Str80) : boolean;
  VAR
    Asciiz : STRING[80];
{ Release file lock, but keep logged in the table }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $EC;                                       { Release file call }
        Asciiz := FName+#0;                                 { null terminate }
        DS := Seg(Asciiz);
        DX := Ofs(Asciiz[1]);

        MsDos(Regs);
      END;
  END;                                               { function Release_File }

  FUNCTION Clear_File(FName : Str80) : boolean;
  VAR
    Asciiz : STRING[80];
{ Release a file from the file log table, unlock the file if it is locked }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $ED;
        Asciiz := FName+#0;
        DS := Seg(Asciiz);
        DX := Ofs(Asciiz[1]);
        MsDos(Regs);
        Clear_File := (AL = 0);  { Al = 0 means OK }
      END;
  END;                                                 { Function Clear_File }


(* THE FOLLOWING FUNCTIONS ARE FOR LOGICAL LOCKING OPERATIONS *)
(* Logical locks work only if all software accessing the files use the *)
(* same logical synchronization scheme.  Logical locks are much easier *)
(* and faster to implement than physical locks. *)


  FUNCTION Begin_Logical_Locking(Mode, Timeout : Integer) : Boolean;

{ Call this when you are about to start the read modify update cycle on an }
{ open shareable file or set of files.  The mode can be zero or one for }
{ No wait or wait, if wait is chosen, the timeout value is set in 1/18th }
{ seconds.  When the shell receives this call, it sends a request to the }
{ server to lock all shareable files that the workstation has opened.  This }
{ only works on file flagged as shareable and is only effective if all }
{ stations that are acessing the files use this method }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C8;                     { Begin Logical File Locking Function }
        DL := Mode;                                  { 0 = No wait, 1 = Wait }
        IF Mode = 1 THEN
          BP := Timeout;          { timeout in 1/18th seconds -- 0 = No wait }
        MsDos(Regs);
        Begin_Logical_Locking := (AL = 0);        { AL=FFh if fail, AL=FEh if
                                                                     timeout }
      END;
  END;                                      { function Begin_Logical_Locking }

FUNCTION End_Logical_Locking : Boolean;
{ This call will indicate that the read modify update cycle is complete }
{ and unlock the logical locks previously placed by Begin_Logical_Locking }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $C9;
        MsDos(Regs);
        End_Logical_Locking := (AL = 0);
      END;
  END;                                                 { End_Logical_Locking }

FUNCTION Log_Logical_Record(Flg, Timeout : Integer; VAR RecName : RecLogType) : Boolean;

{ This function will log the specified record string in the record log table }
{ of the requesting station.  The record format for this string is as follows }

    {    byte      value  }
    {    0         length }
    {    1..100    data   }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D0;
        AL := Flg;     { If bit zero is set, lock as well as log }
                       { If bit one is set, non-exclusive lock( valid only if }
                       { bit zero is set. }
        DS := Seg(RecName);
        DX := Ofs(RecName);
        BP := Timeout;       { In 1/18th seconds (use only with lock bit set }

        MsDos(Regs);

        Log_Logical_Record := (AL = 0);          { Possible errors in AL are }
        { AL=FFh  fail }
        { AL=FEh  timeout }
        { AL=96h  No dynamic memory for file }
      END;
  END;                                                  { Log_Logical_Record }

  FUNCTION Lock_Logical_RecSet(Timeout : Integer) : Boolean;

{ Call this to lock all records logged with Log_Logical_Record }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D1;
        BP := Timeout;                      { In 1/18th seconds, 0 = No wait }
        MsDos(Regs);
        Lock_Logical_RecSet := (AL = 0);    { AL=FF - fail,  AL=FE - timeout }
      END;
  END;                                                 { Lock_Logical_RecSet }

  FUNCTION Release_Logical_Rec(VAR RecName : RecLogType) : Boolean;

{ Call this to release a logical record lock without removing the rec }
{ from the table }

  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D2;
        DS := Seg(RecName);
        DX := Ofs(RecName);
        MsDos(RecName);
        Release_Logical_Rec := (AL = 0);
      END;
  END;                                                 { Release_Logical_Rec }

  FUNCTION Release_Logical_RecSet : Boolean;
{ release all locked logical records, doesn't remove them from the table }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D3;
        MsDos(Regs);
        Release_Logical_RecSet := (AL = 0);
      END;
  END;                                              { Release_Logical_RecSet }

  FUNCTION Clear_Logical_Rec(VAR RecName : RecLogType) : Boolean;
{ This call unlocks and removes the Logical Record lock from the table }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D4;
        DS := Seg(RecName);
        DX := Ofs(RecName);
        MsDos(Regs);
        Clear_Logical_Rec := (AL = 0);
      END;
  END;                                                   { Clear_Logical_Rec }

  FUNCTION Clear_Logical_RecSet : Boolean;
{ Unlocks and removes from the table all of the stations logical record locks }
  BEGIN
    WITH Regs DO
      BEGIN
        AH := $D5;
        MsDos(Regs);
        Clear_Logical_RecSet := (AL = 0);
      END;
  END;                                                { Clear_Logical_RecSet }


  (* THE FOLLOWING ARE PHYSICAL RECORD LOCK CALLS *)


function Log_Phys_Rec(flg : byte; Handle,Start_Hi,Start_Lo,TimeOut,Size_Hi,Size_Lo : integer): boolean;
{ Flg = bit 0 set means log and lock, bit 1 set means non-exclusive lock }
{ Handle is the file handle, Start is the high and low starting word to lock }
{ from; Size is the high and low word length to lock to.  Timeout is in }
{ 1/18th seconds and is only valid if bit 0 of flg is set. }

begin
  with regs do
    begin
      AH := $BC;
      AL := flg;
      BX := Handle;
      CX := Start_hi;
      DX := Start_Lo;
      BP := TimeOut;
      SI := Size_Hi;
      DI := Size_Lo;

      MSDOS(Regs);

      Log_Phys_Rec := (AL = 0);  { $FF = fail, $96 = No dynamic memory }
    end;  { with }
end; { function Log_Phys_Rec(flg : byte; Handle,Start_Hi,Start_Lo,TimeOut,Size_Hi,Size_Lo : integer) }

function Release_Phys_Rec( Handle, Start_Hi, Start_Lo : integer) : boolean;
{ When a record is released, it is unlocked for use by someone else, but }
{ it remains in the log table }
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries of }
{ the locked region to be released }
begin
  with regs do
    begin
      AH := $BD;
      BX := Handle;
      CX := Start_Hi;
      DX := Start_Lo;
      MSDOS(Regs);
      Release_Phys_Rec := (AL = 0);  { $FF = invalid record }
    end;
end; { function Release_Phys_Rec }

function Clear_Phys_Rec(Handle, Start_Hi, Start_Lo : integer): boolean;
{ Handle is the file handle, Start_Hi and Start_Lo are the boundaries }
{ of the file region to be locked. Clearing a record will unlock it }
{ and remove it from the log table. }
begin
  with regs do
    begin
      AH := $BE;
      BX := Handle;
      CX := Start_Hi;
      DX := Start_Lo;
      MSDOS(Regs);
      Clear_Phys_Rec := (AL = 0);
    end;
end; { function Clear_Phys_Rec(Handle, Start_Hi, Start_Lo : integer) }

function Lock_Phys_Rec_Set(flgs : byte; Timeout : integer): boolean;
{ flgs are the lock flags:  bit 1 set means shared (non-exclusive) lock }
{ Timeout is in 1/18 seconds, 0 = no wait, -1 means indefinite wait }
{ This function attempts to lock all of the records logged in the station's }
{ log table. }
begin
  with regs do
    begin
      AH := $C2;
      AL := flgs;
      BP := TimeOut;
      MSDOS(Regs);
      Lock_Phys_Rec_Set := (AL = 0);    { $FF = fail, $FE = timeout fail }
    end;
end; { function Lock_Phys_Rec_Set(flgs, Timeout : byte) }

function Release_Phys_Rec_Set : boolean;
{ unlocks the entire record log table of the station.  records remain in }
{ the log table. }
begin
  regs.AH := $C3;
  MSDOS(Regs);
  Release_Phys_Rec_Set := (regs.AL = 0);
end; { function Release_Phys_Rec_Set  }

function Clear_Phys_Rec_Set : boolean;
{ unlocks and removes from the log table any records logged and locked }
begin
  regs.AH := $C4;
  MSDOS(Regs);
  Clear_Phys_Rec_Set := (regs.AL = 0);
end; { function Clear_Phys_Rec_Set  }

{ Note: Example programs and printing functions will be included in the }
{ first revision of this toolbox. }