0

ファームウェア エンジニアは、現在エンタープライズ バグ ハンティングを行っています。ここに問題があります。プログラムは、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

編集: ソースコードを追加しました。2 回目の編集で、変数名を修正しました。3 番目の編集では、"Close #fileno" ステートメントを削除し (これは間違っていました)、最後に Close ステートメントを追加し、"On error Resume Next" ステートメントを削除しました。

4

3 に答える 3

0

奇妙なのはClose、手順の最後に配置しても問題が解決しなかったことです。Win7 と VB6 の奇妙な相互作用の組み合わせだと思います。残念ながら、これはその動作が発生した理由についての本当の答えではありませんが、先に進んで他の問題に対処する必要があります. だからここに私の妥協があります：

上記のコードを見ると、RunAsUser が 76 文字を超えるファイルパスを受け入れることができないことがわかります。エンドユーザーはそれを認識していました。そのため、ネットワーク上のどこかから関連するフォルダーをデスクトップにコピーし、そこからファイルを添付します。上記のコードを変更して、ファイルを常にC:\temp にコピーし、それを RunAsUser にフィードしました。(H: から来た場合、C;\temp にコピーするだけではなく) 次に、C:\temp から削除します。この方法では、最初からデスクトップに何かをコピーする必要はありません。ネットワーク上のどこからでも関連するファイルを選択できます。プログラムは最初にそれを一時ファイルにコピーし、次にそれを制限された領域にコピーし、次に一時ファイルからファイルを削除します。 . これにより、エンド ユーザーがプログラムを適切に使用すれば、時間と労力を節約できます。

于 2013-10-21T14:22:07.413 に答える
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
于 2013-10-18T22:07:31.710 に答える