Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
diff --git a/listing.frm b/listing.frm
--- a/listing.frm
+++ b/listing.frm
If PItem.Index <> 0 Then Unload PItem
Next PItem
If InStr(FileName, ".") = 0 Then
- GoSub AddUnknown
+ GoSub AddGlobal
Else
For bNum = 1 To Len(FileName)
If InStr(bNum, FileName, ".") > 0 Then
aName = Mid(FileName, bNum - 1)
aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")
If aName = "" Then
- GoSub AddUnknown
+ GoSub AddGlobal
Exit Sub
End If
dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
Else
aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)
If aItem = "" Then
- GoSub AddUnknown
+ GoSub AddGlobal
Exit Sub
End If
If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
aNum = aNum + 1
End If
Loop Until aItem = ""
+ GoSub AddGlobal
If Shift And vbShiftMask Then GoSub AddUnknown
End If
Exit Sub
+AddGlobal:
+ aNum = 0
+ bNum = mnuRoot.Tag
+ dItem = ""
+ If bNum = 0 Then
+ dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open")
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem)
+ If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then
+ If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then
+ mnuItem(bNum).Caption = "Op&en with..."
+ Else
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
+ End If
+ mnuItem(bNum).Tag = dItem
+ mnuRoot.Tag = mnuRoot.Tag + 1
+ bNum = bNum + 1
+ End If
+ End If
+ Do
+ aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum)
+ If aItem <> "" Then
+ If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then
+ On Error Resume Next
+ Load mnuItem(bNum)
+ On Error GoTo 0
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then
+ mnuItem(bNum).Caption = "Op&en with..."
+ Else
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ End If
+ mnuItem(bNum).Tag = aItem
+ mnuRoot.Tag = mnuRoot.Tag + 1
+ bNum = bNum + 1
+ End If
+ aNum = aNum + 1
+ End If
+ Loop Until aItem = ""
+ If bNum = 0 Then
+ GoSub AddUnknown
+ Exit Sub
+ End If
+Return
AddUnknown:
aNum = 0
bNum = mnuRoot.Tag
ShowSelected
ShowTotal
End Sub
+Sub ConvertCwad()
+ Dim hCwad As Long, hMPQ As Long, hFile As Long, ListBuffer As String, BufSize As Long, Files() As String, buffer() As Byte, fLen As Long, nFile As Long, CwadName As String, dwFlags As Long
+
+ If CWadOpenArchive(CD.FileName, 0, hCwad) Then
+ MsgBox "This archive must be converted to MPQ format to open it." + vbCrLf + "Enter a name for the converted archive or cancel if you do not want to perform the conversion.", vbInformation, "WinMPQ"
+ CwadName = CD.FileName
+ CD.Flags = &H1000 Or &H4 Or &H2
+ CD.DefaultExt = "mpq"
+ CD.Filter = "Mpq Archive (*.mpq)|*.mpq"
+ CD.hwndOwner = hWnd
+ CD.FileName = CwadName + ".mpq"
+ If ShowSave(CD) Then
+ If CD.FileName = CwadName Then
+ MsgBox "Cannot overwrite source archive.", vbExclamation, "WinMPQ"
+ CWadCloseArchive hCwad
+ Exit Sub
+ End If
+
+ BufSize = CWadListFiles(hCwad, ListBuffer, 0)
+ If BufSize > 0 Then ListBuffer = String$(BufSize - 1, Chr$(0))
+ CWadListFiles hCwad, ListBuffer, BufSize
+ MultiStringToArray ListBuffer, Files
+
+ If FileExists(CD.FileName) Then Kill CD.FileName
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ = 0 Then
+ StatBar.SimpleText = "Can't create archive " + CD.FileName
+ Else
+ dwFlags = MAFA_REPLACE_EXISTING
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
+
+ For nFile = 1 To UBound(Files)
+ If CWadOpenFile(hCwad, Files(nFile), 0, hFile) Then
+ fLen = CWadGetFileSize(hFile)
+
+ If fLen > 0 Then
+ ReDim buffer(fLen - 1)
+ Else
+ ReDim buffer(0)
+ End If
+
+ CWadSetFilePointer hFile, 0, FILE_BEGIN
+ CWadReadFile hFile, buffer(0), fLen, fLen
+ CWadCloseFile hFile
+
+ StatBar.SimpleText = "Adding " + Files(nFile) + "..."
+ MousePointer = 11
+ If mnuMCNone.Checked Then
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags, 0, 0
+ ElseIf mnuMCStandard.Checked Then
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+ ElseIf mnuMCDeflate.Checked Then
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
+ ElseIf mnuMCAMedium.Checked Then
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 0
+ ElseIf mnuMCAHighest.Checked Then
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 1
+ ElseIf mnuMCALowest.Checked Then
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 2
+ ElseIf mnuMCAuto.Checked Then
+ mAddAutoFromBuffer hMPQ, buffer(0), fLen, Files(nFile)
+ End If
+ End If
+ Next nFile
+
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
+ Else
+ CD.FileName = CwadName
+ End If
+
+ CWadCloseArchive hCwad
+ End If
+End Sub
+
Sub DelRecentFile(rFileName As String)
Dim bNum As Long, fNum As Long
For bNum = 1 To 8
Next lIndex
End Sub
Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)
-Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long
-RetVal = ShellExecute(hWnd, mnuItem(Index).Tag, FileName, vbNullString, vbNullString, 1)
-If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then
- Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")
- Do
- If InStr(Param, "%1") = 0 Then
- Param = Param + " " + FileName
- Else
- bNum = InStr(Param, "%1")
- Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
- End If
- Loop While InStr(Param, "%1")
- bNum = 1
- Do While bNum <= Len(Param)
- If InStr(bNum, Param, "%") Then
- bNum = InStr(bNum, Param, "%")
- If InStr(bNum + 1, Param, "%") Then
- bNum2 = InStr(bNum + 1, Param, "%")
- EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)
- If Environ(EnvName) <> "" Then
- Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)
- End If
- End If
- End If
- bNum = bNum + 1
- Loop
- On Error GoTo NoProgram
- Shell Param, 1
- On Error GoTo 0
-End If
-Exit Sub
-NoProgram:
-If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
+Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO
+If Index < mnuRoot.Tag Then
+ With sei
+ .cbSize = Len(sei)
+ .fMask = 0
+ .hWnd = hWnd
+ .lpVerb = mnuItem(Index).Tag
+ .lpFile = FileName
+ .lpParameters = vbNullString
+ .lpDirectory = vbNullString
+ .nShow = 1
+ End With
+ RetVal = ShellExecuteEx(sei)
+Else
+ With sei
+ .cbSize = Len(sei)
+ .fMask = SEE_MASK_CLASSNAME
+ .hWnd = hWnd
+ .lpVerb = mnuItem(Index).Tag
+ .lpFile = FileName
+ .lpParameters = vbNullString
+ .lpDirectory = vbNullString
+ .nShow = 1
+ .lpClass = "Unknown"
+ End With
+ RetVal = ShellExecuteEx(sei)
+End If
+'If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then
+' Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")
+' Do
+' If InStr(Param, "%1") = 0 Then
+' Param = Param + " " + FileName
+' Else
+' bNum = InStr(Param, "%1")
+' Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
+' End If
+' Loop While InStr(Param, "%1")
+' bNum = 1
+' Do While bNum <= Len(Param)
+' If InStr(bNum, Param, "%") Then
+' bNum = InStr(bNum, Param, "%")
+' If InStr(bNum + 1, Param, "%") Then
+' bNum2 = InStr(bNum + 1, Param, "%")
+' EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)
+' If Environ(EnvName) <> "" Then
+' Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)
+' End If
+' End If
+' End If
+' bNum = bNum + 1
+' Loop
+' On Error GoTo NoProgram
+' Shell Param, 1
+' On Error GoTo 0
+'End If
+'Exit Sub
+'NoProgram:
+'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
End Sub
Sub RunMpq2kCommand(CmdLine As String)
Dim sLine As String, pNum As Long, Param() As String, EndParam As Long, CurPath As String, cType As Integer, Rswitch As Boolean, fCount As Long, Files As String, fEndLine As Long, fLine As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String, TItem As Menu, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, FileShortNames() As String, dwFlags As Long
GoTo FileOpened
End If
On Error GoTo 0
+
+If IsMPQ(CD.FileName) = False Then
+ ConvertCwad
+End If
+
If IsMPQ(CD.FileName) = False Then
CD.FileName = ""
MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"
List.Sorted = False
FileFilter = mFilter
StatBar.SimpleText = "Building list... 0% complete"
+mFilter.Clear
For fNum = 0 To UBound(FileEntries)
#If InternalListing Then
If Mpq.FileExists(CD.FileName, FileList(fNum)) Then
AddRecentFile CD.FileName
MousePointer = 0
End Sub
+
Sub RemoveDuplicates()
Dim fNum As Long
fNum = 1
Loop
End Sub
Sub ShowSelected()
-Dim fNum As Long, nSelect As Long, sSize As Long, fSize As Long, L2 As String, hMPQ As Long, hFile As Long
+Dim fNum As Long, nSelect As Long, sSize As Currency, fSize As Long, L2 As String, hMPQ As Long, hFile As Long
On Error GoTo NotSelected
List.SelectedItem.Tag = List.SelectedItem.Tag
On Error GoTo 0
+On Error Resume Next
For fNum = 1 To List.ListItems.Count
If List.ListItems.Item(fNum).Selected Then
nSelect = nSelect + 1
Else
StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
End If
+On Error GoTo 0
Exit Sub
NotSelected:
StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
End Sub
Sub ShowTotal()
-Dim fNum As Long, nFiles As Long, tSize As Long
+Dim fNum As Long, nFiles As Long, tSize As Currency
+On Error Resume Next
For fNum = 1 To List.ListItems.Count
nFiles = nFiles + 1
If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
Else
StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
End If
+On Error GoTo 0
End Sub
Private Sub cmdGo_Click()
StatBar.Style = 1
If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
+DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)
LocaleID = GetReg(AppKey + "LocaleID", 0)
GlobalEncrypt = False
DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
cmdGo.Top = txtCommand.Top
cmdGo.Left = txtCommand.Left + txtCommand.Width
+ mFilter.Left = Toolbar.Buttons.Item("filterspace").Left
mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
End If
Dim TItem As Menu
CD.Flags = &H1000 Or &H4 Or &H2
CD.DefaultExt = "mpq"
-CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
+CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"
CD.hwndOwner = hWnd
If ShowSave(CD) = False Then GoTo Cancel
ReDim FileList(0) As String
Private Sub mnuFOpen_Click()
Dim OldFileName As String
CD.Flags = &H1000 Or &H4 Or &H2
-CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
+CD.Filter = "All Archives|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x;*.cwd|Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|Cwad Archives (*.cwd;*.exe)|*.cwd;*.exe|All Files (*.*)|*.*"
OldFileName = CD.FileName
CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
|