'本程序功能是文件改名,文件列表,目录列表,磁盘列表等等,在WIN98 的MSDOS,QB4.5版本下通过

'定义文件信息缓冲区为本模块公用
COMMON SHARED FileDta$
'定义文件相关信息
TYPE FileRecord
     Attrib AS INTEGER
     hour AS INTEGER
     min AS INTEGER
     sec AS INTEGER
     Day AS INTEGER
     Year AS INTEGER
     Month AS INTEGER
     size AS LONG
     DosName AS STRING * 12
END TYPE
CLS
'下面是用DIR命令列出当前目录下的所有文本文件,然后用本程序的演示这个功能
'调用DOS命令
SHELL "dir *.txt"
'调用本程序中的函数
FileName$ = "*.txt"
DIM File AS FileRecord
IF FindFirstFile%(FileName$, FileAttrib%) = 1 THEN END
DO
  FileInfo File
  PRINT File.DosName, File.size, File.Year; File.Month; File.Day; File.hour; File.min
LOOP WHILE FindNextFile% = 0
'显示系统中的所有驱动器
GetDiskList DiskList$, DiskNum%
SFind% = 1
FOR i = 1 TO DiskNum%
   Find = INSTR(SFind%, DiskList$, CHR$(0))
   DiskName$ = MID$(DiskList$, SFind%, Find - SFind%)
   PRINT i, DiskName$ + ":"
   SFind% = Find + 1
NEXT i
ankey$ = INPUT$(1)
'显示当前路径
PRINT CurrentPath$
'显示当前路径中所有目录
GetDirList DirList$, DirNum%
SFind% = 1
FOR i = 1 TO DirNum%
   Find = INSTR(SFind%, DirList$, CHR$(0))
   DirName$ = MID$(DirList$, SFind%, Find - SFind%)
   PRINT i, DirName$
   SFind% = Find + 1
NEXT i
ankey$ = INPUT$(1)
'显示当前目录中的所有文件
GetFileList "*.*", &HFF, FileList$, FileNum%
SFind% = 1
FOR i = 1 TO FileNum%
   Find = INSTR(SFind%, FileList$, CHR$(0))
   F1$ = MID$(FileList$, SFind%, Find - SFind%)
   PRINT i, F1$
   SFind% = Find + 1
NEXT i

'Changes current drive.
FUNCTION ChangeDrive% (Drive$)
  '本函数的功能:切换盘付,Drive$为要转换的盘符
  '本函数使用方法举例: 如果要转换到E盘
  '程序:IF ChangeDrive% ("E:")=0 THEN  PRINT "成功转换到了E盘" ELSE PRINT "没有转换到E盘"
  '改变盘符的中断资料:入口AH=0E DL=要转换的盘付(0A,1B..(
  DIM Reg%(9)
  Drive$ = UCASE$(Drive$)
  Reg%(0) = &HE00
  Reg%(3) = ASC(Drive$) - 65
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  ChangeDrive% = Reg%(7) AND 1
END FUNCTION

FUNCTION ChangePath% (Path$)
  '本函数的功能:切换目录,Path$为要切换的目录
  '本函数使用方法举例 :  如果要转换到目录QBASIC下
  '程序:IF ChangePath% ("QBASIC")=0 THEN  PRINT "成功转换到了目录" ELSE PRINT "没有转换到目录"
  '改变目录的中断资料:入口AH=3B DS:DX=要转换的目录
  DIM Reg%(9)
  Path$ = Path$ + CHR$(0)
  Reg%(8) = VARSEG(Path$)
  Reg%(3) = SADD(Path$)
  Reg%(0) = &H3B00
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  ChangePath% = Reg%(7) AND 1
END FUNCTION

SUB CloseFile (FileHandle%)
  '本函数的功能:关闭文件 ,FileHandle%为要关闭的文件号
  '本函数使用方法举例 :  如果要关闭5号文件(操作系统用文件号来管理打开,读写文件)
  '程序: CloseFile 5
  '关闭文件的中断资料:入口AH=3E BX=要关闭的文件号
  DIM Reg%(9)
  Reg%(1) = FileHandle%
  Reg%(0) = &H3E00
  CALL INT86XOLD(&H21, Reg%(), Reg%())
END SUB

SUB CreateDir (DirName$)
  '本函数的功能:建立一个目录,DirName$为要建的目录名
  '本函数使用方法举例 :  如果要建立一个目录TEST
  '程序:CreateDir "test"
  '建立目录的中断资料:入口AH=39 DS:DX=要建立的目录名
  DirName$ = DirName$ + CHR$(0)
  DIM Reg%(9)
  Reg%(8) = VARSEG(DirName$)
  Reg%(3) = SADD(DirName$)
  Reg%(0) = &H3900
  CALL INT86XOLD(&H21, Reg%(), Reg%())
END SUB


FUNCTION CurrentDrive$
  '本函数的功能:获得当前盘符
  '本函数使用方法举例 : 如果要知道当前盘符
  '程序:PRINT "当前盘符- ";CurrentDrive$
  '获得当前目录的中断资料:入口AH=19 返回:AL=0A,1B...
  DIM Reg%(9)
  Drive$ = UCASE$(Drive$)
  Reg%(0) = &H1900
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  CurrentDrive$ = CHR$(65 + (Reg%(0) AND &HFF)) + ":\"
END FUNCTION

FUNCTION CurrentPath$
  '本函数的功能:获得当前盘符的当前路径
  '本函数使用方法举例 : 如果要知道当前盘符的路径
  '程序:PRINT "当前盘符的目录为- ";CurrentPath$
  '获得当前路径的中断资料:入口AH=47 DL=0A,1B... 返回DS:SI地址=路径字符串
  DIM PathSize AS STRING * 64
  DIM Reg%(9)
  Reg%(0) = &H4700
  Reg%(3) = ASC(CurrentDrive$) - 64
  Reg%(8) = VARSEG(PathSize)
  Reg%(5) = VARPTR(PathSize)
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  CurrentPath$ = LEFT$(PathSize, INSTR(PathSize, CHR$(0)) - 1)
END FUNCTION

FUNCTION Deldir% (DirName$)
  '本函数的功能:删除目录,DirName$为要删除的目录名
  '本函数使用方法举例 : 如果删除成功,返回函数的直为0
  '程序:IF Deldir% ("TEST")=0 THEN PRINT "成功删除目录"
  '删除目录的中断资料:入口AH=3A DS:DX地址=路径字符串
  DirName$ = DirName$ + CHR$(0)
  DIM Reg%(9)
  Reg%(8) = VARSEG(DirName$)
  Reg%(3) = SADD(DirName$)
  Reg%(0) = &H3A00
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  Deldir% = Reg%(7) AND 1
END FUNCTION


FUNCTION FindDrives% (Drive$)
  '本函数的功能:查找盘符,Drive$为要查找的盘符
  '本函数使用方法举例 : 如果要知道系统中有无A盘
  '程序:IF FindDrives% ("A:")=0 THEN PRINT "有A盘" ELSE print "无A盘"
  Drive$ = UCASE$(Drive$)
  DIM Reg%(9)
  Reg%(0) = &H440E
  Reg%(1) = ASC(Drive$) - 64
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  FindDrives% = -1
  IF (Reg%(7) AND 1) = 0 THEN FindDrives% = Reg%(0)
END FUNCTION

FUNCTION FindFirstFile% (FileName$, FileAttrib%)
  '查找第一个文件:入口AH=4E CX=属性 DS:DX=文件名 返回AX=错误码
  SetFileDta
  FileName$ = FileName$ + CHR$(0)
  DIM Reg%(9)
  Reg%(0) = &H4E00
  Reg%(8) = VARSEG(FileName$)
  Reg%(3) = SADD(FileName$)
  Reg%(2) = FileAttrib%
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  FindFirstFile% = Reg%(7) AND 1
END FUNCTION

FUNCTION FindNextFile%
  '查找成功根据调用查找下一个文件 入口AH=4F  DS:DX=文件名,返回AX=错误码
  DIM Reg%(9)
  Reg%(0) = &H4F00
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  FindNextFile% = Reg%(7) AND 1
END FUNCTION

SUB GetDirList (DirList$, DirNum%)
  '本函数的功能:获得当前路径下的所有目录 DirList$为目录列表,每个目录名用CHR$(0)隔开, DirNum%为目录的数量
  '本函数使用方法举例 : 如果要知道当前路径下的所有目录
  '程序:GetDirList DirList$, DirNum% :PRINT "目录数量为- ";dirnum%,dirlist$

DirList$ = ""
FileName$ = "*.*"
FileAttrib% = &HFF
IF FindFirstFile%(FileName$, FileAttrib%) = 1 THEN EXIT SUB
DO WHILE FindNextFile% = 0
     Find% = INSTR(31, FileDta$, CHR$(0)) - 30
     FileName$ = MID$(FileDta$, 31, Find%)
     FileAttrib% = CVI((MID$(FileDta$, 21, 2)))
     IF FileAttrib% = 4096 THEN
        DirList$ = DirList$ + FileName$
        i% = i% + 1
     END IF
LOOP
DirNum% = i%
END SUB

SUB GetDiskList (DiskList$, DiskNum%)
'本函数的功能:获得系统中所有盘符 DiskList$为磁盘列表,每个用CHR$(0)隔开, DiskNum%为目录的数量
  '本函数使用方法举例 : 如果要知道所有盘符
  '程序: GetDiskList DiskList$, DiskNum% :PRINT "磁盘数量为- ";disknum%,disklist$
DiskList$ = ""
FOR i = 1 TO 26
  IF FindDrives%(CHR$(i + 64)) = 0 THEN
     DiskList$ = DiskList$ + CHR$(i + 64)
     DiskList$ = DiskList$ + CHR$(0)
     i1% = i1% + 1
  END IF
NEXT i
DiskNum% = i1%
END SUB

FUNCTION RenFile% (OldFile$, NewFile$)
  '本函数的功能:文件改名 ,OldFile$为要改名的文件 NewFile$为新文件名
  '本函数使用方法举例 :  如果要把TEST.TXT改名为DEMO.BAK
  '程序: IF RenFile% ("TEST.TXT", "DEMO.BAK")=0 THEN PRINT "文件改名成功"
  '文件改名的中断资料:入口AH=56 DS:DX=旧文件地址 ES:DI=新
  DIM Reg%(9)
  Old$ = OldFile$ + CHR$(0)
  New$ = NewFile$ + CHR$(0)
  Reg%(8) = VARSEG(Old$)
  Reg%(3) = SADD(Old$)
  Reg%(9) = VARSEG(New$)
  Reg%(6) = SADD(New$)
  Reg%(0) = &H7156
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  FileRen% = Reg%(0)
END FUNCTION

SUB SetFileDta
  '设置DTA:入口AH=1A DX:DX=缓冲区(32)
  FileDta$ = STRING$(43, CHR$(0))
  DIM Reg%(9)
  Reg%(0) = &H1A00
  Reg%(8) = VARSEG(FileDta$)
  Reg%(3) = SADD(FileDta$)
  CALL INT86XOLD(&H21, Reg%(), Reg%())
END SUB


SUB GetFileList (FileName$, FileAttrib%, FileList$, FileNum%)
  '本函数的功能:获得当前路径下的所有文件 FILEList$为文件列表,每个文件名用CHR$(0)隔开, fileNum%为文件的数量
  '本函数使用方法举例 : 如果要知道当前路径下的所有文件
  '程序:GetFileList FileName$, FileAttrib%, FileList$, FileNum%:PRINT "文件数量为- ";filenum%,filelist$

FileList$ = ""
IF FileName$ = "" THEN FileName$ = "*.*"
IF FileAttrib% = 0 THEN FileAttrib% = &HFF
IF FindFirstFile%(FileName$, FileAttrib%) = 1 THEN EXIT SUB
i% = 0
DO
     Find% = INSTR(31, FileDta$, CHR$(0)) - 31
     FileName$ = MID$(FileDta$, 31, Find% + 1)
     FileAttrib% = CVI((MID$(FileDta$, 21, 2)))
     IF FileAttrib% <> 4096 THEN
        FileList$ = FileList$ + FileName$
        i% = i% + 1
     END IF
LOOP WHILE FindNextFile% = 0
FileNum% = i%
'-----un file name
'SFind% = 1
'FOR i = 1 TO FileNum%
'   Find = INSTR(SFind%, FileList$, CHR$(0))
'   F1$ = MID$(FileList$, SFind%, Find - SFind%)
'   PRINT i, F1$
'   SFind% = Find + 1
'NEXT i
END SUB

FUNCTION DelFile% (FileHandle%)
  'ax% = 0: bx% = 1: cx% = 2: dx% = 3: bp% = 4
  'si% = 5: di% = 6: flags% = 7: ds% = 8: es% = 9
  DIM Reg%(9)
  Reg%(1) = FileHandle%
  Reg%(0) = &H4100
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  DleFile% = Reg%(7) AND 1
END FUNCTION
FUNCTION CreateFile% (FileName$)
  'ax% = 0: bx% = 1: cx% = 2: dx% = 3: bp% = 4
  'si% = 5: di% = 6: flags% = 7: ds% = 8: es% = 9
  FileName$ = FileName$ + CHR$(0)
  DIM Reg%(9)
  Reg%(8) = VARSEG(FileName$)
  Reg%(3) = SADD(FileName$)
  Reg%(0) = &H3C00
  Reg%(2) = 0
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  CreateFile% = -1
  IF (Reg%(7) AND 1) = 0 THEN CreateFile% = Reg%(0)
END FUNCTION


SUB FileInfo (File AS FileRecord)
Find% = INSTR(31, FileDta$, CHR$(0)) - 31
File.DosName$ = MID$(FileDta$, 31, Find% + 1)
File.size = CVL(MID$(FileDta$, &H1B, 4))
FileDate% = CVI(MID$(FileDta$, &H19, 2))
FileTime% = CVI(MID$(FileDta$, &H17, 2))
File.Attrib = ASC(MID$(FileDta$, &H16, 1))
File.hour% = (FileTime% AND &HF800) \ &H800 AND &H1F
File.min% = (FileTime% AND &HFFE0) \ &H20 AND &H3F
File.sec% = FileTime% AND &H1F
File.Day% = FileDate% AND &H1F
File.Month% = (FileDate% \ &H20) AND &HF
File.Year% = FileDate% \ &H200 + 1980
END SUB


FUNCTION MovePosition% (FileHandle%, MoveMode%, MoveNum)
  'ax% = 0: bx% = 1: cx% = 2: dx% = 3: bp% = 4
  'si% = 5: di% = 6: flags% = 7: ds% = 8: es% = 9
  DIM t1 AS STRING * 2, t2 AS STRING * 2
  t1 = LEFT$(MKL$(MoveNum), 2)
  t2 = RIGHT$(MKL$(MoveNum), 2)
  DIM Reg%(9)
  Reg%(2) = CVI(t2)
  Reg%(3) = CVI(t1)
  Reg%(1) = FileHandle%
  Reg%(0) = &H4200 OR MoveMode%
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  t2 = MKI$(Reg%(3))
  t1 = MKI$(Reg%(0))
  MoveNum = CVL(t1 + t2)
END FUNCTION

FUNCTION OpenFile% (FileName$, Mode%, FileHandle%)
  FileName$ = FileName$ + CHR$(0)
  DIM Reg%(9)
  Reg%(8) = VARSEG(FileName$)
  Reg%(3) = SADD(FileName$)
  Reg%(0) = &H3D00 OR Mode%
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  FileHandle% = Reg%(0)
  OpenFile% = Reg%(7) AND 1
END FUNCTION

FUNCTION ReadFile% (FileBuff$, ReadLen%, FileHandle%)
  DIM Reg%(9)
  IF FileBuff$ = "" THEN FileBuff$ = SPACE$(ReadLen%)
  Reg%(8) = VARSEG(FileBuff$)
  Reg%(3) = SADD(FileBuff$)
  Reg%(0) = &H3F00
  Reg%(1) = FileHandle%
  Reg%(2) = ReadLen%
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  ReadFile% = Reg%(7) AND 1
  ReadLen% = Reg%(0)
END FUNCTION


FUNCTION WriteFile% (buff$, WriteLen%, FileHandle%)
  ax% = 0: Bx% = 1: Cx% = 2: Dx% = 3: bp% = 4
  Si% = 5: di% = 6: Flags% = 7: Ds% = 8: es% = 9
  DIM Reg%(9)
  Reg%(Ds%) = VARSEG(buff$)
  Reg%(Dx%) = SADD(buff$)
  Reg%(Bx%) = FileHandle%
  Reg%(Cx%) = WriteLen%
  Reg%(ax%) = &H4000
  CALL INT86XOLD(&H21, Reg%(), Reg%())
  WriteFile% = Reg%(Flags%) AND 1
  WriteLen% = Reg%(Cx%)
END FUNCTION