QB大门8字开，“觅缘红尘”请进来

主题：QB大门8字开，“觅缘红尘”请进来

moz [专家分：37620] 发布于 2005-08-15 12:57:00

我不懂怎样用NET读取主机文件列表，
你看过后看情况修改吧。
看不明白的来问我喽。
已修改过以适应FB。

DECLARE SUB MakeOver (f1$, d$)
DECLARE FUNCTION seach$ (s1&, f$, a$)
DECLARE FUNCTION dirfilename$ (a$)
Bzpath$ = "E:\moz\qb71\3"           '[color=FF00FF]本地文件路径[/color]
Zzpath$ = "D:\3"                    '[color=FF00FF]主机文件路径[/color]
needdel$ = "needdel.txt"            '[color=FF00FF]多余文件列表（只有文件名）[/color]
needadd$ = "needadd.txt"            '[color=FF00FF]需要添加的文件列表[/color]
needF5$ = "needF5.txt"              '[color=FF00FF]需要更新的文件列表[/color]
needkeep$ = "needkeep.txt"          '[color=FF00FF]保持的文件列表[/color]

ccurdir$ = CURDIR$
IF RIGHT$(ccurdir$, 1) <> "\" THEN ccurdir$ = ccurdir$ + "\"
Bzdir$ = "bzdir.txt"
Zzdir$ = "zzdir.txt"

IF LEFT$(Bzpath$, 2) <> LEFT$(CURDIR$, 2) THEN shell LEFT$(Bzpath$, 2)
CHDIR Bzpath$
SHELL "DIR /S/ON > " + ccurdir$ + Bzdir$

IF LEFT$(Zzpath$, 2) <> LEFT$(CURDIR$, 2) THEN shell LEFT$(Zzpath$, 2)
CHDIR Zzpath$
SHELL "DIR /S/ON > " + ccurdir$ + Zzdir$

IF LEFT$(ccurdir$, 2) <> LEFT$(CURDIR$, 2) THEN shell LEFT$(ccurdir$, 2)
IF LEN(ccurdir$) > 3 THEN ccurdir$ = LEFT$(ccurdir$, LEN(ccurdir$) - 1)
CHDIR ccurdir$

MakeOver Bzdir$, Bzpath$
MakeOver Zzdir$, Zzpath$

f1% = FREEFILE
OPEN Zzdir$ FOR INPUT AS #f1%
f3% = FREEFILE
OPEN needdel$ FOR OUTPUT AS #f3%
f4% = FREEFILE
OPEN needadd$ FOR OUTPUT AS #f4%
f5% = FREEFILE
OPEN needF5$ FOR OUTPUT AS #f5%
f6% = FREEFILE
OPEN needkeep$ FOR OUTPUT AS #f6%
DO UNTIL EOF(f1%)
   LINE INPUT #f1%, i$
   k% = INSTR(i$, "|||")
   f$ = LEFT$(i$, k% + 2)
   g$ = LTRIM$(RTRIM$(MID$(i$, k% + 3)))
   j$ = LTRIM$(RTRIM$(seach$(1, Bzdir$, f$)))
   IF j$ = "" THEN
      PRINT #f4%, f$
   ELSEIF j$ = g$ THEN
      PRINT #f6%, f$
   ELSEIF j$ <> g$ THEN
      PRINT #f5%, f$
   END IF
LOOP

f2% = FREEFILE
OPEN Bzdir$ FOR INPUT AS #f2%
DO UNTIL EOF(f2%)
   LINE INPUT #f2%, i$
   k% = INSTR(i$, "|||")
   f$ = LEFT$(i$, k% + 2)
   g$ = LTRIM$(RTRIM$(MID$(i$, k% + 3)))
   j$ = LTRIM$(RTRIM$(seach$(1, Zzdir$, f$)))
   IF j$ = "" THEN PRINT #f3%, f$
LOOP
CLOSE #f1%, f2%, f3%, f4%, f5%, f6%

本帖地址： http://bbs.pfan.cn/post/98002.html

回复列表（共3个回复）

沙发

moz [专家分：37620] 发布于 2005-08-15 12:43:00

FUNCTION dirfilename$ (a$)   '[color=FF00FF]从DIR文件中整理资料函数[/color]
IF MID$(a$, 9, 1) = CHR$(32) AND MID$(a$, 13, 1) = CHR$(32) AND MID$(a$, 27, 1) = CHR$(32) AND MID$(a$, 30, 1) = "-" AND MID$(a$, 33, 1) = "-" AND MID$(a$, 40, 1) = ":" THEN

   n$ = RTRIM$(LEFT$(a$, 8))
   b$ = RTRIM$(MID$(a$, 10, 3))
   IF b$ <> "" THEN n$ = n$ + "." + b$

   d$ = MID$(a$, 28, 8)
   y% = VAL(RIGHT$(d$, 2))
   IF y% < 10 THEN y% = 2000 + y% ELSE y% = 1900 + y%
   d$ = RIGHT$(STR$(y%), 4) + "-" + LEFT$(d$, 5)

   t$ = RTRIM$(MID$(a$, 39))
   IF LEN(t$) > 5 THEN
     IF UCASE$(RIGHT$(t$, 1)) = "P" THEN MID$(t$, 1, 2) = RIGHT$(STR$(VAL(t$) + 12), 2)
     t$ = LEFT$(t$, 5)
   END IF
   IF LEFT$(t$, 1) = CHR$(32) THEN MID$(t$, 1, 1) = "0"

   l$ = LTRIM$(RTRIM$(MID$(a$, 14, 13)))

   o$ = n$ + "|||" + d$ + CHR$(32) + t$ + CHR$(32) + l$

ELSEIF MID$(a$, 5, 1) = "-" AND MID$(a$, 8, 1) = "-" AND MID$(a$, 15, 1) = ":" THEN

   d$ = LEFT$(a$, 10)

   t$ = MID$(a$, 13, 5)

   l$ = LTRIM$(RTRIM$(MID$(a$, 19, 20)))

   n$ = LTRIM$(RTRIM$(MID$(a$, 40)))

   o$ = n$ + "|||" + d$ + CHR$(32) + t$ + CHR$(32) + l$

ELSEIF MID$(a$, 9, 1) = CHR$(32) AND MID$(a$, 13, 1) = CHR$(32) AND MID$(a$, 23, 1) = CHR$(32) AND MID$(a$, 26, 1) = "-" AND MID$(a$, 29, 1) = "-" AND MID$(a$, 37, 1) = ":" THEN

   n$ = RTRIM$(LEFT$(a$, 8))
   b$ = RTRIM$(MID$(a$, 10, 3))
   IF b$ <> "" THEN n$ = n$ + "." + b$

   d$ = MID$(a$, 24, 8)
   y% = VAL(LEFT$(d$, 2))
   IF y% < 10 THEN y% = 2000 + y% ELSE y% = 1900 + y%
   d$ = RIGHT$(STR$(y%), 4) + MID$(d$, 3, 6)

   t$ = RTRIM$(MID$(a$, 35, 5))
   IF LEFT$(t$, 1) = CHR$(32) THEN MID$(t$, 1, 1) = "0"

   l$ = LTRIM$(RTRIM$(MID$(a$, 14, 9)))

   o$ = n$ + "|||" + d$ + CHR$(32) + t$ + CHR$(32) + l$

END IF
   dirfilename$ = o$
END FUNCTION

SUB MakeOver (f1$, d$)   '[color=FF00FF]对DIR文件处理函数[/color]
f2$ = "1~" + f1$
l% = LEN(d$) + 1
IF l% > 4 THEN l% = l% + 1
f1% = FREEFILE
OPEN f1$ FOR INPUT AS #f1%
f2% = FREEFILE
OPEN f2$ FOR OUTPUT AS #f2%
DO UNTIL EOF(f1%)
   LINE INPUT #f1%, i$
   j% = INSTR(i$, ":\")
   IF j% > 1 THEN
      p$ = MID$(i$, j% - 1)
      k% = INSTR(p$, CHR$(32))
      IF k% > 0 THEN p$ = LEFT$(p$, k% - 1)
      IF LEN(p$) > 3 THEN p$ = p$ + "\"
   ELSEIF LEFT$(i$, 1) > "/" AND INSTR(i$, "<DIR>") = 0 THEN
      filename$ = dirfilename$(i$)
      IF RTRIM$(filename$) <> "" THEN PRINT #f2%, MID$(p$, l%) + filename$
   END IF
LOOP
CLOSE #f1%, #f2%
KILL f1$
shell "ren "+ f2$ +" "+ f1$
END SUB

FUNCTION seach$ (s1&, f$, a$)  '[color=FF00FF]从文件中查找字符串函数[/color]
La& = LEN(a$)
fl& = 16383 - La&
fr% = FREEFILE
OPEN f$ FOR BINARY AS #fr%
IF s1& = 0 THEN s1& = 1
DO
SEEK #fr%, s1&
s$ = INPUT$(16383, fr%)
s2& = INSTR(1, s$, a$)
IF s2& THEN
   s1& = s1& + s2& - 1
   s2& = s1& + La&
   CLOSE #fr%
   OPEN f$ FOR INPUT AS #fr%
   SEEK #fr%, s2&
   INPUT #fr%, se$
   seach$=se$
   EXIT DO
END IF
s1& = s1& + fl&
LOOP UNTIL EOF(fr%)
CLOSE #fr%
END FUNCTION

板凳

zqnhlm [专家分：780] 发布于 2005-08-15 13:48:00

去死！

3 楼

dqsjrwy [专家分：20] 发布于 2005-08-16 05:52:00

我看了，非常感谢MOZ！！！

我来回复

您尚未登录，请登录后再回复。点此登录或注册

主题：QB大门8字开，“觅缘红尘”请进来

回复列表（共3个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

主题：QB大门8字开，“觅缘红尘”请进来

回复列表 （共3个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

回复列表（共3个回复）