GETDIR.I

[Table of Contents]

The GETDIR.I include file resides on the Kyan Pascal 2.x Utilities Disk 1.

• function get_dir(var dirname:pathstring; header:elemptr):integer;

Source Code

function get_dir(var dirname:pathstring; header:elemptr):integer;
    var
        fullname:pathstring;
        wildcard:array[1..4] of char;
        displace:integer;
        i,icb,j:integer;
        temp    :elemptr;
        function open_dir(var name:pathstring):integer;
           begin
              open_dir:=0;
#a
              stx _t
              ldx #$10
gdopn1        lda $340,x
              cmp #$ff
              beq gdopn2
              txa
              clc
              adc #$10
              tax
              cpx #$80
              bne gdopn1
              lda #$81
              jmp gdleave
gdopn2        stx _t+1
              lda #$03
              sta $342,x
              lda #6
              sta $34a,x
              lda #0
              sta $34b,x
              ldy #7
              lda (_sp),y
              sta $344,x
              iny
              lda (_sp),y
              sta $345,x
              jsr $e456
              bmi gdleave
              ldy _t+1
gdleave       tya
              ldy #5
              sta (_sp),y
              ldx _t
#
    end;
    function get_dir_rec(io:integer; buffer:elemptr):integer;
        begin
            get_dir_rec:=0;
#a
            stx _t+5
            ldy #9
            lda (_sp),y
            tax
            lda #$07
            sta $342,x
            dey
            lda (_sp),y
            sta $345,x
            dey
            lda (_sp),y
            sta $344,x
            lda #>18
            sta $348,x
            lda #<18
            sta $349,x
            jsr $e456
            bmi gdrleave
            ldy #7
            lda (_sp),y
            sta _t
            iny
            lda (_sp),y
            sta _t+1
            lda #32
            ldy #18
            sta (_t),y ;strip off cr
            ldy #1
            lda $348,x
            cmp #17
            bne gdrleave
            ldy #17
            lda #32
            sta (_t),y
            ldy #3
gdrleave    tya
            ldy #5
            sta (_sp),y
            ldx _t+5
#
    end;
    function close_dir(icb:integer):integer;
        begin
            close_dir:=0;
#a
        stx  _t
        ldy  #7
        lda  (_sp),y
        tax
        lda  #$c
        sta  $342,X
        jsr  $e456
        tya
        ldy  #5
        sta  (_sp),y
        ldx  _t
#
    end;
    begin
        wildcard:='*.* ';
        j:=1;
        add_device(dirname,fullname);
        displace:=0;
        if fullname[3]=' ' then
            displace:=2
        else
            if fullname[4]=' ' then
                displace:=3;
        if displace<>0 then
            for i:=1 to 4 do
                fullname[i+displace]:=wildcard[i];
        icb:=open_dir(fullname);
        if icb>112 then
            get_dir:=icb
        else begin
            while j=1 do begin
                new(temp);
                temp^.next:=nil;
                j:=get_dir_rec(icb,temp);
                if (j=1) or (j=136) then 
                    header^.next:=temp;
                header:=temp;
            end;(*while*)
            if j=136 then
               get_dir:=1
            else
               get_dir:=j;
            j:=close_dir(icb);
        end;(*else*)
end;(*get_dir*)