phantom.pas

大量的汇编程序源代码

{ PHANTOM.PAS -- revised from version in UNDOCUMENTED DOS, Chapter 4. 
  In particular, note use of the INT 2Fh AX=1208h and AX=120Ch functions
  in dec_SFT() and set_Owner(). This version works properly in DOS 5. }

{$A-,B-,D+,L+,E-,F-,I-,N-,O-,R-,S-,V-}
{$M 2048,128,1000}

program phantom_drive;
uses
    dos, crt;

type
    sig_rec = record
        signature : string[7];
        psp : word;
        drive_no : byte;
    end;

const
    cds_id_size = 10;
    cds_id = 'Phantom. :\';
    our : sig_rec =
        (   signature : 'PHANTOM'; psp : 0; drive_no : 0);
    vollab : string[13] = 'AN ILLUS.ION'#0; { Our Volume label }
    maxfilesize = 32767;                     { for our 1 file }

    isr_code_max = 102;                     { offset of last byte }
                                            { in our ISR macine code }

type
    strptr = ^string;
    cdsidarr = array[1..cds_id_size] of char;
    cdsidptr = ^cdsidarr;

{ FindFirst/Next data block - ALL DOS VERSIONS }
    sdb_ptr = ^sdb_rec;
    sdb_rec = record
        drv_lett : byte;
        srch_tmpl : array[0..10] of char;
        srch_attr : byte;
        dir_entry : word;
        par_clstr : word;
        f1 : array[1..4] of byte;
    end;

{ DOS System File Table entry - ALL DOS VERSIONS }
    sft_ptr = ^sft_rec;
    sft_rec = record
        handle_cnt,
        open_mode : word;
        attr_byte : byte;
        dev_info : word;
        devdrv_ptr : pointer;
        start_clstr,        { we don't need to touch this }
        f_time,
        f_size,
        f_pos : longint;
        rel_lastclstr,      { we don't need to touch this }
        abs_lastclstr,      { we don't need to touch this }
        dir_sector : word;  { we don't need to touch this }
        dir_entryno : byte; { we don't need to touch this }
        fcb_fn : array[0..10] of char;
    end;

{ DOS Current directory structure - DOS VERSION 3.xx }
    cds3_rec = record
        curr_path : array[0..66] of char;
        flags : word;
        f1 : array[1..10] of byte;  { we don't need to touch this }
        root_ofs : word;
    end;

{ DOS Current directory structure - DOS VERSION 4.xx }
    cds4_rec = record
        curr_path : array[0..66] of char;
        flags : word;
        f1 : array[1..10] of byte;  { we don't need to touch this }
        root_ofs : word;
        f2 : array[1..7] of byte;   { we don't need to touch this }
    end;

{ DOS Directory entry for 'found' file - ALL DOS VERSIONS }
    dir_ptr = ^dir_rec;
    dir_rec = record
        fname : array[0..10] of char;
        fattr : byte;
        f1 : array[1..10] of byte;
        time_lstupd,
        date_lstupd,
        start_clstr : word;         { we don't need to touch this }
        fsiz : longint;
    end;

{ Swappable DOS Area - DOS VERSION 3.xx }
    sda3_rec = record
         f0 : array[1..12] of byte;
         curr_dta : pointer;
         f1 : array[1..30] of byte;
         dd,
         mm : byte;
         yy_1980 : word;
         f2 : array[1..96] of byte;
         fn1,
         fn2 : array[0..127] of char;
         sdb : sdb_rec;
         found_file : dir_rec;
         drive_cdscopy : cds3_rec;
         fcb_fn1 : array[0..10] of char;
         f3 : byte;
         fcb_fn2 : array[0..10] of char;
         f4 : array[1..11] of byte;
         srch_attr : byte;
         open_mode : byte;
         f5 : array[1..48] of byte;
         drive_cdsptr : pointer;
         f6 : array[1..12] of byte;
         fn1_csofs,
         fn2_csofs : word;
         f7 : array[1..56] of byte;
         ren_srcfile : sdb_rec;
         ren_file : dir_rec;
    end;

{ Swappable DOS Area - DOS VERSION 4.xx }
    sda4_ptr = ^sda4_rec;
    sda4_rec = record
         f0 : array[1..12] of byte;
         curr_dta : pointer;
         f1 : array[1..32] of byte;
         dd,
         mm : byte;
         yy_1980 : word;
         f2 : array[1..106] of byte;
         fn1,
         fn2 : array[0..127] of char;
         sdb : sdb_rec;
         found_file : dir_rec;
         drive_cdscopy : cds4_rec;
         fcb_fn1 : array[0..10] of char;
         f3 : byte;
         fcb_fn2 : array[0..10] of char;
         f4 : array[1..11] of byte;
         srch_attr : byte;
         open_mode : byte;
         f5 : array[1..51] of byte;
         drive_cdsptr : pointer;
         f6 : array[1..12] of byte;
         fn1_csofs,
         fn2_csofs : word;
         f7 : array[1..71] of byte;
         spop_act,
         spop_attr,
         spop_mode : word;
         f8 : array[1..29] of byte;
         ren_srcfile : sdb_rec;
         ren_file : dir_rec;
    end;

{ DOS List of lists structure - DOS VERSIONS 3.1 thru 4 }
    lol_rec = record
        f1 : array[1..22] of byte;
        cds : pointer;
        f2 : array[1..7] of byte;
        last_drive : byte;
    end;

{ This serves as a list of the function types that we support }
    fxn_type = (_inquiry, _rd, _md, _cd, _close, _commit, _read,
                _write, _lock, _unlock, _space, _setattr, _getattr, 
                _rename, _delete, _open, _create, _ffirst, _fnext, 
                _seek, _specopen, _unsupported);

{ A de rigeur structure for manipulators of pointers }
    os = record o,s:word; end;

    fcbfnbuf = array[0..12] of char;
    fcbfnptr = ^fcbfnbuf;

    ascbuf = array[0..127] of char;
    ascptr = ^ascbuf;

{ This defines a pointer to our primary Int 2Fh ISR structure }
    isrptr = ^isr_rec;

{ A structure to contain all register values. The TP DOS registers 
    type is insufficient }
    regset = record 
        bp,es,ds,di,si,dx,cx,bx,ax,ss,sp,cs,ip,flags:word; end;

{ Our Int 2F ISR structure }
    isr_code_buffer = array[0..isr_code_max] of byte;
    isr_rec = record
        ic:isr_code_buffer;  { Contains our macine code ISR stub code }
        save_ss,             { Stores SS on entry before stack switch }
        save_sp,             { Stores SP on entry before stack switch }
        real_fl,             { Stores flags as they were on entry }
        save_fl,             { Stores flags from the stack }
        save_cs,             { Stores return CS from the stack }
        save_ip : word;      { Stores return IP from the stack }
        our_drive : boolean; { For ISR to either chain on or return }
    end;

    strfn = string[12];

const
 { all the calls we need to support are in the range 0..33 }
    fxn_map_max = $2e;
    fxn_map : array[0..fxn_map_max] of fxn_type =
                (_inquiry, _rd, _unsupported, _md, _unsupported,
                _cd, _close, _commit, _read, _write,
                _lock, _unlock, _space, _unsupported, _setattr, 
                _getattr, _unsupported, _rename, _unsupported,
                _delete, _unsupported, _unsupported, _open, _create, 
                _unsupported, _unsupported, _unsupported, _ffirst, _fnext,
                _unsupported, _unsupported, _unsupported, _unsupported,
                _seek, _unsupported, _unsupported, _unsupported, 
                _unsupported, _unsupported, _unsupported, _unsupported, 
                _unsupported, _unsupported, _unsupported, _unsupported, 
                _unsupported, _specopen
                );

{ The following are offsets into the ISR stub code where run time 
  values must be fixed in }
    prev_hndlr  = 99;
    redir_entry = 49;
    our_sp_ofs  = 45;
    our_ss_ofs  = 40;

{ The following offsets are known at compile time and are directly 
  referenced in the ISR stub code }
    save_ss_ofs = isr_code_max+1;
    save_sp_ofs = isr_code_max+3;
    save_rf_ofs = isr_code_max+5;
    save_fl_ofs = isr_code_max+7;
    save_cs_ofs = isr_code_max+9;
    save_ip_ofs = isr_code_max+11;
    our_drv_ofs = isr_code_max+13;

{ Our ISR stub code is defined as a constant array of bytes which 
  actually contains machine code as commented on the right }
    isr_code : isr_code_buffer = { entry: }
    (       $90,                { nop OR int 3          ; for debugging }
            $9c,                { pushf                 ; save flags    }
        $80,$fc,$11,            { cmp   ah,11h          ; our fxn?      }
        $75,$5a,                { jne   not_ours        ; bypass        }
    $2e,$8f,$06, save_rf_ofs, 0,{ pop   cs:real_fl      ; store act flgs}
    $2e,$8f,$06, save_ip_ofs, 0,{ pop   cs:save_ip      ; store cs:ip   }
    $2e,$8f,$06, save_cs_ofs, 0,{ pop   cs:save_cs      ; and flags     }
    $2e,$8f,$06, save_fl_ofs, 0,{ pop   cs:save_fl      ; from stack    }

    $2e,$89,$26, save_sp_ofs, 0,{ mov   cs:save_sp,sp   ; save stack    }
        $8c,$d4,                { mov   sp,ss                           }
    $2e,$89,$26, save_ss_ofs, 0,{ mov   cs:save_ss,sp                   }

        $bc,     0,0,           { mov   sp,SSEG         ; set our stack }
        $8e,$d4,                { mov   ss,sp                           }
        $bc,     0,0,           { mov   sp,SPTR                         }

        $9c,                    { pushf                 ; call our      }
        $9a,     0,0,0,0,       { call  redir           ; intr proc.    }

    $2e,$8b,$26, save_ss_ofs, 0,{ mov   sp,cs:save_ss   ; put back      }
        $8e,$d4,                { mov   ss,sp           ; caller's stack}
    $2e,$8b,$26, save_sp_ofs, 0,{ mov   sp,cs:save_sp                   }

    $2e,$ff,$36, save_fl_ofs, 0,{ push  cs:save_fl      ; restore       }
    $2e,$ff,$36, save_cs_ofs, 0,{ push  cs:save_cs      ; restore       }
    $2e,$ff,$36, save_ip_ofs, 0,{ push  cs:save_ip      ; return addr.  }
    $2e,$ff,$36, save_rf_ofs, 0,{ push  cs:real_fl      ; save act flgs }

    $2e,$80,$3e, our_drv_ofs,0,0,{ cmp cs:our_drive,0; not our drive?}
        $74,$04,                { je    not_ours        ; no, jump      }
        $9d,                    { popf                  ; yes, restore  }
        $ca,$02,$00,            { retf  2               ; & return flags}
                            { not_ours: }
        $9d,                    { popf                  ; restore flags }
        $ea,    0,0,0,0         { jmp   far prev_hndlr  ; pass the buck }
        );

var
{ The instance of our Int 2F ISR }
    isr : isrptr;

{ variables relating to the one allowable file.. }
    file_name : fcbfnbuf;
    file_buffer : array[0..maxfilesize] of byte;
{    file_opens, }
    file_date,
    file_time : word;
    file_attr : byte;
    file_size : longint;

{ Our full directory structure }
    max_path : ascbuf;

{ Global stuff }
    our_sp : word;          { SP to switch to on entry }
    dos_major,              { Major DOS vers }
    dos_minor,              { Minor DOS vers }
    drive_no : byte;        { A: is 1, B: is 2, etc. }
    strbuf : string;        { General purpose pascal string buffer }
    a1,                     { Pointer to an ASCIIZ string }
    a2 : ascptr;            { Pointer to an ASCIIZ string }
    drive : string[3];      { Command line parameter area }
    fxn : fxn_type;         { Record of function in progress }
    r : regset;             { Global save area for all caller's regs }
    temp_name : fcbfnbuf;   { General purpose ASCIIZ filename buffer }
    iroot,                  { Index to root directory in max_path }
    icur,                   { Index to current directory in max_path }
    lmax,                   { Length of max_path }
    ifile : byte;           { Index to directory in max_path with file }
    ver : word;             { full DOS version }
    sda : pointer;          { pointer to the Swappable Dos Area }
    lol : pointer;          { pointer to the DOS list of lists struct }

const h:array[0..15] of char = '0123456789abcdef';
type str4 = string[4];
function hex(inp:word):str4;
begin
    hex[0]:=#4;
    hex[1]:=h[inp shr 12];
    hex[2]:=h[(inp shr 8) and $f];
    hex[3]:=h[(inp shr 4) and $f];
    hex[4]:=h[inp and $f];
end;

{ Fail PHANTOM, print message, exit to DOS }
procedure failprog(msg:string);
begin
    writeln(msg);
    Halt(1);
end;

{ Get DOS version, address of Swappable DOS Area, and address of 
  DOS List of lists. We only run on versions of DOS >= 3.10, so
  fail otherwise }
procedure get_dos_vars;
var r : registers;
begin
    ver:=dosversion;
    dos_major:=lo(ver);
    dos_minor:=hi(ver);
    if (dos_major<3) or ((dos_major=3) and (dos_minor<10)) then
        failprog('DOS Version must be 3.10 or greater');
    with r do
        begin
            ax:=$5d06; msdos(r); sda:=ptr(ds,si);   { Get SDA pointer }
            ax:=$5200; msdos(r); lol:=ptr(es,bx);   { Get LoL pointer }
        end;
end;

{ Fail the current redirector call with the supplied error number, i.e.
  set the carry flag in the returned flags, and set ax=error code }
procedure fail(err:word);
begin
    r.flags:=r.flags or fcarry;
    r.ax:=err;
end;


{ Convert an 11 byte fcb style filename to ASCIIZ name.ext format }
procedure fnfmfcbnm(var ss; var p:ascptr);
var i,j:byte; s:ascbuf absolute ss;
    dot : boolean;
begin
    p:=@temp_name;
    i:=0;
    while (i<8) and (s[i]<>' ') do inc(i);
    move(s,p^,i);
    j:=8;
    while (j<11) and (s[j]<>' ') do inc(j);
    move(s,p^[succ(i)],j-8);
    if j<>8 then begin p^[i]:='.'; p^[j]:=#0; end
    else p^[i]:=#0;
end;    

{ The opposite of the above, convert an ASCIIZ name.ext filename 
  into an 11 byte fcb style filename }
procedure cnvt2fcb(var ss; var pp);
var i,j:byte;
    s:ascbuf absolute ss;
    p:ascbuf absolute pp;
begin
    i:=0; j:=0;
    fillchar(p,11,' ');
    while s[i]<>#0 do
        begin
            if s[i]='.' then j:=7 else p[j]:=s[i];
            inc(i);
            inc(j);
        end;
end;    

{ Get the length of an ASCIIZ string }
function asclen(var a:ascbuf):word;
var i:word;
begin i:=0; while (i<65535) and (a[i]<>#0) do inc(i); asclen:=i; end;

{ Translate a maximum of strlim bytes of an ASCIIZ string to a Pascal string }
procedure ascii2string(src, dst : pointer; strlim : byte);
var i:integer;
begin
    byte(dst^):=strlim;
    move(src^,pointer(succ(longint(dst)))^,strlim);
    i:=pos(#0,string(dst^));
    if i<>0 then byte(dst^):=pred(i);
end;

{ Set up global a1 to point to the appropriate source for the file
  or directory name parameter for this call }
procedure set_fn1;