i will try my best to explain much as i can and make one example,i will also add attachment to needed files .dat zipped up and 3 sample zip to work with.
let me show you a sample of file struction inside .dat file we are comparing.
when searching for the zip file remove the extension so its like dinorex .dat file sample extracted
Now if all dinorex.zip contents match with all the .dat file then create a good folder and move that zip in their.
Now this is what i have.
Code:
Dim xx As Integer
Set sh = CreateObject("shell.application")
Set n = sh.NameSpace(App.Path & "\New folder\")
For Each i In n.Items
Set nn = sh.NameSpace(App.Path & "\New folder\" & i)
For Each ii In nn.Items
If ii = "687_l03.10a" Then
List1.AddItem ii
End If
Next
Next
Where you se 687_l03.10a i need to replace with ii and loop through .dat file provided and se if it matches all zip and if it does then move zip to good folder.
if it don't match then move zip to bad folder.
tricky part is if one file matches and others are missing how do you tell the app what to do am still learning so excuse me.
Here is a code to get 1 zip file contents populated into list1 by it's name
Code:
RichTextBox1.Text = ""
RichTextBox2.Text = ""
Dim TextFileData As String, MyArray() As String, i As Long
Dim mMyArray() As String, ii As Long
Dim iii As Long
Dim xa As String
Dim output() As String, outputt() As String
Open App.Path & "\FB Alpha v0.2.97.30.dat" For Binary As #1
TextFileData = Space$(LOF(1))
Get #1, , TextFileData
Close #1
MyArray() = Split(TextFileData, Text1.Text)
For i = 0 To UBound(MyArray())
If InStr(MyArray(i), "dinorex") Then
xa = GetBetween(MyArray(i), Text2.Text, Text3.Text)
output = Split(xa, Text5.Text)
outputt = Split(output(0), Text6.Text)
Text7.Text = outputt(0)
If outputt(0) = "dinorex" Then
End If
End If
Next
On Error Resume Next
For ii = 0 To UBound(MyArray())
mMyArray() = Split(xa, "/>")
RichTextBox2.Text = RichTextBox2.Text & GetBetween(mMyArray(ii), Text9.Text, Text10.Text) & vbNewLine
Next
text9.text = rom name="
text10.text= " single quotation
text1.text= <game
text2.text = name="
text3.text = </game>
text9.text = rom name="
text7.text = blank
text5.text = <game name="
text6.text = " single quotation
Code:
Public Function GetBetween(ByRef sSearch As String, ByRef sStart As String, ByRef sStop As String, _
Optional ByRef lSearch As Long = 1) As String
lSearch = InStr(lSearch, sSearch, sStart)
If lSearch > 0 Then
lSearch = lSearch + Len(sStart)
Dim lTemp As Long
lTemp = InStr(lSearch, sSearch, sStop)
If lTemp > lSearch Then
GetBetween = Mid$(sSearch, lSearch, lTemp - lSearch)
End If
End If
End Function
so to summerise all i just place the zip files in app path with .dat and press a button and it should scan every single one of them.
matched zip files goes to good folder and un-matched still missing files go to bad folder.
.dat file https://filebin.net/hd6x13z0fts5l792...zip?t=o2ll1uf4
extract it after downloaded
As already said in your other post, the answer to your constantly shifting "Filter-GoalPosts"
lies in using SQL for that kind of stuff.
I've posted a demo for that already.
Now, I've:
- simply placed your additional 4 Zip-Files im my Demo-Folder
- and then ran the following SQL-query:
Select Distinct ParentName From ZipContents
Where (Select Content From ZipContents Where RelZipName Like '*.dat*' Limit 1)
Glob ('*' || RelZipName || '*')
The answer I've got was "5 (Parent)-ZipFiles" with the following names:
As already said in your other post, the answer to your constantly shifting "Filter-GoalPosts"
lies in using SQL for that kind of stuff.
I've posted a demo for that already.
Now, I've:
- simply placed your additional 4 Zip-Files im my Demo-Folder
- and then ran the following SQL-query:
Select Distinct ParentName From ZipContents
Where (Select Content From ZipContents Where RelZipName Like '*.dat*' Limit 1)
Glob ('*' || RelZipName || '*')
The answer I've got was "5 (Parent)-ZipFiles" with the following names:
Select Distinct ParentName From ZipContents
Where (Select Content From ZipContents Where RelZipName Like '*.dat*' Limit 1)
Glob ('*' || RelZipName || '*')
the executed code shown what exactly is it asking to do,is it comparing zip file contents with .dat file to se if all files exist in zip.
If I understood your recent posts correctly, I think this demo might be close enough to what you're trying to do. The demo parses the dat file (which is actually an XML file) using SAX2 rather than the GetBetween function you're using. The demo places each zip file listed in the dat file in 1 of 3 ListBoxes depending on whether its contained files match perfectly with the files specified in the dat file or not (Complete lists all zip files with a perfect match, Unprocessed lists all zip files that were unprocessed for whatever reason [e.g., nonexistent zip files] and Mismatched Files lists all zip files with either missing or has extra files). The demo doesn't physically move any zip file to any folder; I will leave that task up to you (it's easy enough to modify the source code to accomplish that).
Code:
Implements IVBSAXContentHandler
Private m_FileNamesUB As Long
Private m_FileNames() As String
Private m_ZipFileName As String
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
Const CDFH_SIGNATURE = &H2014B50, EOCD_SIGNATURE = &H6054B50, EFS = &H800 'EFS - Language encoding flag
Dim FN As Integer, I As Long, J As Long, K As Long, Pos As Long
Dim sFileName As String, CDFH As CDFH, EOCD As EOCD
If strLocalName <> "game" Then Exit Sub
FN = FreeFile
sFileName = txtPath.Text
sFileName = Left$(sFileName, InStrRev(sFileName, "\")) & m_ZipFileName 'Build a fully-qualified filename from the specified DatFile and ZIP filename
On Error GoTo 1
If (GetAttr(sFileName) And vbDirectory) <> vbDirectory Then 'Must verify the zip file already exists because Open For Binary will create it if missing
Open sFileName For Binary Access Read Lock Write As FN
Pos = LOF(FN) + 1& 'Must add 1 because the Get statement is 1-based
For Pos = Pos - 22& To Pos - &H10015 Step -1& 'Scan the file backwards starting from (LOF - EOCD min size) to (LOF - EOCD max size)
Get FN, Pos, EOCD.Signature
If EOCD.Signature = EOCD_SIGNATURE Then Exit For
Next
If EOCD.Signature = EOCD_SIGNATURE Then
Get FN, Pos, EOCD
Pos = EOCD.CDStartOffset + 1& 'Must add 1 because the Get statement is 1-based
Do While EOCD.DiskCDRecords 'Examine all central directory records on this disk
Get FN, Pos, CDFH
If CDFH.Signature = CDFH_SIGNATURE Then
If (CDFH.ExtFileAttribs And vbDirectory) <> vbDirectory Then 'If not a folder
If (CDFH.GPFlag And EFS) = 0 Then 'If filename (and comment) are in the original ZIP character encoding (IBM Code Page 437)
SysReAllocStringLen VarPtr(sFileName), , CDFH.FileNameLen
Get FN, Pos + 46&, sFileName
Else
'TODO: Add support for UTF-8 filenames
End If
I = InStrRev(sFileName, "/") 'See if the filename contains a path
If I Then sFileName = Mid$(sFileName, I + 1&) 'If it does, strip the path from the filename
For I = m_FileNamesUB To 0& Step -1& 'Scan the m_FileNames array backwards
If m_FileNames(I) = sFileName Then 'and look for the filename
If I < m_FileNamesUB Then 'If the matching filename isn't at the end of the array
J = StrPtr(m_FileNames(I)) 'Swap it with the last element
K = StrPtr(m_FileNames(m_FileNamesUB)) 'Note: swapping string pointers is faster than exchanging string data
PutMem4 VarPtr(m_FileNames(m_FileNamesUB)), J
PutMem4 VarPtr(m_FileNames(I)), K 'If the matching filename is at the end of the array however,
End If 'simply exclude it from the active elements of the array
m_FileNamesUB = m_FileNamesUB - 1& 'Decrement m_FileNamesUB to simulate shrinking the array (this is faster than ReDim Preserve)
Exit For 'Stop scanning once a match is found and the relevant array elements are rearranged
End If
Next
If I = -1& Then 'If zip file has a file not found in the DatFile,
lstMismatchedFiles.AddItem m_ZipFileName 'add it to the Mismatched Files list & quit searching
Exit Do
End If
End If
Pos = Pos + 46& + CDFH.FileNameLen + CDFH.ExtraFieldLen + CDFH.FileCommentLen
EOCD.DiskCDRecords = EOCD.DiskCDRecords - 1
Else
Err = vbObjectError
Exit Do 'Abort searching the zip file if there is at least 1 invalid central directory signature
End If
Loop
If EOCD.DiskCDRecords = 0 Then
If m_FileNamesUB = -1& Then 'If the DatFile & zip file have exactly the same set of filenames,
lstComplete.AddItem m_ZipFileName 'add the zip file to the Complete list
Else
lstMismatchedFiles.AddItem m_ZipFileName 'If the DatFile has file(s) not found in the zip file,
End If 'add the zip file to the Mismatched Files list
End If
Else
Err = vbObjectError 'Couldn't find the end of central directory signature; possibly corrupt Zip file
End If
1 Close FN
End If
If Err Then lstUnprocessed.AddItem m_ZipFileName 'If searching was interrupted for any reason or if the DatFile has a game not
On Error GoTo 0 'found in the specified folder, add the game filename to the Unprocessed list
m_FileNamesUB = -1& 'Reset m_FileNamesUB
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
Const ALLOC_CHUNK = 50&
Dim sFileName As String
Select Case strLocalName
Case "rom": sFileName = oAttributes.getValueFromName(vbNullString, "name")
If m_FileNamesUB = UBound(m_FileNames) Then
ReDim Preserve m_FileNames(0& To m_FileNamesUB + ALLOC_CHUNK) As String 'Grow the array in chunks to avoid ReDim'ming frequently
End If
m_FileNamesUB = m_FileNamesUB + 1& 'Increment m_FileNamesUB to simulate expanding the array
m_FileNames(m_FileNamesUB) = sFileName
Case "game": m_ZipFileName = oAttributes.getValueFromName(vbNullString, "name") & ".zip"
End Select
End Sub
. . .
Private Sub cmdSort_Click()
Const WM_SETREDRAW = 11&
Dim Start As Long, ErrNum As Long, ErrDesc As String
Start = timeGetTime
MousePointer = vbHourglass
lstComplete.Clear
lstUnprocessed.Clear
lstMismatchedFiles.Clear
lstComplete.Visible = False 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, False, 0& 'WM_SETREDRAW seems to be ignored by VB.ListBox
lstUnprocessed.Visible = False 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, False, 0&
lstMismatchedFiles.Visible = False 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, False, 0&
With New SAXXMLReader60
Set .contentHandler = Me 'The prohibit-dtd feature is True by default for MSXML 6.0
.putFeature "prohibit-dtd", False 'Disable it so that SAXXMLReader60 won't complain about the DTD in "FB Alpha v0.2.97.30.dat"
On Error Resume Next
.parseURL txtPath.Text
If Err Then ErrNum = Err: ErrDesc = Err.Description
On Error GoTo 0
End With
lstComplete.Visible = True 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, -True, 0&
lstUnprocessed.Visible = True 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, -True, 0&
lstMismatchedFiles.Visible = True 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, -True, 0&
m_FileNames = Split(vbNullString) 'Reset the array to its initialized but empty state to reduce memory usage
m_ZipFileName = vbNullString
MousePointer = vbDefault
If ErrNum = 0& Then
Caption = "Sorting " & FormatNumber(lstComplete.ListCount + _
lstUnprocessed.ListCount + lstMismatchedFiles.ListCount, 0&) & _
" Zip Files took " & FormatNumber((timeGetTime - Start) / 1000&, 3&) & " seconds"
Label(0).Caption = "Complete: " & FormatNumber(lstComplete.ListCount, 0&)
Label(1).Caption = "Unprocessed: " & FormatNumber(lstUnprocessed.ListCount, 0&)
Label(2).Caption = "Mismatched Files: " & FormatNumber(lstMismatchedFiles.ListCount, 0&)
Else
Caption = "Sort Zip Files Demo"
Label(0).Caption = "Complete"
Label(1).Caption = "Unprocessed"
Label(2).Caption = "Mismatched Files"
MsgBox ErrDesc, vbCritical, "Error &H" & Hex$(ErrNum)
End If
End Sub
Note:
The attached zip file below contains a 7z file. This was done in order to make the zip file smaller than 500 KB, which is the max file size allowed for zip files. The 7z format is generally more size efficient than the zip format and is an open format as well. If you don't have an application that can open 7z files, I recommend that you download 7-Zip, which is free and open source.
Last edited by Victor Bravo VI; Oct 1st, 2019 at 04:29 PM.
Reason: Reposted attachment
An obscure body in the SK system. The inhabitants call it Earth
Posts
7,900
Re: Scan and compare files in .dat and zip files.
I've removed the attached files. I haven't checked what was in them but, if you're asking people to rename them then you're circumventing our forum rules. Please don't do that.
I think you were just trying to attach a zip file, in which case go right ahead and attach the zip. There's nothing in our rules to prevent that as long as it doesn't contain any compiled binaries.
The best argument against democracy is a five minute conversation with the average voter - Winston Churchill
Hadoop actually sounds more like the way they greet each other in Yorkshire - Inferrd
I gave my attachment the .docx extension because it exceeded VBForum's 500 KB limit for the .zip file type (VBForum reminded me of this as I was attaching my zip file). I decided to rename its extension to .docx because it is the only allowed file type that has a Max File-size limit greater than 500 KB (up to 4.77 MB). Also, the .docx file type is actually just a .zip file with a different extension. I could have uploaded a smaller file but the .rar (450 KB) and .7z (369 KB) formats are both not allowed (which is puzzling; from reading old posts, one discovers that VBForums used to allow the .rar file type). The reason my attachment is quite large is because I included the OP's .dat file (4.50 MB). Nope, there are no compiled binaries in it. The OP unfortunately uploaded the .dat file to a 3rd-party site that had an expiry date of just 1 week (it will expire 3 days from now). So, I decided to include it so that the demo will still work in the future.
Please let me know how I should proceed regarding this matter.
An obscure body in the SK system. The inhabitants call it Earth
Posts
7,900
Re: Scan and compare files in .dat and zip files.
Fair enough, there's nothing there we'd object to. I'd suggest simply omitting the .dat file as,presumably, they already have it.
I wasn't aware that there was a smaller file limit to zip files and I can't think of a reason why that would be the case. You may want to raise that in the forum feedback section so the admins can take a look.
The best argument against democracy is a five minute conversation with the average voter - Winston Churchill
Hadoop actually sounds more like the way they greet each other in Yorkshire - Inferrd
I wasn't aware that there was a smaller file limit to zip files and I can't think of a reason why that would be the case. You may want to raise that in the forum feedback section so the admins can take a look.
Now that is baffling, provided that the codebank is full of .docx submissions with explicit instructions to rename to .zip before decompression.
If I understood your recent posts correctly, I think this demo might be close enough to what you're trying to do. The demo parses the dat file (which is actually an XML file) using SAX2 rather than the GetBetween function you're using. The demo places each zip file listed in the dat file in 1 of 3 ListBoxes depending on whether its contained files match perfectly with the files specified in the dat file or not (Complete lists all zip files with a perfect match, Unprocessed lists all zip files that were unprocessed for whatever reason [e.g., nonexistent zip files] and Mismatched Files lists all zip files with either missing or has extra files). The demo doesn't physically move any zip file to any folder; I will leave that task up to you (it's easy enough to modify the source code to accomplish that).
Code:
Implements IVBSAXContentHandler
Private m_FileNamesUB As Long
Private m_FileNames() As String
Private m_ZipFileName As String
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
Const CDFH_SIGNATURE = &H2014B50, EOCD_SIGNATURE = &H6054B50, EFS = &H800 'EFS - Language encoding flag
Dim FN As Integer, I As Long, J As Long, K As Long, Pos As Long
Dim sFileName As String, CDFH As CDFH, EOCD As EOCD
If strLocalName <> "game" Then Exit Sub
FN = FreeFile
sFileName = txtPath.Text
sFileName = Left$(sFileName, InStrRev(sFileName, "\")) & m_ZipFileName 'Build a fully-qualified filename from the specified DatFile and ZIP filename
On Error GoTo 1
If (GetAttr(sFileName) And vbDirectory) <> vbDirectory Then 'Must verify the zip file already exists because Open For Binary will create it if missing
Open sFileName For Binary Access Read Lock Write As FN
Pos = LOF(FN) + 1& 'Must add 1 because the Get statement is 1-based
For Pos = Pos - 22& To Pos - &H10015 Step -1& 'Scan the file backwards starting from (LOF - EOCD min size) to (LOF - EOCD max size)
Get FN, Pos, EOCD.Signature
If EOCD.Signature = EOCD_SIGNATURE Then Exit For
Next
If EOCD.Signature = EOCD_SIGNATURE Then
Get FN, Pos, EOCD
Pos = EOCD.CDStartOffset + 1& 'Must add 1 because the Get statement is 1-based
Do While EOCD.DiskCDRecords 'Examine all central directory records on this disk
Get FN, Pos, CDFH
If CDFH.Signature = CDFH_SIGNATURE Then
If (CDFH.ExtFileAttribs And vbDirectory) <> vbDirectory Then 'If not a folder
If (CDFH.GPFlag And EFS) = 0 Then 'If filename (and comment) are in the original ZIP character encoding (IBM Code Page 437)
SysReAllocStringLen VarPtr(sFileName), , CDFH.FileNameLen
Get FN, Pos + 46&, sFileName
Else
'TODO: Add support for UTF-8 filenames
End If
I = InStrRev(sFileName, "/") 'See if the filename contains a path
If I Then sFileName = Mid$(sFileName, I + 1&) 'If it does, strip the path from the filename
For I = m_FileNamesUB To 0& Step -1& 'Scan the m_FileNames array backwards
If m_FileNames(I) = sFileName Then 'and look for the filename
If I < m_FileNamesUB Then 'If the matching filename isn't at the end of the array
J = StrPtr(m_FileNames(I)) 'Swap it with the last element
K = StrPtr(m_FileNames(m_FileNamesUB)) 'Note: swapping string pointers is faster than exchanging string data
PutMem4 VarPtr(m_FileNames(m_FileNamesUB)), J
PutMem4 VarPtr(m_FileNames(I)), K 'If the matching filename is at the end of the array however,
End If 'simply exclude it from the active elements of the array
m_FileNamesUB = m_FileNamesUB - 1& 'Decrement m_FileNamesUB to simulate shrinking the array (this is faster than ReDim Preserve)
Exit For 'Stop scanning once a match is found and the relevant array elements are rearranged
End If
Next
If I = -1& Then 'If zip file has a file not found in the DatFile,
lstMismatchedFiles.AddItem m_ZipFileName 'add it to the Mismatched Files list & quit searching
Exit Do
End If
End If
Pos = Pos + 46& + CDFH.FileNameLen + CDFH.ExtraFieldLen + CDFH.FileCommentLen
EOCD.DiskCDRecords = EOCD.DiskCDRecords - 1
Else
Err = vbObjectError
Exit Do 'Abort searching the zip file if there is at least 1 invalid central directory signature
End If
Loop
If EOCD.DiskCDRecords = 0 Then
If m_FileNamesUB = -1& Then 'If the DatFile & zip file have exactly the same set of filenames,
lstComplete.AddItem m_ZipFileName 'add the zip file to the Complete list
Else
lstMismatchedFiles.AddItem m_ZipFileName 'If the DatFile has file(s) not found in the zip file,
End If 'add the zip file to the Mismatched Files list
End If
Else
Err = vbObjectError 'Couldn't find the end of central directory signature; possibly corrupt Zip file
End If
1 Close FN
End If
If Err Then lstUnprocessed.AddItem m_ZipFileName 'If searching was interrupted for any reason or if the DatFile has a game not
On Error GoTo 0 'found in the specified folder, add the game filename to the Unprocessed list
m_FileNamesUB = -1& 'Reset m_FileNamesUB
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
Const ALLOC_CHUNK = 50&
Dim sFileName As String
Select Case strLocalName
Case "rom": sFileName = oAttributes.getValueFromName(vbNullString, "name")
If m_FileNamesUB = UBound(m_FileNames) Then
ReDim Preserve m_FileNames(0& To m_FileNamesUB + ALLOC_CHUNK) As String 'Grow the array in chunks to avoid ReDim'ming frequently
End If
m_FileNamesUB = m_FileNamesUB + 1& 'Increment m_FileNamesUB to simulate expanding the array
m_FileNames(m_FileNamesUB) = sFileName
Case "game": m_ZipFileName = oAttributes.getValueFromName(vbNullString, "name") & ".zip"
End Select
End Sub
. . .
Private Sub cmdSort_Click()
Const WM_SETREDRAW = 11&
Dim Start As Long, ErrNum As Long, ErrDesc As String
Start = timeGetTime
MousePointer = vbHourglass
lstComplete.Clear
lstUnprocessed.Clear
lstMismatchedFiles.Clear
lstComplete.Visible = False 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, False, 0& 'WM_SETREDRAW seems to be ignored by VB.ListBox
lstUnprocessed.Visible = False 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, False, 0&
lstMismatchedFiles.Visible = False 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, False, 0&
With New SAXXMLReader60
Set .contentHandler = Me 'The prohibit-dtd feature is True by default for MSXML 6.0
.putFeature "prohibit-dtd", False 'Disable it so that SAXXMLReader60 won't complain about the DTD in "FB Alpha v0.2.97.30.dat"
On Error Resume Next
.parseURL txtPath.Text
If Err Then ErrNum = Err: ErrDesc = Err.Description
On Error GoTo 0
End With
lstComplete.Visible = True 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, -True, 0&
lstUnprocessed.Visible = True 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, -True, 0&
lstMismatchedFiles.Visible = True 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, -True, 0&
m_FileNames = Split(vbNullString) 'Reset the array to its initialized but empty state to reduce memory usage
m_ZipFileName = vbNullString
MousePointer = vbDefault
If ErrNum = 0& Then
Caption = "Sorting " & FormatNumber(lstComplete.ListCount + _
lstUnprocessed.ListCount + lstMismatchedFiles.ListCount, 0&) & _
" Zip Files took " & FormatNumber((timeGetTime - Start) / 1000&, 3&) & " seconds"
Label(0).Caption = "Complete: " & FormatNumber(lstComplete.ListCount, 0&)
Label(1).Caption = "Unprocessed: " & FormatNumber(lstUnprocessed.ListCount, 0&)
Label(2).Caption = "Mismatched Files: " & FormatNumber(lstMismatchedFiles.ListCount, 0&)
Else
Caption = "Sort Zip Files Demo"
Label(0).Caption = "Complete"
Label(1).Caption = "Unprocessed"
Label(2).Caption = "Mismatched Files"
MsgBox ErrDesc, vbCritical, "Error &H" & Hex$(ErrNum)
End If
End Sub
BTW, rename Sort Zip Files Demo.zip.docx to Sort Zip Files Demo.zip.
can you add source
Last edited by doberman2002; Sep 30th, 2019 at 02:59 PM.
I'd suggest simply omitting the .dat file as,presumably, they already have it.
Well, as I've already pointed out, interested readers in the future (that's just 4 days from now) won't be able to make my demo work properly because a crucial file is missing. I doubt the OP could be bothered to reupload it every time it expires. Ideally, the OP should have attached his files to his post, but if you'll check their file sizes, all but one exceeds VBForum's zip file limit, so it's no wonder he chose to upload them to a 3rd-party file hosting site. I don't want to do the same as these sites are notoriously unreliable (most of them have expiry dates; the site the OP chose is by far the most stingy that I've seen).
Originally Posted by FunkyDexter
You may want to raise that in the forum feedback section so the admins can take a look.
An obscure body in the SK system. The inhabitants call it Earth
Posts
7,900
Re: Scan and compare files in .dat and zip files.
Now that is baffling, provided that the codebank is full of .docx submissions with explicit instructions to rename to .zip before decompression.
It shouldn't be and anyone who's doing that is breaking our rules. Bear in mind that we moderate in response to users reporting violations. If the violation goes unreported the chances are the mods simply won't be aware of it. Still, we'd ask you all not to do that in the future.
I don't want to do the same as these sites are notoriously unreliable
Agreed and we encourage users to attach any files to their forum posts wherever possible. however, we are aware that sometimes files are just too big and then we're happy for you to host them on third party sites. GitHub is probably the best. It's free, has been around for ages and looks like being around for ages more.
That said, if you're frequently finding the file size limits to be too small then, again, that'd be a good thing to highlight in the forum feedback section. The admins are pretty good at listening in my experience.
The best argument against democracy is a five minute conversation with the average voter - Winston Churchill
Hadoop actually sounds more like the way they greet each other in Yorkshire - Inferrd
It shouldn't be and anyone who's doing that is breaking our rules. Bear in mind that we moderate in response to users reporting violations. If the violation goes unreported the chances are the mods simply won't be aware of it. Still, we'd ask you all not to do that in the future.
Sure. If I see a .docx used instead of .zip in codebank I'll post a note with link to the submission in forum's feedback section, write you personally and call local police. No problem, don't worry. . .
An obscure body in the SK system. The inhabitants call it Earth
Posts
7,900
Re: Scan and compare files in .dat and zip files.
it's really funny how detached admins/moderators are from the problems of the regular users here
Yeah, I get that. Some of us (myself included) aren't active coders any more. I don't think any of us are using VB6 anymore (actually, Shaggy might be, not sure) and, while we do chip in on threads, I don't think any of us are anywhere near as active as some of the busiest members. The admins, in particular, tend not to be active members of the forum at all - they administrate multiple different forums for QuinnStreet and don't have time to be active on any single one.
But this really is why I'd encourage you guys to use things like the forum feedback area. The admins check it frequently, they do listen to the suggestion members make and they have the clout to actually get changes made. Make the forum yours.
The best argument against democracy is a five minute conversation with the average voter - Winston Churchill
Hadoop actually sounds more like the way they greet each other in Yorkshire - Inferrd
Well, as I've feared, it doesn't seem like anything would be done about it. In fact, it just got worse as there's no longer any way for us to attach files greater than 500 KB.
EDIT
OK, I take it back. The admins have listened and have actually managed to persuade the higher-ups to make some improvements.
Originally Posted by FunkyDexter
Make the forum yours.
Sorry, but I really feel like we don't have a voice here. I mean, none of the forum's longstanding issues have been resolved yet (e.g., https, double posts, technical terms being censored, images being limited to 600 px wide, the PHP User Warnings wqweto mentioned, etc.). I really wish the forum made life easier for the contributors who makes this place a valuable resource so that we wouldn't have to resort to hacks like the above.
Originally Posted by doberman2002
can you add source
Alright, I've reattached the demo. Hopefully, nobody will report my post again this time as I don't think there's any written or unwritten rule that prohibits a zip file from containing a 7z file (which is an open format like the zip format) in order to work around the file size limit.
Hurry up and grab it before somebody tries to take it down again!
Last edited by Victor Bravo VI; Oct 3rd, 2019 at 06:00 PM.
FWIW ('am a bit late with it) - I'm still convinced, that doing such stuff in two steps:
1) via a generic import-run, to fill the data into a (re-usable) SQLite-DB (InMemory or File-DB)
2) and then performing all the different filter-queries against that DB
...is worthwhile, because it will require less code, which doesn't need to specifically tailored
(via filtering loop-constructs) - and is thus better maintainable (by just adapting SQL-Strings)...
I'd choose such an approach also, when it wouldn't quite reach the performance of the "specially adapted loops" -
but not even that is the case (so far, in the scenario we have here)...
If I understood your recent posts correctly, I think this demo might be close enough to what you're trying to do. The demo parses the dat file (which is actually an XML file) using SAX2 rather than the GetBetween function you're using. The demo places each zip file listed in the dat file in 1 of 3 ListBoxes depending on whether its contained files match perfectly with the files specified in the dat file or not (Complete lists all zip files with a perfect match, Unprocessed lists all zip files that were unprocessed for whatever reason [e.g., nonexistent zip files] and Mismatched Files lists all zip files with either missing or has extra files). The demo doesn't physically move any zip file to any folder; I will leave that task up to you (it's easy enough to modify the source code to accomplish that).
Code:
Implements IVBSAXContentHandler
Private m_FileNamesUB As Long
Private m_FileNames() As String
Private m_ZipFileName As String
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
Const CDFH_SIGNATURE = &H2014B50, EOCD_SIGNATURE = &H6054B50, EFS = &H800 'EFS - Language encoding flag
Dim FN As Integer, I As Long, J As Long, K As Long, Pos As Long
Dim sFileName As String, CDFH As CDFH, EOCD As EOCD
If strLocalName <> "game" Then Exit Sub
FN = FreeFile
sFileName = txtPath.Text
sFileName = Left$(sFileName, InStrRev(sFileName, "\")) & m_ZipFileName 'Build a fully-qualified filename from the specified DatFile and ZIP filename
On Error GoTo 1
If (GetAttr(sFileName) And vbDirectory) <> vbDirectory Then 'Must verify the zip file already exists because Open For Binary will create it if missing
Open sFileName For Binary Access Read Lock Write As FN
Pos = LOF(FN) + 1& 'Must add 1 because the Get statement is 1-based
For Pos = Pos - 22& To Pos - &H10015 Step -1& 'Scan the file backwards starting from (LOF - EOCD min size) to (LOF - EOCD max size)
Get FN, Pos, EOCD.Signature
If EOCD.Signature = EOCD_SIGNATURE Then Exit For
Next
If EOCD.Signature = EOCD_SIGNATURE Then
Get FN, Pos, EOCD
Pos = EOCD.CDStartOffset + 1& 'Must add 1 because the Get statement is 1-based
Do While EOCD.DiskCDRecords 'Examine all central directory records on this disk
Get FN, Pos, CDFH
If CDFH.Signature = CDFH_SIGNATURE Then
If (CDFH.ExtFileAttribs And vbDirectory) <> vbDirectory Then 'If not a folder
If (CDFH.GPFlag And EFS) = 0 Then 'If filename (and comment) are in the original ZIP character encoding (IBM Code Page 437)
SysReAllocStringLen VarPtr(sFileName), , CDFH.FileNameLen
Get FN, Pos + 46&, sFileName
Else
'TODO: Add support for UTF-8 filenames
End If
I = InStrRev(sFileName, "/") 'See if the filename contains a path
If I Then sFileName = Mid$(sFileName, I + 1&) 'If it does, strip the path from the filename
For I = m_FileNamesUB To 0& Step -1& 'Scan the m_FileNames array backwards
If m_FileNames(I) = sFileName Then 'and look for the filename
If I < m_FileNamesUB Then 'If the matching filename isn't at the end of the array
J = StrPtr(m_FileNames(I)) 'Swap it with the last element
K = StrPtr(m_FileNames(m_FileNamesUB)) 'Note: swapping string pointers is faster than exchanging string data
PutMem4 VarPtr(m_FileNames(m_FileNamesUB)), J
PutMem4 VarPtr(m_FileNames(I)), K 'If the matching filename is at the end of the array however,
End If 'simply exclude it from the active elements of the array
m_FileNamesUB = m_FileNamesUB - 1& 'Decrement m_FileNamesUB to simulate shrinking the array (this is faster than ReDim Preserve)
Exit For 'Stop scanning once a match is found and the relevant array elements are rearranged
End If
Next
If I = -1& Then 'If zip file has a file not found in the DatFile,
lstMismatchedFiles.AddItem m_ZipFileName 'add it to the Mismatched Files list & quit searching
Exit Do
End If
End If
Pos = Pos + 46& + CDFH.FileNameLen + CDFH.ExtraFieldLen + CDFH.FileCommentLen
EOCD.DiskCDRecords = EOCD.DiskCDRecords - 1
Else
Err = vbObjectError
Exit Do 'Abort searching the zip file if there is at least 1 invalid central directory signature
End If
Loop
If EOCD.DiskCDRecords = 0 Then
If m_FileNamesUB = -1& Then 'If the DatFile & zip file have exactly the same set of filenames,
lstComplete.AddItem m_ZipFileName 'add the zip file to the Complete list
Else
lstMismatchedFiles.AddItem m_ZipFileName 'If the DatFile has file(s) not found in the zip file,
End If 'add the zip file to the Mismatched Files list
End If
Else
Err = vbObjectError 'Couldn't find the end of central directory signature; possibly corrupt Zip file
End If
1 Close FN
End If
If Err Then lstUnprocessed.AddItem m_ZipFileName 'If searching was interrupted for any reason or if the DatFile has a game not
On Error GoTo 0 'found in the specified folder, add the game filename to the Unprocessed list
m_FileNamesUB = -1& 'Reset m_FileNamesUB
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
Const ALLOC_CHUNK = 50&
Dim sFileName As String
Select Case strLocalName
Case "rom": sFileName = oAttributes.getValueFromName(vbNullString, "name")
If m_FileNamesUB = UBound(m_FileNames) Then
ReDim Preserve m_FileNames(0& To m_FileNamesUB + ALLOC_CHUNK) As String 'Grow the array in chunks to avoid ReDim'ming frequently
End If
m_FileNamesUB = m_FileNamesUB + 1& 'Increment m_FileNamesUB to simulate expanding the array
m_FileNames(m_FileNamesUB) = sFileName
Case "game": m_ZipFileName = oAttributes.getValueFromName(vbNullString, "name") & ".zip"
End Select
End Sub
. . .
Private Sub cmdSort_Click()
Const WM_SETREDRAW = 11&
Dim Start As Long, ErrNum As Long, ErrDesc As String
Start = timeGetTime
MousePointer = vbHourglass
lstComplete.Clear
lstUnprocessed.Clear
lstMismatchedFiles.Clear
lstComplete.Visible = False 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, False, 0& 'WM_SETREDRAW seems to be ignored by VB.ListBox
lstUnprocessed.Visible = False 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, False, 0&
lstMismatchedFiles.Visible = False 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, False, 0&
With New SAXXMLReader60
Set .contentHandler = Me 'The prohibit-dtd feature is True by default for MSXML 6.0
.putFeature "prohibit-dtd", False 'Disable it so that SAXXMLReader60 won't complain about the DTD in "FB Alpha v0.2.97.30.dat"
On Error Resume Next
.parseURL txtPath.Text
If Err Then ErrNum = Err: ErrDesc = Err.Description
On Error GoTo 0
End With
lstComplete.Visible = True 'SendMessageW lstComplete.hWnd, WM_SETREDRAW, -True, 0&
lstUnprocessed.Visible = True 'SendMessageW lstUnprocessed.hWnd, WM_SETREDRAW, -True, 0&
lstMismatchedFiles.Visible = True 'SendMessageW lstMismatchedFiles.hWnd, WM_SETREDRAW, -True, 0&
m_FileNames = Split(vbNullString) 'Reset the array to its initialized but empty state to reduce memory usage
m_ZipFileName = vbNullString
MousePointer = vbDefault
If ErrNum = 0& Then
Caption = "Sorting " & FormatNumber(lstComplete.ListCount + _
lstUnprocessed.ListCount + lstMismatchedFiles.ListCount, 0&) & _
" Zip Files took " & FormatNumber((timeGetTime - Start) / 1000&, 3&) & " seconds"
Label(0).Caption = "Complete: " & FormatNumber(lstComplete.ListCount, 0&)
Label(1).Caption = "Unprocessed: " & FormatNumber(lstUnprocessed.ListCount, 0&)
Label(2).Caption = "Mismatched Files: " & FormatNumber(lstMismatchedFiles.ListCount, 0&)
Else
Caption = "Sort Zip Files Demo"
Label(0).Caption = "Complete"
Label(1).Caption = "Unprocessed"
Label(2).Caption = "Mismatched Files"
MsgBox ErrDesc, vbCritical, "Error &H" & Hex$(ErrNum)
End If
End Sub
Note:
The attached zip file below contains a 7z file. This was done in order to make the zip file smaller than 500 KB, which is the max file size allowed for zip files. The 7z format is generally more size efficient than the zip format and is an open format as well. If you don't have an application that can open 7z files, I recommend that you download 7-Zip, which is free and open source.
OMG WOW.
May i kindly ask where are the zips coming from is it getting it from link or are they in res file.
this is Brilliant just to good.
Last edited by doberman2002; Oct 7th, 2019 at 04:30 PM.
May i kindly ask where are the zips coming from is it getting it from link or are they in res file.
The zip files in the Test Folder are being randomly generated according to your FB Alpha v0.2.97.30.dat file by the prjMakeZipFiles.vbp project in the Make Zip Files folder or by the MakeZips.exe program that that project compiles. At startup, the prjSortZipFiles.vbp project (or the SortZips.exe that it compiles) will prompt you to run prjMakeZipFiles.vbp/MakeZips.exe if it can't find any zip file in the Test Folder.
BTW, if this project request is a one-time task only, then a bespoke solution like my example above is fine. Otherwise, you should favor a more generic and flexible approach like the one Olaf proposes so that you won't have to reinvent the wheel each time.
FWIW ('am a bit late with it) - I'm still convinced, that doing such stuff in two steps:
1) via a generic import-run, to fill the data into a (re-usable) SQLite-DB (InMemory or File-DB)
2) and then performing all the different filter-queries against that DB
...is worthwhile, because it will require less code, which doesn't need to specifically tailored
(via filtering loop-constructs) - and is thus better maintainable (by just adapting SQL-Strings)...
I'd choose such an approach also, when it wouldn't quite reach the performance of the "specially adapted loops" -
but not even that is the case (so far, in the scenario we have here)...