{$PAGESIZE:64,$TITLE:'DOSFUN -- DOS FUNCTION HOOKS'}

{Listing is turned off for including FILKQQ.INC}
{$LIST-}
{$INCLUDE:'FILKQQ.INC'}
{$LIST+}
{$INCLUDE:'DOSFUN.INC'}

IMPLEMENTATION OF DOSFUN;

USES FILKQQ;

FUNCTION DOSXQQ(COMMAND:BYTE;PARM:WORD):BYTE;EXTERN;
{PASCAL page 11-23}

CONST {Definitions:}
  SPACE = ' ';

TYPE
  TOKENS = (NONE,NAME,DOT,COLON,SPACES);
  LSTRPTR = ^LSTRING;

{The following function is used as part of a text
  scanner to retrieve valid file names}

FUNCTION TOKEN(VAR INSTR,TKSTR:LSTRING):TOKENS;

{Get next token from INSTR. Function returns
  token type. NOTE: TKSTR must be big enough 
  to hold result i.e. as big as INSTR. 
  INSTR will have the token removed}


CONST 
  LETTER = ['A'..'Z','a'..'z','0'..'9','*'];

VAR
  C:CHAR;

  BEGIN
    TKSTR.LEN := 0;          {Initialize}
    IF (INSTR.LEN = 0) THEN [TOKEN := NONE; RETURN];
    C := INSTR[1];           {Get first char}
    CASE C OF                {Single char test}
      '.': [TOKEN := DOT; DELETE(INSTR,1,1)];
      ':': [TOKEN := COLON; DELETE(INSTR,1,1)];
      SPACE:
        BEGIN
          TOKEN := SPACES;
          WHILE (C = SPACE) DO
            BEGIN
              DELETE(INSTR,1,1); 
              IF (INSTR.LEN > 0) THEN C := INSTR[1]
                ELSE C := CHR(#D); {Mark end if done}
            END;
         END
       OTHERWISE             {Have char string}
         BEGIN
           {WHILE loop packs name into result string}
           WHILE (C IN LETTER) DO
             BEGIN
               CONCAT(TKSTR,C);
               DELETE(INSTR,1,1);
               IF (INSTR.LEN = 0) THEN C := CHR(#D) {end}
                 ELSE C := INSTR[1];
              END;
          END;
          IF(TKSTR.LEN = 0) THEN TOKEN := NONE
            ELSE TOKEN := NAME;
        END; {case}
  END;

PROCEDURE INSERTLB(CONST S1:LSTRING; VAR S2:LSTRING);
  {Like INSERT(S1,S2,1) except won't bomb if 
    S2.LEN = 0}

  BEGIN 
    IF (S2.LEN = 0) THEN COPYLST(S1,S2)
      ELSE INSERT(S1,S2,1);
  END;


PROCEDURE SETNAME(CONST S:LSTRING; VAR F:DOSFCB);

{Set DOS file name from S to FCB F}

  VAR
    I:BYTE;  {Loop counter}
    FCH:CHAR;  {Fill character}

  BEGIN
    FCH := SPACE;
    FOR I := 1 TO 8 DO
      BEGIN
        IF (I <= S.LEN) THEN
          BEGIN
            IF (S[I]<>'*') THEN  F.FN[I] := S[I]
              ELSE
                BEGIN
                  FCH := '?';
                  F.FN[I] := FCH;
                END;
          END 
         ELSE F.FN[I] := FCH
      END;
  END;

PROCEDURE SETFT(CONST S:LSTRING; VAR F:DOSFCB);

{Set file suffix in S to FCB F}

  VAR I:BYTE;
      FCH:CHAR;

  BEGIN
    FCH:=SPACE;
    FOR I := 1 TO 3 DO
      BEGIN
        IF (I <= S.LEN) THEN
          BEGIN
            IF (S[I]<>'*') THEN  F.FT[I] := S[I]
              ELSE
                BEGIN
                  FCH := '?';
                  F.FT[I] := FCH;
                END;
          END 
         ELSE F.FT[I] := FCH
      END;
  END;



PROCEDURE PFNAME;


  VAR
    CUR:TOKENS;              {Current token}
    TS:LSTRPTR;              {Tempory string}

  PROCEDURE PROCDOT; {Process dot }

     BEGIN
       CUR := TOKEN(S,TS^);
       IF (CUR = NAME) THEN SETFT(TS^,F) {got suffix}
         ELSE INSERTLB(TS^,S);  {Restore unused data}
     END;

  BEGIN
    NEW(TS,S.LEN);            {tempory string}
    CUR := TOKEN(S,TS^);     {Get first token}
                             {IF spaces then get next token}
    IF (CUR = SPACES) THEN CUR := TOKEN(S,TS^);
    IF (CUR = NAME) THEN
      BEGIN                  {Test for drive}
        IF (S.LEN > 0) THEN
          BEGIN
            IF (S[1] = ':') THEN
              BEGIN
                F.DR := WRD(TS^[1])-WRD('A')+1; {+ Valid test}
                DELETE(S,1,1);
                CUR := TOKEN(S,TS^);
              END;
          END;
      END;
    IF (CUR = NAME) THEN  {Save name}
      BEGIN
        SETNAME(TS^,F);
        CUR := TOKEN(S,TS^); {Get next element}
      END;
     { Process suffix or restore unused data}
    IF (CUR = DOT) THEN PROCDOT ELSE INSERTLB(TS^,S); 
    DISPOSE(TS);
  END;

PROCEDURE FILL_NAME(CONST C:CHAR; VAR F:DOSFCB);
  {Procedure blanks name in FCB for defaults.
   used by RENAME and DEL}

  VAR I:BYTE;    {Loop counter}

  BEGIN
    F.DR := 0;
    FOR I := 1 TO 8 DO F.FN[I] := C;
    FOR I := 1 TO 3 DO F.FT[I] := C;
  END;

FUNCTION RENAME;

  VAR 
    F1,F2:DOSFCB;    {DOSFCBs for PFNAME & DOS CALL}
    TS:LSTRPTR;      {Tempory string}
    I:BYTE;          {Loop counter}

  BEGIN
    {Setup first file name}
      FILL_NAME(' ',F1);
      NEW(TS,SFROM.LEN);
      COPYLST(SFROM,TS^);   {Put input where we can play w/ it}
      PFNAME(TS^,F1);
      DISPOSE(TS);
    {Setup second file name}
      FILL_NAME('?',F2);
      NEW(TS,STO.LEN);
      COPYLST(STO,TS^);
      PFNAME(TS^,F2);
      DISPOSE(TS);
      {Move 2nd file name to first FCB for dos call}
      FOR I := 1 TO 8 DO F1.RFN[I] := F2.FN[I];
      FOR I := 1 TO 3 DO F1.RFT[I] := F2.FT[I];
    {Now let dos change the name}
    I := DOSXQQ(#17,WRD(ADR F1));
    IF(I = 0 ) THEN RENAME := TRUE ELSE RENAME := FALSE;  
  END;

FUNCTION DEL;

  VAR
    TS:LSTRPTR;    {Tempories}
    F:DOSFCB;
    I:BYTE;

  BEGIN
    FILL_NAME(' ',F);
    NEW(TS,S.LEN); {Get name so we can use it}
    COPYLST(S,TS^);
    PFNAME(TS^,F);  {Put name into FCB}
    DISPOSE(TS);
    I := DOSXQQ(#13,WRD(ADR F)); {use dos to delete file}
    IF(I = 0) THEN DEL := TRUE ELSE DEL := FALSE;
  END;

FUNCTION SDIRS;

  VAR
    TS:LSTRPTR;    {tempories}
    I:BYTE;

  BEGIN
    FILL_NAME('?',F.DOSF);
    NEW(TS,S.LEN);
    COPYLST(S,TS^);
    PFNAME(TS^,F.DOSF);
    DISPOSE(TS);
    I := DOSXQQ(#1A,WRD(ADR F.SBUF)); {Mark data return point}
    I := DOSXQQ(#11,WRD(ADR F.DOSF)); {Get dir from DOS}
    IF(I = 0) THEN SDIRS := TRUE ELSE SDIRS := FALSE;
  END;

FUNCTION CDIRS;

  VAR
    I:BYTE;

  BEGIN
    I := DOSXQQ(#1A,WRD(ADR F.SBUF));
    I := DOSXQQ(#12,WRD(ADR F.DOSF));
    IF(I = 0) THEN CDIRS := TRUE ELSE CDIRS := FALSE;
  END;



END. {of implementation of DOSFUN}