home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / DEBIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  4.8 KB  |  148 lines
  1. Unit Debit;
  2. {========================================================================}
  3. Interface
  4.   Procedure RemoveUpLdCredit;
  5. {========================================================================}
  6. Implementation
  7.   Uses
  8.     Dos, General, MaxAreas, MfmDefs, MfmStr, Screen, Strings;
  9. {========================================================================}
  10. Procedure RemoveUpLdCredit;
  11.   Const
  12.     Max_Alen = 10;
  13.   Type
  14.     UserRecordType = Record
  15.       Name, City : Array[0..35] Of Char;
  16.       Alias : Array[0..20] Of Char;
  17.       Phone : Array[0..14] Of Char;
  18.       LastReadPtr, TimeRemaining : Word;
  19.       Pwd : Array[0..15] Of Char;
  20.       Times : Word;
  21.       Help : Byte;
  22.       Rsvd1 : Array[1..2] Of Byte;
  23.       Video, Nulls, Bits1 : Byte;
  24.       Rsvd2, Bits2 : Word;
  25.       Priv : Integer;
  26.       Rsvd3 : Array[1..19] Of Byte;
  27.       StructLen : Byte;
  28.       Time, DelFlag : Word;
  29.       Rsvd4 : Array[1..8] Of Byte;
  30.       Width, Len : Byte;
  31.       Credit, Debit : Word;
  32.       XpPriv : Integer;
  33.       XpDate, XpMins : LongInt;
  34.       XpFlag, XpRsvd : Byte;
  35.       LuDate, Xkeys : LongInt;
  36.       Lang : Byte;
  37.       DefProto : ShortInt;
  38.       Up, Down : LongInt;
  39.       DownToday : LongInt;
  40.       Msg : Array[1..Max_Alen] Of Byte;
  41.       Files : Array[1..Max_Alen] Of Byte;
  42.       Compress, Rsvd5 : Byte;
  43.       Extra : LongInt;
  44.     End;
  45.   Var
  46.     RcD : DirStr;
  47.     RcN : NameStr;
  48.     RcE : ExtStr;
  49.     UpLdLog : Text;
  50.     UpLdStr : String;
  51.     UserRecPtr : ^UserRecordType;
  52.     UserBbs : File;
  53.     StructLen : Byte;
  54.     Buffer : Pointer;
  55.     UserNo, NumberOfUsers : LongInt;
  56.     UserName : String[36];
  57.     AmountUpLd : LongInt;
  58.     FileFound : Boolean;
  59.     Rcc : Char;
  60.   Begin
  61.     FSplit(AreaPath,Rcd,RcN,RcE);
  62.     If FileExist(Rcd+'UL.LOG') Then
  63.     Begin
  64.       Assign(UpLdLog,Rcd+'UL.LOG');
  65.       Reset(UpLdLog);
  66.       AnsiGotoXY(1,1);
  67.       FileFound := False;
  68.       While Not Eof(UpLdLog) Do
  69.       Begin
  70.         ReadLn(UpLdLog,UpLdStr);
  71.         UpLdStr := UpperString(UpLdStr);
  72.         If Pos(UpperString(FileAreaPath+CurrentEntry^.FileName),UpLdStr) > 0 Then
  73.         Begin
  74.           FileFound := True;
  75.           If FileExist(Rcd+'USER.BBS') Then
  76.           Begin
  77.             UserName := Copy(UpLdStr,1,Pos('UL',UpLdStr)-2);
  78.             Val(Copy(UpLdStr,Pos('(',UpLdStr)+1,(Pos(')',UpLdStr)-Pos('(',UpLdStr))-2),AmountUpLd,Result);
  79.             Assign(UserBbs,Rcd+'USER.BBS');
  80.             FileMode := 2;
  81.             Reset(UserBbs,1);
  82.             Seek(UserBbs,161);
  83.             BlockRead(UserBbs,StructLen,1);
  84.             GetMem(Buffer,StructLen*20);
  85.             UserRecPtr := Buffer;
  86.             NumberOfUsers := DirInfo.Size Div (StructLen*20);
  87.             For UserNo := 0 To NumberOfUsers-1 Do
  88.             Begin
  89.               Seek(UserBbs,UserNo*StructLen*20);
  90.               BlockRead(UserBbs,Buffer^,StructLen*20);
  91.               If UserName = StrPas(StrUpper(UserRecPtr^.Name)) Then
  92.               Begin
  93.                 AnsiGotoXY(25,1); AnsiClearToEol;
  94.                 Write(CurrentEntry^.FileName+' was uploaded by '+
  95.                   StrPas(UserRecPtr^.Name)+', (+ or -) credit or (Q)uit: ');
  96.                 Repeat
  97.                   Rcc := UpCase(Char(GetInput));
  98.                 Until Pos(Rcc,'+-Q') > 0;
  99.                 If Rcc In ['+','-'] Then
  100.                 Begin
  101.                   Seek(UserBbs,UserNo*StructLen*20);
  102.                   Case Rcc Of
  103.                     '+' : UserRecPtr^.Up := UserRecPtr^.Up+(AmountUpLd Div 1024);
  104.                     '-' : UserRecPtr^.Up := UserRecPtr^.Up-(AmountUpLd Div 1024);
  105.                   End;
  106.                   BlockWrite(UserBbs,Buffer^,StructLen*20);
  107.                   AnsiGotoXY(25,1); AnsiClearToEol;
  108.                   Write(StrPas(UserRecPtr^.Name)+' was ');
  109.                   Case Rcc Of
  110.                     '+' : Write('credited with ');
  111.                     '-' : Write('debited by ');
  112.                   End;
  113.                   Write(MyStr(AmountUpLd Div 1024,0)+'Kb.  ');
  114.                   AnyKey;
  115.                 End;
  116.               End;
  117.             End;
  118.             Close(UserBbs);
  119.             FreeMem(Buffer,StructLen*20);
  120.           End
  121.           Else
  122.           Begin
  123.             AnsiGotoXY(25,1); AnsiClearToEol;
  124.             Write('USER.BBS not found!   ');
  125.             AnyKey;
  126.           End;
  127.         End;
  128.       End;
  129.       If Not FileFound Then
  130.       Begin
  131.         AnsiGotoXY(25,1); AnsiClearToEol;
  132.         Write('File not found in UL.LOG.  ');
  133.         AnyKey;
  134.       End;
  135.       Close(UpLdLog);
  136.     End
  137.     Else
  138.     Begin
  139.       AnsiGotoXY(25,1); AnsiClearToEol;
  140.       Write('UL.LOG not found!   ');
  141.       AnyKey;
  142.     End;
  143.   End;
  144. {========================================================================}
  145. Begin
  146. End.
  147. {========================================================================}
  148.