home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / sos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  9.8 KB  |  386 lines
  1. unit sos;
  2.  
  3. interface
  4.  
  5. uses dos;
  6.  
  7. const sosversion  = '0.00ß';
  8.       sosmaxfiles = 100;
  9.       def_marker  = #27+'[2JSmart Overlay System V'+sosversion+#13+#10
  10.                        +'Copyright (C) Onkel Dittmeyer 1994'+#13+#10
  11.                        +'All Rights Reserved.'+#13+#10+#26;
  12.  
  13. type soshfilerec  = record
  14.                         filename   :string[8];
  15.                         ext        :string[3];
  16.                         index, len :longint;
  17.                      end;
  18.  
  19. type sos_header   = record
  20.                         marker   :string;
  21.                         descript :string[70];
  22.                         numfiles :word;
  23.                         crc      :longint;
  24.                         nextfree :longint;
  25.                         files    :array[1..sosmaxfiles] of soshfilerec;
  26.                       end;
  27.  
  28. var sosf         :file;
  29.     x            :longint;
  30.     blankheader  :sos_header;
  31.     blankfilerec :soshfilerec;
  32.     buf          :array[1..1024] of byte;
  33.     hdr          :sos_header;
  34.     sos_busy     :boolean;
  35.     sos_fopen    :boolean;
  36.     sos_newfile  :boolean;
  37.     sos_filepos  :longint;
  38.     sos_hmodified:boolean;
  39.     {-------------------------}
  40.     masterfile   :string;            { - important stuff!!! - }
  41.     masterindex  :longint;
  42.     crec         :word;              { open record; 0 = none  }
  43.     {-------------------------}
  44.  
  45. procedure sosopen;
  46. procedure sosclose;
  47. procedure sosfopen(fn:string);
  48. procedure sosseek(seekpos:longint);
  49. procedure sosread(target:pointer;count:word);
  50. procedure soswrite(source:pointer;count:word);
  51. function  sosexist(fn:string):boolean;
  52. function  sosbfsize(fn:string):longint;
  53. procedure sosfcreate(fn:string);
  54. procedure addfile(sosfile,fn:string);
  55. procedure extract(sosfile,fn:string);
  56. procedure sosdir(sosfile:string);
  57. procedure wildadd(sosfile,mask:string);
  58. procedure sosblockread(target:pointer;count:word;var res:word);
  59.  
  60. implementation
  61.  
  62. procedure err(errcode:byte);
  63. begin
  64.   write('SOS server error #',errcode,': ');
  65.   case errcode of
  66.     1 :writeln('Server busy!');
  67.     2 :writeln('Server not open!');
  68.     3 :writeln('File already open!');
  69.     4 :writeln('File not found in SOS overlay!');
  70.     5 :writeln('Server open, File is not!');
  71.     6 :writeln('File not found in SOS overlay during bfs check!');
  72.   end;
  73.   halt(30+errcode);
  74. end;
  75.  
  76. function uc(s:string):string;
  77. var x:byte;
  78.     st:string;
  79. begin
  80.   st[0]:=s[0];
  81.   for x:=1 to length(s) do st[x]:=upcase(s[x]);
  82.   uc:=st;
  83. end;
  84.  
  85. procedure sosopen;
  86. begin
  87.   if sos_busy then err(1) else sos_busy:=true;
  88.   sos_hmodified:=false;
  89.   assign(sosf,masterfile);
  90.   {$I-} reset(sosf,1); {$I+}
  91.   if ioresult<>0 then begin
  92.     rewrite(sosf,1);
  93.     blockwrite(sosf,blankheader,sizeof(blankheader));
  94.     close(sosf);
  95.     reset(sosf,1);
  96.   end;
  97.   seek(sosf,masterindex);
  98.   {$I-} blockread(sosf,hdr,sizeof(hdr)); {$I+}
  99.   if ioresult<>0 then begin
  100.     blockwrite(sosf,blankheader,sizeof(blankheader));
  101.     hdr:=blankheader;
  102.     hdr.nextfree:=masterindex+sizeof(hdr);
  103.   end;
  104. end;
  105.  
  106. procedure sosclose;
  107. begin
  108.   if not(sos_busy) then err(2) else sos_busy:=false;
  109.   crec:=0;
  110.   sos_newfile:=false;
  111.   sos_fopen:=false;
  112.   if sos_hmodified then begin
  113.     seek(sosf,masterindex);
  114.     blockwrite(sosf,hdr,sizeof(hdr));
  115.   end;
  116.   close(sosf);
  117. end;
  118.  
  119. procedure sosfopen(fn:string);
  120. var x :word;
  121. begin
  122.   sos_filepos:=0;
  123.   if not(sos_busy) then err(2);
  124.   if sos_fopen then err(3) else sos_fopen:=true;
  125.   sos_newfile:=false;
  126.   crec:=0;
  127.   for x:=1 to hdr.numfiles do with hdr.files[x] do
  128.   if filename+'.'+ext=uc(fn) then crec:=x;
  129.   if crec=0 then err(4);
  130.   seek(sosf,masterindex+hdr.files[crec].index);
  131. end;
  132.  
  133. procedure sosseek(seekpos:longint);
  134. begin
  135.   if not(sos_busy) then err(2);
  136.   if not(sos_fopen) then err(5);
  137.   seek(sosf,masterindex+hdr.files[crec].index+seekpos);
  138.   sos_filepos:=seekpos;
  139. end;
  140.  
  141. procedure sosread(target:pointer;count:word);
  142. begin
  143.   if not(sos_busy) then err(2);
  144.   if not(sos_fopen) then err(5);
  145.   blockread(sosf,target^,count);
  146.   inc(sos_filepos,count);
  147. end;
  148.  
  149. procedure sosblockread(target:pointer;count:word;var res:word);
  150. var w :word;
  151. begin
  152.   if not(sos_busy) then err(2);
  153.   if not(sos_fopen) then err(5);
  154.   if (hdr.files[crec].len-sos_filepos)>=count then begin
  155.     blockread(sosf,target^,count);
  156.     res:=count;
  157.     inc(sos_filepos,count);
  158.   end else begin
  159.     w:=hdr.files[crec].len-sos_filepos;
  160.     blockread(sosf,target^,w);
  161.     res:=w;
  162.     inc(sos_filepos,w);
  163.   end;
  164. end;
  165.  
  166. procedure soswrite(source:pointer;count:word);
  167. begin
  168.   if not(sos_busy) then err(2);
  169.   if not(sos_fopen) then err(5);
  170.   blockwrite(sosf,source^,count);
  171.   inc(sos_filepos,count);
  172.   if sos_newfile then begin
  173.     inc(hdr.files[crec].len,count);
  174.     inc(hdr.nextfree,count);
  175.     sos_hmodified:=true;
  176.   end;
  177. end;
  178.  
  179. function sosexist(fn:string):boolean;
  180. var x :word;
  181. begin
  182.   sosopen;
  183.   for x:=1 to hdr.numfiles do with hdr.files[x] do
  184.   if filename+'.'+ext=uc(fn) then begin
  185.     sosclose;
  186.     sosexist:=true;
  187.     exit;
  188.   end;
  189.   sosexist:=false;
  190.   sosclose;
  191. end;
  192.  
  193. function sosbfsize(fn:string):longint;
  194. var x :word;
  195. begin
  196.   sosopen;
  197.   for x:=1 to hdr.numfiles do with hdr.files[x] do
  198.   if filename+'.'+ext=uc(fn) then begin
  199.     sosclose;
  200.     sosbfsize:=hdr.files[x].len;
  201.     exit;
  202.   end;
  203.   err(6);
  204.   sosclose;
  205. end;
  206.  
  207. procedure sosfcreate(fn:string);
  208. begin
  209.   if not(sos_busy) then err(2);
  210.   with hdr do begin
  211.     inc(numfiles);
  212.     files[numfiles].filename:=copy(fn,1,pos('.',fn)-1);
  213.     files[numfiles].ext:=copy(fn,pos('.',fn)+1,length(fn)-pos('.',fn));
  214.     files[numfiles].index:=nextfree;
  215.   end;
  216.   seek(sosf,hdr.nextfree+masterindex);
  217.   sos_newfile:=true;
  218.   sos_fopen:=true;
  219.   crec:=hdr.numfiles;
  220.   sos_filepos:=0;
  221.   sos_hmodified:=true;
  222. end;
  223.  
  224. procedure addfile(sosfile,fn:string);
  225. var inf    :file;
  226.     br, bw :word;
  227. begin
  228.   fn:=uc(fn);
  229.   write('adding ',fn,' to ',sosfile);
  230.   assign(sosf,sosfile);
  231.   {$I-} reset(sosf,1); {$I+}
  232.   if ioresult<>0 then begin
  233.     write(' [new file]');
  234.     rewrite(sosf,1);
  235.     blockwrite(sosf,blankheader,sizeof(blankheader));
  236.     close(sosf);
  237.     reset(sosf,1);
  238.   end;
  239.   seek(sosf,masterindex);
  240.   {$I-} blockread(sosf,hdr,sizeof(hdr)); {$I+}
  241.   if ioresult<>0 then begin
  242.     blockwrite(sosf,blankheader,sizeof(blankheader));
  243.     hdr:=blankheader;
  244.     hdr.nextfree:=masterindex+sizeof(hdr);
  245.   end;
  246.   with hdr do begin
  247.     inc(numfiles);
  248.     files[numfiles].filename:=copy(fn,1,pos('.',fn)-1);
  249.     files[numfiles].ext:=copy(fn,pos('.',fn)+1,length(fn)-pos('.',fn));
  250.     files[numfiles].index:=nextfree;
  251.   end;
  252.   seek(sosf,hdr.nextfree+masterindex);
  253.   assign(inf,fn);
  254.   reset(inf,1);
  255.   hdr.files[hdr.numfiles].len:=filesize(inf);
  256.   repeat
  257.     blockread(inf,buf,sizeof(buf),br);
  258.     blockwrite(sosf,buf,br,bw);
  259.   until (br=0) or (br<>bw);
  260.   close(inf);
  261.   inc(hdr.nextfree,hdr.files[hdr.numfiles].len);
  262.   seek(sosf,masterindex);
  263.   blockwrite(sosf,hdr,sizeof(hdr));
  264.   close(sosf);
  265.   writeln(' -OK');
  266. end;
  267.  
  268. procedure extract(sosfile,fn:string);
  269. var filename     :string[8];
  270.     ext          :string[3];
  271.     x            :word;
  272.     found        :boolean;
  273.     btogo        :longint;
  274.     outf         :file;
  275.     br           :word;
  276.  
  277. begin
  278.   fn:=uc(fn);
  279.   found:=false;
  280.   writeln('extracting ',fn,' from ',sosfile,'...');
  281.   assign(sosf,sosfile);
  282.   reset(sosf,1);
  283.   seek(sosf,masterindex);
  284.   blockread(sosf,hdr,sizeof(hdr));
  285.   filename:=copy(fn,1,pos('.',fn)-1);
  286.   ext:=copy(fn,pos('.',fn)+1,length(fn)-pos('.',fn));
  287.   for x:=1 to hdr.numfiles do
  288.     if (filename=hdr.files[x].filename) and (ext=hdr.files[x].ext) then begin
  289.     found:=true;
  290.     writeln('found at #',x,': writing into file...');
  291.     seek(sosf,hdr.files[x].index+masterindex);
  292.     btogo:=hdr.files[x].len;
  293.     assign(outf,fn);
  294.     rewrite(outf,1);
  295.     repeat
  296.       if btogo>sizeof(buf) then blockread(sosf,buf,sizeof(buf),br)
  297.         else blockread(sosf,buf,btogo,br);
  298.       blockwrite(outf,buf,br);
  299.       dec(btogo,br);
  300.     until btogo=0;
  301.     close(outf);
  302.   end;
  303.   close(sosf);
  304.   if not(found) then writeln('nothing found matching ',fn);
  305. end;
  306.  
  307. procedure sosdir(sosfile:string);
  308. var x,y,fshown :word;
  309. begin
  310.   fshown:=6;
  311.   assign(sosf,sosfile);
  312.   reset(sosf,1);
  313.   seek(sosf,masterindex);
  314.   blockread(sosf,hdr,sizeof(hdr));
  315.   close(sosf);
  316.   writeln;
  317.   writeln('   Title: ',hdr.descript);
  318.   writeln('NextFree: ',hdr.nextfree);
  319.   writeln('Assuming an ',sosmaxfiles,' record index table.');
  320.   writeln;
  321.   write('Index table        ');
  322.   writeln(masterindex:10,'   ',sizeof(hdr):10);
  323.   for x:=1 to hdr.numfiles do begin
  324.     with hdr.files[x] do begin
  325.       inc(fshown);
  326.       write(filename);  for y:=1 to 10-length(filename) do write(' ');
  327.       write(ext);       for y:=1 to 6 do write(' ');
  328.       writeln(index:10,'   ',len:10);
  329.       if fshown=24 then begin
  330.         write('[ENTER to continue]');
  331.         readln;
  332.         fshown:=0;
  333.       end;
  334.     end;
  335.   end;
  336.   writeln;
  337.   writeln(hdr.numfiles,' file(s) in SOSfile.');
  338. end;
  339.  
  340. procedure init;
  341. begin
  342.   with blankfilerec do begin
  343.     filename:='';
  344.     ext:='';
  345.     index:=0;
  346.     len:=0;
  347.   end;
  348.   with blankheader do begin
  349.     marker:=def_marker;
  350.     descript:='BlueBEEP All-In-1 Smart Overlay System [SOS] - Data File';
  351.     numfiles:=0;
  352.     crc:=0;
  353.     nextfree:=sizeof(blankheader);
  354.     for x:=1 to sosmaxfiles do files[x]:=blankfilerec;
  355.   end;
  356.   sos_busy:=false;
  357.   sos_fopen:=false;
  358.   sos_newfile:=false;
  359.   crec:=0;
  360. end;
  361.  
  362. procedure wildadd(sosfile,mask:string);
  363. var sr :searchrec;
  364.     fc :longint;
  365. begin
  366.   fc:=0;
  367.   findfirst(mask,anyfile,sr);
  368.   while doserror=0 do begin
  369.     if (sr.attr<>directory) then if (sr.name<>uc(sosfile)) then begin
  370.       inc(fc);
  371.       addfile(sosfile,sr.name);
  372.     end;
  373.     findnext(sr);
  374.   end;
  375.   writeln;
  376.   writeln(fc,' file(s) added.');
  377. end;
  378.  
  379. begin
  380.   init;
  381.   if paramstr(1)='/(C)' then begin
  382.     write(def_marker);
  383.     readln;
  384.   end;
  385. end.
  386.