📄 mpqstuff.bas
字号:
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
For pNum = 1 To Len(Files)
fEndLine = InStr(pNum, Files, vbCrLf)
fLine = Mid(Files, pNum, fEndLine - pNum)
If pNum > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": "
End If
fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..."
If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
SFileCloseFile hFile
MpqDeleteFile hMPQ, fLine2
MpqRenameFile hMPQ, fLine, fLine2
Else
MpqRenameFile hMPQ, fLine, fLine2
End If
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
MpqCloseUpdatedArchive hMPQ, 0
End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf
End If
Else
AddScriptOutput "You must use wildcards with new name" + vbCrLf
End If
Else
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
SFileCloseFile hFile
MpqDeleteFile hMPQ, Param(3)
MpqRenameFile hMPQ, Param(2), Param(3)
Else
MpqRenameFile hMPQ, Param(2), Param(3)
End If
MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
Else
AddScriptOutput " Required parameter missing" + vbCrLf
End If
Else
AddScriptOutput "No archive open" + vbCrLf
End If
Case "m", "move"
If MpqFile <> "" Then
For pNum = 1 To Len(Param(2))
If InStr(bNum, Param(2), "\") Then
bNum = InStr(bNum, Param(2), "\")
Else
Exit For
End If
Next pNum
fLineTitle = Mid(Param(2), bNum)
If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
Param(3) = Param(3) + fLineTitle
If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Moving " + Param(2) + " => " + Param(3) + "..."
If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
For pNum = 1 To Len(Files)
fEndLine = InStr(pNum, Files, vbCrLf)
fLine = Mid(Files, pNum, fEndLine - pNum)
If pNum > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": "
End If
fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..."
If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
SFileCloseFile hFile
MpqDeleteFile hMPQ, fLine2
MpqRenameFile hMPQ, fLine, fLine2
Else
MpqRenameFile hMPQ, fLine, fLine2
End If
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
MpqCloseUpdatedArchive hMPQ, 0
End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf
End If
Else
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
SFileCloseFile hFile
MpqDeleteFile hMPQ, Param(3)
MpqRenameFile hMPQ, Param(2), Param(3)
Else
MpqRenameFile hMPQ, Param(2), Param(3)
End If
MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
Else
AddScriptOutput " Required parameter missing" + vbCrLf
End If
Else
AddScriptOutput "No archive open" + vbCrLf
End If
Case "d", "del", "delete"
If MpqFile <> "" Then
If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Deleting " + Param(2) + "..."
If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
For pNum = 1 To Len(Files)
fEndLine = InStr(pNum, Files, vbCrLf)
fLine = Mid(Files, pNum, fEndLine - pNum)
If pNum > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": "
End If
AddScriptOutput "Deleting " + fLine + "..."
MpqDeleteFile hMPQ, fLine
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
MpqCloseUpdatedArchive hMPQ, 0
End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf
End If
Else
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
MpqDeleteFile hMPQ, Param(2)
MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
Else
AddScriptOutput " Required parameter missing" + vbCrLf
End If
Else
AddScriptOutput "No archive open" + vbCrLf
End If
Case "f", "flush", "compact"
If MpqFile <> "" Then
AddScriptOutput "Flushing " + MpqFile + "..."
hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ Then
MpqCompactArchive hMPQ
MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
Else
AddScriptOutput "No archive open" + vbCrLf
End If
Case "l", "list"
If MpqFile <> "" Then
If Param(2) <> "" Then
AddScriptOutput "Creating list..."
If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
Param(2) = Param(3)
Else
Files = MpqDir(FullPath(NewPath, MpqFile), "*")
End If
fNum = FreeFile
Open FullPath(CurPath, Param(2)) For Binary As #fNum
Put #fNum, 1, Files
Close #fNum
AddScriptOutput " Done" + vbCrLf
Else
AddScriptOutput " Required parameter missing" + vbCrLf
End If
Else
AddScriptOutput "No archive open" + vbCrLf
End If
Case "s", "script"
AddScriptOutput "Running script " + Param(2) + "..." + vbCrLf + vbCrLf
If Param(2) <> "" Then
RunScript FullPath(CurPath, Param(2))
Else
AddScriptOutput " Required parameter missing" + vbCrLf
End If
AddScriptOutput vbCrLf + "Continuing with previous script..." + vbCrLf
Case "x", "exit", "quit"
Unload MpqEx
Case Else
If Left(Param(1), 1) <> ";" Then
If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then
On Error Resume Next
ChDir Param(2)
On Error GoTo 0
CurPath = CurDir
AddScriptOutput "Current directory is " + CurPath + vbCrLf
ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then
On Error Resume Next
ChDir Mid(Param(1), 3)
On Error GoTo 0
CurPath = CurDir
AddScriptOutput "Current directory is " + CurPath + vbCrLf
ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then
On Error Resume Next
ChDir Mid(Param(1), 6)
On Error GoTo 0
CurPath = CurDir
AddScriptOutput "Current directory is " + CurPath + vbCrLf
ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then
On Error Resume Next
ChDrive Left(Param(1), 2)
On Error GoTo 0
CurPath = CurDir
AddScriptOutput "Current directory is " + CurPath + vbCrLf
Else
AddScriptOutput "Running command " + sLine + "..."
Shell "command.com /c " + sLine, 1
AddScriptOutput " Done" + vbCrLf
End If
Else
AddScriptOutput "Comment " + sLine + vbCrLf
End If
End Select
End If
CommandError:
lNum = lNum + 1
bNum = EndLine + 1
Next bNum
DefaultMaxFiles = OldDefaultMaxFiles
If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
ChDir OldPath
End Sub
Function FindMpqHeader(MpqFile As String) As Long
If FileExists(MpqFile) = False Then
FindMpqHeader = -1
Exit Function
End If
Dim hFile
hFile = FreeFile
Open MpqFile For Binary As #hFile
Dim FileLen As Long
FileLen = LOF(hFile)
Dim pbuf As String
pbuf = String(32, Chr(0))
Dim i As Long
For i = 0 To FileLen - 1 Step 512
Get #hFile, 1 + i, pbuf
If Left(pbuf, 4) = "MPQ" + Chr(26) Or Left(pbuf, 4) = "BN3" + Chr(26) Then
' Storm no longer does this, so this shouldn't either
'FileLen = FileLen - i
'If JBytes(pbuf, 9, 4) = FileLen
' FileMpqHeader = i
' Close #hFile
' Exit Function
'Else
' FileLen = FileLen + i
'End If
FindMpqHeader = i
Close #hFile
Exit Function
End If
Next i
FindMpqHeader = -1
Close #hFile
End Function
Function GetNumMpqFiles(MpqFile As String) As Long
Dim fNum As Long, Text As String, MpqHeader As Long
fNum = FreeFile
Text = String(4, Chr(0))
MpqHeader = FindMpqHeader(MpqFile)
If MpqHeader > -1 Then
Open MpqFile For Binary As #fNum
Get #fNum, MpqHeader + 29, GetNumMpqFiles
Close #fNum
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -