ognetwrk.pas

详细的ERP设计资料

var
  Key      : TKey;
  Code     : TCode;
  Modifier : LongInt;
begin
  if FAutoCheck and not (csDesigning in ComponentState) then begin   {!!.08}
    Code := DoOnGetCode;
    DoOnGetKey(Key);
    Modifier := DoOnGetModifier;

    {if no file name, fire event to get one}                           {!!.02}
    if FFileName = '' then                                            {!!.02}
      FFilename := DoOnGetFileName;                                    {!!.02}

    ApplyModifierToKeyPrim(Modifier, Key, SizeOf(Key));
    if DecodeNAFCountCode(Key, Code) > 0 then begin
      try
        if not GetNetAccessFileInfo(FFileName, Key, nacNetAccessInfo) then
          CreateAccessFile; {wasn't there, try to create it}
        LockNetAccessFile(FFileName, Key, nacNetAccess); 
      except
        {ignore errors - CheckCode will report that record is not locked}
      end;
    end;
  end;

  inherited Loaded;
end;

function TOgNetCode.ResetAccessFile : Boolean;
var
  Key      : TKey;
  Modifier : LongInt;
begin
  DoOnGetKey(Key);
  Modifier := DoOnGetModifier;
  ApplyModifierToKeyPrim(Modifier, Key, SizeOf(Key));
  Result := ResetNetAccessFile(FFileName, Key);
end;


{network user access/count routines}
function CheckNetAccessFile(const NetAccess : TNetAccess) : Boolean;
var
  Code : TCode;
begin
  Result := False;

  if (NetAccess.Fh > -1) then begin
    FileSeek(NetAccess.Fh, NetAccess.Index * SizeOf(Code), 0);
    if (FileRead(NetAccess.Fh, Code, SizeOf(Code)) = SizeOf(Code)) then begin
      MixBlock(T128bit(NetAccess.Key), Code, False);
      Result := (Code.CheckValue = NetAccess.CheckValue) and (Code.NetIndex = NetAccess.Index);
    end;
  end;
end;

function CreateNetAccessFile(const FileName : string; const Key : TKey; Count : Word) : Boolean;
var
  Fh   : Integer;
  I    : LongInt;
  Code : TCode;
begin
  Result := False;

  Fh := FileCreate(FileName);
  if (Fh > -1) then begin
    for I := 0 to Count - 1 do begin
      Code.CheckValue := NetCheckCode;
      Code.Expiration := 0; {not used}
      Code.NetIndex := I;
      MixBlock(T128bit(Key), Code, True);
      FileWrite(Fh, Code, SizeOf(Code));
    end;

    FlushFileBuffers(Fh);
    Result := GetFileSize(Fh) = (Count * SizeOf(Code));
    FileClose(Fh);
  end;
end;

function CreateNetAccessFileEx(const FileName : string; const Key : TKey; const Code : TCode) : Boolean;
var
  L : LongInt;
begin
  L := DecodeNAFCountCode(Key, Code);
  if L > 0 then
    Result := CreateNetAccessFile(FileName, Key, L)
  else
    Result := False;
end;

function DecodeNAFCountCode(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  if (Work.CheckValue = NetCheckCode) then
    Result := Work.NetIndex
  else
    Result := -1;
end;

procedure EncodeNAFCountCode(const Key : TKey; Count : Cardinal; var Code : TCode);
begin
  Code.CheckValue := NetCheckCode;
  Code.Expiration := 0; {not used}
  Code.NetIndex := Count;
  MixBlock(T128bit(Key), Code, True);
end;

function GetNetAccessFileInfo(const FileName : string; const Key : TKey;
         var NetAccessInfo : TNetAccessInfo) : Boolean;
var
  Fh   : Integer;
  I    : LongInt;
  Code : TCode;
begin
  Result := False;

  Fh := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if (Fh > -1) then begin
    NetAccessInfo.Total := GetFileSize(Fh) div SizeOf(Code);
    NetAccessInfo.Locked := 0;
    NetAccessInfo.Invalid := 0;

    for I := 0 to NetAccessInfo.Total - 1 do begin
      if LockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0) then begin
        FileSeek(Fh, I * SizeOf(Code), 0);
        FileRead(Fh, Code, SizeOf(Code));
        MixBlock(T128bit(Key), Code, False);
        if (Code.NetIndex <> I) or (Code.CheckValue <> NetCheckCode) then
          Inc(NetAccessInfo.Invalid);
        UnlockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0);
      end else
        Inc(NetAccessInfo.Locked);
    end;

    FlushFileBuffers(Fh);
    FileClose(Fh);
    Result := True;
  end;
end;

{$IFDEF Win32}
function IsAppOnNetwork(const ExePath : string) : Boolean;
begin
  Result := (GetDriveType(PAnsiChar(ExtractFileDrive(ExePath) + '\')) = DRIVE_REMOTE);
end;
{$ELSE}
function IsAppOnNetwork(const ExePath : string) : Boolean;
var
  D : Integer;
begin
  D := Ord(UpCase(ExePath[1])) - Ord('A');                             {!!.07}
  Result := GetDriveType(D) = DRIVE_REMOTE;
end;
{$ENDIF}

function LockNetAccessFile(const FileName : string; const Key : TKey;
                           var NetAccess : TNetAccess) : Boolean;
var
  Fh    : Integer;
  Count : Cardinal;
  I     : LongInt;
  Code  : TCode;
begin
  Result := False;

  FillChar(NetAccess, SizeOf(NetAccess), 0);
  NetAccess.Fh := -1;

  Fh := FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone);
  if (Fh > -1) then begin
    Count := GetFileSize(Fh) div SizeOf(Code);
    {find an unused record to use}
    for I := 0 to Count - 1 do begin
      if LockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0) then begin
        FileSeek(Fh, I * SizeOf(Code), 0);
        FileRead(Fh, Code, SizeOf(Code));
        MixBlock(T128bit(Key), Code, False);
        if (Code.NetIndex = I) and (Code.CheckValue = NetCheckCode) then begin
          NetAccess.Fh := Fh;
          NetAccess.Key := Key;
          NetAccess.Index := I;
          NetAccess.CheckValue := HiWord(GenerateUniqueModifierPrim);

          Code.CheckValue := NetAccess.CheckValue;
          Code.Expiration := 0; {not used}
          Code.NetIndex := NetAccess.Index;
          MixBlock(T128bit(Key), Code, True);

          FileSeek(Fh, I * SizeOf(Code), 0);
          FileWrite(Fh, Code, SizeOf(Code));
          FlushFileBuffers(Fh);
          Result := True;
          Exit;
        end else
          UnlockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0);
      end;
    end;
    FileClose(Fh);
  end;
end;

function ResetNetAccessFile(const FileName : string; const Key : TKey) : Boolean;
var
  Fh    : Integer;
  Count : Cardinal;
  I     : LongInt;
  Code  : TCode;
begin
  Result := False;

  Fh := FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone);
  if (Fh > -1) then begin
    Count := GetFileSize(Fh) div SizeOf(Code);
    for I := 0 to Count - 1 do
      {attempt to lock this record. skip records that are locked}
      if LockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0) then begin
        try
          Code.CheckValue := NetCheckCode;
          Code.Expiration := 0; {not used}
          Code.NetIndex := I;
          MixBlock(T128bit(Key), Code, True);
          FileSeek(Fh, I * SizeOf(Code), 0);
          FileWrite(Fh, Code, SizeOf(Code));
        finally
          UnlockFile(Fh, I * SizeOf(Code), 0, SizeOf(Code), 0);
        end;
      end;
    FlushFileBuffers(Fh);
    FileClose(Fh);
    Result := True;
  end;
end;

function UnlockNetAccessFile(var NetAccess : TNetAccess) : Boolean;
var
  Code : TCode;
begin
  Result := False;

  if CheckNetAccessFile(NetAccess) then begin
    Code.CheckValue := NetCheckCode;
    Code.Expiration := 0; {not used}
    Code.NetIndex := NetAccess.Index;
    MixBlock(T128bit(NetAccess.Key), Code, True);
    FileSeek(NetAccess.Fh, NetAccess.Index * SizeOf(Code), 0);
    FileWrite(NetAccess.Fh, Code, SizeOf(Code));

    FlushFileBuffers(NetAccess.Fh);
    FileClose(NetAccess.Fh);

    FillChar(NetAccess, SizeOf(NetAccess), 0);
    NetAccess.Fh := -1;

    Result := True;
  end;
end;

end.