Показать сообщение отдельно
Старый 23.08.2005, 06:54     # 9
UriF
Member
 
Регистрация: 20.05.2004
Сообщения: 385

UriF Луч света в тёмном царствеUriF Луч света в тёмном царствеUriF Луч света в тёмном царствеUriF Луч света в тёмном царствеUriF Луч света в тёмном царстве
Перелистал форум и увидел, что могу дать любопытное решение, тем более что эта API действительно обходит защиту Windows (сам бился над этой проблемой пару лет назад ок. 3-х месяцев - надо было копировать .doc, открытые MS Word - ничего не помогало). Так что дал, так сказать, для будущих читателей

Если Вас это интересует, то вот этот код с этой API

Public Function WinCopyFile(SourceFile As String, DestFile As String) As Long
'---------------------------------------------------------------
' PURPOSE: Copy a file on disk from one location to another.
' ACCEPTS: The name of the source file and destination file.
' RETURNS: Nothing
'---------------------------------------------------------------
Dim Result As Long
If Dir(SourceFile) = "" Then
Result = 0
Else
Result = apiCopyFile(SourceFile, DestFile, False)
End If

WinCopyFile = Result
End Function

А это код для удаления файлов, которые не хотят удаляться


Public Type SHFILEOPSTRUCT
hwnd As Long 'handle to a window, can be 0
wFunc As Long 'one of the 4 available constants shown later
pFrom As String 'string indicating a path to the file that function will work on (must be zero terminated)
pTo As String 'string indicating the resulting file after operation
fFlags As Integer 'shown later
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long ' only used if FOF_SIMPLEPROGRESS
End Type

Public Const FO_COPY = &H2 'copy operation
Public Const FO_DELETE = &H3 'delete operation
Public Const FO_MOVE = &H1 'move operation
Public Const FO_RENAME = &H4 'rename operation, don't use with multiple files


'fFlags can be one of the following constants:

Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_FILESONLY = &H80
Public Const FOF_MULTIDESTFILES = &H1 'The pTo member specifies multiple destination files (one for each source file) rather 'than one directory where all source files are to be deposited
Public Const FOF_NOCONFIRMATION = &H10 'Respond with "Yes to All" for any dialog box that is displayed.
Public Const FOF_NOCONFIRMMKDIR = &H200 'Do not confirm the creation of a new directory if the operation requires one to be 'created.
Public Const FOF_RENAMEONCOLLISION = &H8 'Give the file being operated on a new name in a move, copy, or rename 'operation if a file with the target name already exists
Public Const FOF_SILENT = &H4 'Do not display a progress dialog box
Public Const FOF_SIMPLEPROGRESS = &H100 'Display a progress dialog box but do not show the file names.
Public Const FOF_WANTMAPPINGHANDLE = &H20

Public Declare Function SHFileOperation Lib "shell32.dll" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const OFS_MAXPATHNAME = 128
Public Const OF_EXIST = &H4000

Public Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type

Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long


Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long


Public Function DoesFileExist(NameOfFile As String) As Boolean
Dim X As Long
Dim wStyle As Long
Dim Buffer As OFSTRUCT
Dim IsThere As Long

If (Len(NameOfFile) = 0) Or (InStr(NameOfFile, "*") > 0) Or (InStr(NameOfFile, "?") > 0) Then
DoesFileExist = False
Exit Function
End If
On Error GoTo NoSuchFile

X = OpenFile(NameOfFile, Buffer, OF_EXIST)

If X < 0 Then
GoTo CheckForError
Else
DoesFileExist = True
Exit Function
End If
CheckForError:
X = Buffer.nErrCode
If X = 3 Then
GoTo NoSuchFile
End If

NoSuchFile:
DoesFileExist = False
ExitFileExist:
On Error GoTo 0
End Function

'First Version
Public Function DeleteFIleAPI(sFilename As String, bSilent As Boolean, AllowRecycle As Boolean) As Boolean
'recycles the file specified in sFilename
On Error GoTo er
Dim X As Long
Dim rc As Long
Dim shfo As SHFILEOPSTRUCT
bSilent = True
If DoesFileExist(sFilename) Then
X = DeleteFile(sFilename)
End If
DeleteFIleAPI = CBool(X)
Exit Function

er: DeleteFIleAPI = False
End Function

'Second Version
Public Function DeleteFIleAPI(sFilename As String, bSilent As Boolean, AllowRecycle As Boolean) As Boolean
'recycles the file specified in sFilename
On Error GoTo er
'Dim X As Long
Dim rc As Long
Dim shfo As SHFILEOPSTRUCT
bSilent = True
If DoesFileExist(sFilename) Then
With shfo
.wFunc = FO_DELETE 'set the flag to delete the file
.pFrom = sFilename & Chr$(0) 'zero terminate file name
If AllowRecycle Then
.fFlags = FOF_SILENT + FOF_ALLOWUNDO + FOF_NOCONFIRMATION 'some additional flags
Else
.fFlags = FOF_SILENT + FOF_NOCONFIRMATION 'some additional flags
End If
'check if we want silent or with progress bar delete
If Not bSilent Then .fFlags = .fFlags + FOF_SIMPLEPROGRESS
End With
'perform the operation
'X = SHFileOperation(shfo)
DeleteFIleAPI = (SHFileOperation(shfo) = 0)
End If
Exit Function

er: DeleteFIleAPI = False
End Function

Впрочем, модератор может удалить этот пост

Последний раз редактировалось UriF; 23.08.2005 в 07:03.
UriF вне форума