Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/CBVR097U.ZIP/GETTRASH.PAS

Pascal/Delphi Source File | 1992-07-11 | 4KB | 179 lines

{$I+}
PROGRAM GETTRASH;

USES RBVVAR, DOS;

CONST

  TempName = 'GETTRASH.DAT';


VAR

  oneline,
  cname,
  cphone : STRING;
  FTT    : TEXT;
  runi,
  numof  : WORD;

  maskSL : BYTE;

PROCEDURE OpenText;
  BEGIN
    Assign(FTT,TempName);
    Rewrite(FTT);
  END;


PROCEDURE GetVals;
  BEGIN
    cname := RGUser.name;
    cphone:= RGUser.ph;
  END;

PROCEDURE ReadUserList(xx : LONGINT);
  BEGIN
    Seek(RGUserFile,0);
    Seek(RGuserfile,xx);
    Read(RGUserFile,RGUser);
  END;

PROCEDURE OpenUserList;
  BEGIN
    Assign(RGUserFile,paramstr(1));
    FileMode := 66;
    Reset(RGUserFile);
    numof := FileSize(RGUserFile)-1;
    IF (IOResult <> 0) THEN BEGIN
      Writeln('[>ERROR<] - COULD NOT OPEN USER FILE ');
      HALT;
    END;

  END;

FUNCTION  PadStrR(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  VAR
    ilen : BYTE;
  BEGIN
    ilen := length(s);
    WHILE (ilen < len) DO
      BEGIN
        INC(ilen);
        s := s + PadCh;
      END;
    PadStrR := s;
  END;

FUNCTION  PadStrL(s : STRING; PadCh : CHAR; len : BYTE) : STRING;
  VAR
    ilen : BYTE;
  BEGIN
    ilen := length(s);
    WHILE (ilen < len) DO
      BEGIN
        INC(ilen);
        s := PadCh + s;
      END;
    PadStrL := s;
  END;

FUNCTION  IStr(number : LONGINT; len : BYTE)            : STRING;
  VAR
    tstr : STRING;
  BEGIN
    Str(number,tstr);
    IStr := PadStrL(tstr,'0',len);
  END;

PROCEDURE GetCount;
  VAR
    S  : SearchRec;
    ie : INTEGER;
  BEGIN
    FindFirst(paramstr(1),anyfile,s);
    IF DosError <> 0 THEN BEGIN
      Writeln(#7#7+'User file not found '+paramstr(1));
      HALT;
    END;
    IF paramcount = 2 THEN BEGIN
      VAL(paramstr(2),maskSL,ie);
      IF (ie <> 0) THEN maskSL := 30;
    END ELSE maskSL := 30;

  END;


FUNCTION  CurrentTime : LONGINT;
  VAR
    ho,mi,se,hs : WORD;
  BEGIN
    GetTime(ho,mi,se,hs);
    CurrentTime := (LONGINT(ho) * 3600) + (LONGINT(mi) * 60) + se;
  END;

FUNCTION  DateString                 : STRING;
  VAR
    yr,mo,dy,dw : WORD;
    tstr        : STRING;
  BEGIN
    GetDate(yr,mo,dy,dw);
    tstr := IStr(mo,2) + '/' + IStr(dy,2) + '/' + IStr(yr,2);
    DateString := tstr;
  END;

FUNCTION  TimeString(time : LONGINT) : STRING;
  VAR
    ho,mn,se : WORD;
    tstr     : STRING;
  BEGIN
    ho := time DIV 3600;
    DEC(time,LONGINT(ho)*3600);
    mn := time DIV 60;
    DEC(time,LONGINT(mn)*60);
    se := time;
    tstr := IStr(ho,2) + ':' + IStr(mn,2) + ':' + IStr(se,2);
    TimeString := tstr;
  END;


PROCEDURE WriteEntry;
  BEGIN
    Writeln(FTT,cphone,'    ;    ',PadStrR(cname,' ',32),
                     ' "',datestring,' | ',timestring(CurrentTime),'"');

  END;

BEGIN
  Writeln('GETTRASH');
  Writeln;
  Writeln('This program will create a textfile called GETTRASH.DAT');
  Writeln('which contain a list of usernames and phone numbers of all');
  Writeln('users on your system,  the format of the list is compatible');
  Writeln('with the file CBVTRASH.DAT');
  Writeln;
  Writeln;
  Writeln('Usage > GetTrash path/userlist VSL');
  Writeln;
  Writeln(' VSL = Minimum SL to be included in list ');
  Writeln;
  GetCount;
  OpenText;
  OpenUserList;
  Writeln('Minimum SL included   = ',maskSL);
  Writeln('Number of users found = ',numof);
  FOR runi := 1 TO numof DO BEGIN
    Write(#13);
    Write('Current user number ',runi);
    ReadUserList(runi);
    GetVals;
    IF (RGUser.SL >= MaskSL) AND NOT (deleted IN RGUser.sflags) THEN
      WriteEntry;
  END;
  Close(FTT);
  Close(RGUserFile);
  Writeln;
  Writeln('Done...');
END.