Firmware Engineer currently doing Enterprise bug hunting. Ok here's the issue: The program runs in windows XP/7 written in VB6. The program can add attachments to part numbers (which are keys in a database.) It adds attachments through the common file dialog window. Then it copies the file chosen to a specific place on the network drive with FileCopy. If a user decides to copy from a folder on his desktop instead of a file on his desktop he cannot delete the folder because Windows 7 throws the "the file/folder is in use by another program." This issue happens if the Program is not closed every time and sometimes (?? why only sometimes ??) after the Program is closed until the machine is rebooted. I'm sure there is a good way of handling this, because other programs do it all the time without issue, I just don't know what that appropriate way is. Also I "found" a registry edit that fixes the issue, fixes like that are not appropriate.
Alright the code is below. Yes I'm aware that its an ugly mess and no I don't need a reminder on that. I'm not trying to ask people to do my homework, I just legitimately need some help on the VB6/Windows side of things.
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
Edit: Added source code. Second edit, fixed a variable name. Third edit, removed "Close #fileno" statement (which was wrong), added Close statement at end, and removed "On error Resume Next" statement.
@jac, you're right it is a problem with Common Dialog. Looking into a related problem, I found an answer here:
http://www.xtremevbtalk.com/showthread.php?t=228622
The fix is to call ChDir("C:\my_favorite_file_path") when the Procedure exits. Windows will apparently lock a folder that you searched in if its the current working directory. To get around this you simply have to change the current working directory.
Thanks for all your help @jac, VB6 support for line of business applications definitely isn't my forte, but it looks like I'm going to be doing alot of it in the coming year or two.
edit: formatting