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

{
You may be unlocking the records incorrectly, it may be your system, or
it may be bad code (I only found one good proc in AllSwags and that
needed some tweaking to get it to work right).  Here is a program that
has been tested and works fine, I had ~7 copies running at once under
Win95 and it was still pretty fast:

{NOTE: IT generates the dat file if one is not found}

{$M 4000, 0,0}

program Test;

uses Crt;

const
  {File mode def's}
  fmReadOnly  = $00;
  fmWriteOnly = $01; {Use one of these}
  fmReadWrite = $02;

  fmDenyAll   = $10; {with one of these}
  fmDenyWrite = $20;
  fmDenyRead  = $30;
  fmDenyNone  = $40;

type
  LockAction = (Lock, Unlock);

var
  Err: Integer;
  Timer: Longint absolute $40:$6C;
  Buffer: array[0..4991] of byte;
  Data: array[0..127] of byte;
  F: file;
  I: Integer;
  FPos: Longint;

function ShareIn: Boolean; assembler;
asm
  mov ax, 1000h  {Test for share}
  int 2fh        {Call multiplex interrupt}
  cmp al, 0ffh   {ShareIn = AL=$FF}
  xor al, al     {Default is false}
  jne @@Done     {False}
  mov al, 01h    {True}
@@Done:
  mov ax, 01h
end;

function FLock(var F; Action: LockAction; FPos,Len: Longint): Word;
  assembler;
asm
  je @@End
  mov al, Action  {0=Lock,1=Unlock}
  mov ah, $5C     {Dos lock function}
  les si, F       {Load F}
  mov bx, es:[si] {Get file handle}
  les dx, Fpos
  mov cx, es      {CX:DI=Begin position}
  les di, len
  mov si, es      {SI:DI length lock area}
  int 21h         {MS-DOS}
  jc @@End        {If error, return AX}
  xor ax, ax      {Else, return 0}
@@End:
end;

begin
  if not ShareIn then
  begin
    Writeln('Either run under Win95 or install SHARE');
    Exit;
  end;
  {$I-}
  assign(F, 'Test.dat');
  filemode := fmDenyNone and fmReadWrite;
  Reset(F,128);
  if IOResult = 2 then
  begin
    FileMode := $02;
    Rewrite(F, 1);
    BlockWrite(F,Buffer,SizeOf(Buffer));
    Close(F);
    FileMode := fmDenyNone + fmReadWrite;
    Reset(F,128);
  end;
  {$I+}
  repeat
    I := 0;
  while not EOf(F) do
  begin
    inc(I);
    FPos := FilePos(F);
    repeat
      Err := Flock(F,Lock,FPos,FPos+SizeOf(Data));
    until Err <> 33;
    if Err <> 0 then
    begin
      Writeln('Error locking!');
      Halt;
    end;
    BlockRead(F, Data, 1);
    Flock(F,unLock,FPos,FPos+SizeOf(Data));
    Writeln(I);
  end;
  Seek(F,0);
  until KeyPressed;
  Close(F);
end.

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