固件工程师目前正在进行企业漏洞攻击。好的，这是问题： 该程序在用VB6编写的Windows XP / 7中运行。该程序可以添加附件到部件号（它们是数据库中的键）。它通过公共文件对话框窗口添加附件。然后，它使用FileCopy将选定的文件复制到网络驱动器上的特定位置。如果用户决定从他桌面上的文件夹而不是桌面上的文件中复制，则他无法删除该文件夹，因为Windows 7会抛出“文件/文件夹正由另一个程序使用”。如果在程序关闭之后程序没有每次都关闭（有时只是为什么？），直到机器重新启动，这个问题就会发生。我确信有一个很好的方法来处理这个，因为其他程序一直都没有问题，我只是不知道那是什么方法。此外，我“找到”一个修复问题的注册表编辑，这些修复是不合适的。
好的代码如下。是的，我知道这是一个丑陋的混乱，不，我不需要提醒。我不是要求人们做我的作业，我只是需要一些关于VB6 / Windows方面的帮助。
Private Sub Command1_Click()
On Error GoTo Command1_Click_Error
Dim File_To_Copy As String
Dim File_To_Copy_Path As String
Dim strTargetF As String
Dim filethere As String
Dim fPath As String
Dim Type_Of_Part As String
Dim Long_File_To_Read As String
Dim File_To_Read As String
Dim pointer_to_remote As Long
Dim another_pointer_to_remote As String
Dim wnet_return_val As Long
Dim temp As String
Dim File_To_Write As String
Dim revert_to_self_return_val As Boolean
Dim Output_File_Var
Dim Input_File_Len
Dim temp_str As String
Me.txtComp.Text = Global_Company_Name
CommonDialog1.InitDir = "c:\"
If Len(Trim(Global_Part_Var)) = 5 Then
Type_Of_Part = "Part_Type_A"
Else
Type_Of_Part = Mid(Global_Part_Var, 1, 3)
If Type_Of_Part = "Part_Type_B" Then
Type_Of_Part = "Part_Type_C"
End If
End If
CommonDialog1.ShowOpen
CommonDialog1.CancelError = True
File_To_Copy = CommonDialog1.FileTitle
File_To_Copy_Path = CommonDialog1.FileName
If Err = cdlCancel Then
Exit Sub
End If
Err.Clear
If File_To_Copy = "" Or IsNull(File_To_Copy) Or File_To_Copy = Empty Then
Exit Sub
End If
strTargetF = File_To_Copy
'runasuser copy will not allow a path and file longer than 76 characters total..including drive and extension
If Len(File_To_Copy_Path) > 76 Then
DoMessage GetLangString(STRING_TOO_LONG) & CStr(Len(File_To_Copy_Path)) & vbCr & File_To_Copy_Path
Exit Sub
End If
fPath = PartsLinkPath & Type_Of_Part & "\" & Trim(Global_Part_Var) & "\" & "FAI_" & Company & "_" & lineinc
If Not (Mid(fPath, (Len(fPath)), 1) = "\") Then
fPath = fPath & "\"
End If
If Not DirExists(fPath) Then
Dim FolderToCreate
FolderToCreate = "Obscure_Proprietary_Business_Process_Name_" & Global_Company_Name & "_" & lineinc
RunAsUser SuperUser, SuperUserPassword, MyDomain, "C:\Windows\System32\cmd.exe /c ""mkdir """ & _
PartsLinkPath & Type_Of_Part & "\" & Trim(Global_Part_Var) & "\" & FolderToCreate, "c:\"
revert_to_self_return_val = RevertToSelf()
End If
Sleep SLEEP_1_SECOND 'wait for folder to be created
revert_to_self_return_val = RevertToSelf()
filethere = fPath & strTargetF
filethere = Dir(filethere)
'If the file is on the User's share on the H:\ drive, first copy it into C:\temp
If StrComp(UCase(Left(File_To_Copy_Path, 2)), "H:") = 0 Then
If Not DirExists(TEMP_FILE_LOC_STR) Then 'If C:\temp does not exist then create it
Dim temp_folder
temp_folder = TEMP_FILE_LOC_STR
RunAsUser SuperUser, SuperUserPassword, MyDomain, "C:\Windows\System32\cmd.exe /c ""mkdir "" " & _
TEMP_FILE_LOC_STR, "c:\"
revert_to_self_return_val = RevertToSelf()
Sleep SLEEP_1_SECOND 'wait for folder to be created
End If
temp_str = TEMP_FILE_LOC_STR & File_To_Copy
If FileExists(temp_str) Then 'delete the file from C:\temp if it exists
Kill temp_str
End If
FileCopy File_To_Copy_Path, temp_str
Sleep SLEEP_1_SECOND 'wait for file to be copied
File_To_Copy_Path = temp_str
End If
If IsNull(filethere) Or filethere = "" Then
Long_File_To_Read = File_To_Copy_Path
File_To_Read = GetShortFileName(File_To_Copy_Path, True)
If Left(File_To_Read, 2) Like "[F-Z][:]" Then
pointer_to_remote = lBUFFER_SIZE
another_pointer_to_remote = another_pointer_to_remote & Space(lBUFFER_SIZE)
wnet_return_val = WNetGetConnection32(Left(File_To_Read, 2), another_pointer_to_remote, pointer_to_remote)
temp = Trim(another_pointer_to_remote)
File_To_Read = GetShortFileName(Left(temp, Len(temp) - 1) + Right(File_To_Read, Len(File_To_Read) - 2), True)
End If
File_To_Copy_Path = Long_File_To_Read
If File_To_Copy_Path = "" Then
Exit Sub
End If
Input_File_Len = FileLen(File_To_Copy_Path)
File_To_Write = ParseOutputFilename("", File_To_Copy_Path)
Output_File_Var = fPath & "\" & File_To_Write
RunAsUser SuperUser, SuperUserPassword, MyDomain, "C:\Windows\System32\cmd.exe /c ""copy " + _
File_To_Read + " """ + fPath + Mid(File_To_Copy_Path, Len(fPath) + 1, 3) + _
"\" + Mid(File_To_Copy_Path, Len(fPath) + 1, 3) + File_To_Write + """""", "c:\"
Sleep SLEEP_1_SECOND 'wait for file to copy over
filethere = fPath & strTargetF
filethere = Dir(filethere)
Else
OpenFormYesNo = True
FormYesNo.lblMsgbox.Caption = strTargetF & GetLangString(STRING_ALREADY_EXISTS)
FormYesNo.Visible = True
FormYesNo.cmdNo.SetFocus
FormFAIData.ZOrder 0
FormYesNo.ZOrder 0
Do
If (FormCount("FormYesNo") > 0) Then
If (Screen.ActiveForm.Name <> "FormYesNo") And (OpenFormYesNo = True) Then
FormYesNo.cmdNo.SetFocus
End If
End If
DoEvents
Sleep SLEEP_TIME
Loop While FormCount("FormYesNo") > 0 And (OpenFormYesNo = True)
FormFAIData.ZOrder 0
If YesNo = vbYes Then
Long_File_To_Read = File_To_Copy_Path
File_To_Read = GetShortFileName(File_To_Copy_Path, True)
If Left(File_To_Read, 2) Like "[F-Z][:]" Then
pointer_to_remote = lBUFFER_SIZE
another_pointer_to_remote = another_pointer_to_remote & Space(lBUFFER_SIZE)
wnet_return_val = WNetGetConnection32(Left(File_To_Read, 2), another_pointer_to_remote, pointer_to_remote)
temp = Trim(another_pointer_to_remote)
File_To_Read = GetShortFileName(Left(temp, Len(temp) - 1) + Right(File_To_Read, _
Len(File_To_Read) - 2), True)
End If
File_To_Copy_Path = Long_File_To_Read
If File_To_Copy_Path = "" Then
Exit Sub
End If
Input_File_Len = FileLen(File_To_Copy_Path)
File_To_Write = ParseOutputFilename("", File_To_Copy_Path)
Output_File_Var = fPath & "\" & File_To_Write
RunAsUser SuperUser, SuperUserPassword, MyDomain, "C:\Windows\System32\cmd.exe /c ""copy " + _
File_To_Read + " """ + fPath + Mid(File_To_Copy_Path, Len(fPath) + 1, 3) + _
"\" + Mid(File_To_Copy_Path, Len(fPath) + 1, 3) + File_To_Write + """""", "c:\"
Sleep SLEEP_1_SECOND 'wait for file to be copied
filethere = fPath & strTargetF
filethere = Dir(filethere)
Else
DoMessage GetLangString(STRING_USER_ENDED)
End If
End If
Sleep SLEEP_1_SECOND
filethere = fPath & strTargetF
filethere = Dir(filethere)
Dim Output_File_Len
Output_File_Len = FileLen(Output_File_Var)
Close 'Close all open files
If Not Input_File_Len = Output_File_Len Then
DoMessage GetLangString(STRING_NOT_COPIED)
Else
DoMessage GetLangString(STRING_FILE_COPIED)
End If
Exit Sub
Command1_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command1_Click of Form Purposely_Changed_Form_Name"
End Sub
编辑：添加了源代码。第二次编辑，修复了一个变量名。第三次编辑，删除“关闭#fileno”语句（这是错误的），在结束时添加了Close语句，并删除了“On Error Resume Next”语句。
答案 0 :(得分：1)
@jac，你是对的，这是Common Dialog的一个问题。看一个相关的问题，我在这里找到了答案：
http://www.xtremevbtalk.com/showthread.php?t=228622
修复是在程序退出时调用ChDir("C:\my_favorite_file_path")。如果是当前工作目录，Windows显然会锁定您搜索的文件夹。要解决这个问题，您只需更改当前的工作目录即可。
感谢您对@jac的所有帮助，VB6对业务线应用程序的支持绝对不是我的强项，但看起来我将在未来一年中做很多或两个。
编辑：格式化
答案 1 :(得分：0)
我想我很久以前就记得遇到过这个问题，我相信我认为这与常见的对话框控件有关。至少我认为这就是我编写一个使用 SHBrowseForFolder API函数来选择文件的函数的原因。随意使用或不使用，但它将避免您遇到的问题。该函数返回文件名，如果未选择文件则返回空字符串。我希望我得到了示例代码中的所有声明，我从更大的通用实用程序模块中删除了部分。
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Any) As Long
Private Const BIF_INITIALIZED = 1
Private Const BIF_SELCHANGED = 2
Private Const WM_USER = &H400
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
Private Const BIF_EDITBOX = &H10
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH = 260
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const ERROR_SHARING_VIOLATION = 32&
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private mstrInitDir As String 'holds the path from the getfolder function
Private mstrFindFile As String 'holds the filename from the getfolder function
Public Function BrowseForFolder(ByVal hwndOwner As Long, ByVal sDefaultPath As String, ByVal sFindFile As String, _
Optional ByVal sTitle As String = "Select Folder", Optional ByVal ShowMsg As Boolean = True, Optional ShowFiles As Boolean = True) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
Dim MSG As String
mstrInitDir = sDefaultPath & vbNullChar
mstrFindFile = sFindFile
If ShowMsg = True Then
'display what's happening to the user
MSG = ProgramTitle & " was unable to find the file, '" & sFindFile & "'. " _
& "Please use the following dialog box to set path to this file." _
& vbCrLf & vbCrLf & "If this path is not set " _
& ProgramTitle() & " will be unable to continue."
MsgBox MSG, vbOKOnly + vbInformation, "File Not Found"
End If
'give the user the box
szTitle = sTitle
With tBrowseInfo
.hwndOwner = hwndOwner
.lpszTitle = szTitle 'lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_STATUSTEXT '
If ShowFiles = True Then
.ulFlags = .ulFlags Or BIF_BROWSEINCLUDEFILES
End If
.pidlRoot = 0
.lpfnCallback = GetAddressOf(AddressOf BrowseCallBack)
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
End If
End Function
Private Function BrowseCallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim Rtn As Long
Dim sBuffer As String * MAX_PATH
Dim strPath As String
On Error Resume Next 'attempt to prevent error propagation to caller
Select Case uMsg
Case Is = BIF_SELCHANGED
sBuffer = Space$(MAX_PATH)
Rtn = SHGetPathFromIDList(lParam, sBuffer)
If Rtn = 1 Then
If Len(mstrFindFile) > 1 Then
strPath = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
If FileExists(strPath & mstrFindFile) = True Then
Rtn = SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, ByVal (mstrFindFile & " found!" & vbNullChar))
Else
Rtn = SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, ByVal ("not found, " & mstrFindFile))
End If
Else
Rtn = SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, ByVal FormatPath(sBuffer))
End If
End If
Case Is = BIF_INITIALIZED
Rtn = SendMessage(hwnd, BFFM_SETSELECTION, 1, ByVal (mstrInitDir))
End Select
End Function
Function FileExists(ByVal fSpec As String) As Boolean
Dim lngResult As Long
Dim udtSA As SECURITY_ATTRIBUTES
On Error GoTo errFileExists
If Len(fSpec) > 0 Then
udtSA.nLength = Len(udtSA)
udtSA.bInheritHandle = 1&
udtSA.lpSecurityDescriptor = 0&
lngResult = CreateFile(fSpec, GENERIC_READ, FILE_SHARE_READ, udtSA, OPEN_EXISTING, 0&, 0&)
If lngResult <> INVALID_HANDLE_VALUE Then
Call CloseHandle(lngResult)
FileExists = True
Else
Select Case Err.LastDllError 'some errors may indicate the file exists, but there was an error opening it
Case Is = ERROR_SHARING_VIOLATION
FileExists = True
Case Else
FileExists = False
End Select
End If
End If
Exit Function
errFileExists:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Function
Private Function GetAddressOf(ByVal lpAddr As Long) As Long
GetAddressOf = lpAddr
End Function
Public Function ProgramTitle() As String
Dim sDefaultTitle As String
On Error GoTo errProgramTitle
sDefaultTitle = StrConv(App.EXEName, vbProperCase)
ProgramTitle = IIf(Len(App.ProductName) > 0, App.ProductName, sDefaultTitle)
Exit Function
errProgramTitle:
ProgramTitle = sDefaultTitle
End Function
'format a path to look like C:\Windows\Folder from c:\windows\folder
Public Function FormatPath(ByVal Path As String) As String
Dim sReturn As String
Dim sCurChar As String * 1
Dim sLastChar As String * 1
Dim i As Integer
For i = 1 To Len(Trim$(Path))
sCurChar = Mid$(Path, i, 1)
If sLastChar = vbNullChar Then
sReturn = StrConv(sCurChar, vbUpperCase)
ElseIf sLastChar Like "[/\: ]" Then
sReturn = sReturn & StrConv(sCurChar, vbUpperCase)
Else
sReturn = sReturn & StrConv(sCurChar, vbLowerCase)
End If
sLastChar = sCurChar
Next i
FormatPath = sReturn
End Function
答案 2 :(得分：0)
奇怪的是，在程序结束时放Close并没有解决问题。我认为它是奇怪的Win7和VB6交互的组合。不幸的是，这不是一个真正的答案，为什么这种行为正在发生，但我需要继续前进并处理其他事情。所以这是我的妥协：
如果查看上面的代码，您将看到RunAsUser无法接受超过76个字符的文件路径。最终用户意识到了这一点;所以他们会从网络上的某个地方将相关文件夹复制到桌面并附加文件。我将上面的代码更改为始终将文件复制到C：\ temp中，然后将其提供给RunAsUser。 （而不是仅将其复制到C; \ temp，如果它来自H :)然后从C：\ temp中删除它。这样一来，没有人必须将任何内容复制到他们的桌面上，他们可以从网络上的任何地方选择相关文件，程序会先将其复制到temp，然后将其复制到限制区域，然后从temp中删除文件。如果他们适当地使用该程序，这最终会为最终用户节省一些时间和精力。