Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/AMOD095.ZIP/LMOD.PAS

Pascal/Delphi Source File | 1995-12-21 | 3KB | 193 lines

{$m 8000,0,0}
uses dos;
const
temp_path : string = 'c:\';

var
oldpath : string;
filename : string;

function installed : boolean;
var
p : ^word;
begin
  getintvec($fc,pointer(p));
  if p^ <> $5350 then begin
    installed := false;
    exit;
  end;
  installed := false;
  asm
    mov  ax,0
    int  $fc
    cmp  ax,$666
    jne  @@1
    mov  @result,-1
@@1:
  end;
end;

procedure load; assembler;
asm
  mov  ax,seg filename
  mov  es,ax
  mov  bx,offset filename
  mov  ax,1
  int  $fc
end;

procedure stop; assembler;
asm
  mov  ax,2
  int  $fc
end;

procedure start; assembler;
asm
  mov  ax,3
  int  $fc
end;

function toupper(s : string) : string;
var
n,i : integer;
begin
  n := length(s);
  if n < 1 then begin
    toupper := '';
    exit;
  end;
  for i := 1 to n do s[i] := upcase(s[i]);
  toupper := s;
end;

function exists(s : string) : boolean;
var
f : file of byte;
i : integer;
begin
  assign(f,s);
  {$i-}
  reset(f);
  i := ioresult;
  {$i+}
  if i = 0 then begin
    close(f);
    exists := true;
  end else exists := false;
end;

function addext(str,ext: string) : string;
begin
  if pos('.',str) > 0 then addext := str
  else addext := str+ext;
end;

function getext(s : string) : string;
var
p,l : integer;
begin
  p := pos('.',s);
  l := length(s);
  if p > 0 then begin
    getext := copy(s,p+1,l-p);
  end
  else getext := '';
end;

procedure unzip(s : string);
var
zippath : string;
begin
  zippath := fsearch('PKUNZIP.EXE',getenv('PATH'));
  exec(zippath,s+' *.mod *.s3m '+temp_path+' -o');
  chdir(temp_path);
  if doserror <> 0 then begin
    writeln('Dos error ',doserror);
    chdir(oldpath);
    halt(1);
  end;
end;

procedure delall;
var
s : searchrec;
f : file;
begin
  findfirst('*.mod',anyfile,s);
  while (doserror = 0) do begin
    assign(f,s.name);
    erase(f);
    findnext(s);
  end;
  findfirst('*.s3m',anyfile,s);
  while (doserror = 0) do begin
    assign(f,s.name);
    erase(f);
    findnext(s);
  end;
end;

procedure loadzip(s : string);
var
dir : searchrec;
begin
  if not exists(s) then begin
    writeln('File not found');
    halt(2);
  end;
  getdir(0,oldpath);
  unzip(s);
  findfirst('*.mod',archive,dir);
  if doserror = 0 then begin
    writeln('Loading ',dir.name);
    filename := dir.name;
    load;
    delall;
  end
  else begin
    findfirst('*.s3m',archive,dir);
    if doserror = 0 then begin
      writeln('Loading ',dir.name);
      filename := dir.name;
      load;
      delall;
    end;
  end;
  chdir(oldpath);
end;


var
s : string;

begin
  if paramcount < 1 then begin
    writeln('LMOD.EXE [mod.s3m] [/1] [/2]');
    writeln('/1 : Start playing');
    writeln('/2 : Stop playing');
    halt(0);
  end;
  if not installed then begin
    writeln('Adnmod not in memory!');
    exit;
  end;
  writeln('Adnmod in memory');
  s := getenv('TEMP');
  if s <> '' then temp_path := s;
  if toupper(getext(paramstr(1)))='ZIP' then begin
    loadzip(paramstr(1));
    halt(0);
  end;
  if paramcount < 1 then exit;
  filename := paramstr(1);
  if filename[1] = '/' then case filename[2] of
    '1' : start;
    '2' : stop;
  end
  else begin
    if exists(filename) then load
    else writeln('File not found');
  end;
end.