⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tdos.pas

📁 Turbo Pascal 6.0编译器源码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit TDos;

{$O+,F+,S-}

interface

const

  ReadOnly  = $01;
  Hidden    = $02;
  SysFile   = $04;
  VolumeID  = $08;
  Directory = $10;
  Archive   = $20;
  AnyFile   = $3F;

type

  PathStr = string[79];
  DirStr  = string[67];
  NameStr = string[8];
  ExtStr  = string[4];

  SearchRec = record
    Fill: array[1..21] of Byte;
    Attr: Byte;
    Time: Longint;
    Size: Longint;
    Name: string[12];
  end;

  DateTime = record
    Year,Month,Day,Hour,Min,Sec: Word;
  end;

function  FOpen(Path: PathStr; Mode: Word): Integer;
procedure FClose(Handle: Integer);
function  FRead(Handle: Integer; var Buf; Count: Integer): Integer;
function  FWrite(Handle: Integer; var Buf; Count: Integer): Integer;
function  FSeek(Handle: Integer; Pos: Longint; Mode: Word): Longint;
function  GetFTime(Handle: Integer): Longint;
procedure SetFTime(Handle: Integer; Time: Longint);
function  FDelete(Path: PathStr): Integer;
function  GetFileTime(Path: PathStr): Longint;
function  FileExists(Path: PathStr): Boolean;
function  GetFileAttr(Path: PathStr): Integer;
function  FindFirst(Path: PathStr; Attr: Word; var F: SearchRec): Integer;
function  FindNext(var F: SearchRec): Integer;
function  FSearch(Path: PathStr; DirList: string): PathStr;
procedure FExpand(Path: PathStr; var Result: PathStr);
procedure FSplit(Path: PathStr; var Dir: DirStr; var Name: NameStr;
  var Ext: ExtStr);
function  FRename(Path, NewName: PathStr): Integer;
function  GetCurDir(Drive: Char): DirStr;
function  ChDir(Path: PathStr): Integer;
function  GetCurDrive: Char;
procedure SetCurDrive(Drive: Char);
function  DriveValid(Drive: Char): Boolean;
procedure UnpackTime(P: Longint; var T: DateTime);
function  GetDateTime: Longint;
function  GetEnv(EnvVar: string): string;

implementation

procedure Pas2C; near; assembler;
asm
        MOV     DX,DI
        PUSH    SS
        POP     ES
        CLD
        LODSB
        XOR     AH,AH
        XCHG    AX,CX
        REP     MOVSB
        XCHG    AX,CX
        STOSB
        PUSH    ES
        POP     DS
end;

procedure C2Pas; assembler;
asm
        PUSH    DS
        PUSH    ES
        POP     DS
        XOR     AL,AL
        MOV     CX,256
        CLD
        REPNZ   SCASB
        NOT     CL
        MOV     AL,CL
        DEC     DI
        MOV     SI,DI
        DEC     SI
        STD
        REP     MOVSB
        STOSB
        POP     DS
end;

function FOpen(Path: PathStr; Mode: Word): Integer; assembler;
var
  PathC: array[0..79] of Char;
asm
        PUSH    DS
        LDS     SI,Path
        LEA     DI,PathC
        CALL    Pas2C
        MOV     AX,Mode
        CMP     AL,3
        ADC     AH,3CH
        XOR     CX,CX
        INT     21H
        JNC     @@1
        NEG     AX
@@1:    POP     DS
end;

procedure FClose(Handle: Integer); assembler;
asm
        MOV     AH,3EH
        MOV     BX,Handle
        INT     21H
end;

function FRead(Handle: Integer; var Buf; Count: Integer): Integer; assembler;
asm
        PUSH    DS
        MOV     AH,3FH
        MOV     BX,Handle
        MOV     CX,Count
        LDS     DX,Buf
        INT     21H
        JNC     @@1
        MOV     AX,-1
@@1:    POP     DS
end;

function FWrite(Handle: Integer; var Buf; Count: Integer): Integer; assembler;
asm
        PUSH    DS
        MOV     AH,40H
        MOV     BX,Handle
        MOV     CX,Count
        LDS     DX,Buf
        INT     21H
        JNC     @@1
        MOV     AX,-1
@@1:    POP     DS
end;

function FSeek(Handle: Integer; Pos: Longint; Mode: Word): Longint; assembler;
asm
        MOV     AH,42H
        MOV     AL,Mode.Byte
        MOV     BX,Handle
        MOV     DX,Pos.Word[0]
        MOV     CX,Pos.Word[2]
        INT     21H
        JNC     @@1
        MOV     AX,-1
        CWD
@@1:
end;

function GetFTime(Handle: Integer): Longint; assembler;
asm
        MOV     AX,5700H
        MOV     BX,Handle
        INT     21H
        XCHG    AX,CX
end;

procedure SetFTime(Handle: Integer; Time: Longint); assembler;
asm
        MOV     AX,5701H
        MOV     BX,Handle
        MOV     CX,Time.Word[0]
        MOV     DX,Time.Word[2]
        INT     21H
end;

function FDelete(Path: PathStr): Integer; assembler;
var
  PathC: array[0..79] of Char;
asm
        PUSH    DS
        LDS     SI,Path
        LEA     DI,PathC
        CALL    Pas2C
        MOV     AH,41H
        INT     21H
        JC      @@1
        XOR     AX,AX
@@1:    NEG     AX
        POP     DS
end;

function GetFileTime(Path: PathStr): Longint; assembler;
var
  PathC: array[0..79] of Char;
  DTA: array[0..47] of Byte;
asm
        PUSH    DS
        MOV     AH,1AH
        LEA     DX,DTA
        PUSH    SS
        POP     DS
        INT     21H
        LDS     SI,Path
        LEA     DI,PathC
        CALL    Pas2C
        MOV     AH,4EH
        XOR     CX,CX
        INT     21H
        MOV     AX,DTA.SearchRec.Time.Word[0]
        MOV     DX,DTA.SearchRec.Time.Word[2]
        JNC     @@1
        MOV     AX,-1
        CWD
@@1:    POP     DS
end;

function FileExists(Path: PathStr): Boolean; assembler;
asm
        LES     DI,Path
        PUSH    ES
        PUSH    DI
        CALL    GetFileTime
        AND     AX,DX
        INC     AX
        JZ      @@1
        MOV     AL,1
@@1:
end;

procedure DTAName; near; assembler;
asm
        INT     21H
        JC      @@1
        ADD     DI,SearchRec.Name
        CALL    C2Pas
        XOR     AX,AX
@@1:    NEG     AX
end;

function FindFirst(Path: PathStr; Attr: Word; var F: SearchRec): Integer;
  assembler;
var
  PathC: array[0..79] of Char;
asm
        PUSH    DS
        MOV     AH,1AH
        LDS     DX,F
        INT     21H
        LDS     SI,Path
        LEA     DI,PathC
        CALL    Pas2C
        MOV     AH,4EH
        MOV     CX,Attr
        LES     DI,F
        CALL    DTAName
        POP     DS
end;

function FindNext(var F: SearchRec): Integer; assembler;
asm
        PUSH    DS
        MOV     AH,1AH
        LDS     DX,F
        INT     21H
        MOV     AH,4FH
        LES     DI,F
        CALL    DTAName
        POP     DS
end;

function FSearch(Path: PathStr; DirList: string): PathStr; assembler;
asm
        PUSH    DS
        LDS     SI,DirList
        CLD
        LODSB
        MOV     BL,AL
        XOR     BH,BH
        ADD     BX,SI
        LES     DI,@Result
        INC     DI
@@1:    PUSH    SI
        PUSH    DS
        LDS     SI,Path
        LODSB
        MOV     CL,AL
        XOR     CH,CH
        REP     MOVSB
        XOR     AL,AL
        STOSB
        DEC     DI
        MOV     AX,4300H
        LDS     DX,@Result
        INC     DX
        INT     21H
        POP     DS
        POP     SI
        JC      @@2
        TEST    CX,VolumeID+Directory
        JZ      @@5
@@2:    LES     DI,@Result
        INC     DI
        CMP     SI,BX
        JE      @@5
        XOR     AX,AX
@@3:    LODSB
        CMP     AL,';'
        JE      @@4
        STOSB
        MOV     AH,AL
        CMP     SI,BX
        JNE     @@3
@@4:    CMP     AH,':'
        JE      @@1
        CMP     AH,'\'
        JE      @@1
        MOV     AL,'\'
        STOSB
        JMP     @@1
@@5:    MOV     AX,DI
        LES     DI,@Result
        SUB     AX,DI
        DEC     AX
        STOSB
        POP     DS
end;

function GetFileAttr(Path: PathStr): Integer; assembler;
var
  PathC: array[0..79] of Char;
  DTA: array[0..47] of Byte;
asm
        PUSH    DS
        MOV     AH,1AH
        LEA     DX,DTA
        PUSH    SS
        POP     DS
        INT     21H
        LDS     SI,Path
        LEA     DI,PathC
        CALL    Pas2C
        MOV     AH,4EH
        MOV     CX,Directory
        INT     21H
        MOV     AL,DTA.SearchRec.Attr
        MOV     AH,0
        JNC     @@1
        MOV     AX,-1
        CWD
@@1:    POP     DS
end;

procedure FExpand(Path:PathStr;var Result:PathStr);assembler;
var
  PathC, ResultC: array[0..79] of Char;
asm
        PUSH    DS
        LDS     SI,Path
        CLD
        LODSB
        XOR     AH,AH
        XCHG    AX,CX
        ADD     CX,SI
        LEA     DI,ResultC
        PUSH    SS
        POP     ES
        LODSW
        CMP     SI,CX
        JA      @@1

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -