VFP 愛用者社區 :: 觀看文章 - 刪除目錄及其所有子目錄及文件到回收站(有動畫)（內有指針函數、字符轉換函數）

VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.

常見問題

搜尋

會員列表

會員群組

會員註冊

個人資料

登入檢查您的私人訊息

登入

刪除目錄及其所有子目錄及文件到回收站(有動畫)（內有指針函數、字符轉換函數）

VFP 愛用者社區首頁 -> VFP 討論區

發表人

內容

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2160

第 1 樓

發表於: 星期五九月 01, 2006 4:49 pm 文章主題: 刪除目錄及其所有子目錄及文件到回收站(有動畫)（內有指針函數、字符轉換函數）

資料來源: VFP天堂論壇 http://foxtiantang.vicp.net/dispbbs.asp?boardid=8&replyid=3305&id=2046&page=1&skin=0&Star=4

代碼:

* 刪除目錄及其所有 (含子目錄及文件) 到資源回收桶
* 已修正一些原出處的錯誤..garfield
Clea
? deltree("c:\tttt")
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 64
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) + 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

_________________
利用>>搜尋<<的功能會比問的還要快得到答案.

garfield 在星期二五月 05, 2009 12:00 pm 作了第 1 次修改

回頂端

區榮熾

註冊時間: 2005-11-14
文章: 191

第 2 樓

發表於: 星期二五月 05, 2009 10:47 am 文章主題: 經測試,不成功(宣告 DLL造成例外)

套用: Clea ? deltree("H:\Ggprg_e\Ggprg_e") Clea dlls Return

回頂端

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2160

第 3 樓

發表於: 星期二五月 05, 2009 12:01 pm 文章主題:

再次修正, 已可以正常deltree _________________ 利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

區榮熾

註冊時間: 2005-11-14
文章: 191

第 4 樓

發表於: 星期三五月 06, 2009 8:21 am 文章主題:

garfield 寫到:

再次修正, 已可以正常deltree

謝謝 garfield 兄的幫助,多了一支工具程式.....
確定已可執行,謝謝!(唯因不接受刪除空的目錄,所以我的困擾仍未沒解決)
&& DELTREE 不能刪除空的目錄(所有可用的......DELETE, Shift+Delete, Ctrl+X....,且進到XPE 也都砍不掉),沒法了,最後就要FORMAT了......... :(

回頂端

區榮熾

註冊時間: 2005-11-14
文章: 191

第 5 樓

發表於: 星期三五月 06, 2009 11:44 am 文章主題:

garfield 寫到:

再次修正, 已可以正常deltree

沒錯,很好用....
我加上一傳遞參數,簡化執行,祗改參數(要刪除的正確路徑)就可以了..
Lparameter cTreename && 完整路徑

Local cName
cName = cTreename
? Deltree((cName))
Clear Dlls
Return
*******************
使用時 DO Deltree.prg With cTreename
祗要變更 cTreename值就行了,很方便
謝謝 garfield

回頂端

從之前的文章開始顯示:

	VFP 愛用者社區首頁 -> VFP 討論區	所有的時間均為台北時間 (GMT + 8 小時)
第1頁(共1頁)

您無法在這個版面發表文章
您無法在這個版面回覆文章
您無法在這個版面編輯文章
您無法在這個版面刪除文章
您無法在這個版面進行投票
您無法在這個版面附加檔案
您無法在這個版面下載檔案