could the problem be related to the system32/cmd.exe privileges.
with win 10 blocking gamebase from running it.
thinking it was a threat or something.
also i could recompile the gemus.dll with any command-line based file extractor with command-line switches of your choice.
http://infozip.sourceforge.net/
it won't work for all archive types like 7z., but might be a temporary fix for win10 and ZIP files.
the offer is there is you want it.
the current gemus example...
Code: Select all
'Run 7z.exe.
With sInfo
.cbReserved2 = 0
.lpReserved2 = vbNull
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
.cb = Len(sInfo)
End With
' a add to archive
' -r recursive
' -y answer yes on all queries
' (7-zip help file recommends using long filenames, as short [8.3] ones may not work 100% of the time)
strCommandLine = m_strCommandCom & strExtractorPath_in & " a """ & strDestArchivePathFile_in & """ * -r -y"
Call LogStatus("Running 7-Zip [" & strCommandLine & "]")
lngRetVal = CreateProcess(sNull, strCommandLine, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
lngRetVal = WaitForSingleObject(pInfo.hProcess, INFINITE)
strDefaultError = " [" & strDestArchivePathFile_in & "] " & _
GetINIMessage("Running Games", "SevenZipRepackCommandFrom", "7-Zip repack command from") & _
" [" & strRepackFolder & "]:" & vbCrLf & vbCrLf & strCommandLine
'if the dest folder is there, it might have worked
If Not m_xobjFunc.FileExists(strDestArchivePathFile_in, False, "GEMUS") Then
strError_out = GetINIMessage("", "UnableToCreateArchive", "Unable to create archive") & strDefaultError
Call PopLogFileTrace
Exit Function
End If
'get a list file so the contents of the created archive can be compared to those that should have been added
strError_out = SevenZipList(strDestArchivePathFile_in, strRepackFolderWBS & "__gemus_repack_check.txt", lngNumFiles, a_strFiles)
If strError_out <> "" Then
strError_out = GetINIMessage("Running Games", "UnableToGetListOfArchiveContents", "Unable to get list of contents for repacked archive") & strDefaultError & vbCrLf & vbCrLf & strError_out
Call PopLogFileTrace
Exit Function
End If
'make sure all added files are in the archive
Call StoreRecursiveUnpackedFilesSnapshot(strRepackFolder)
For lngRecursiveIdx = 0 To m_lngTotalRecursiveUnpackedFilesSnapshot - 1
strItem = UCase$(ma_strRecursiveUnpackedFilesSnapshot(lngRecursiveIdx))
blnFound = False
For lngAddedIdx = 0 To lngNumFiles - 1
If UCase$(a_strFiles(lngAddedIdx)) = strItem Then
blnFound = True
Exit For
End If
Next lngAddedIdx
If Not blnFound Then
strError_out = GetINIMessage("Running Games", "RepackAbortedMissingFiles", "Repack aborted. Did not find all required files in the destination archive") & " " & strDefaultError
Call PopLogFileTrace
Exit Function
End If
Next lngRecursiveIdx
'successfully repacked
SevenZipRepackFolder = True
Call PopLogFileTrace
End Function
Public Sub StorePreUnpackedFilesSnapshot(strFolder_in As String)
Dim lngIdx As Long
Dim lngLen As Long
ReDim ma_udtPreUnpackedFilesSnapshot(0)
m_lngTotalPreUnpackedFilesSnapshot = 0
If strFolder_in = "" Then Exit Sub
Set m_xobjFuncPre = New GBFuncs.clsFunctions
Call m_xobjFuncPre.FindFiles(strFolder_in, "*.*") 'calls callback function
Set m_xobjFuncPre = Nothing
lngLen = Len(strFolder_in)
For lngIdx = 0 To m_lngTotalPreUnpackedFilesSnapshot - 1
With ma_udtPreUnpackedFilesSnapshot(lngIdx)
.strRelativePathFile = Right$(.strRelativePathFile, Len(.strRelativePathFile) - lngLen)
.strUCaseRelativePathFile = UCase$(.strRelativePathFile)
End With
Next lngIdx
End Sub
Public Sub StorePostUnpackedFilesSnapshot(strFolder_in As String)
Dim lngIdx As Long
Dim lngLen As Long
ReDim ma_udtPostUnpackedFilesSnapshot(0)
m_lngTotalPostUnpackedFilesSnapshot = 0
If strFolder_in = "" Then Exit Sub
Set m_xobjFuncPost = New GBFuncs.clsFunctions
Call m_xobjFuncPost.FindFiles(strFolder_in, "*.*") 'calls callback function
Set m_xobjFuncPost = Nothing
lngLen = Len(strFolder_in)
For lngIdx = 0 To m_lngTotalPostUnpackedFilesSnapshot - 1
With ma_udtPostUnpackedFilesSnapshot(lngIdx)
.strRelativePathFile = Right$(.strRelativePathFile, Len(.strRelativePathFile) - lngLen)
.strUCaseRelativePathFile = UCase$(.strRelativePathFile)
End With
Next lngIdx
End Sub
Public Sub StoreRecursiveUnpackedFilesSnapshot(strFolder_in As String)
Dim lngIdx As Long
Dim lngLen As Long
Dim strPathFile As String
ReDim ma_strRecursiveUnpackedFilesSnapshot(0)
m_lngTotalRecursiveUnpackedFilesSnapshot = 0
If strFolder_in = "" Then Exit Sub
Set m_xobjFuncRecursive = New GBFuncs.clsFunctions
Call m_xobjFuncRecursive.FindFiles(strFolder_in, "*.*") 'calls callback function
Set m_xobjFuncRecursive = Nothing
lngLen = Len(strFolder_in)
For lngIdx = 0 To m_lngTotalRecursiveUnpackedFilesSnapshot - 1
strPathFile = ma_strRecursiveUnpackedFilesSnapshot(lngIdx)
ma_strRecursiveUnpackedFilesSnapshot(lngIdx) = Right$(strPathFile, Len(strPathFile) - lngLen)
Next lngIdx
End Sub
Public Function IsFileASupportedArchiveFileType(strFile As String) As Boolean
IsFileASupportedArchiveFileType = IsFileMatchingFileTypes(strFile, ma_strUnpackableFileTypes)
End Function
Public Function IsFileARepackableArchiveFileType(strFile As String) As Boolean
IsFileARepackableArchiveFileType = IsFileMatchingFileTypes(strFile, ma_strRepackableFileTypes)
End Function
Public Function SevenZipUnpack(strExtractorPath_in As String, strPath_in As String, strFile_in As String, _
strDestPath_in As String) As Boolean
Dim sNull As String
Dim sInfo As STARTUPINFO
Dim pInfo As PROCESS_INFORMATION
Dim lngRetVal As Long
Dim strCommandLine As String
Call PushLogFileTrace("clsUnpack.SevenListUnpack")
'change to drive/directory containing archive
ChDrive strPath_in
ChDir strPath_in
Call LogStatus("Changed Directory to [" & strPath_in & "]")
'Run 7z.exe.
With sInfo
.cbReserved2 = 0
.lpReserved2 = vbNull
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
.cb = Len(sInfo)
End With
' x extract with full paths
' -y answer yes on all queries
' -r recurse directories
' -o output folder
' (7-zip help file recommends using long filenames, as short [8.3] ones may not work 100% of the time)
strCommandLine = m_strCommandCom & strExtractorPath_in & " x """ & strFile_in & """ -y -r -o""" & strDestPath_in & "\"""
Call LogStatus("Running 7-Zip [" & strCommandLine & "]")
lngRetVal = CreateProcess(sNull, strCommandLine, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
lngRetVal = WaitForSingleObject(pInfo.hProcess, INFINITE)
'if the dest folder is there, assume it worked
SevenZipUnpack = m_xobjFunc.DirExists(strDestPath_in)
Call PopLogFileTrace
End Function
