home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SYSPC22.ZIP / GFILES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-11  |  28.3 KB  |  1,098 lines
  1. overlay PrOcEdUrE genfiles; {major overlay}
  2. var showit,itsotay:boolean;
  3.  
  4. Type GFileRec=Record
  5.        GFileDescr:string[75];
  6.        Sentby:string[28];
  7.        Path:string[50];
  8.        ArcName:sstr;
  9.        FName:lstr;
  10.        FileSize:real;
  11.        SentDa,SentTi:sstr;
  12.        Downloaded:integer;
  13.        SpecialFile,NewFile:boolean;
  14.      end;
  15.  
  16.      GFileArea=Record
  17.        Name:Lstr;
  18.        GFileDir:string[49];
  19.        In_Conf:Byte;
  20.        Sponsor:mstr;
  21.        Level:integer;
  22.        UpAble:Boolean;
  23.      end;
  24.  
  25. var GFile:File of GFileRec;
  26.     GF:GFileRec;
  27.     GFileA:File of GFileArea;
  28.     GFA:GFileArea;
  29.     Curarea:integer;
  30.  
  31.   FuNcTiOn NumGFiles:integer;
  32.   begin
  33.     numgfiles:=filesize(GFile)
  34.   end;
  35.  
  36.   FuNcTiOn NumAreas:integer;
  37.   begin
  38.     numareas:=filesize (GFileA)
  39.   end;
  40.  
  41.   PrOcEdUrE SeekGFile (n:integer);
  42.   begin
  43.     seek (GFile,n-1)
  44.   end;
  45.  
  46.   PrOcEdUrE SeekGFileA (n:integer);
  47.   begin
  48.     seek (GFileA,n-1)
  49.   end;
  50.  
  51.   PrOcEdUrE AssignGF (N:Integer);
  52.   begin
  53.     close (GFile);
  54.     assign (GFile,uploaddir+'GFILE'+strr(n));
  55.   end;
  56.  
  57.   FuNcTiOn MakeArea:boolean;
  58.   var num,n:integer;
  59.       GFATmp:GFileArea;
  60.   begin
  61.     makearea:=false;
  62.     writestr ('Create area '+strr(numareas+1)+'? *');
  63.     writeln;
  64.  
  65.     if yes then begin
  66.       writestr ('Area name: *');
  67.       if length(input)=0 then exit;
  68.       GFATmp.Name:=input;
  69.       writestr ('Access level: *');
  70.       if length(input)=0 then exit;
  71.       GFATmp.Level:=valu(input);
  72.       writestr ('Sponsor [CR/'+unam+']:');
  73.       if length(input)=0 then input:=unam;
  74.       GFATmp.Sponsor:=input;
  75. {*      writestr ('Conference In [0/None]:');
  76.       if length(input)=0 then input:='0';
  77.       GFATmp.In_Conf:=valu(input);  *}
  78.       GFATmp.UpAble:=True;
  79.       writestr('Able to Upload to area [CR/Yes]: *');
  80.       if length(input)=0 then input:='Y';
  81.       if upcase(input[1])<>'Y' then GFATmp.UpAble:=False;
  82.       writestr('Upload Directory [CR/'+uploaddir+']: *');
  83.       if length(input)=0 then input:=uploaddir;
  84.       GFATmp.GFileDir:=input;
  85.       SeekGFileA (numareas+1);
  86.       write (GFileA,GFATmp);
  87.       GFA:=GFATmp;
  88.       Curarea:=NumAreas+1;
  89.       AssignGF(CurArea);
  90.       rewrite (GFile);
  91.       writeln ('Area created');
  92.       makearea:=true;
  93. {*      writelog ('Created GFile area '+GFATmp.Name+' ['+strr(num)+']'); *}
  94.     end
  95.  
  96.   end;
  97.  
  98.   PrOcEdUrE OpenGFile;
  99.   var n:integer;
  100.   begin
  101.     n:=ioresult;
  102.     assign (GFileA,uploaddir+'GFileDir');
  103.     reset (GFileA);
  104.     if ioresult<>0 then begin
  105.       close (GFileA);
  106.       n:=ioresult;
  107.       rewrite (GFileA);
  108.       itsotay:=makearea;
  109.     end else itsotay:=true;
  110.   end;
  111.  
  112.   FuNcTiOn GetFName (path:lstr; name:mstr):lstr;
  113.   var l:lstr;
  114.   begin
  115.     l:=path;
  116.     if length(l)<>0 then
  117.       if not (upcase(l[length(l)]) in [':','\'])
  118.         then l:=l+'\';
  119.     l:=l+name;
  120.     getfname:=l;
  121.   end;
  122.  
  123.   FuNcTiOn GetAPath:lstr;
  124.   var q,r:integer;
  125.       f:file;
  126.       b:boolean;
  127.       p:lstr;
  128.   begin
  129.     getapath:=GFA.GFileDir;
  130.     repeat
  131.       writestr ('Upload path [CR/'+GFA.GFileDir+']:');
  132.       if hungupon then exit;
  133.       if length(input)=0 then input:=GFA.GFileDir;
  134.       p:=input;
  135.       if input[length(p)]<>'\' then p:=p+'\';
  136.       b:=true;
  137.       assign (f,p+'CON');
  138.       reset (f);
  139.       q:=ioresult;
  140.       close (f);
  141.       r:=ioresult;
  142.       if q<>0 then begin
  143.         writestr ('Make that path? *');
  144.         b:=yes;
  145.         if b then begin
  146.           mkdir (copy(p,1,length(p)-1));
  147.           q:=ioresult;
  148.           b:=q=0;
  149.           if b then writestr ('Directory created..')
  150.             else writestr ('Unable to create directory..')
  151.         end
  152.       end
  153.     until b;
  154.     getapath:=p;
  155.   end;
  156.  
  157.   PrOcEdUrE fastlistfile (n:integer);
  158.   var q:sstr;
  159.   begin
  160.     seekGFile (n);
  161.     read (GFile,GF);
  162.     writeln;
  163.     tab (strr(n)+'.',4);
  164.     if break then exit;
  165.     if gf.newfile then write ('New    ') else if gf.specialfile then write ('Sys   ')
  166.     else
  167.     if (GF.ArcName='') then
  168.       if exist(GetFName(GF.Path,GF.FName)) then
  169.         tab (streal(GF.FileSize),7) else write ('OffLine')
  170.       else write ('Arc''ed ');
  171.     if break then exit;
  172.     tab ('  '+GF.GFileDescr,40);
  173.     if break then exit;
  174.   end;
  175.  
  176.   FuNcTiOn NoFiles:boolean;
  177.   begin
  178.     if NumGFiles=0 then begin
  179.       nofiles:=true;
  180.       writeln (^M'*> No G-Files <*')
  181.     end else nofiles:=false
  182.   end;
  183.  
  184.   PrOcEdUrE FastListGFiles;
  185.   var cnt,max,r1,r2,r3:integer;
  186.   begin
  187.     if nofiles then exit;
  188.     writehdr ('File List'^M);
  189.     max:=NumGFiles;
  190.     thereare (max,'G-File','G-Files');
  191.     parserange (max,r1,r2);
  192.     if r1=0 then exit;
  193.     tab ('No.',4);
  194.     tab ('Bytes',7);
  195.     writeln ('Description');
  196.     r3:=0;
  197.     for cnt:=r1 to r2 do begin
  198.     r3:=r3+2;
  199.       FASTlistfile (cnt);
  200.       if break then exit
  201.     end;
  202.     writeln;
  203.   end;
  204.  
  205.   FuNcTiOn GetGFileNum (t:mstr):integer;
  206.   var n,s:integer;
  207.       x1,x2,x3,i:integer;
  208.       y1,y2,y3:real;
  209.  
  210.  
  211.     FuNcTiOn SearchforFile (f:sstr):integer;
  212.     var cnt:integer;
  213.     begin
  214.       for cnt:=1 to numgfiles do begin
  215.         seekGFile (cnt);
  216.         read (GFile,GF);
  217.         if match(GF.FName,f) then begin
  218.           searchforfile:=cnt;
  219.           exit
  220.         end
  221.       end;
  222.       searchforfile:=0
  223.     end;
  224.  
  225.  
  226.   begin
  227.     getgfilenum:=0;
  228.     if match (t,'download') then begin
  229. x1:=urec.gfup;
  230. x2:=urec.gfdown;
  231. if x1<1 then x1:=1;
  232. if x2<1 then x2:=1;
  233.    y1:=int(x1);
  234.    y2:=int(x2);
  235.    y1:=y1;
  236.    y2:=y2;
  237.    y3:=y1/y2;
  238.    Y3:=Y3*100;
  239.   x3:=trunc(y3);
  240.  
  241. if gfudratio > 0 then
  242. if (x3<gfudratio) and not issysop and (ulvl<nopcr) then
  243.  begin
  244.   dontstop:=true;
  245.   nobreak:=true;
  246.   if exist (textfiledir+'GUDRatio') then printfile (textfiledir+'GUDatio') else begin
  247. writeln (^T'         *> Upload/Download Ratio <*');
  248.   writeln ('    You''ve uploaded ',urec.gfup,' files');
  249.   writeln ('    And have downloaded ',urec.gfdown,' files.');
  250.   writeln ('    You have a ',x3,'% ratio now.');
  251.   writeln ('    Minimum Ratio is ',GFUDRATIO,'%.');
  252.   Writeln (^M' Your Upload/Download ratio is too low,Post a message or two!');
  253.   end;
  254.     exit;
  255.     end;
  256.       end;
  257.     if length(input)>1 then input:=copy(input,2,255) else
  258.       repeat
  259.         writestr ('File # to '+t+' [?/List]:');
  260.         if hungupon or (length(input)=0) then exit;
  261.         if input='?' then begin
  262.           fastlistgfiles;
  263.           input:=''
  264.         end
  265.       until input<>'';
  266.     val (input,n,s);
  267.     if s<>0 then begin
  268.       n:=searchforfile(input);
  269.       if n=0 then begin
  270.         writeln ('No such file..');
  271.         exit
  272.       end
  273.     end;
  274.     if (n<1) or (n>numgfiles) then writeln ('Invalid number..')
  275.       else getgfilenum:=n
  276.   end;
  277.  
  278.   PrOcEdUrE AddFile (GF:GFileRec);
  279.   begin
  280.     SeekGFile (NumGFiles+1);
  281.     write (GFile,GF)
  282.   end;
  283.  
  284.   FuNcTiOn Getfsize(Filename:anystr):real;
  285.   var df:file of byte;
  286.   begin
  287.     GF.FileSize:=-1;
  288.     assign (df,Filename);
  289.     reset (df);
  290.     if ioresult<>0 then exit;
  291.     GetFSize:=longfilesize(df);
  292.     close(df)
  293.   end;
  294.  
  295.   const beenaborted:boolean=false;
  296.  
  297.   FuNcTiOn Aborted:boolean;
  298.   begin
  299.     if beenaborted then begin
  300.       aborted:=true;
  301.       exit
  302.     end;
  303.     aborted:=xpressed or hungupon;
  304.     if xpressed then begin
  305.       beenaborted:=true;
  306.       writeln (^B'New-scan aborted..')
  307.     end
  308.   end;
  309.  
  310.   PrOcEdUrE NewScan;
  311.   var cnt:integer;
  312.       first:integer;
  313.       newest:boolean;
  314.   label notlater;
  315.   begin
  316.     newest:=false;
  317.     beenaborted:=false;
  318.     first:=0;
  319.     for cnt:=filesize(GFile) downto 1 do begin
  320.       SeekGFile (cnt);
  321.       read (GFile,GF);
  322.       if later (GF.SentDa,GF.SentTi,lastonda,lastonti)
  323.         then first:=cnt
  324.         else goto notlater
  325.     end;
  326.     notlater:
  327.     if first<>0 then begin
  328.       writeln;
  329.       writeln (^M^T'File Area: ['^S,GFA.name+']');
  330.       for cnt:=first to filesize(GFile) do begin
  331.         if aborted then exit;
  332.         fastlistfile (cnt);
  333.       end
  334.     end
  335.   end;
  336.  
  337.   Function IsConference:Boolean;
  338.   begin
  339.     isconference:=false;
  340. {    if GFA.In_Conf<>0 then isconference:=true;  }
  341.   end;
  342.  
  343.   Function IsInConf:Boolean;
  344.   begin
  345.    Isinconf:=true;
  346.   (**  isinconf:=false;
  347.     if urec.level>=sysoplevel then isinconf:=true else
  348.     if isconference { and Conf_Acc[curconf]} then isinconf:=true;**)
  349.   end;
  350.  
  351.   Procedure SetArea (n:integer);
  352.   var otay:boolean;
  353.   begin
  354.     curarea:=n;
  355.     otay:=false;
  356.     if (n>numareas) or (n<1) then begin
  357.       writeln (^B'Invalid area..');
  358.       if issysop then if makearea then setarea (curarea)
  359.         else setarea (1)
  360.       else setarea (1);
  361.       exit
  362.     end;
  363.     seekGFileA (n);
  364.     read (GFileA,GFA);
  365.  
  366.     otay:=(urec.GFLvl>=GFA.Level); { or isinconf;}
  367.  
  368.     if not otay then
  369.       if curarea=1 then error ('Access level too low..','','')
  370.         else begin
  371.           reqlevel (GFA.level);
  372.           setarea (1);
  373.           exit
  374.         end;
  375.  
  376.     AssignGF(n);
  377.     close (GFile);
  378.     reset (GFile);
  379.     if ioresult<>0 then rewrite (GFile);
  380.     if not showit then begin
  381.     writeln (^B^M^M'G-File Area: '^S,'[',curarea,']:[',GFA.name,']');
  382.     if issysop then  writeln (^B'%: Sponsor Commands');
  383.     writeln;
  384.     end;
  385.   end;
  386.  
  387.   PrOcEdUrE newscanall;
  388.   var cnt:integer;
  389.       otay:boolean;
  390.   begin
  391. {*    urec.LastGFileArea:=curarea; *}
  392.     writehdr ('Newscanning, press [X] to abort.');
  393.     if aborted then exit;
  394.     for cnt:=1 to filesize(GFileA) do begin
  395.       seekGFileA (cnt);
  396.       read (GFileA,GFA);
  397.       otay:=false;
  398.  
  399.       if urec.GFLvl>=GFA.Level then otay:=true else otay:=false;
  400.       if otay then begin
  401.         if aborted then exit;
  402.         showit:=true;
  403.         setarea (cnt);
  404.         showit:=false;
  405.         if aborted then exit;
  406.         newscan;
  407.       end;
  408.       if aborted then exit
  409.     end;
  410. {*    setarea(urec.LastGFileArea); *}
  411.   end;
  412.  
  413.   PrOcEdUrE ListAreas;
  414.   var cnt,old:integer;
  415.         GFATmp:GFileArea;
  416.  
  417.   begin
  418.     writehdr ('Area List');
  419.     old:=curarea;
  420.     seekGfileA (1);
  421.     writeln(^M'[Number]   [Level]      [Name]');
  422.     for cnt:=1 to NumAreas do begin
  423.       read (GFileA,GFATmp);
  424.       if {* IsInConf or *} (urec.level>=GFATmp.Level) then begin
  425.         write ('[',cnt:2,']       [');
  426.         {* if GFATmp.In_Conf<>0 then write('Cnf ',Strr(GFATmp.In_Conf)) else *}
  427.           write(GFATmp.Level:5);
  428.         write(']      ');
  429.         tab ('['+GFATmp.Name,26);
  430.         writeln (']');
  431.         if break then begin
  432.           setarea(old);
  433.           exit;
  434.         end;
  435.       end;
  436.     end;
  437.     writeln;
  438.     setarea(old);
  439.   end;
  440.  
  441.   FuNcTiOn GetAreaNum:integer;
  442.   var areastr:sstr;
  443.       areanum:integer;
  444.   begin
  445.     getareanum:=0;
  446.     if length(input)>1 then areastr:=copy(input,2,255) else
  447.     repeat
  448.       listareas;
  449.       writestr (^M'Enter New Area [?/List]:');
  450.       if input='!' then listareas else areastr:=input
  451.     until (input<>'?') or hungupon;
  452.     if length(areastr)=0 then exit;
  453.     areanum:=valu(areastr);
  454.     if (areanum>0) and (areanum<=NumAreas) then getareanum:=areanum
  455.     else begin
  456.       writestr ('No such area..');
  457.       if issysop then if makearea then getareanum:=numareas
  458.     end;
  459. {*    urec.LastGFileArea:=areanum;  *}
  460.   end;
  461.  
  462.   PrOcEdUrE GetArea;
  463.   var areanum:integer;
  464.   begin
  465.     areanum:=getareanum;
  466.     if areanum<>0 then SetArea (areanum);
  467.   end;
  468.  
  469.  
  470.  
  471.  
  472.  
  473.   PrOcEdUrE MakeGFile(FileName:anystr);
  474.   var t:text;
  475.       b,yo,ymodem,crcmode:boolean;
  476.       z:integer;
  477.   begin
  478.      if hungupon then exit;
  479.      yo:=false;
  480.      write ('*> Upload using Xmodem [No=Ascii]? :');
  481.      getstr; yo:=yes;
  482.      if not yo then begin
  483.     assign (t,Filename);
  484.     rewrite (t);
  485.     writeln (^M'Enter text-file [Echo''d] [/S]:[Save] [/A]:[Abort]'^M);
  486.     repeat
  487.       lastprompt:='Continue...'^M;
  488.       wordwrap:=true;
  489.       getstr;
  490.       b:=match(input,'/S') or match(input,'/A');
  491.       if not b then writeln (t,input);
  492.       if hungupon then input:='/A';
  493.     until b;
  494.     textclose (t);
  495.     if match(input,'/A') then erase(t);
  496. {*    writelog ('Created GFile disk file '+Filename); *}
  497.     end else begin
  498.     write ('Use CRC-Mode? ');
  499.     getstr;crcmode:=yes;
  500.     if hungupon then exit;
  501.     writeln(^M'*> Make sure file is NOT Arc''ed <*');
  502.     write ('*> Continue with X-Modem Transfer? ');
  503.     getstr;
  504.     if hungupon then exit;
  505.     if not yes then exit;
  506.     ymodem:=false;
  507.     z:=protocolxfer(false,crcmode,ymodem,filename);
  508.     if z<>0 then yo:=false;
  509.     if yo then writeln (^B'File Received.');
  510. {*    IF YO THEN Writelog ('Created GFile disk file '+Filename); *}
  511.       if not yo then begin
  512.               assign (t,filename);erase(t);
  513.              end;
  514.     end;
  515.   end;
  516.  
  517.  
  518.  
  519.  
  520.   overlay procedure yourgfstatus(a:integer; heh:boolean);
  521.   var x1,x2,x3:integer;
  522.       y1,y2,y3:real;
  523.  
  524.   begin
  525.    if (not heh) or (not ansi) or (not urec.windows) then begin
  526.     writeln (^B^M'Access level:    '^S,urec.Gflvl,
  527.                ^M'Uploads:         '^S,urec.gfup,
  528.                ^M'Downloads:       '^S,urec.gfdown);
  529.     exit;
  530.   end;
  531.   windowit (31,7,4,2);
  532.   movexy (8,3);
  533.   writeln ('G-File Transfer Section');
  534.   movexy (6,5);
  535.   writeln ('Current G-file Level: '^S,urec.Gflvl);
  536.   movexy (19,6);
  537.   writeln ('Uploads: '^S,urec.gfup);
  538.   movexy (17,7);
  539.   writeln ('Downloads: '^S,urec.gfdown);
  540.   windowit (28,6,33,6);
  541.   movexy (43,7);
  542.   writeln ('# of Calls: '^S,urec.numon);
  543.   movexy (43,8);
  544.   writeln ('# of Posts: '^S,urec.nbu);
  545.   movexy (36,9);
  546.   writeln ('Current P/C Ratio: '^S,a,'%');
  547.   movexy (36,10);
  548.   writeln ('Minimum P/C Ratio: '^S,gfratio,'%');
  549.   windowit (32,4,37,2);
  550.   movexy (39,3);
  551. x1:=urec.gfup;
  552. x2:=urec.gfdown;
  553. if x1<1 then x1:=1;
  554. if x2<1 then x2:=1;
  555.    y1:=int(x1);
  556.    y2:=int(x2);
  557.    y1:=y1;
  558.    y2:=y2;
  559.    y3:=y1/y2;
  560.    Y3:=Y3*100;
  561.   x3:=trunc(y3);
  562.   writeln ('Current U/L D/L Ratio: '^S,x3,'%');
  563.   movexy (39,4);
  564.   writeln ('Minimum U/L D/L Ratio: '^S,gfudratio,'%');
  565.   movexy (1,13);
  566.   end;
  567.  
  568.   overlay PrOcEdUrE ShowGFile (n:integer);
  569.   var f:file;
  570.       yo:boolean;
  571.       y:integer;
  572.       fn:lstr;
  573.   begin
  574.     seekGFile (n);
  575.     read (GFile,GF);
  576.     if ulvl<0 then
  577.       reqlevel (0);
  578.     if ulvl<0 then   exit;
  579.     writeln;
  580.     if GF.ArcName<>'' then begin
  581.       writeln;
  582.       write('*> File in Archive.. Please Hold..');
  583.       if exist(GF.FName) then begin
  584.         writeln;
  585.         writeln (' Cannot View File.. Leave Sysop a comment.. <*');
  586.         exit;
  587.       end;
  588.       dos_shell(unarc+' '+GetFName(GF.Path,GF.ArcName)+' '+GF.FName+' >temp.txt');
  589.       if not exist(GF.FName) then begin
  590.         writeln;
  591.         writeln ('Error. Inform Sysop <*');
  592.         exit;
  593.       end;
  594.       writeln('Extracted <*');
  595.     end;
  596.     if (GF.ArcName='') and not exist(GetFName(GF.Path,GF.Fname)) then begin
  597.       writeln('*> File Offline <*');
  598.       writeln;
  599.       exit;
  600.     end;
  601.     writestr ('*> Download using X-Modem [No=Ascii]: *');
  602.     if hungupon then exit;
  603.     if yes then yo:=true;
  604.     if not yo then begin
  605.     writestr('*> Press [X] to Abort / [CR] to Continue: *');
  606.     if upcase(input[1])='X' then exit;
  607.     writeln (^M'*> Title:   '^S,GF.GFileDescr,
  608.              ^M'*> Date:    '^S,GF.SentDa,
  609.              ^M'*> Time:    '^S,GF.SentTi,^M);
  610.     if GF.ArcName='' then printfile (GetFname(GF.Path,GF.Fname)) else
  611.       printfile (GF.FName);
  612.     urec.GfDown:=urec.GfDown+1;
  613.     end
  614.     else begin
  615.     if GF.ArcName='' then fn:=(GetFname(GF.Path,GF.Fname)) else
  616.       fn:=GF.FName;
  617.     writeln ('*> Begin X-Modem-CRC DownLoad <*');
  618.     y:=protocolxfer(true,true,false,fn);
  619.     if y<1 then urec.gfdown:=urec.gfdown+1 else writeln ('*> Aborted <*');
  620.     end;
  621.     if GF.ArcName<>'' then begin
  622.       assign(f,GF.FName);
  623.       erase(f);
  624.     end;
  625.     writeln(asciidownload);
  626.   end;
  627.  
  628.   overlay PrOcEdUrE UploadGFile;
  629.   var FN:anystr;
  630.   begin
  631.     writeln;
  632.     repeat
  633.       writestr('Enter Upload Filename: *');
  634.       if length(input)=0 then exit;
  635.       if hungupon then exit;
  636.    until validfname(input);
  637.     GF.FName:=input;
  638.     FN:=GetFName(GFA.GFileDir,GF.FName);
  639.     if not exist(FN) then begin
  640.       writestr ('Description: *');
  641.       GF.GFileDescr:=input;
  642.       makeGFile(FN);
  643.     end else writeln('File exists!');
  644.     writeln;
  645.     if not exist(FN) then begin
  646.       writeln('*> Upload aborted <*');
  647.       exit;
  648.     end else writeln('*> Upload Completed <*');
  649.     GF.SentTi:=timestr;
  650.     GF.SentDa:=datestr;
  651.     GF.SentBy:=Unam;
  652.     GF.Path:=gfa.gfiledir;
  653.     GF.Downloaded:=0;
  654.     GF.SpecialFile:=False;
  655.     GF.NewFile:=True;
  656.     GF.ArcName:='';
  657.     Urec.GFUp:=Urec.GfUp+1;
  658.     seekGFile (numgfiles+1);
  659.     write (GFile,GF);
  660.     writeln;
  661. {*    writelog ('Uploaded GFile: '+GF.GFileDescr) *}
  662.   end;
  663.  
  664.   PrOcEdUrE SysopCommands;
  665.   var q:integer;
  666.     PrOcEdUrE getstr (prompt:mstr; var ss; len:integer);
  667.     var a:anystr absolute ss;
  668.     begin
  669.       writeln (^B^M'  Current ',prompt,' is: '^S,a);
  670.       buflen:=len;
  671.       writestr ('Enter new '+prompt+':');
  672.       if length(input)>0 then a:=input;
  673.     end;
  674.  
  675.     PrOcEdUrE getint (prompt:mstr; var i:integer);
  676.     var q:sstr;
  677.         n:integer;
  678.     begin
  679.       str (i,q);
  680.       getstr (prompt,q,5);
  681.       n:=valu (q);
  682.       if n<>0 then i:=n
  683.     end;
  684.  
  685.     PrOcEdUrE getboo (t:lstr; var b:boolean);
  686.     var s:sstr;
  687.     begin
  688.       s:=yesno (b);
  689.       getstr (t,s,1);
  690.       b:=upcase(s[1])='Y'
  691.     end;
  692.  
  693.     procedure RemoveFile (n:integer);
  694.     var cnt:integer;
  695.     begin
  696.       for cnt:=n to numgfiles-1 do begin
  697.         seekGFile (cnt+1);
  698.         read (GFile,GF);
  699.         seekGFile (cnt);
  700.         write (GFile,GF)
  701.       end;
  702.       seekGFile (numgfiles);
  703.       truncate (GFile)
  704.     end;
  705.  
  706.  
  707.     PrOcEdUrE AddGFile;
  708.     var FN:Anystr;
  709.     begin
  710.       writestr ('Filename: *');
  711.       if length(input)=0 then exit;
  712.       GF.FName:=input;
  713.       Writestr ('Path [CR/'+GFA.GFileDir+']: *');
  714.       if length(input)=0 then Input:=GFA.GFileDir;
  715.       GF.Path:=input;
  716.       WriteStr ('Archive Filename [CR/None]: *');
  717.       if length(input)=0 then GF.ArcName:='' else begin
  718.         GF.ArcName:=input;
  719.         writestr('Make sure file is in the Arc.. Is it? *');
  720.         if not yes then GF.ArcName:='';
  721.       end;
  722.       if GF.ArcName='' then begin
  723.         FN:=GetFName(GF.Path,GF.FName);
  724.         if not exist(FN) then begin
  725.           writestr ('File not found!  Enter file now? *');
  726.           if yes then makegfile(FN)
  727.         end;
  728.         if not exist(FN) then exit;
  729.       end;
  730.       writestr ('Description:');
  731.       if length(input)=0 then exit;
  732.       if GF.ArcName='' then GF.FileSize:=GetFSize(FN) else GF.FileSize:=0;
  733.       GF.GFileDescr:=input;
  734.       GF.SentTi:=timestr;
  735.       GF.SentDa:=datestr;
  736.       GF.SentBy:=Unam;
  737.       GF.Downloaded:=0;
  738.       GF.SpecialFile:=False;
  739.       GF.NewFile:=False;
  740.       seekGFile (numgfiles+1);
  741.       write (GFile,GF);
  742.       writeln;
  743. {*      writelog ('Added/Created GFile: '+GF.GFileDescr) *}
  744.     end;
  745.  
  746.     overlay PrOcEdUrE EditGFile;
  747.     var n:integer;
  748.         fn:anystr;
  749.     begin
  750.       n:=getgfilenum('edit');
  751.       if n=0 then exit;
  752.       seekGFile (n);
  753.       read (GFile,GF);
  754.       getstr ('filename',GF.FName,12);
  755.       getstr ('path',GF.Path,50);
  756.       getstr ('arc filename',GF.ArcName,50);
  757.       if GF.ArcName='' then begin
  758.         FN:=GetFName(GF.Path,GF.FName);
  759.         if not exist (FN) then begin
  760.           write (^B^M,FN,' not found!');
  761.           writestr (^M'Create new file '+FN+'? *');
  762.           if yes then makegfile(FN);
  763.           if not exist(FN) then exit;
  764.         end else GF.FileSize:=GetFSize(FN);
  765.       end else GF.FileSize:=0;
  766.       getstr ('description',GF.GFileDescr,75);
  767.       getstr ('uploader',GF.SentBy,28);
  768.       getstr ('update time',GF.SentTi,8);
  769.       getstr ('update date',GF.SentDa,8);
  770.       getboo ('special file',GF.SpecialFile);
  771.       getboo ('new file',GF.NewFile);
  772.       seekGFile (n);
  773.       write (GFile,GF);
  774. {*      writelog ('Changed GFile '+GF.GFileDescr); *}
  775.     end;
  776.  
  777.     overlay PrOcEdUrE KillGArea;
  778.     var GFATmp:GFileArea;
  779.         cnt,n:integer;
  780.         oldname,newname:sstr;
  781.     begin
  782.       GFATmp:=GFA;
  783.       writestr ('Delete A'+strr(curarea)+' ['+GFATmp.Name+']: *');
  784.       if not yes then exit;
  785.       close (GFile);
  786.       oldname:=uploaddir+'GFile'+strr(curarea);
  787.       assign (GFile,oldname);
  788.       erase (GFile);
  789.       for cnt:=curarea to NumAreas-1 do begin
  790.         newname:=oldname;
  791.         oldname:=uploaddir+'GFile'+strr(cnt+1);
  792.         assign (GFile,oldname);
  793.         rename (GFile,newname);
  794.         n:=ioresult;
  795.         SeekGFileA (cnt+1);
  796.         read (GFileA,GFATmp);
  797.         seekGFileA (cnt);
  798.         write (GFileA,GFATmp);
  799.       end;
  800.       seekGFileA (numareas);
  801.       truncate (GFileA);
  802.       setarea (1)
  803.     end;
  804.  
  805.     overlay PrOcEdUrE ModGArea;
  806.     var GFATmp:GFileArea;
  807.     begin
  808.       GFATmp:=GFA;
  809.       getstr ('area name',GFATmp.Name,80);
  810.       getint ('access level',GFATmp.Level);
  811.       getstr ('sponsor',GFATmp.Sponsor,30);
  812.    {*   getstr ('conference #',GFATmp.In_Conf,1);  *}
  813.       getboo ('"Able to upload here"',GFATmp.UpAble);
  814.       getstr ('upload dir',GFATmp.GFileDir,50);
  815.       seekGFileA (curarea);
  816.       write (GFileA,GFATmp);
  817.       GFA:=GFATmp;
  818.     end;
  819.  
  820.     overlay PrOcEdUrE DeleteGFile;
  821.     var cnt,n:integer;
  822.         f:file;
  823.     begin
  824.       n:=getgfilenum('delete');
  825.       if n=0 then exit;
  826.       SeekGFile (n);
  827.       read (GFile,GF);
  828.       writestr ('Delete '+GF.GFileDescr+'? *');
  829.       if not yes then exit;
  830.       writestr ('Erase disk file '+GF.FName+'? *');
  831.       if yes then begin
  832.         if GF.ArcName<>'' then begin
  833.           writeln('File is in archive. You cannot delete it from here.');
  834.           exit;
  835.         end;
  836.         assign (f,GetFname(GF.Path,GF.FName));
  837.         erase (f);
  838.         if ioresult<>0 then writestr ('Couldn''t erase file..')
  839.       end;
  840.       for cnt:=n+1 to numgfiles do begin
  841.         seekGFile (cnt);
  842.         read (GFile,GF);
  843.         seekGFile (cnt-1);
  844.         write (GFile,GF)
  845.       end;
  846.       seekGFile (numgfiles);
  847.       truncate (GFile);
  848.       writestr (^M'Deleted.');
  849. {*      writelog ('Deleted GFile '+GF.GFileDescr) *}
  850.     end;
  851.  
  852.     overlay PrOcEdUrE UpdateGFile;
  853.     var n:integer;
  854.     begin
  855.       n:=GetGFileNum('update');
  856.       if n=0 then exit;
  857.       seekGFile (n);
  858.       read (GFile,GF);
  859.       GF.SentTi:=timestr;
  860.       GF.SentDa:=datestr;
  861.       if GF.ArcName='' then GF.FileSize:=getFSize(getFName(GF.Path,GF.FName));
  862.       seekGFile (n);
  863.       write (GFile,GF);
  864. {*      writelog ('Updated time/date for GFile '+GF.GFileDescr) *}
  865.     end;
  866.  
  867.     overlay PrOcEdUrE SortGArea;
  868.     var temp,mark,cnt,method:integer;
  869.         v1,v2:string[80];
  870.         GFTmp:GFileRec;
  871.     begin
  872.       writehdr ('Sort G-Files');
  873.       writeln;
  874.       writeln ('[0]: Quit');
  875.       writeln ('[1]: Description');
  876.       writeln ('[2]: Filename');
  877.       writeln;
  878.       writestr ('Enter method: *');
  879.       method:=valu(input[1]);
  880.       if method=0 then exit;
  881.       mark:=numgfiles-1;
  882.       repeat
  883.         if mark<>0 then begin
  884.           temp:=mark;
  885.           mark:=0;
  886.           for cnt:=1 to temp do begin
  887.             seekGFile (cnt);
  888.             read (GFile,GF);
  889.             read (GFile,GFTmp);
  890.             if method=1 then begin
  891.               v1:=upstring(GF.GFileDescr);
  892.               v2:=upstring(GFTmp.GFileDescr);
  893.             end else begin
  894.               v1:=upstring(GF.FName);
  895.               v2:=upstring(GFTmp.FName);
  896.             end;
  897.             if v1>v2 then begin
  898.               mark:=cnt;
  899.               seekGFile (cnt);
  900.               write (GFile,GFTmp);
  901.               write (GFile,GF)
  902.             end
  903.           end
  904.         end
  905.       until mark=0
  906.     end;
  907.  
  908.     PrOcEdUrE ReorderGAreas;
  909.     var cura,newa:integer;
  910.         GFATmp:GFileArea;
  911.         f1,f2:file;
  912.         fn1,fn2:sstr;
  913.     label exit;
  914.     begin
  915.       writehdr ('Reorder G-File Areas');
  916.       writeln (^M'Number of G-File areas: ',numareas:1);
  917.       for cura:=0 to numareas-2 do begin
  918.         repeat
  919.           writestr (CrLF+'New area #'+strr(cura+1)+' [?/List]:[CR/Quit]:');
  920.           if length(input)=0 then goto exit;
  921.           if input='?' then begin
  922.             listareas;
  923.             newa:=-1
  924.           end else begin
  925.             newa:=valu(input)-1;
  926.             if (newa<0) or (newa>=numareas) then begin
  927.               writeln ('Not found!  Please re-enter...');
  928.               newa:=-1
  929.             end
  930.           end
  931.         until (newa>0);
  932.         seek (GFileA,cura);
  933.         read (GFileA,GFA);
  934.         seek (GFileA,newa);
  935.         read (GFileA,GFATmp);
  936.         seek (GFileA,cura);
  937.         write (GFileA,GFATmp);
  938.         seek (GFileA,newa);
  939.         write (GFileA,GFA);
  940.         fn1:=uploaddir+'GFile';
  941.         fn2:=fn1+strr(newa+1);
  942.         fn1:=fn1+strr(cura+1);
  943.         assign (f1,fn1);
  944.         assign (f2,fn2);
  945.         rename (f1,'Temp$$$$.XYZ');
  946.         rename (f2,fn1);
  947.         rename (f1,fn2)
  948.       end;
  949.       exit:
  950.       setarea (1)
  951.     end;
  952.  
  953.  
  954.     PrOcEdUrE MoveGFile;
  955.     var an,fn,old:integer;
  956.         newfilesam,sambam,filesam,wangbang:anystr;
  957.         darn:file;
  958.         GFTmp:GFileRec;
  959.     begin
  960.       fn:=GetGFileNum ('move');
  961.       old:=curarea;
  962.       if fn=0 then exit;
  963.       input:='';
  964.       an:=GetAreaNum;
  965.       if an=0 then exit;
  966.       SeekGFile (fn);
  967.       read (GFile,GFTmp);
  968.       removefile (fn);
  969.       if GFTmp.ArcName='' then
  970.         writestr('Literally move the file to correct area? *') else
  971.         input:='N';
  972.       write ('Moving...');
  973.       filesam:=GetFName(GFTmp.Path,GFTmp.FName);
  974.       sambam:=GFTmp.Path;
  975.       setarea(an);
  976.       if (sambam<>GFA.GFileDir) then if yes then begin
  977.         GFTmp.Path:=GFA.GFileDir;
  978.         newfilesam:=GetFName(GFTmp.Path,GFTmp.FName);
  979.         Dos_Shell('Copy '+filesam+' '+newfilesam+' >temp');
  980.         wangbang:=filesam;
  981.         assign(darn,wangbang);
  982.         if exist(newfilesam) then erase (darn) else begin
  983.           GFTmp.Path:=sambam;
  984.           writeln('*> Fatal Error <*');
  985.         end;
  986.       end;
  987.       setarea (An);
  988.       Addfile (GFTmp);
  989.       setarea (old);
  990.       writeln (^B'Done.')
  991.     end;
  992.  
  993.   begin
  994.     if not issysop then begin
  995.       reqlevel (sysoplevel);
  996.       exit
  997.     end;
  998.     repeat
  999.       q:=menu ('G-File Sysop','GFILE','QACDUKRMSO@');
  1000.       case q of
  1001.         2:AddGFile;
  1002.         3:EditGFile;
  1003.         4:DeleteGFile;
  1004.         5:UpdateGFile;
  1005.         6:KillGArea;
  1006.         7:ModGArea;
  1007.         8:MoveGFile;
  1008.         9:SortGArea;
  1009.         10:ReorderGAreas;
  1010.       end
  1011.     until hungupon or (q=1)
  1012.   end;
  1013.  
  1014. var prompt:lstr;
  1015.     n:integer;
  1016.     k:char;
  1017.     x1,x2,x3,i:integer;
  1018.     y1,y2,y3:real;
  1019.     q1:mstr;
  1020.     a:arearec;
  1021.     ms:boolean;
  1022.     dammit:boolean;
  1023. begin
  1024.  
  1025. dammit:=false;
  1026. x1:=urec.nbu;
  1027. x2:=urec.numon;
  1028. if x1<1 then x1:=1;
  1029. if x2<1 then x2:=1;
  1030.    y1:=int(x1);
  1031.    y2:=int(x2);
  1032.    y1:=y1;
  1033.    y2:=y2;
  1034.  
  1035.    y3:=y1/y2;
  1036.    Y3:=Y3*100;
  1037.   x3:=trunc(y3);
  1038.     IF ANSI THEN ANSICLS;
  1039. if gfratio > 0 then
  1040. if (x3<gfratio) and not issysop and (ulvl<nopcr) then
  1041.  begin
  1042.   dontstop:=true;
  1043.   nobreak:=true;
  1044.   if exist (textfiledir+'GFRatio') then printfile (textfiledir+'GFRatio') else begin
  1045.   writeln (^T'         *> Post/Call Ratio <*');
  1046.   writeln ('    You''ve posted ',urec.nbu,' messages');
  1047.   writeln ('    And have called ',urec.numon,' times.');
  1048.   writeln ('    You have a ',x3,'% ratio now.');
  1049.   writeln ('    Minimum Ratio is ',GFRATIO,'%.');
  1050.   Writeln (^M' Your Posts/G-File ratio is too low,Post a message or two!');
  1051.   end;
  1052.   dammit:=true;
  1053.   end;
  1054.   if dammit then exit;
  1055.   writeln;
  1056.   if (not urec.windows) or (not ansi) then writeln   ('      *> General Files Section <*');
  1057.   writeln;
  1058.   itsotay:=false;
  1059.   OpenGFile;
  1060.   if not itsotay then exit;
  1061.   SeekGFileA(1);
  1062.   Read (GFileA,GFA);
  1063.   if (urec.GFLvl<GFA.Level) {or (GFA.In_Conf<>0)} then begin
  1064.     writeln('*> Access Level Too Low <*');
  1065.     exit;
  1066.   end;
  1067.   YourGFStatus(x3,true);
  1068.   setarea(1);
  1069. {*  if (urec.LastGFileArea>0) then setarea(urec.LastGFileArea)
  1070.     else  begin
  1071.     urec.LastGFileArea:=1;
  1072.   end; *}
  1073.   repeat
  1074.     prompt:='';
  1075.     write (^B'[',curarea,'] [',gfa.name,']');
  1076. { begin} {    if curconf<>0 then}
  1077.     q:=menu ('G-Files','GFILE','QU%LAYNVD_');
  1078.     case q of
  1079.       1:begin
  1080.           Close(GFile);
  1081.           Close(GFileA);
  1082.         end;
  1083.       2:UploadGFile;
  1084.       3:SysopCommands;
  1085.       4:FastListGFiles;
  1086.       5:GetArea;
  1087.       6:YourGFStatus(0,false);
  1088.       7:NewScanAll;
  1089.       8:NewScan;
  1090.       9:begin
  1091.           n:=GetGFileNum('download');
  1092.           if n>0 then ShowGFile(n);
  1093.         end;
  1094.       10:;
  1095.     end;
  1096.   until hungupon or (q=1);
  1097. end;
  1098.