home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / CBVR097U.ZIP / GETTRASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-11  |  3.6 KB  |  179 lines
  1. {$I+}
  2. PROGRAM GETTRASH;
  3.  
  4. USES RBVVAR, DOS;
  5.  
  6. CONST
  7.  
  8.   TempName = 'GETTRASH.DAT';
  9.  
  10.  
  11. VAR
  12.  
  13.   oneline,
  14.   cname,
  15.   cphone : STRING;
  16.   FTT    : TEXT;
  17.   runi,
  18.   numof  : WORD;
  19.  
  20.   maskSL : BYTE;
  21.  
  22. PROCEDURE OpenText;
  23.   BEGIN
  24.     Assign(FTT,TempName);
  25.     Rewrite(FTT);
  26.   END;
  27.  
  28.  
  29. PROCEDURE GetVals;
  30.   BEGIN
  31.     cname := RGUser.name;
  32.     cphone:= RGUser.ph;
  33.   END;
  34.  
  35. PROCEDURE ReadUserList(xx : LONGINT);
  36.   BEGIN
  37.     Seek(RGUserFile,0);
  38.     Seek(RGuserfile,xx);
  39.     Read(RGUserFile,RGUser);
  40.   END;
  41.  
  42. PROCEDURE OpenUserList;
  43.   BEGIN
  44.     Assign(RGUserFile,paramstr(1));
  45.     FileMode := 66;
  46.     Reset(RGUserFile);
  47.     numof := FileSize(RGUserFile)-1;
  48.     IF (IOResult <> 0) THEN BEGIN
  49.       Writeln('[>ERROR<] - COULD NOT OPEN USER FILE ');
  50.       HALT;
  51.     END;
  52.  
  53.   END;
  54.  
  55. FUNCTION  PadStrR(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  56.   VAR
  57.     ilen : BYTE;
  58.   BEGIN
  59.     ilen := length(s);
  60.     WHILE (ilen < len) DO
  61.       BEGIN
  62.         INC(ilen);
  63.         s := s + PadCh;
  64.       END;
  65.     PadStrR := s;
  66.   END;
  67.  
  68. FUNCTION  PadStrL(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  69.   VAR
  70.     ilen : BYTE;
  71.   BEGIN
  72.     ilen := length(s);
  73.     WHILE (ilen < len) DO
  74.       BEGIN
  75.         INC(ilen);
  76.         s := PadCh + s;
  77.       END;
  78.     PadStrL := s;
  79.   END;
  80.  
  81. FUNCTION  IStr(number : LONGINT; len : BYTE)            : STRING;
  82.   VAR
  83.     tstr : STRING;
  84.   BEGIN
  85.     Str(number,tstr);
  86.     IStr := PadStrL(tstr,'0',len);
  87.   END;
  88.  
  89. PROCEDURE GetCount;
  90.   VAR
  91.     S  : SearchRec;
  92.     ie : INTEGER;
  93.   BEGIN
  94.     FindFirst(paramstr(1),anyfile,s);
  95.     IF DosError <> 0 THEN BEGIN
  96.       Writeln(#7#7+'User file not found '+paramstr(1));
  97.       HALT;
  98.     END;
  99.     IF paramcount = 2 THEN BEGIN
  100.       VAL(paramstr(2),maskSL,ie);
  101.       IF (ie <> 0) THEN maskSL := 30;
  102.     END ELSE maskSL := 30;
  103.  
  104.   END;
  105.  
  106.  
  107. FUNCTION  CurrentTime : LONGINT;
  108.   VAR
  109.     ho,mi,se,hs : WORD;
  110.   BEGIN
  111.     GetTime(ho,mi,se,hs);
  112.     CurrentTime := (LONGINT(ho) * 3600) + (LONGINT(mi) * 60) + se;
  113.   END;
  114.  
  115. FUNCTION  DateString                 : STRING;
  116.   VAR
  117.     yr,mo,dy,dw : WORD;
  118.     tstr        : STRING;
  119.   BEGIN
  120.     GetDate(yr,mo,dy,dw);
  121.     tstr := IStr(mo,2) + '/' + IStr(dy,2) + '/' + IStr(yr,2);
  122.     DateString := tstr;
  123.   END;
  124.  
  125. FUNCTION  TimeString(time : LONGINT) : STRING;
  126.   VAR
  127.     ho,mn,se : WORD;
  128.     tstr     : STRING;
  129.   BEGIN
  130.     ho := time DIV 3600;
  131.     DEC(time,LONGINT(ho)*3600);
  132.     mn := time DIV 60;
  133.     DEC(time,LONGINT(mn)*60);
  134.     se := time;
  135.     tstr := IStr(ho,2) + ':' + IStr(mn,2) + ':' + IStr(se,2);
  136.     TimeString := tstr;
  137.   END;
  138.  
  139.  
  140. PROCEDURE WriteEntry;
  141.   BEGIN
  142.     Writeln(FTT,cphone,'    ;    ',PadStrR(cname,' ',32),
  143.                      ' "',datestring,' | ',timestring(CurrentTime),'"');
  144.  
  145.   END;
  146.  
  147. BEGIN
  148.   Writeln('GETTRASH');
  149.   Writeln;
  150.   Writeln('This program will create a textfile called GETTRASH.DAT');
  151.   Writeln('which contain a list of usernames and phone numbers of all');
  152.   Writeln('users on your system,  the format of the list is compatible');
  153.   Writeln('with the file CBVTRASH.DAT');
  154.   Writeln;
  155.   Writeln;
  156.   Writeln('Usage > GetTrash path/userlist VSL');
  157.   Writeln;
  158.   Writeln(' VSL = Minimum SL to be included in list ');
  159.   Writeln;
  160.   GetCount;
  161.   OpenText;
  162.   OpenUserList;
  163.   Writeln('Minimum SL included   = ',maskSL);
  164.   Writeln('Number of users found = ',numof);
  165.   FOR runi := 1 TO numof DO BEGIN
  166.     Write(#13);
  167.     Write('Current user number ',runi);
  168.     ReadUserList(runi);
  169.     GetVals;
  170.     IF (RGUser.SL >= MaskSL) AND NOT (deleted IN RGUser.sflags) THEN
  171.       WriteEntry;
  172.   END;
  173.   Close(FTT);
  174.   Close(RGUserFile);
  175.   Writeln;
  176.   Writeln('Done...');
  177. END.
  178.  
  179.