home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / CBVW161U.ZIP / GETTRASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-05  |  4.6 KB  |  209 lines
  1. PROGRAM GETTRASH;
  2.  
  3. USES CBVVAR, DOS;
  4.  
  5. CONST
  6.  
  7.   TempName = 'GETTRASH.DAT';
  8.  
  9.  
  10. VAR
  11.  
  12.   oneline,
  13.   cname,
  14.   cphone : STRING;
  15.   FTT    : TEXT;
  16.   runi,
  17.   numof  : WORD;
  18.  
  19. PROCEDURE GetCount;
  20.   VAR
  21.     S : SearchRec;
  22.   BEGIN
  23.     FindFirst(paramstr(1),anyfile,s);
  24.     IF DosError <> 0 THEN BEGIN
  25.       Writeln(#7#7+'User file not found '+paramstr(1));
  26.       HALT;
  27.     END;
  28.     numof := S.size DIV Config.userreclen;
  29.   END;
  30.  
  31. PROCEDURE OpenText;
  32.   BEGIN
  33.     Assign(FTT,TempName);
  34.     Rewrite(FTT);
  35.   END;
  36.  
  37. FUNCTION AsciizToStr(VAR a ) : STRING;
  38.     {-Convert ASCIIZ to Turbo STRING}
  39.   VAR
  40.     s : STRING;
  41.     slen : BYTE ABSOLUTE s;
  42.  
  43.   BEGIN                       {AsciizToStr}
  44.     slen := 0;
  45.     WHILE ASCIIZ(a)[slen] <> #0 DO
  46.       slen := Succ(slen);
  47.     Move(ASCIIZ(a), s[1], slen);
  48.     AsciizToStr := s;
  49.   END;                        {AsciizToStr}
  50.  
  51. PROCEDURE GetVals;
  52.   VAR
  53.     tstr   : STRING;
  54.     count,
  55.     loop1  : BYTE;
  56.     temp   : ARRAY[0..40] OF CHAR;
  57.   BEGIN
  58.     count := 0;
  59.     FillChar(temp,SizeOf(temp),#0);
  60.     FOR loop1 := Config.offset_name TO Config.offset_name + 31 DO BEGIN
  61.       temp[count] := file_buffer[loop1];
  62.       INC(count);
  63.     END;
  64.     cname := AsciizToStr(temp);
  65.     count := 0;
  66.     FillChar(temp,SizeOf(temp),#0);
  67.     FOR loop1 := Config.offset_phone TO Config.offset_phone + 13 DO BEGIN
  68.       temp[count] := file_buffer[loop1];
  69.       INC(count);
  70.     END;
  71.     cphone := AsciiZtoStr(temp);
  72.   END;
  73.  
  74. PROCEDURE ReadUserList(xx : LONGINT);
  75.   VAR
  76.     actual   : WORD;
  77.     base1,
  78.     base2,
  79.     position : LONGINT;
  80.   BEGIN
  81.     Assign(userfile,paramstr(1));
  82.     Reset(userfile,1);
  83.     IF (IOResult <> 0) THEN BEGIN
  84.       Writeln('[>ERROR<] - COULD NOT OPEN USER FILE ');
  85.       HALT;
  86.     END;
  87.     IF ((FileSize(userfile) MOD Config.userreclen) <> 0) THEN BEGIN
  88.       Writeln('[>ERROR<]- ERROR IN SIZE OF USER FILE ');
  89.       HALT;
  90.     END;
  91.     base1 := xx;
  92.     base2 := Config.userreclen;
  93.     position := base1 * base2;
  94.     Seek(userfile,position);
  95.     BlockRead(userfile,file_buffer,Config.userreclen,actual);
  96.     Close(userfile);
  97.   END;
  98.  
  99. PROCEDURE GetConfig;
  100.   BEGIN
  101.     Assign(ConfigFile,_config);
  102.     Reset(ConfigFile);
  103.     IF IOResult <> 0 THEN BEGIN
  104.       Writeln('CBVCFG.DAT not found in current path!');
  105.       HALT;
  106.     END;
  107.     Read(ConfigFile,Config);
  108.     Close(ConfigFile);
  109.   END;
  110.  
  111. FUNCTION  PadStrR(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  112.   VAR
  113.     ilen : BYTE;
  114.   BEGIN
  115.     ilen := length(s);
  116.     WHILE (ilen < len) DO
  117.       BEGIN
  118.         INC(ilen);
  119.         s := s + PadCh;
  120.       END;
  121.     PadStrR := s;
  122.   END;
  123.  
  124. FUNCTION  PadStrL(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  125.   VAR
  126.     ilen : BYTE;
  127.   BEGIN
  128.     ilen := length(s);
  129.     WHILE (ilen < len) DO
  130.       BEGIN
  131.         INC(ilen);
  132.         s := PadCh + s;
  133.       END;
  134.     PadStrL := s;
  135.   END;
  136.  
  137. FUNCTION  IStr(number : LONGINT; len : BYTE)            : STRING;
  138.   VAR
  139.     tstr : STRING;
  140.   BEGIN
  141.     Str(number,tstr);
  142.     IStr := PadStrL(tstr,'0',len);
  143.   END;
  144.  
  145. FUNCTION  CurrentTime : LONGINT;
  146.   VAR
  147.     ho,mi,se,hs : WORD;
  148.   BEGIN
  149.     GetTime(ho,mi,se,hs);
  150.     CurrentTime := (LONGINT(ho) * 3600) + (LONGINT(mi) * 60) + se;
  151.   END;
  152.  
  153. FUNCTION  DateString                 : STRING;
  154.   VAR
  155.     yr,mo,dy,dw : WORD;
  156.     tstr        : STRING;
  157.   BEGIN
  158.     GetDate(yr,mo,dy,dw);
  159.     tstr := IStr(mo,2) + '/' + IStr(dy,2) + '/' + IStr(yr,2);
  160.     DateString := tstr;
  161.   END;
  162.  
  163. FUNCTION  TimeString(time : LONGINT) : STRING;
  164.   VAR
  165.     ho,mn,se : WORD;
  166.     tstr     : STRING;
  167.   BEGIN
  168.     ho := time DIV 3600;
  169.     DEC(time,LONGINT(ho)*3600);
  170.     mn := time DIV 60;
  171.     DEC(time,LONGINT(mn)*60);
  172.     se := time;
  173.     tstr := IStr(ho,2) + ':' + IStr(mn,2) + ':' + IStr(se,2);
  174.     TimeString := tstr;
  175.   END;
  176.  
  177.  
  178. PROCEDURE WriteEntry;
  179.   BEGIN
  180.     Writeln(FTT,cphone,'    ;    ',PadStrR(cname,' ',32),
  181.                      ' "',datestring,' | ',timestring(CurrentTime),'"');
  182.  
  183.   END;
  184.  
  185. BEGIN
  186.   Writeln('GETTRASH');
  187.   Writeln;
  188.   Writeln('This program will create a textfile called GETTRASH.DAT');
  189.   Writeln('which contain a list of usernames and phone numbers of all');
  190.   Writeln('users on your system,  the format of the list is compatible');
  191.   Writeln('with the file CBVTRASH.DAT,  however this program cannot');
  192.   Writeln('determine whether or not the user is deleted or inactive');
  193.   Writeln;
  194.   Writeln;
  195.   GetConfig;
  196.   GetCount;
  197.   OpenText;
  198.   FOR runi := 1 TO numof DO BEGIN
  199.     Write(#13);
  200.     Write('Current user number ',runi);
  201.     ReadUserList(runi);
  202.     GetVals;
  203.     WriteEntry;
  204.   END;
  205.   Close(FTT);
  206.   Writeln;
  207.   Writeln('Done...');
  208. END.
  209.