用VLISP删除文件，如何放到垃圾箱里面，而不是永久删除？

Lisphk · 发表于 2017-6-6 22:39:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

用VLISP删除文件，如何放到垃圾箱里面，而不是永久删除？
用 vl-file-delete 是把文件永久删除了。

ayl1004 · 发表于 2017-6-10 20:57:39

应该是把文件移动到垃圾箱里

/db_自贡黄明儒_ · 发表于 2017-6-11 13:33:28

本帖最后由 /db_自贡黄明儒_ 于 2017-6-11 13:34 编辑

这个好像办不到。当时G版写了一个程序，不断用时间为文件名来保存，经使用，一旦崩溃，这些产生的文件也全部消失。Highflybird大师，清除cad垃圾文件的程序中，办到了移到“回收站”中，可能不是用的lisp语言。我希望Highflybird把这个函数独立出来，然后我加载当一个函数使用，结果Highflybird没回

ayl1004 · 发表于 2017-6-11 16:24:47

文件系统对象有移动的方法

st788796 · 发表于 2017-6-11 16:26:43

ayl1004 发表于 2017-6-11 16:24

回收站是含有特殊字符的文件夹，moveFile 不支持

marting · 发表于 2017-6-11 16:32:08

(defun recycle (filespec / shell folder items file)
(defun getobject (progid)
(vla-getinterfaceobject (vlax-get-acad-object) progid)
)
(defun extract-filename (pathstr)
(strcat (vl-filename-base pathstr)
(vl-filename-extension pathstr)
)
)
(defun release (objlist)
(mapcar
'(lambda (obj)
(if (not (vlax-object-released-p obj))
(vlax-release-object obj)
)
)
(if (listp objlist)
objlist
(list objlist)
)
)
)
(setq invoke vlax-invoke-method)
(setq shell (getobject "Shell.Application"))
(setq folder
(invoke shell
'NameSpace
(vl-filename-directory filespec)
)
)
(setq items (invoke Folder 'Items))
(setq file (invoke items 'item (extract-filename filespec)))
(invoke file 'InvokeVerbEx "&Delete")
(release (list file items folder shell))
nil
)

(defun recycle (filespec / shell folder items file) 
  (defun getobject (progid) 
    (vla-getinterfaceobject (vlax-get-acad-object) progid) 
  ) 
  (defun extract-filename (pathstr) 
    (strcat (vl-filename-base pathstr) 
            (vl-filename-extension pathstr) 
    ) 
  ) 
  (defun release (objlist) 
    (mapcar 
      '(lambda (obj) 
         (if (not (vlax-object-released-p obj)) 
           (vlax-release-object obj) 
         ) 
       ) 
      (if (listp objlist) 
        objlist 
        (list objlist) 
      ) 
    ) 
  ) 
  (setq invoke vlax-invoke-method) 
  (setq shell (getobject "Shell.Application")) 
  (setq folder 
         (invoke shell 
                 'NameSpace 
                 (vl-filename-directory filespec) 
         ) 
  ) 
  (setq items (invoke Folder 'Items)) 
  (setq file (invoke items 'item (extract-filename filespec))) 
  (invoke file 'InvokeVerbEx "&Delete") 
  (release (list file items folder shell)) 
  nil 
)

以前收的一段代码，使用 (invoke file 'InvokeVerbEx "&Delete") ，"&Delete" 可以删除到回收站，但是这个和操作系统语言相关，&Delete 可以在英文WIN下执行，中文试了，不行，不知道哪位高手知道在中文WIN下，这个删除的上下文 &Delete 该怎么写？

上面代码的&Delete 如果改成 Delete，是执行永久删除的。

st788796 · 发表于 2017-6-11 16:56:17

marting 发表于 2017-6-11 16:32

中文版windows这样改下试试

(invoke file 'InvokeVerb "Delete")

复制代码

marting · 发表于 2017-6-11 17:06:37

本帖最后由 marting 于 2017-6-11 17:09 编辑

st788796 发表于 2017-6-11 16:56

OK了，行了

marting · 发表于 2017-6-11 17:14:43

本帖最后由 marting 于 2017-6-11 17:21 编辑

st788796 发表于 2017-6-11 16:56

有个问题，如果回收站属性设置了删除提示，如何把这个提示选项去掉，删除到回收站后再把属性改回来。

ActiveX有方法吗？应该是保存在注册表里面吧，哪个值呢？

QQ截图20170611171346.png

st788796 · 发表于 2017-6-11 17:31:46

本帖最后由 st788796 于 2017-6-11 18:59 编辑

有办法，需要使用wmi备份一个键值，删除前修改，完成后恢复
HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer 键下 ShellState，这个值是 DWORD 二进制，把第四个改成 39

Function vFn_File_Recycle (vFilePath)
'Sends the file 'vFilePath' to the recycle bin without any delete confirmation. Returns 0 for no
'error, else returns the Err.Number.
'---------------------------------------------------------------------------------------------------
On Error Resume Next
'VERIFY FILE EXISTS
Set f_ObjFSO = CreateObject("Scripting.FileSystemObject")
If Not f_ObjFSO.FileExists(vFilePath) Then vExists = 0 Else vExists = 1
'CONTINUE IF FILE EXISTS
If vExists = 1 Then
'BACKUP CURRENT USER RECYCLE BIN SETTINGS
Set f_ObjReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
f_ObjReg.GetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vStateArr
vBackupState = vStateArr
vStateArr(4) = 39
f_ObjReg.SetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vStateArr
'INVOTE SHELL APPLICATION DELETE COMMAND
Set f_ObjShell = CreateObject("Shell.Application").NameSpace(0).ParseName(vFilePath).InvokeVerb("delete")
'RESTORE USER RECYCLE BIN SETTINGS
f_ObjReg.SetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vBackupState
End If
'CHECK FOR ERRORS AND CLOSE THE FUNCTION
If Err.Number <> 0 Then vFn_File_Recycle = 0 Else vFn_File_Recycle = Err.Number
On Error Goto 0
End Function

Function vFn_File_Recycle (vFilePath) 
'Sends the file 'vFilePath' to the recycle bin without any delete confirmation. Returns 0 for no 
'error, else returns the Err.Number. 
'--------------------------------------------------------------------------------------------------- 
  On Error Resume Next 
  'VERIFY FILE EXISTS 
    Set f_ObjFSO = CreateObject("Scripting.FileSystemObject") 
      If Not f_ObjFSO.FileExists(vFilePath) Then vExists = 0 Else vExists = 1 
  'CONTINUE IF FILE EXISTS 
    If vExists = 1 Then 
    'BACKUP CURRENT USER RECYCLE BIN SETTINGS 
      Set f_ObjReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 
        f_ObjReg.GetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vStateArr 
        vBackupState = vStateArr 
        vStateArr(4) = 39 
        f_ObjReg.SetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vStateArr 
    'INVOTE SHELL APPLICATION DELETE COMMAND 
      Set f_ObjShell = CreateObject("Shell.Application").NameSpace(0).ParseName(vFilePath).InvokeVerb("delete") 
    'RESTORE USER RECYCLE BIN SETTINGS 
        f_ObjReg.SetBinaryValue &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", vBackupState 
      End If 
  'CHECK FOR ERRORS AND CLOSE THE FUNCTION 
    If Err.Number <> 0 Then vFn_File_Recycle = 0 Else vFn_File_Recycle = Err.Number 
    On Error Goto 0 
  End Function

账号		自动登录	找回密码
密码			立即注册

[求助] 用VLISP删除文件，如何放到垃圾箱里面，而不是永久删除？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

评分