 |
VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
| 上一篇主題 :: 下一篇主題 |
| 發表人 |
內容 |
lcm
註冊時間: 2004-12-27
文章: 45
第 1 樓
|
 發表於: 星期日 十月 16, 2005 2:52 am 文章主題: 刪除整個目錄(包括子目錄) |
 |
|
下面的程序可以使你刪除整個目錄，包目錄下文件或子目錄
PARAMETERS deldirpath
LOCAL lGetDir[254,254],lGetDirNum[254],sFiles,ListFiles[1],cFile,cNewFile,i
LOCAL lcCurDir
for i=1 to 254
lGetDirNum[i]=0
endfor
counter=0
sFiles = ADIR(ListFiles,deldirpath+"\*.*","D")
IF sFiles > 0
FOR i=1 TO ALEN(ListFiles,1)
IF NOT INLIST(ListFiles(i,1),".","..") &&不處理.,..
IF "D" $ ListFiles(i,5) &&處理目錄
lGetDir[1,counter+1]=deldirpath+"\"+ListFiles(i,1)
counter=counter+1
lGetDirnum[1]=counter
ENDIF
ENDIF
ENDFOR
ENDIF
FOR i=2 TO 254
counter=0
FOR j=1 TO lGetDirNum(i-1)
sFiles = ADIR(ListFiles,lGetDir(i-1,j)+"\*.*","D")
IF sFiles > 0
FOR k=1 TO ALEN(ListFiles,1)
IF NOT INLIST(ListFiles(k,1),".","..") &&不處理.,..
IF "D" $ ListFiles(k,5) &&處理目錄
lGetDir[i,counter+1]=lGetDir(i-1,j)+"\"+ListFiles(k,1)
counter=counter+1
lGetDirnum[i]=counter
ENDIF
ENDIF
ENDFOR
ENDIF
ENDFOR
ENDFOR
FOR i=254 TO 1 STEP -1
FOR j=1 TO 254
IF EMPTY(lGetDir(i,j))
EXIT
ENDIF
erasestr="ERASE "+lGetDir(i,j)+"\*.*"
&erasestr
RD lGetDir(i,j)
ENDFOR
ENDFOR
RD (deldirpath) |
|
| 回頂端 |
|
 |
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2160
第 2 樓
|
| 發表於: 星期一 十月 17, 2005 9:25 am 文章主題: |
|
|
這是用vb寫的, 如果能換成vfp代碼, 那功能更強了.
**********************
用API拷貝.移動.刪除文件
--------------------------------------------------------------------------------
日期：2005年1月4日 作者：-=不詳=- 人氣：610 人
VB提供的Filecopy函數一次只能拷貝刪除一個文件，刪除的文件不可恢復。用API函數SHFileOperation可以實現多個文件（允許使用通佩符）甚至是整個目錄（包括目錄中的下級子目錄）的移動、拷貝，也可以完成多個文件（允許使用通佩符）甚至是整個目錄（包括目錄中的下級子目錄）的刪除，而且這種刪除是可恢復的——將全部刪除的文件放入回收站而不是徹底刪除。下面介紹該API函數的使用示例。
先添加一個模塊，將如下代碼粘帖於內。
| 代碼: |
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
HWnd As Long '窗口句柄
wFunc As Long '執行的操作
pFrom As String '原地點
pTo As String '目標地點
fFlags As Long '操作執行方式
fAnyOperationsAborted As Long '錯誤代碼返回
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
在主窗體上放置一個命令按鈕，將如下代碼粘帖在代碼窗口中。按下按鈕可以操作對應目錄。
Private Sub Command1_Click()
Dim DelFileOp As SHFILEOPSTRUCT
Dim result As Long
With DelFileOp
.HWnd = Me.HWnd
.wFunc = FO_MOVE '(這三行代碼代表移動)
.pFrom = "e:\api\*" & vbNullChar & vbNullChar
.pTo = "e:\test"
'.wFunc = FO_DELETE '(這兩行代碼代表刪除)
'.pFrom = "e:\test\*" & vbNullChar & vbNullChar'
'.wFunc = FO_COPY '(這三行代碼代表拷貝)
'.pFrom = "e:\api\*" & vbNullChar & vbNullChar'
'.pTo = "e:\test"'
.fFlags = FOF_ALLOWUNDO
End With
result = SHFileOperation(DelFileOp)
If result <> 0 Then ' Operation failed
If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError ' Msgbox the error that occurred in the API.
End If
Else
If DelFileOp.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub
|
上述示例將完成d:\api\*.*文件到d:\test目錄的移動，如果目的目錄不存在程序可自動重建；如果目標目錄下有下級子目錄將一同被移動。
如果相拷貝或刪除目錄需要對上述代碼進行修改，將移動部分的兩行代碼註釋掉，將拷貝的三行代碼（或刪除的兩行代碼）的註釋去掉即可。
_________________
利用>>搜尋<<的功能會比問的還要快得到答案. |
|
| 回頂端 |
|
|
bin1x
註冊時間: 2004-08-27
文章: 462
第 3 樓
|
| 發表於: 星期一 十月 17, 2005 12:14 pm 文章主題: |
|
|
太複雜了
動動腦是不錯啦,
說要解決問題的話
我的作法是
run deltree /y大概就行了,反正dos 公用程式寫好了,不用白不用 |
|
| 回頂端 |
|
|
a123eric
註冊時間: 2003-10-20
文章: 64
第 4 樓
|
| 發表於: 星期一 十月 17, 2005 1:14 pm 文章主題: |
|
|
| w32api 中 有一個 deletefloder 的涵數可以用 |
|
| 回頂端 |
|
|
rcj811
註冊時間: 2003-08-12
文章: 35
第 5 樓
|
| 發表於: 星期二 十月 18, 2005 11:16 am 文章主題: |
|
|
這是 vfp 用API
只要將下 &del_name 改為您要刪除的路徑即可
| 代碼: |
deltree("&del_name")
Clea dlls
Return
Function deltree
Para deltree
Declare integer SHFileOperation in SHELL32.dll string @LPSHFILEOPSTRUCT
Declare integer GetActiveWindow in WIN32API
oheap = createobj('Heap')
#Define fo_copy 3
#Define fof_noconfirmation 48
#DEFINE FOF_NOERRORUI 0x400
cdeststring = deltree + chr(0) + chr(0)
nstringbase = oheap.allocblob(cdeststring)
cfileopstruct = numtodword(getactivewindow()) ;
+ numtodword(fo_copy) ;
+ numtodword(nstringbase) ;
+ numtodword(nstringbase + len(cdeststring)) ;
+ numtodword(fof_noconfirmation+FOF_NOERRORUI) + chr(0) ;
+ numtodword(0) ;
+ numtodword(0)
If SHFileOperation(cfileopstruct) = 0
retu .T.
Else
retu .F.
Endif
oheap = ''
Endfunc
*------------------------------------
Define class heap as custom
Protected inhandle, innumallocsactive,iaallocs[1,3]
inhandle = null
innumallocsactive = 0
iaallocs = null
Name = "heap"
Procedure alloc
Lparameter nsize
Declare integer HeapAlloc in WIN32API as HAlloc integer hHeap, integer dwFlags, integer dwBytes
Declare integer HeapSize in WIN32API as HSize integer hHeap, integer dwFlags, integer lpcMem
Local nptr
With this
nptr = halloc(.inhandle, 0, @nsize)
If nptr # 0
.innumallocsactive = .innumallocsactive + 1
Dimension .iaallocs[.inNumAllocsActive,3]
.iaallocs[.inNumAllocsActive,1] = nptr
.iaallocs[.inNumAllocsActive,2] = hsize(.inhandle, 0, nptr)
.iaallocs[.inNumAllocsActive,3] = .t.
Else
nptr = null
Endif
Endwith
Return nptr
Endproc
deltree("&del_name")
Clea dlls
Return
Function deltree
Para deltree
Declare integer SHFileOperation in SHELL32.dll string @LPSHFILEOPSTRUCT
Declare integer GetActiveWindow in WIN32API
oheap = createobj('Heap')
#Define fo_copy 3
#Define fof_noconfirmation 48
#Define FOF_NOERRORUI 0x400
cdeststring = deltree + chr(0) + chr(0)
nstringbase = oheap.allocblob(cdeststring)
cfileopstruct = numtodword(GetActiveWindow()) ;
+ numtodword(fo_copy) ;
+ numtodword(nstringbase) ;
+ numtodword(nstringbase + len(cdeststring)) ;
+ numtodword(fof_noconfirmation+FOF_NOERRORUI) + chr(0) ;
+ numtodword(0) ;
+ numtodword(0)
If SHFileOperation(cfileopstruct) = 0
Retu .T.
Else
Retu .F.
Endif
oheap = ''
Endfunc
*------------------------------------
Define class heap as custom
Protected inhandle, innumallocsactive,iaallocs[1,3]
inhandle = null
innumallocsactive = 0
iaallocs = null
Name = "heap"
Procedure alloc
Lparameter nsize
Declare integer HeapAlloc in WIN32API as HAlloc integer hHeap, integer dwFlags, integer dwBytes
Declare integer HeapSize in WIN32API as HSize integer hHeap, integer dwFlags, integer lpcMem
Local nptr
With this
nptr = HAlloc(.inhandle, 0, @nsize)
If nptr # 0
.innumallocsactive = .innumallocsactive + 1
Dimension .iaallocs[.inNumAllocsActive,3]
.iaallocs[.inNumAllocsActive,1] = nptr
.iaallocs[.inNumAllocsActive,2] = HSize(.inhandle, 0, nptr)
.iaallocs[.inNumAllocsActive,3] = .t.
Else
nptr = null
Endif
Endwith
Return nptr
Endproc
Function allocblob
Lparameter cbstringtocopy
Local nallocptr
With this
nallocptr = .alloc(len(cbstringtocopy))
If ! isnull(nallocptr)
.copyto(nallocptr,cbstringtocopy)
Endif
Endwith
Return nallocptr
Endfunc
Function allocstring
Lparameter cstring
Return this.allocblob(cstring + chr(0))
Endfunc
Function allocinitas
Lparameter nsizeofbuffer, nbytevalue
If type('nByteValue') # 'N' or ! between(nbytevalue,0,255)
nbytevalue = 0
Endif
Return this.allocblob(replicate(chr(nbytevalue),nsizeofbuffer))
Endfunc
Procedure dealloc
Lparameter nptr
Declare integer HeapFree in WIN32API as HFree ;
integer hHeap, ;
integer dwFlags, ;
integer lpMem
Local nctr
nctr = null
With this
nctr = .findallocid(nptr)
If ! isnull(nctr)
=HFree(.inhandle, 0, nptr)
.iaallocs[nCtr,3] = .f.
Endif
Endwith
Return ! isnull(nctr)
Endproc
Procedure copyto
Lparameter nptr, csource
Declare RtlMoveMemory in WIN32API as RtlCopy ;
integer nDestBuffer, ;
string @pVoidSource, ;
integer nLength
Local nctr
nctr = null
If type('nPtr') = 'N' and type('cSource') $ 'CM' ;
and ! (isnull(nptr) or isnull(csource))
With this
nctr = .findallocid(nptr)
If ! isnull(nctr)
=RtlCopy((.iaallocs[nCtr,1]), ;
csource, ;
min(len(csource),.iaallocs[nCtr,2]))
Endif
Endwith
Endif
Return ! isnull(nctr)
Endproc
Procedure copyfrom
Lparameter nptr
Declare RtlMoveMemory in WIN32API as RtlCopy ;
string @DestBuffer, ;
integer pVoidSource, ;
integer nLength
Local nctr, ubuffer
ubuffer = null
nctr = null
If type('nPtr') = 'N' and ! isnull(nptr)
With this
nctr = .findallocid(nptr)
If ! isnull(nctr)
ubuffer = repl(chr(0),.iaallocs[nCtr,2])
=RtlCopy(@ubuffer, ;
(.iaallocs[nCtr,1]), ;
(.iaallocs[nCtr,2]))
Endif
Endwith
Endif
Return ubuffer
Endproc
Protected function findallocid
Lparameter nptr
Local nctr
With this
For nctr = 1 to .innumallocsactive
If .iaallocs[nCtr,1] = nptr and .iaallocs[nCtr,3]
Exit
Endif
Endfor
Return iif(nctr <= .innumallocsactive,nctr,null)
Endwith
Endproc
Procedure sizeofblock
Lparameters nptr
Local nctr, nsizeofblock
nsizeofblock = null
With this
nctr = .findallocid(nptr)
Return iif(isnull(nctr),null,.iaallocs[nCtr,2])
Endwith
Endproc
Procedure destroy
Declare HeapDestroy in WIN32API as HDestroy integer hHeap
Local nctr
With this
For nctr = 1 to .innumallocsactive
If .iaallocs[nCtr,3]
.dealloc(.iaallocs[nCtr,1])
Endif
Endfor
HDestroy[.inHandle]
Endwith
DoDefault()
Endproc
Procedure init
Declare integer HeapCreate in WIN32API as HCreate ;
integer dwOptions, ;
integer dwInitialSize, ;
integer dwMaxSize
#Define swapfilepagesize 4096
#Define blockallocsize 2 * swapfilepagesize
With this
.inhandle = HCreate(0, blockallocsize, 0)
Dimension .iaallocs[1,3]
.iaallocs[1,1] = 0
.iaallocs[1,2] = 0
.iaallocs[1,3] = .f.
.innumallocsactive = 0
Endwith
Return (this.inhandle # 0)
Endproc
Enddefine
Function setmem
Lparameters nptr, csource
Declare RtlMoveMemory in WIN32API as RtlCopy ;
integer nDestBuffer, ;
string @pVoidSource, ;
integer nLength
RtlCopy(nptr, csource, len(csource))
Return .t.
Endfunc
Function getmem
Lparameters nptr, nlen
Declare RtlMoveMemory in WIN32API as RtlCopy ;
string @DestBuffer, ;
integer pVoidSource, ;
integer nLength
Local ubuffer
ubuffer = repl(chr(0),nlen)
=RtlCopy(@ubuffer, nptr, nlen)
Return ubuffer
Endfunc
Function getmemstring
Lparameters nptr, nsize
Declare integer lstrcpyn in WIN32API as StrCpyN ;
string @ lpDestString, ;
integer lpSource, ;
integer nMaxLength
Local ubuffer
If type('nSize') # 'N' or isnull(nsize)
nsize = 512
Endif
ubuffer = repl(chr(0), nsize)
If StrCpyN(@ubuffer, nptr, nsize-1) # 0
ubuffer = left(ubuffer, max(0,at(chr(0),ubuffer) - 1))
Else
ubuffer = null
Endif
Return ubuffer
Endfunc
Function shorttonum
Lparameter tcint
Local b0,b1,nretval
b0=asc(tcint)
b1=asc(subs(tcint,2,1))
If b1<128
nretval=b1 * 256 + b0
Else
b1=255-b1
b0=256-b0
nretval= -( (b1 * 256) + b0)
Endif
Return nretval
Endfunc
Function numtoshort
Lparameter tnnum
Local b0,b1,x
If tnnum>=0
x=int(tnnum)
b1=int(x/256)
b0=mod(x,256)
Else
x=int(-tnnum)
b1=255-int(x/256)
b0=256-mod(x,256)
If b0=256
b0=0
b1=b1+1
Endif
Endif
Return chr(b0)+chr(b1)
Endfunc
Function dwordtonum
Lparameter tcdword
Local b0,b1,b2,b3
b0=asc(tcdword)
b1=asc(subs(tcdword,2,1))
b2=asc(subs(tcdword,3,1))
b3=asc(subs(tcdword,4,1))
Return ( ( (b3 * 256 + b2) * 256 + b1) * 256 + b0)
Endfunc
Function numtodword
Lparameter tnnum
Return numtolong(tnnum)
Endfunc
Function wordtonum
Lparameter tcword
Return (256 * asc(subst(tcword,2,1)) ) + asc(tcword)
Endfunc
Function numtoword
Lparameter tnnum
Local x
x=int(tnnum)
Return chr(mod(x,256))+chr(int(x/256))
Endfunc
Function numtolong
Lparameter tnnum
Declare RtlMoveMemory in WIN32API as RtlCopyLong ;
string @pDestString, ;
integer @pVoidSource, ;
integer nLength
Local cstring
cstring = space(4)
=RtlCopyLong(@cstring, bitor(tnnum,0), 4)
Return cstring
Endfunc
Function longtonum
Lparameter tclong
Declare RtlMoveMemory in WIN32API as RtlCopyLong ;
integer @ DestNum, ;
string @ pVoidSource, ;
integer nLength
Local nnum
nnum = 0
=RtlCopyLong(@nnum, tclong, 4)
Return nnum
Endfunc
Function allocnetapibuffer
Lparameter nsize
If type('nSize') # 'N' or nsize <= 0
Return null
Endif
If ! 'NT' $ os()
Return null
Endif
Declare integer NetApiBufferAllocate in NETAPI32.dll ;
integer dwByteCount, ;
integer lpBuffer
Local nbufferpointer
nbufferpointer = 0
If NetApiBufferAllocate(int(nsize), @nbufferpointer) # 0
nbufferpointer = null
Endif
Return nbufferpointer
Endfunc
Function deallocnetapibuffer
Lparameter nptr
If type('nPtr') # 'N'
Return .f.
Endif
If ! 'NT' $ os()
Return .f.
Endif
Declare integer NetApiBufferFree in NETAPI32.dll ;
integer lpBuffer
Return (NetApiBufferFree(int(nptr)) = 0)
Endfunc
Function copydoubletostring
Lparameter ndoubletocopy
Declare RtlMoveMemory in WIN32API as RtlCopyDbl ;
string @DestString, ;
double @pVoidSource, ;
integer nLength
Local cstring
cstring = space(8)
=RtlCopyDbl(@cstring, ndoubletocopy, 8)
Return cstring
Endfunc
Function doubletonum
Lparameter cdoubleinstring
Declare RtlMoveMemory in WIN32API as RtlCopyDbl ;
double @DestNumeric, ;
string @pVoidSource, ;
integer nLength
Local nnum
nnum = 0.000000000000000000
=RtlCopyDbl(@nnum, cdoubleinstring, 8)
Return nnum
Endfunc
|
|
|
| 回頂端 |
|
|
bin1x
註冊時間: 2004-08-27
文章: 462
第 6 樓
|
| 發表於: 星期二 十月 18, 2005 4:10 pm 文章主題: |
|
|
又是一個神奇的人
先前不是有人在問指標嗎?
看這篇就可以找到一些東西了
難怪我資料結構不想回去修
看到頭都昏了
可不可以問一下
heap表 跟 記憶體空間配置,跟檔案目錄結構
有什麼關係,可提供文章教一下觀念嗎?
如果我記得沒錯的話
刪除好像是簡單地在檔名第一個字元置換@就可以了
rd 我就不知道了 |
|
| 回頂端 |
|
|
|
|
您 無法 在這個版面發表文章
您 無法 在這個版面回覆文章
您 無法 在這個版面編輯文章
您 無法 在這個版面刪除文章
您 無法 在這個版面進行投票
您 無法 在這個版面附加檔案
您 無法 在這個版面下載檔案
|
|
常見問題
搜尋
會員列表
會員群組
會員註冊
個人資料
登入檢查您的私人訊息
登入
