561 lines
20 KiB
Plaintext
561 lines
20 KiB
Plaintext
{$X+,B-,V-,S-} {essential compiler directives}
|
|
|
|
Unit nwAcct;
|
|
|
|
{ nwAcct unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
|
|
|
|
INTERFACE
|
|
|
|
Uses nwIntr,nwMisc,nwBindry,nwConn;
|
|
|
|
{ Primary functions: Interrupt: Comments:
|
|
|
|
* GetAccountStatus (F217/96) (1)
|
|
* SubmitAccountCharge (F217/97) (2)(3)
|
|
* SubmitAccountHold (F217/98) (2)
|
|
* SubmitAccountNote (F217/99) (2)
|
|
|
|
Secondary functions:
|
|
|
|
* AccountingInstalled (4)
|
|
* SetAccountStatus (5)
|
|
* AddAccountingServer (5)
|
|
* DeleteAccountingServer (5)
|
|
* DeleteAccountHolds (2)
|
|
|
|
Notes: (1) To be called by:
|
|
-accounting servers;
|
|
-supervisor equivalent users;
|
|
-objects querying their own account status.
|
|
(2) To be called by accounting servers only.
|
|
(3) Can be imitated by supervisor-equivalent users by
|
|
calling GetAccountStatus and SetAccountStatus. Atomicity
|
|
of such a bindery transaction can not be guaranteed.
|
|
(4) Can be called by all logged on users.
|
|
(5) Supervisor equivalent users only.
|
|
|
|
}
|
|
|
|
Var result:word;
|
|
|
|
{ Type definitions based on NET$ACCT.FMT by Wolfgang Schreiber }
|
|
{ See Acct.pas in the XACCT archive for an example of their use. }
|
|
|
|
CONST { Accounting file record types }
|
|
RT_SUBMIT_CHARGE=1;
|
|
RT_ACCOUNT_NOTE =2;
|
|
|
|
{ comment types within accounting file }
|
|
|
|
CT_CONN_CHARGE = 1;
|
|
CT_STORAGE_CHARGE = 2;
|
|
CT_LOGIN_NOTE = 3;
|
|
CT_LOGOUT_NOTE = 4;
|
|
CT_INTRUDER_NOTE = 5;
|
|
CT_TIMEMOD_NOTE = 6;
|
|
CT_BOOT_NOTE = 8;
|
|
CT_DOWN_NOTE = 9;
|
|
CT_COMMENT = 99;
|
|
|
|
Type TAccDateTime6 = Array [1..6] of Byte; { date and time stamp of entry YMDHMS}
|
|
|
|
Type TComment = RECORD { interprete comments according to CmtType }
|
|
CASE Integer of
|
|
CT_CONN_CHARGE : (ConnectTime : LongInt;
|
|
RequestCount : LongInt;
|
|
BytesRead : Array[1..6] of BYTE; {hi-lo}
|
|
BytesWritten : Array[1..6] of BYTE); {hi-lo}
|
|
CT_STORAGE_CHARGE : (BlocksOwned : LongInt;
|
|
HalfHours : LongInt);
|
|
CT_LOGIN_NOTE,
|
|
CT_LOGOUT_NOTE,
|
|
CT_INTRUDER_NOTE : (Net :TnetworkAddress;
|
|
Node:TnodeAddress);
|
|
CT_TIMEMOD_NOTE : (ServerTime : TAccDateTime6);
|
|
CT_BOOT_NOTE,
|
|
CT_DOWN_NOTE : ();{ NO comment fields }
|
|
CT_COMMENT : (Comment : String)
|
|
END;
|
|
|
|
{ Use either the Type SubmitCharge or SubmitNote to interprete
|
|
an entry - decide on typecasting with the aid of the RecType field. }
|
|
|
|
Type TChargeRecord = RECORD
|
|
Length : Word;
|
|
ServerObjId : LongInt; {hi-lo}
|
|
TimeStamp : TAccDateTime6;
|
|
RecType : BYTE; {Record type Note/Charge}
|
|
ccode : BYTE; {completion code}
|
|
ServiceType : WORD; {hi-lo}
|
|
ClientObjID : LongInt; {hi-lo}
|
|
Charge : LongInt; {hi-lo}
|
|
CommentType : WORD; {hi-lo}
|
|
Comment : Tcomment; {Variable length field}
|
|
END;
|
|
|
|
Type TNoteRecord = RECORD
|
|
Length : Word;
|
|
ServerObjId : LongInt; {hi-lo}
|
|
TimeStamp : TAccDateTime6;
|
|
RecType : BYTE;
|
|
ccode : BYTE;
|
|
ServiceType : WORD; {hi-lo}
|
|
ClientObjID : LongInt; {hi-lo}
|
|
CommentType : WORD; {hi-lo}
|
|
Comment : TComment;
|
|
END;
|
|
|
|
|
|
{F217/96 [2.15c+]}
|
|
Function GetAccountStatus(objName:string; objType:word;
|
|
Var balance,limit,holds:LongInt):boolean;
|
|
|
|
{F217/97 [2.15c+]}
|
|
Function SubmitAccountCharge(objName:string; objType:word;
|
|
charge,cancelHoldAmount:Longint;
|
|
serviceType, commentType:word; comment:string):boolean;
|
|
|
|
{F217/98 [2.15c+]}
|
|
Function SubmitAccountHold(objName:string; objType:word;
|
|
reserveAmount:Longint ):boolean;
|
|
|
|
{F217/99 [2.15c+]}
|
|
Function SubmitAccountNote(objName:string; objType:word;
|
|
serviceType,commentType:word; comment:string):boolean;
|
|
|
|
{--------Secondary Functions-----------------------------------------------}
|
|
|
|
Function AccountingInstalled:boolean;
|
|
|
|
Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
|
|
{ need to be supervisor equivalent to use this call }
|
|
|
|
Function AddAccountingServer(objName:string;objType:word):boolean;
|
|
{ need to be supervisor equivalent to use this call }
|
|
|
|
Function DeleteAccountingServer(objName:string;objType:word):boolean;
|
|
{ need to be supervisor equivalent to use this call }
|
|
|
|
Function DeleteAccountHolds(objName:string; objType:word):boolean;
|
|
{ delete all holds the caller (an accounting server) has on the
|
|
object with name objName of type objType. }
|
|
|
|
Type Tcharge=record
|
|
DaysOfCharge:Byte; { bit 0=sunday,.. bit 6=saturday }
|
|
TimeOfCharge:Byte; { 0:00=0 ..23:30 =47, half-hour
|
|
during which the specified 'new' rate takes effect. }
|
|
ChargeRateMultiplier,
|
|
ChargeRateDivisor:Word;
|
|
end;
|
|
TchargeRec=record
|
|
NextChargeTime:Longint; { minutes since 1-1-1985 }
|
|
charges:array[1..20] of Tcharge;
|
|
end;
|
|
|
|
|
|
Type TchargeTableEntry=array[0..47] of Real;
|
|
Var ChargeTable:Array [0..6] of TchargeTableEntry;
|
|
|
|
IMPLEMENTATION {===========================================================}
|
|
|
|
Procedure GetBindryAccountStatus(objName:string; objType:word;
|
|
Var balance,limit,holds:LongInt);
|
|
{ called by GetAccountStatus when the calling object isn't an
|
|
accounting server. The F217/96 fails, but a bindery read will
|
|
work for supervisor-equivalent users. }
|
|
Var accPropVal:Tproperty;
|
|
accVal: record
|
|
_balance:LongInt; {hi-lo}
|
|
_limit:LongInt; {hi-lo}
|
|
_Reserved:array[1..120] of byte; { NW internal info }
|
|
end ABSOLUTE accPropVal;
|
|
holdPropVal:Tproperty;
|
|
holdVal: array[1..16]
|
|
of record
|
|
AccountServerID:Longint; {hi-lo}
|
|
HoldAmount :LongInt; {hi-lo}
|
|
end ABSOLUTE holdPropVal;
|
|
moreSegments:boolean;
|
|
t,propFlags:byte;
|
|
begin
|
|
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
|
|
accPropVal,moreSegments,propFlags)
|
|
then begin
|
|
balance:=Lswap(accVal._balance);
|
|
limit:=Lswap(accVal._limit);
|
|
IF ReadPropertyValue(objName,objType,'ACCOUNT_HOLDS',1,
|
|
holdPropVal,moreSegments,propFlags)
|
|
then begin { holds exist. }
|
|
holds:=0;
|
|
for t:=1 to 16
|
|
do if holdVal[t].AccountServerID<>0
|
|
then holds:=holds+Lswap(holdVal[t].HoldAmount);
|
|
end;
|
|
if nwBindry.result=$FB
|
|
then begin
|
|
result:=0;
|
|
holds:=0;
|
|
end
|
|
else result:=nwBindry.result;
|
|
end
|
|
else if nwBindry.result=$FB { no such property }
|
|
then result:=$C1
|
|
else if nwBindry.result=$F1 { invalid bindery security }
|
|
then result:=$C0
|
|
else result:=nwBindry.result;
|
|
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
|
|
96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
|
|
FF Bindery Failure}
|
|
end;
|
|
|
|
|
|
{F217/96 [2.15c+]}
|
|
Function GetAccountStatus(objName:string; objType:word;
|
|
Var balance,limit,holds:LongInt):boolean;
|
|
{ equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
|
|
of the object. The properties may not exist. }
|
|
{ This function will be successful if:
|
|
a) the caller is an accounting server on the current fileserver
|
|
OR b) the caller is supervisor-equivalent
|
|
OR c) the caller is querying his own account status }
|
|
Type Treq=record
|
|
len:word;
|
|
subF:byte;
|
|
_objType:word; {hi-lo}
|
|
_objName:string[48];
|
|
end;
|
|
Trep=record
|
|
_balance: LongInt; {hi-lo}
|
|
_limit : Longint; {hi-lo}
|
|
reserved: array [1..120] of byte;
|
|
_holds : array [1..16]
|
|
of record
|
|
serverObjId:LongInt; {hi-lo}
|
|
HoldAmount :LongInt {hi-lo}
|
|
end;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
Var t:byte;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
len:=sizeOf(Treq)-2;
|
|
subf:=$96;
|
|
_objType:=swap(objType); { force hi-lo}
|
|
PstrCopy(_objName,objName,48); UpString(_objName);
|
|
end;
|
|
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
|
|
With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
balance:=Lswap(_balance); { force lo-hi again }
|
|
limit:=Lswap(_limit); { force lo-hi again }
|
|
holds:=0;
|
|
for t:=1 to 16
|
|
do if _holds[t].serverObjId<>0
|
|
then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
|
|
end;
|
|
IF result=$C0 { no account privileges }
|
|
then GetBindryAccountStatus(objName,objType,balance,limit,holds);
|
|
{ try to read status not as an accounting server, but as a supervisor }
|
|
GetAccountStatus:=(result=0);
|
|
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
|
|
end;
|
|
|
|
|
|
{F217/97 [2.15c+]}
|
|
Function SubmitAccountCharge(objName:string; objType:word;
|
|
charge,cancelHoldAmount:Longint;
|
|
serviceType, commentType:word; comment:string):boolean;
|
|
{ -The cancelHold amount should be exactly the same as the amount that
|
|
was put on huld with the SubmitAccountHold call. If no
|
|
SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
|
|
-'negative charges' are allowed. They will increase the balance of
|
|
the object objName of objType.
|
|
-Use the objectType of caller for the serviceType parameter.
|
|
(audit log purposes)
|
|
-Set commentType to 0 and comment to '' if you aren't interested in the
|
|
audit log.
|
|
-To be called by accounting servers only.
|
|
-Can be imitated by supervisor-equivalent users by
|
|
calling GetAccountStatus and SetAccountStatus. Atomicity
|
|
of such a bindery transcation can not be guaranteed.
|
|
|
|
}
|
|
Type Treq=record
|
|
len :word;
|
|
subf:byte;
|
|
_serviceType:word; {hi-lo}
|
|
_charge :Longint; {hi-lo}
|
|
_cancelHold :Longint; {hi-lo}
|
|
_objType :word; {hi-lo}
|
|
_commentType:word; {hi-lo}
|
|
_objNameAndComment:Array[1..305] of char;
|
|
end;
|
|
TPreq=^Treq;
|
|
Var p:byte;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$97;
|
|
_serviceType:= swap(serviceType); {force hi-lo}
|
|
_charge :=Lswap(charge); {force hi-lo}
|
|
_cancelHold :=Lswap(cancelHoldAmount); {force hi-lo}
|
|
_objType := swap(objType); {force hi-lo}
|
|
_commentType:= swap(commentType); {force hi-lo}
|
|
p:=ord(objName[0]);if p>48 then p:=48;
|
|
UpString(objName);
|
|
Move(objname[0],_objNameandComment[1],p+1);
|
|
Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
|
|
len:=15+p+1+ord(comment[0])+1;
|
|
F2SystemCall($17,len+2,0,result);
|
|
end;
|
|
SubmitAccountCharge:=(result=$00);
|
|
{ resultcodes: 00 successful; C0 No Account Privileges;
|
|
C1 No Account Balance; C2 Credit Limit Exceeded. }
|
|
end;
|
|
|
|
|
|
{F217/98 [2.15c+]}
|
|
Function SubmitAccountHold(objName:string; objType:word;
|
|
reserveAmount:Longint ):boolean;
|
|
{ To be called by accounting servers only. }
|
|
Type Treq=record
|
|
len :word;
|
|
subf:byte;
|
|
_reserveAmount:Longint; {hi-lo}
|
|
_objType:word; {hi-lo}
|
|
_objName:string[48];
|
|
end;
|
|
TPreq=^Treq;
|
|
Var p:byte;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$98;
|
|
_reserveAmount:=Lswap(ReserveAmount); { force hi-lo}
|
|
_objType:=swap(objType); { force hi-lo }
|
|
p:=ord(objName[0]); if p>48 then p:=48;
|
|
_objName:=objname;UpString(_objName);_objName[0]:=chr(p);
|
|
len:=7+p+1;
|
|
F2SystemCall($17,len+2,0,result);
|
|
end;
|
|
SubmitAccountHold:=(result=$00);
|
|
{ resultcodes: 00 successful; C0 No Account Privileges;
|
|
C1 No Account Balance; C2 Credit Limit Exceeded.
|
|
C3 Account Too Many Holds }
|
|
end;
|
|
|
|
{F217/99 [2.15c+]}
|
|
Function SubmitAccountNote(objName:string; objType:word;
|
|
serviceType,commentType:word; comment:string):boolean;
|
|
{ To be called by accounting servers only.}
|
|
Type Treq=record
|
|
len:word;
|
|
subf:byte;
|
|
_serviceType:word; {hi-lo}
|
|
_objType:word; {hi-lo}
|
|
_commentType:word; {hi-lo}
|
|
_objNameAndComment:array[1..305] of char;
|
|
end;
|
|
TPreq=^Treq;
|
|
Var p:byte;
|
|
begin
|
|
with TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$99;
|
|
_serviceType:= swap(serviceType); {force hi-lo}
|
|
_objType := swap(objType); {force hi-lo}
|
|
_commentType:= swap(commentType); {force hi-lo}
|
|
p:=ord(objName[0]);if p>48 then p:=48;
|
|
UpString(objName);
|
|
Move(objname[0],_objNameandComment[1],p+1);
|
|
Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
|
|
len:=7+p+1+ord(comment[0])+1;
|
|
F2SystemCall($17,len+2,0,result);
|
|
end;
|
|
SubmitAccountNote:=(result=0);
|
|
{resultcodes: 00 Successful; C0 No Account Privileges }
|
|
end;
|
|
|
|
{---------------- Secondary Functions--------------------------------------}
|
|
|
|
|
|
Function AccountingInstalled:boolean;
|
|
Var propVal:Tproperty;
|
|
connId:byte;
|
|
moreSegments:boolean;
|
|
propFlags:byte;
|
|
currServerName:string;
|
|
begin
|
|
IF NOT GetEffectiveConnectionID(ConnId)
|
|
then result:=nwConn.result
|
|
else if NOT GetFileServerName(ConnId,currServerName)
|
|
then result:=nwConn.result
|
|
else begin
|
|
ReadPropertyValue(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',1,
|
|
propVal,moreSegments,propFlags);
|
|
result:=nwBindry.result;
|
|
end;
|
|
AccountingInstalled:=(result=0);
|
|
end;
|
|
|
|
|
|
Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
|
|
{ will change the account status to reflect the given parameters.
|
|
any holds will not be changed.
|
|
You need to be supervisor-eq. to do this...}
|
|
Var accPropVal:Tproperty;
|
|
accVal: record
|
|
_balance:LongInt; {hi-lo}
|
|
_limit:LongInt; {hi-lo}
|
|
_Reserved:array[1..120] of byte; { NW internal info }
|
|
end ABSOLUTE accPropVal;
|
|
OldBalance,OldLimit,OldHolds:LongInt;
|
|
moreSegments:boolean;
|
|
propFlags:byte;
|
|
begin
|
|
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
|
|
accPropVal,moreSegments,propFlags)
|
|
then begin
|
|
accVal._balance:=Lswap(balance); { force hi-lo}
|
|
accVal._limit:=Lswap(limit); { force hi-lo}
|
|
WritePropertyValue(objName,objType,'ACCOUNT_BALANCE',
|
|
1,accPropVal,FALSE);
|
|
if (nwBindry.result=$F1) or (nwBindry.result=$F8)
|
|
then result:=$C0
|
|
else result:=nwBindry.result;
|
|
end
|
|
else if nwBindry.result=$FB { no such property }
|
|
then result:=$C1
|
|
else if nwBindry.result=$F1 { invalid bindery security }
|
|
then result:=$C0
|
|
else result:=nwBindry.result;
|
|
SetAccountStatus:=(result=$00);
|
|
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
|
|
96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
|
|
FF Bindery Failure}
|
|
end;
|
|
|
|
|
|
Function AddAccountingServer(objName:string;objType:word):boolean;
|
|
Var ConnId:byte;
|
|
currServerName:string;
|
|
begin
|
|
IF NOT GetEffectiveConnectionID(ConnId)
|
|
then result:=nwConn.result
|
|
else if NOT GetFileServerName(ConnId,currServerName)
|
|
then result:=nwConn.result
|
|
else begin
|
|
AddBinderyObjectToSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
|
|
objName,objType);
|
|
result:=nwBindry.result;
|
|
end;
|
|
AddAccountingServer:=(result=0);
|
|
end;
|
|
|
|
Function DeleteAccountingServer(objName:string;objType:word):boolean;
|
|
Var ConnId:byte;
|
|
currServerName:string;
|
|
begin
|
|
IF NOT GetEffectiveConnectionID(ConnId)
|
|
then result:=nwConn.result
|
|
else if NOT GetFileServerName(ConnId,currServerName)
|
|
then result:=nwConn.result
|
|
else begin
|
|
DeleteBinderyObjectFromSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
|
|
objName,objType);
|
|
result:=nwBindry.result;
|
|
end;
|
|
DeleteAccountingServer:=(result=0);
|
|
end;
|
|
|
|
{F217/96 }
|
|
Function DeleteAccountHolds(objName:string; objType:word):boolean;
|
|
{ delete all holds the caller (an accounting server) has on the
|
|
object with name objName of type objType. }
|
|
Type Treq=record
|
|
len:word;
|
|
subF:byte;
|
|
_objType:word; {hi-lo}
|
|
_objName:string[48];
|
|
end;
|
|
Trep=record
|
|
_balance: LongInt; {hi-lo}
|
|
_limit : Longint; {hi-lo}
|
|
reserved: array [1..120] of byte;
|
|
_holds : array [1..16]
|
|
of record
|
|
serverObjId:LongInt; {hi-lo}
|
|
HoldAmount :LongInt {hi-lo}
|
|
end;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
Var t:byte;
|
|
holds:LongInt;
|
|
level:byte;
|
|
accServerId:LongInt;
|
|
accServerType:word;
|
|
accServerName:string;
|
|
begin
|
|
GetBinderyAccessLevel(Level,accServerID);
|
|
GetBinderyObjectName(accServerID,accServerName,accServerType);
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
len:=sizeOf(Treq)-2;
|
|
subf:=$96;
|
|
_objType:=swap(objType); { force hi-lo}
|
|
PstrCopy(_objName,objName,48); UpString(_objName);
|
|
end;
|
|
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
|
|
if result=0
|
|
then With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
holds:=0;
|
|
for t:=1 to 16
|
|
do if accServerID=Lswap(_holds[t].serverObjId)
|
|
then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
|
|
if holds<>0
|
|
then SubmitAccountCharge(objName,objType,0,holds,
|
|
accServerType,0,'clearing holds');
|
|
end;
|
|
DeleteAccountHolds:=(result=0);
|
|
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
|
|
end;
|
|
|
|
|
|
Function GetConnectTimeCharge(Var currentCharge:Real;Var chargeRec:TchargeRec):boolean;
|
|
Var propVal:Tproperty;
|
|
_chargeRec:TchargeRec ABSOLUTE propVal;
|
|
_currcharge:record
|
|
fill:LongInt;
|
|
currMult,currDiv:word; {hi-lo}
|
|
end ABSOLUTE propVal;
|
|
connId:byte;
|
|
moreSegments:boolean;
|
|
propFlags:byte;
|
|
currServerName:string;
|
|
begin
|
|
IF NOT GetEffectiveConnectionID(ConnId)
|
|
then result:=nwConn.result
|
|
else if NOT GetFileServerName(ConnId,currServerName)
|
|
then result:=nwConn.result
|
|
else if ReadPropertyValue(currServerName,OT_FILE_SERVER,
|
|
'CONNECT_TIME',1,
|
|
propVal,moreSegments,propFlags)
|
|
then begin
|
|
IF _currCharge.currDiv=0
|
|
then currentCharge:=0
|
|
else currentCharge:=Swap(_currCharge.currMult)/Swap(_currCharge.currDiv);
|
|
move(propVal[9],propVal[5],124);
|
|
chargeRec:=_chargeRec;
|
|
result:=0;
|
|
end
|
|
else result:=nwBindry.result;
|
|
GetConnectTimeCharge:=(result=0);
|
|
end;
|
|
|
|
|
|
|
|
end. |