home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / MISC / TGARTS.ZIP / SAMPLE.ZIP / TGSHORT.PAS < prev    next >
Pascal/Delphi Source File  |  1998-12-20  |  3KB  |  93 lines
  1.  
  2. Program TGshort;
  3.  
  4. Uses Crt, Dtime;
  5.  
  6. {$I telegard.inc}
  7.  
  8. Var Short_file : file of shortmsgrec;
  9.     Short_Rec  : shortmsgrec;
  10.     Temp_File  : File of shortmsgrec;
  11.     Temp_Rec   : shortmsgrec;  {Temporary files}
  12.     Key : Char;
  13.     Del_Count,Total_count : Integer;
  14.     TempS : String;
  15.     DateR : datetimerec;
  16.  
  17. Begin
  18.   Clrscr;
  19.   Del_Count := 0; { Delete entry counter }
  20.   Total_count := 0;
  21.   Writeln('Are you sure you wish to pack (remove deleted entries)');
  22.   Writeln('your shortmsg.dat file?  Press Y to continue or any other');
  23.   Writeln('to abort the packing');
  24.   Repeat
  25.   Until (Keypressed) or (Key='Y');
  26.   Key := Readkey;Key:= Upcase(Key);
  27.   IF Key='Y' then {Pack}
  28.   Begin
  29.     Assign(Short_file, 'shortmsg.dat');
  30.     Reset(short_file);
  31.     Assign(temp_file, 'shortmsg.new');
  32.     Rewrite(temp_file);
  33.     Writeln('Processing data file to purge deleted entries..stand by');
  34.     While not eof(short_file) do
  35.     Begin
  36.       Read(short_file, short_rec);
  37.       If short_rec.userid<>0 then {if 0 then ignore entry mark for deletion}
  38.       Begin
  39.         Temp_rec := short_rec; {copy record to write record}
  40.         Write(temp_file,temp_rec);
  41.       end;
  42.       If short_rec.userid=0 then Inc(Del_count);
  43.       inc(Total_count);
  44.     end;
  45.     Close(short_file);
  46.     Close(Temp_file);
  47.     Writeln;textcolor(11);
  48.     Writeln('Purge complete.');
  49.     Str(total_count,TempS);
  50.     Writeln('Total records '+TempS);
  51.     str(del_count,TempS);
  52.     Textcolor(14);Writeln('Total removed '+TempS);
  53.     If del_count=total_count then
  54.     Begin
  55.       Textcolor(12); {all records gone}
  56.       Writeln('The complete file has been purged!');
  57.     end else
  58.     Begin
  59.       If del_count>0 then {=0 then no need to rename files}
  60.       Begin
  61.         Textcolor(15);
  62.         Writeln('Renaming shortmsg.dat to shortmsg.bak (just in case)');
  63.         Rename(short_file,'shortmsg.bak');
  64.         Writeln('Renaming temporary file to shortmsg.dat');
  65.         Rename(temp_file,'shortmsg.dat');
  66.         Writeln('Erasing temporary file');
  67.       end;
  68.       if del_count=0 then erase(temp_file);
  69.     end;
  70.     Writeln;
  71.     {Remove next 15 lines for a basic purge program}
  72.     Textcolor(13);
  73.     Writeln('Now adding note to the end of the data file');
  74.     Writeln('Adding note to Sysop (record number 1) about the purge');
  75.     Assign(short_file,'shortmsg.dat');
  76.     Reset(short_file);
  77.     Short_rec.userid := 1;
  78.     Short_rec.msg    := 'Removed '+temps+' from shortmsg.dat!!!';
  79.     Short_rec.msgid  := 0;
  80.     Getdatetime(dateR); {Gets current date/time}
  81.     Short_rec.written:= dt2unix(dater);;  {function to convert to unix}
  82.     {see dtime.pas for dt2unix function}
  83.     Seek(short_file,filesize(short_file));
  84.     Write(short_file,short_rec);
  85.     Close(Short_file);
  86.     Writeln('Note added to file!');
  87.   end else Writeln('No packing will be done');
  88.   Writeln;
  89.   Writeln('Program execusion is done');
  90. end.
  91.  
  92.  
  93.