home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / AMOD095.ZIP / LMOD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-21  |  3.3 KB  |  193 lines
  1. {$m 8000,0,0}
  2. uses dos;
  3. const
  4. temp_path : string = 'c:\';
  5.  
  6. var
  7. oldpath : string;
  8. filename : string;
  9.  
  10. function installed : boolean;
  11. var
  12. p : ^word;
  13. begin
  14.   getintvec($fc,pointer(p));
  15.   if p^ <> $5350 then begin
  16.     installed := false;
  17.     exit;
  18.   end;
  19.   installed := false;
  20.   asm
  21.     mov  ax,0
  22.     int  $fc
  23.     cmp  ax,$666
  24.     jne  @@1
  25.     mov  @result,-1
  26. @@1:
  27.   end;
  28. end;
  29.  
  30. procedure load; assembler;
  31. asm
  32.   mov  ax,seg filename
  33.   mov  es,ax
  34.   mov  bx,offset filename
  35.   mov  ax,1
  36.   int  $fc
  37. end;
  38.  
  39. procedure stop; assembler;
  40. asm
  41.   mov  ax,2
  42.   int  $fc
  43. end;
  44.  
  45. procedure start; assembler;
  46. asm
  47.   mov  ax,3
  48.   int  $fc
  49. end;
  50.  
  51. function toupper(s : string) : string;
  52. var
  53. n,i : integer;
  54. begin
  55.   n := length(s);
  56.   if n < 1 then begin
  57.     toupper := '';
  58.     exit;
  59.   end;
  60.   for i := 1 to n do s[i] := upcase(s[i]);
  61.   toupper := s;
  62. end;
  63.  
  64. function exists(s : string) : boolean;
  65. var
  66. f : file of byte;
  67. i : integer;
  68. begin
  69.   assign(f,s);
  70.   {$i-}
  71.   reset(f);
  72.   i := ioresult;
  73.   {$i+}
  74.   if i = 0 then begin
  75.     close(f);
  76.     exists := true;
  77.   end else exists := false;
  78. end;
  79.  
  80. function addext(str,ext: string) : string;
  81. begin
  82.   if pos('.',str) > 0 then addext := str
  83.   else addext := str+ext;
  84. end;
  85.  
  86. function getext(s : string) : string;
  87. var
  88. p,l : integer;
  89. begin
  90.   p := pos('.',s);
  91.   l := length(s);
  92.   if p > 0 then begin
  93.     getext := copy(s,p+1,l-p);
  94.   end
  95.   else getext := '';
  96. end;
  97.  
  98. procedure unzip(s : string);
  99. var
  100. zippath : string;
  101. begin
  102.   zippath := fsearch('PKUNZIP.EXE',getenv('PATH'));
  103.   exec(zippath,s+' *.mod *.s3m '+temp_path+' -o');
  104.   chdir(temp_path);
  105.   if doserror <> 0 then begin
  106.     writeln('Dos error ',doserror);
  107.     chdir(oldpath);
  108.     halt(1);
  109.   end;
  110. end;
  111.  
  112. procedure delall;
  113. var
  114. s : searchrec;
  115. f : file;
  116. begin
  117.   findfirst('*.mod',anyfile,s);
  118.   while (doserror = 0) do begin
  119.     assign(f,s.name);
  120.     erase(f);
  121.     findnext(s);
  122.   end;
  123.   findfirst('*.s3m',anyfile,s);
  124.   while (doserror = 0) do begin
  125.     assign(f,s.name);
  126.     erase(f);
  127.     findnext(s);
  128.   end;
  129. end;
  130.  
  131. procedure loadzip(s : string);
  132. var
  133. dir : searchrec;
  134. begin
  135.   if not exists(s) then begin
  136.     writeln('File not found');
  137.     halt(2);
  138.   end;
  139.   getdir(0,oldpath);
  140.   unzip(s);
  141.   findfirst('*.mod',archive,dir);
  142.   if doserror = 0 then begin
  143.     writeln('Loading ',dir.name);
  144.     filename := dir.name;
  145.     load;
  146.     delall;
  147.   end
  148.   else begin
  149.     findfirst('*.s3m',archive,dir);
  150.     if doserror = 0 then begin
  151.       writeln('Loading ',dir.name);
  152.       filename := dir.name;
  153.       load;
  154.       delall;
  155.     end;
  156.   end;
  157.   chdir(oldpath);
  158. end;
  159.  
  160.  
  161. var
  162. s : string;
  163.  
  164. begin
  165.   if paramcount < 1 then begin
  166.     writeln('LMOD.EXE [mod.s3m] [/1] [/2]');
  167.     writeln('/1 : Start playing');
  168.     writeln('/2 : Stop playing');
  169.     halt(0);
  170.   end;
  171.   if not installed then begin
  172.     writeln('Adnmod not in memory!');
  173.     exit;
  174.   end;
  175.   writeln('Adnmod in memory');
  176.   s := getenv('TEMP');
  177.   if s <> '' then temp_path := s;
  178.   if toupper(getext(paramstr(1)))='ZIP' then begin
  179.     loadzip(paramstr(1));
  180.     halt(0);
  181.   end;
  182.   if paramcount < 1 then exit;
  183.   filename := paramstr(1);
  184.   if filename[1] = '/' then case filename[2] of
  185.     '1' : start;
  186.     '2' : stop;
  187.   end
  188.   else begin
  189.     if exists(filename) then load
  190.     else writeln('File not found');
  191.   end;
  192. end.
  193.