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

Pascal/Delphi Source File | 1992-05-05 | 5KB | 209 lines

PROGRAM GETTRASH;

USES CBVVAR, DOS;

CONST

  TempName = 'GETTRASH.DAT';


VAR

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

PROCEDURE GetCount;
  VAR
    S : SearchRec;
  BEGIN
    FindFirst(paramstr(1),anyfile,s);
    IF DosError <> 0 THEN BEGIN
      Writeln(#7#7+'User file not found '+paramstr(1));
      HALT;
    END;
    numof := S.size DIV Config.userreclen;
  END;

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

FUNCTION AsciizToStr(VAR a ) : STRING;
    {-Convert ASCIIZ to Turbo STRING}
  VAR
    s : STRING;
    slen : BYTE ABSOLUTE s;

  BEGIN                       {AsciizToStr}
    slen := 0;
    WHILE ASCIIZ(a)[slen] <> #0 DO
      slen := Succ(slen);
    Move(ASCIIZ(a), s[1], slen);
    AsciizToStr := s;
  END;                        {AsciizToStr}

PROCEDURE GetVals;
  VAR
    tstr   : STRING;
    count,
    loop1  : BYTE;
    temp   : ARRAY[0..40] OF CHAR;
  BEGIN
    count := 0;
    FillChar(temp,SizeOf(temp),#0);
    FOR loop1 := Config.offset_name TO Config.offset_name + 31 DO BEGIN
      temp[count] := file_buffer[loop1];
      INC(count);
    END;
    cname := AsciizToStr(temp);
    count := 0;
    FillChar(temp,SizeOf(temp),#0);
    FOR loop1 := Config.offset_phone TO Config.offset_phone + 13 DO BEGIN
      temp[count] := file_buffer[loop1];
      INC(count);
    END;
    cphone := AsciiZtoStr(temp);
  END;

PROCEDURE ReadUserList(xx : LONGINT);
  VAR
    actual   : WORD;
    base1,
    base2,
    position : LONGINT;
  BEGIN
    Assign(userfile,paramstr(1));
    Reset(userfile,1);
    IF (IOResult <> 0) THEN BEGIN
      Writeln('[>ERROR<] - COULD NOT OPEN USER FILE ');
      HALT;
    END;
    IF ((FileSize(userfile) MOD Config.userreclen) <> 0) THEN BEGIN
      Writeln('[>ERROR<]- ERROR IN SIZE OF USER FILE ');
      HALT;
    END;
    base1 := xx;
    base2 := Config.userreclen;
    position := base1 * base2;
    Seek(userfile,position);
    BlockRead(userfile,file_buffer,Config.userreclen,actual);
    Close(userfile);
  END;

PROCEDURE GetConfig;
  BEGIN
    Assign(ConfigFile,_config);
    Reset(ConfigFile);
    IF IOResult <> 0 THEN BEGIN
      Writeln('CBVCFG.DAT not found in current path!');
      HALT;
    END;
    Read(ConfigFile,Config);
    Close(ConfigFile);
  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;

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,  however this program cannot');
  Writeln('determine whether or not the user is deleted or inactive');
  Writeln;
  Writeln;
  GetConfig;
  GetCount;
  OpenText;
  FOR runi := 1 TO numof DO BEGIN
    Write(#13);
    Write('Current user number ',runi);
    ReadUserList(runi);
    GetVals;
    WriteEntry;
  END;
  Close(FTT);
  Writeln;
  Writeln('Done...');
END.