您所在位置：主题：[原创]一个老问题:搜索文件(包含子目录名)
QB71
[专家分：1300] 发布于 2005-05-28 12:58:00
'这个问题我在论坛发过帖子
'现在这个帖子找不到了
'这是重新优化过的过程
'CALL absolute 过程是由QB45提供的
'这个过程能够搜索到当前路径下的所有文件名及子目录名(不管文件什么属性)
'如果在根目录,也能够获得分区的卷标名
DEFINT A-Z
FUNCTION Dirs$ (Path AS STRING, Attr AS INTEGER, Size as LONG)
'******************************************************
' 搜索目录下的所有文件和文件夹,适用7.1和4.5版本
' Attr位 8=卷标 16=目录 其他为文件
' 第一次调用时Path为要搜索的路径,第二次调用时Path请置空
' 返回:Attr=文件属性 Size=文件长度
'******************************************************
STATIC Lc AS INTEGER
STATIC ErrCode AS INTEGER
STATIC FileDATA AS STRING * 44
STATIC FirstCode AS STRING * 28
STATIC NextCode AS STRING * 18
STATIC FileName AS STRING * 64
IF Lc = 0 THEN
Lc = 1
DIM AsmCode AS STRING * 12
'=================================================================
MID$(AsmCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(FileDATA))
MID$(AsmCode, 4, 1) = CHR$(&H1F)
MID$(AsmCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(FileDATA))
MID$(AsmCode, 8, 2) = CHR$(&HB4) + CHR$(&H1A)
MID$(AsmCode, 10, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(AsmCode, 12, 1) = CHR$(&HCB)
'=================================================================
DEF SEG = VARSEG(AsmCode): CALL ABSOLUTE(VARPTR(AsmCode)): DEF SEG
'=================================================================
MID$(FirstCode, 4, 1) = CHR$(&H1F)
MID$(FirstCode, 8, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4E)
MID$(FirstCode, 11, 3) = CHR$(&HB9) + MKI$(255)
MID$(FirstCode, 14, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(FirstCode, 16, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(FirstCode, 19, 1) = CHR$(&H1F)
MID$(FirstCode, 20, 2) = CHR$(&H72) + CHR$(&H2)
MID$(FirstCode, 22, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(FirstCode, 24, 1) = CHR$(&H3E)
MID$(FirstCode, 25, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(FirstCode, 28, 1) = CHR$(&HCB)
'=================================================================
MID$(NextCode, 1, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4F)
MID$(NextCode, 4, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(NextCode, 6, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(NextCode, 9, 1) = CHR$(&H1F)
MID$(NextCode, 10, 2) = CHR$(&H72) + CHR$(&H2)
MID$(NextCode, 12, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(NextCode, 14, 1) = CHR$(&H3E)
MID$(NextCode, 15, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(NextCode, 18, 1) = CHR$(&HCB)
'=================================================================
END IF
IF Path$ <> "" THEN
FileName = Path + CHR$(0)
MID$(FirstCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(FileName))
MID$(FirstCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(FileName))
DEF SEG = VARSEG(FirstCode)
CALL ABSOLUTE(VARPTR(FirstCode)): DEF SEG
IF ErrCode THEN EXIT FUNCTION
ELSE
DEF SEG = VARSEG(NextCode)
CALL ABSOLUTE(VARPTR(NextCode)): DEF SEG
IF ErrCode THEN EXIT FUNCTION
END IF
File$ = MID$(FileDATA, 31)
Dirs$ = LEFT$(File$, INSTR(File$, CHR$(0)) - 1)
Attr% = ASC(MID$(FileDATA, 22, 1))
Size& = CVL(MID$(FileDATA, 27, 4))
END FUNCTION
'现在这个帖子找不到了
'这是重新优化过的过程
'CALL absolute 过程是由QB45提供的
'这个过程能够搜索到当前路径下的所有文件名及子目录名(不管文件什么属性)
'如果在根目录,也能够获得分区的卷标名
DEFINT A-Z
FUNCTION Dirs$ (Path AS STRING, Attr AS INTEGER, Size as LONG)
'******************************************************
' 搜索目录下的所有文件和文件夹,适用7.1和4.5版本
' Attr位 8=卷标 16=目录 其他为文件
' 第一次调用时Path为要搜索的路径,第二次调用时Path请置空
' 返回:Attr=文件属性 Size=文件长度
'******************************************************
STATIC Lc AS INTEGER
STATIC ErrCode AS INTEGER
STATIC FileDATA AS STRING * 44
STATIC FirstCode AS STRING * 28
STATIC NextCode AS STRING * 18
STATIC FileName AS STRING * 64
IF Lc = 0 THEN
Lc = 1
DIM AsmCode AS STRING * 12
'=================================================================
MID$(AsmCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(FileDATA))
MID$(AsmCode, 4, 1) = CHR$(&H1F)
MID$(AsmCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(FileDATA))
MID$(AsmCode, 8, 2) = CHR$(&HB4) + CHR$(&H1A)
MID$(AsmCode, 10, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(AsmCode, 12, 1) = CHR$(&HCB)
'=================================================================
DEF SEG = VARSEG(AsmCode): CALL ABSOLUTE(VARPTR(AsmCode)): DEF SEG
'=================================================================
MID$(FirstCode, 4, 1) = CHR$(&H1F)
MID$(FirstCode, 8, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4E)
MID$(FirstCode, 11, 3) = CHR$(&HB9) + MKI$(255)
MID$(FirstCode, 14, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(FirstCode, 16, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(FirstCode, 19, 1) = CHR$(&H1F)
MID$(FirstCode, 20, 2) = CHR$(&H72) + CHR$(&H2)
MID$(FirstCode, 22, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(FirstCode, 24, 1) = CHR$(&H3E)
MID$(FirstCode, 25, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(FirstCode, 28, 1) = CHR$(&HCB)
'=================================================================
MID$(NextCode, 1, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4F)
MID$(NextCode, 4, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(NextCode, 6, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(NextCode, 9, 1) = CHR$(&H1F)
MID$(NextCode, 10, 2) = CHR$(&H72) + CHR$(&H2)
MID$(NextCode, 12, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(NextCode, 14, 1) = CHR$(&H3E)
MID$(NextCode, 15, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(NextCode, 18, 1) = CHR$(&HCB)
'=================================================================
END IF
IF Path$ <> "" THEN
FileName = Path + CHR$(0)
MID$(FirstCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(FileName))
MID$(FirstCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(FileName))
DEF SEG = VARSEG(FirstCode)
CALL ABSOLUTE(VARPTR(FirstCode)): DEF SEG
IF ErrCode THEN EXIT FUNCTION
ELSE
DEF SEG = VARSEG(NextCode)
CALL ABSOLUTE(VARPTR(NextCode)): DEF SEG
IF ErrCode THEN EXIT FUNCTION
END IF
File$ = MID$(FileDATA, 31)
Dirs$ = LEFT$(File$, INSTR(File$, CHR$(0)) - 1)
Attr% = ASC(MID$(FileDATA, 22, 1))
Size& = CVL(MID$(FileDATA, 27, 4))
END FUNCTION
