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:
18 files changed:
| .gitattributes | [new file with mode: 0644] | patch | blob |
| About.frm | patch | blob | blame | history | |
| ChLCID.frm | patch | blob | blame | history | |
| CwadLib.bas | patch | blob | blame | history | |
| EditTItem.frm | patch | blob | blame | history | |
| FileDialog.bas | patch | blob | blame | history | |
| FixIcon.bas | patch | blob | blame | history | |
| FoldName.frm | patch | blob | blame | history | |
| MpqStuff.bas | patch | blob | blame | history | |
| Options.frm | patch | blob | blame | history | |
| Registry.bas | patch | blob | blame | history | |
| SFmpqapi.bas | patch | blob | blame | history | |
| ScriptOut.frm | patch | blob | blame | history | |
| ToolList.frm | patch | blob | blame | history | |
| WinMPQ.vbp | patch | blob | blame | history | |
| frmAddToList.frm | patch | blob | blame | history | |
| frmMpq.frm | patch | blob | blame | history | |
| listing.frm | patch | blob | blame | history |
diff --git a/.gitattributes b/.gitattributes
--- /dev/null
+++ b/.gitattributes
@@ -0,0 +1,8 @@
+*.bas -crlf
+*.frm -crlf
+*.frx -crlf
+*.gif -crlf
+*.ico -crlf
+*.res -crlf
+*.rtf -crlf
+*.vbp -crlf
diff --git a/About.frm b/About.frm
--- a/About.frm
+++ b/About.frm
-VERSION 4.00
-Begin VB.Form About
- BorderStyle = 3 'Fixed Dialog
- Caption = "About"
- ClientHeight = 1575
- ClientLeft = 1890
- ClientTop = 2265
- ClientWidth = 5820
- Height = 1980
- Icon = "About.frx":0000
- Left = 1830
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1575
- ScaleWidth = 5820
- ShowInTaskbar = 0 'False
- Top = 1920
- Width = 5940
- Begin VB.CommandButton Command1
- Caption = "O&k"
- Default = -1 'True
- Height = 375
- Left = 4920
- TabIndex = 3
- Top = 120
- Width = 735
- End
- Begin VB.Label Label5
- BackStyle = 0 'Transparent
- Caption = "This program uses "
- Height = 255
- Left = 120
- TabIndex = 5
- Top = 1320
- Width = 5535
- End
- Begin VB.Label Label4
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "E-mail: blakflare@hotmail.com"
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Times New Roman"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = -1 'True
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00FF0000&
- Height = 210
- Left = 120
- TabIndex = 4
- Top = 1080
- Width = 2280
- End
- Begin VB.Label Label3
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "ShadowFlare's Realm - http://sfsrealm.hopto.org/"
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Times New Roman"
- Size = 9.75
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = -1 'True
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00FF0000&
- Height = 480
- Left = 120
- TabIndex = 2
- Top = 600
- Width = 3855
- WordWrap = -1 'True
- End
- Begin VB.Label Label2
- AutoSize = -1 'True
- Caption = "Copyright © ShadowFlare Software"
- Height = 195
- Left = 120
- TabIndex = 1
- Top = 360
- Width = 2490
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "WinMPQ v"
- Height = 195
- Left = 120
- TabIndex = 0
- Top = 120
- Width = 780
- End
-End
-Attribute VB_Name = "About"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-Function GetAppVersionString() As String
-GetAppVersionString = CStr(App.Major) + "."
-If Len(CStr(App.Minor)) < 2 Then
- GetAppVersionString = GetAppVersionString + "0" + CStr(App.Minor)
-Else
- GetAppVersionString = GetAppVersionString + CStr(App.Minor)
-End If
-If App.Revision <> 0 Then
- If Len(CStr(App.Revision)) < 4 Then
- GetAppVersionString = GetAppVersionString + "." + String(4 - Len(CStr(App.Revision)), "0") + CStr(App.Revision)
- Else
- GetAppVersionString = GetAppVersionString + "." + CStr(App.Revision)
- End If
-End If
-End Function
-Private Sub Command1_Click()
-Unload Me
-End Sub
-Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = False
-End Sub
-Private Sub Form_Load()
-Dim SFmpqString As String
-Left = MpqEx.Left + 330
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-Caption = "About " + App.Title
-Label1 = App.Title + " v"
-Label1 = Label1 + GetAppVersionString
-Label2 = App.LegalCopyright
-SFmpqString = String(SFMpqGetVersionString2(NullPtr, 0) - 1, Chr(0))
-SFMpqGetVersionString2 SFmpqString, SFMpqGetVersionString2(NullPtr, 0)
-Label5 = Label5 + SFmpqString
-End Sub
-Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = False
-End Sub
-Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = False
-End Sub
-Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = False
-End Sub
-Private Sub Label3_Click()
-ShellExecute hWnd, vbNullString, "http://sfsrealm.hopto.org/", vbNullString, vbNullString, 1
-End Sub
-Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF00&
-End Sub
-Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF&
-Label3.Font.underline = True
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = False
-End Sub
-Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-End Sub
-Private Sub Label4_Click()
-ShellExecute hWnd, vbNullString, "mailto:blakflare@hotmail.com", vbNullString, vbNullString, 1
-End Sub
-Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label4.ForeColor = &HFF00&
-End Sub
-Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF&
-Label4.Font.underline = True
-Label5.Font.underline = False
-End Sub
-Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-End Sub
-Private Sub Label5_Click()
-AboutSFMpq
-End Sub
-Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label3.ForeColor = &HFF0000
-Label3.Font.underline = False
-Label4.ForeColor = &HFF0000
-Label4.Font.underline = False
-Label5.Font.underline = True
-End Sub
-Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
-Label5.Font.underline = False
-End Sub
+VERSION 4.00\r
+Begin VB.Form About \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "About"\r
+ ClientHeight = 1575\r
+ ClientLeft = 1890\r
+ ClientTop = 2265\r
+ ClientWidth = 5820\r
+ Height = 1980\r
+ Icon = "About.frx":0000\r
+ Left = 1830\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 1575\r
+ ScaleWidth = 5820\r
+ ShowInTaskbar = 0 'False\r
+ Top = 1920\r
+ Width = 5940\r
+ Begin VB.CommandButton Command1 \r
+ Caption = "O&k"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 4920\r
+ TabIndex = 3\r
+ Top = 120\r
+ Width = 735\r
+ End\r
+ Begin VB.Label Label5 \r
+ BackStyle = 0 'Transparent\r
+ Caption = "This program uses "\r
+ Height = 255\r
+ Left = 120\r
+ TabIndex = 5\r
+ Top = 1320\r
+ Width = 5535\r
+ End\r
+ Begin VB.Label Label4 \r
+ AutoSize = -1 'True\r
+ BackStyle = 0 'Transparent\r
+ Caption = "E-mail: blakflare@hotmail.com"\r
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} \r
+ Name = "Times New Roman"\r
+ Size = 8.25\r
+ Charset = 0\r
+ Weight = 700\r
+ Underline = 0 'False\r
+ Italic = -1 'True\r
+ Strikethrough = 0 'False\r
+ EndProperty\r
+ ForeColor = &H00FF0000&\r
+ Height = 210\r
+ Left = 120\r
+ TabIndex = 4\r
+ Top = 1080\r
+ Width = 2280\r
+ End\r
+ Begin VB.Label Label3 \r
+ AutoSize = -1 'True\r
+ BackStyle = 0 'Transparent\r
+ Caption = "ShadowFlare's Realm - http://sfsrealm.hopto.org/"\r
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} \r
+ Name = "Times New Roman"\r
+ Size = 9.75\r
+ Charset = 0\r
+ Weight = 700\r
+ Underline = 0 'False\r
+ Italic = -1 'True\r
+ Strikethrough = 0 'False\r
+ EndProperty\r
+ ForeColor = &H00FF0000&\r
+ Height = 480\r
+ Left = 120\r
+ TabIndex = 2\r
+ Top = 600\r
+ Width = 3855\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Label Label2 \r
+ AutoSize = -1 'True\r
+ Caption = "Copyright © ShadowFlare Software"\r
+ Height = 195\r
+ Left = 120\r
+ TabIndex = 1\r
+ Top = 360\r
+ Width = 2490\r
+ End\r
+ Begin VB.Label Label1 \r
+ AutoSize = -1 'True\r
+ Caption = "WinMPQ v"\r
+ Height = 195\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 120\r
+ Width = 780\r
+ End\r
+End\r
+Attribute VB_Name = "About"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+Function GetAppVersionString() As String\r
+GetAppVersionString = CStr(App.Major) + "."\r
+If Len(CStr(App.Minor)) < 2 Then\r
+ GetAppVersionString = GetAppVersionString + "0" + CStr(App.Minor)\r
+Else\r
+ GetAppVersionString = GetAppVersionString + CStr(App.Minor)\r
+End If\r
+If App.Revision <> 0 Then\r
+ If Len(CStr(App.Revision)) < 4 Then\r
+ GetAppVersionString = GetAppVersionString + "." + String(4 - Len(CStr(App.Revision)), "0") + CStr(App.Revision)\r
+ Else\r
+ GetAppVersionString = GetAppVersionString + "." + CStr(App.Revision)\r
+ End If\r
+End If\r
+End Function\r
+Private Sub Command1_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Form_Load()\r
+Dim SFmpqString As String\r
+Left = MpqEx.Left + 330\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+Caption = "About " + App.Title\r
+Label1 = App.Title + " v"\r
+Label1 = Label1 + GetAppVersionString\r
+Label2 = App.LegalCopyright\r
+SFmpqString = String(SFMpqGetVersionString2(NullPtr, 0) - 1, Chr(0))\r
+SFMpqGetVersionString2 SFmpqString, SFMpqGetVersionString2(NullPtr, 0)\r
+Label5 = Label5 + SFmpqString\r
+End Sub\r
+Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Label3_Click()\r
+ShellExecute hWnd, vbNullString, "http://sfsrealm.hopto.org/", vbNullString, vbNullString, 1\r
+End Sub\r
+Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF00&\r
+End Sub\r
+Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF&\r
+Label3.Font.underline = True\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+End Sub\r
+Private Sub Label4_Click()\r
+ShellExecute hWnd, vbNullString, "mailto:blakflare@hotmail.com", vbNullString, vbNullString, 1\r
+End Sub\r
+Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label4.ForeColor = &HFF00&\r
+End Sub\r
+Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF&\r
+Label4.Font.underline = True\r
+Label5.Font.underline = False\r
+End Sub\r
+Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+End Sub\r
+Private Sub Label5_Click()\r
+AboutSFMpq\r
+End Sub\r
+Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label3.ForeColor = &HFF0000\r
+Label3.Font.underline = False\r
+Label4.ForeColor = &HFF0000\r
+Label4.Font.underline = False\r
+Label5.Font.underline = True\r
+End Sub\r
+Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Label5.Font.underline = False\r
+End Sub\r
diff --git a/ChLCID.frm b/ChLCID.frm
--- a/ChLCID.frm
+++ b/ChLCID.frm
-VERSION 4.00
-Begin VB.Form ChLCID
- BorderStyle = 3 'Fixed Dialog
- Caption = "Changing Locale ID..."
- ClientHeight = 1335
- ClientLeft = 2670
- ClientTop = 3180
- ClientWidth = 3615
- Height = 1740
- Icon = "ChLCID.frx":0000
- Left = 2610
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1335
- ScaleWidth = 3615
- ShowInTaskbar = 0 'False
- Top = 2835
- Width = 3735
- Begin VB.CommandButton Command2
- Cancel = -1 'True
- Caption = "&Cancel"
- Height = 375
- Left = 1920
- TabIndex = 3
- Top = 840
- Width = 1335
- End
- Begin VB.CommandButton Command1
- Caption = "O&K"
- Default = -1 'True
- Height = 375
- Left = 360
- TabIndex = 2
- Top = 840
- Width = 1335
- End
- Begin VB.TextBox Text1
- Height = 285
- Left = 120
- TabIndex = 1
- Text = "0"
- Top = 480
- Width = 1215
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Type in the new locale ID for the file(s) below."
- Height = 195
- Left = 120
- TabIndex = 0
- Top = 120
- Width = 3225
- End
-End
-Attribute VB_Name = "ChLCID"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-Private Sub Command1_Click()
-MpqEx.ChangeLCID Text1
-Unload Me
-End Sub
-Private Sub Command2_Click()
-Unload Me
-End Sub
-Private Sub Form_Load()
-Left = MpqEx.Left + 330 * 2
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315 * 2
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-End Sub
-Private Sub Text1_KeyPress(KeyAscii As Integer)
-Dim NewValue As Long
-If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0
-On Error GoTo TooBig
-If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text1 + Chr(KeyAscii))
-On Error GoTo 0
-Exit Sub
-TooBig:
-KeyAscii = 0
-End Sub
-Private Sub Text1_LostFocus()
-If Text1 = "" Then Text1 = 0
-End Sub
+VERSION 4.00\r
+Begin VB.Form ChLCID \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Changing Locale ID..."\r
+ ClientHeight = 1335\r
+ ClientLeft = 2670\r
+ ClientTop = 3180\r
+ ClientWidth = 3615\r
+ Height = 1740\r
+ Icon = "ChLCID.frx":0000\r
+ Left = 2610\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 1335\r
+ ScaleWidth = 3615\r
+ ShowInTaskbar = 0 'False\r
+ Top = 2835\r
+ Width = 3735\r
+ Begin VB.CommandButton Command2 \r
+ Cancel = -1 'True\r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 1920\r
+ TabIndex = 3\r
+ Top = 840\r
+ Width = 1335\r
+ End\r
+ Begin VB.CommandButton Command1 \r
+ Caption = "O&K"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 360\r
+ TabIndex = 2\r
+ Top = 840\r
+ Width = 1335\r
+ End\r
+ Begin VB.TextBox Text1 \r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 1\r
+ Text = "0"\r
+ Top = 480\r
+ Width = 1215\r
+ End\r
+ Begin VB.Label Label1 \r
+ AutoSize = -1 'True\r
+ Caption = "Type in the new locale ID for the file(s) below."\r
+ Height = 195\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 120\r
+ Width = 3225\r
+ End\r
+End\r
+Attribute VB_Name = "ChLCID"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+Private Sub Command1_Click()\r
+MpqEx.ChangeLCID Text1\r
+Unload Me\r
+End Sub\r
+Private Sub Command2_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub Form_Load()\r
+Left = MpqEx.Left + 330 * 2\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315 * 2\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+End Sub\r
+Private Sub Text1_KeyPress(KeyAscii As Integer)\r
+Dim NewValue As Long\r
+If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0\r
+On Error GoTo TooBig\r
+If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text1 + Chr(KeyAscii))\r
+On Error GoTo 0\r
+Exit Sub\r
+TooBig:\r
+KeyAscii = 0\r
+End Sub\r
+Private Sub Text1_LostFocus()\r
+If Text1 = "" Then Text1 = 0\r
+End Sub\r
diff --git a/CwadLib.bas b/CwadLib.bas
--- a/CwadLib.bas
+++ b/CwadLib.bas
-Attribute VB_Name = "CwadLib"
-Option Explicit
-
-Public Const CWAD_INFO_NUM_FILES As Long = &H03 ' Number of files in CWAD
-Public Const CWAD_INFO_TYPE As Long = &H04 ' Is HANDLE a file or a CWAD?
-Public Const CWAD_INFO_SIZE As Long = &H05 ' Size of CWAD or uncompressed file
-Public Const CWAD_INFO_COMPRESSED_SIZE As Long = &H06 ' Size of compressed file
-Public Const CWAD_INFO_FLAGS As Long = &H07 ' File flags (compressed, etc.)
-Public Const CWAD_INFO_PARENT As Long = &H08 ' Handle of CWAD that file is in
-Public Const CWAD_INFO_POSITION As Long = &H09 ' Position of file pointer in files
-Public Const CWAD_INFO_PRIORITY As Long = &H0B ' Priority of open CWAD
-
-Public Const CWAD_TYPE_CWAD As Long = &H01
-Public Const CWAD_TYPE_FILE As Long = &H02
-
-Public Const CWAD_SEARCH_CURRENT_ONLY As Long = &H00 ' Used with CWadOpenFile; only the archive with the handle specified will be searched for the file
-Public Const CWAD_SEARCH_ALL_OPEN As Long = &H01 ' CWadOpenFile will look through all open archives for the file
-
-Declare Function CWadOpenArchive Lib "CwadLib.dll" (ByVal lpFileName As String, ByVal dwPriority As Long, ByRef hCWAD As Long) As Boolean
-Declare Function CWadCloseArchive Lib "CwadLib.dll" (ByVal hCWAD As Long) As Boolean
-Declare Function CWadListFiles Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Long ' Returns required buffer size. Strings are in multi string form. (null-terminated strings with an extra null after the last string)
-Declare Function CWadOpenFile Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal lpFileName As String, ByVal dwSearchScope As Long, ByRef hFile As Long) As Boolean
-Declare Function CWadCloseFile Lib "CwadLib.dll" (ByVal hFile As Long) As Boolean
-Declare Function CWadGetFileSize Lib "CwadLib.dll" (ByVal hFile As Long) As Long
-Declare Function CWadGetFileInfo Lib "CwadLib.dll" (ByVal hFile As Long, ByVal dwInfoType As Long) As Long
-Declare Function CWadSetFilePointer Lib "CwadLib.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByVal dwMoveMethod As Long) As Long
-Declare Function CWadReadFile Lib "CwadLib.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long) As Boolean
-Declare Function CWadSetArchivePriority Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal dwPriority As Long) As Boolean
-Declare Function CWadFindHeader Lib "CwadLib.dll" (ByVal hFile As Long) As Long
+Attribute VB_Name = "CwadLib"\r
+Option Explicit\r
+\r
+Public Const CWAD_INFO_NUM_FILES As Long = &H03 ' Number of files in CWAD\r
+Public Const CWAD_INFO_TYPE As Long = &H04 ' Is HANDLE a file or a CWAD?\r
+Public Const CWAD_INFO_SIZE As Long = &H05 ' Size of CWAD or uncompressed file\r
+Public Const CWAD_INFO_COMPRESSED_SIZE As Long = &H06 ' Size of compressed file\r
+Public Const CWAD_INFO_FLAGS As Long = &H07 ' File flags (compressed, etc.)\r
+Public Const CWAD_INFO_PARENT As Long = &H08 ' Handle of CWAD that file is in\r
+Public Const CWAD_INFO_POSITION As Long = &H09 ' Position of file pointer in files\r
+Public Const CWAD_INFO_PRIORITY As Long = &H0B ' Priority of open CWAD\r
+\r
+Public Const CWAD_TYPE_CWAD As Long = &H01\r
+Public Const CWAD_TYPE_FILE As Long = &H02\r
+\r
+Public Const CWAD_SEARCH_CURRENT_ONLY As Long = &H00 ' Used with CWadOpenFile; only the archive with the handle specified will be searched for the file\r
+Public Const CWAD_SEARCH_ALL_OPEN As Long = &H01 ' CWadOpenFile will look through all open archives for the file\r
+\r
+Declare Function CWadOpenArchive Lib "CwadLib.dll" (ByVal lpFileName As String, ByVal dwPriority As Long, ByRef hCWAD As Long) As Boolean\r
+Declare Function CWadCloseArchive Lib "CwadLib.dll" (ByVal hCWAD As Long) As Boolean\r
+Declare Function CWadListFiles Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Long ' Returns required buffer size. Strings are in multi string form. (null-terminated strings with an extra null after the last string)\r
+Declare Function CWadOpenFile Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal lpFileName As String, ByVal dwSearchScope As Long, ByRef hFile As Long) As Boolean\r
+Declare Function CWadCloseFile Lib "CwadLib.dll" (ByVal hFile As Long) As Boolean\r
+Declare Function CWadGetFileSize Lib "CwadLib.dll" (ByVal hFile As Long) As Long\r
+Declare Function CWadGetFileInfo Lib "CwadLib.dll" (ByVal hFile As Long, ByVal dwInfoType As Long) As Long\r
+Declare Function CWadSetFilePointer Lib "CwadLib.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByVal dwMoveMethod As Long) As Long\r
+Declare Function CWadReadFile Lib "CwadLib.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long) As Boolean\r
+Declare Function CWadSetArchivePriority Lib "CwadLib.dll" (ByVal hCWAD As Long, ByVal dwPriority As Long) As Boolean\r
+Declare Function CWadFindHeader Lib "CwadLib.dll" (ByVal hFile As Long) As Long\r
diff --git a/EditTItem.frm b/EditTItem.frm
--- a/EditTItem.frm
+++ b/EditTItem.frm
-VERSION 4.00
-Begin VB.Form EditTItem
- BorderStyle = 3 'Fixed Dialog
- ClientHeight = 2535
- ClientLeft = 1890
- ClientTop = 2145
- ClientWidth = 5535
- Height = 2940
- Icon = "EditTItem.frx":0000
- Left = 1830
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 2535
- ScaleWidth = 5535
- ShowInTaskbar = 0 'False
- Top = 1800
- Width = 5655
- Begin VB.CommandButton cmdBrowse
- Caption = "&Browse..."
- Height = 285
- Left = 4560
- TabIndex = 2
- Top = 1680
- Width = 855
- End
- Begin VB.CommandButton cmdCancel
- Cancel = -1 'True
- Caption = "&Cancel"
- Height = 375
- Left = 3120
- TabIndex = 4
- Top = 2040
- Width = 1455
- End
- Begin VB.CommandButton cmdOK
- Caption = "O&K"
- Default = -1 'True
- Height = 375
- Left = 960
- TabIndex = 3
- Top = 2040
- Width = 1455
- End
- Begin VB.TextBox txtCommand
- Height = 285
- Left = 120
- TabIndex = 1
- Top = 1680
- Width = 4335
- End
- Begin VB.TextBox txtName
- Height = 285
- Left = 120
- TabIndex = 0
- Top = 480
- Width = 5295
- End
- Begin VB.Label Label1
- Caption = "Title: (Use a && before a letter to make it the key for the menu option. Use &&&& to display a &&.)"
- Height = 390
- Left = 120
- TabIndex = 5
- Top = 0
- Width = 5295
- WordWrap = -1 'True
- End
- Begin VB.Label Label2
- Caption = $"EditTItem.frx":000C
- Height = 870
- Left = 120
- TabIndex = 6
- Top = 840
- Width = 5295
- WordWrap = -1 'True
- End
-End
-Attribute VB_Name = "EditTItem"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Dim ClickedOK As Boolean, Finished As Boolean
-Function EditItem(FormCaption As String, cName As String, cCommand As String) As String
-Left = ToolList.Left + 330
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = ToolList.Top + 315
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-Caption = FormCaption
-txtName = cName
-txtCommand = cCommand
-Finished = False
-ClickedOK = False
-Show 1
-If ClickedOK = True Then
- EditItem = txtName + vbCrLf + txtCommand
-Else
- EditItem = cName + vbCrLf + cCommand
-End If
-Finished = True
-Unload Me
-End Function
-Private Sub cmdBrowse_Click()
-Dim OldFileName As String, OldPath As String
-CD.Flags = &H1000 Or &H4 Or &H2
-CD.Filter = "Programs (*.exe;*.com;*.bat)|*.exe;*.com;*.bat|All Files (*.*)|*.*"
-OldFileName = CD.FileName
-OldPath = CurDir
-If Mid(App.Path, 2, 1) = ":" Then
- ChDrive Left(App.Path, 1)
- ChDir Left(App.Path, 2) + "\"
-End If
-CD.FileName = ""
-CD.hwndOwner = hWnd
-If ShowOpen(CD) = False Then GoTo Cancel
-txtCommand = Chr(34) + CD.FileName + Chr(34)
-Cancel:
-CD.FileName = OldFileName
-If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
-ChDir OldPath
-End Sub
-Private Sub cmdCancel_Click()
-Hide
-End Sub
-Private Sub cmdOK_Click()
-ClickedOK = True
-Hide
-End Sub
-Private Sub Form_Unload(Cancel As Integer)
-If Finished = False Then
- Cancel = True
- Hide
-End If
-End Sub
+VERSION 4.00\r
+Begin VB.Form EditTItem \r
+ BorderStyle = 3 'Fixed Dialog\r
+ ClientHeight = 2535\r
+ ClientLeft = 1890\r
+ ClientTop = 2145\r
+ ClientWidth = 5535\r
+ Height = 2940\r
+ Icon = "EditTItem.frx":0000\r
+ Left = 1830\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 2535\r
+ ScaleWidth = 5535\r
+ ShowInTaskbar = 0 'False\r
+ Top = 1800\r
+ Width = 5655\r
+ Begin VB.CommandButton cmdBrowse \r
+ Caption = "&Browse..."\r
+ Height = 285\r
+ Left = 4560\r
+ TabIndex = 2\r
+ Top = 1680\r
+ Width = 855\r
+ End\r
+ Begin VB.CommandButton cmdCancel \r
+ Cancel = -1 'True\r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 3120\r
+ TabIndex = 4\r
+ Top = 2040\r
+ Width = 1455\r
+ End\r
+ Begin VB.CommandButton cmdOK \r
+ Caption = "O&K"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 960\r
+ TabIndex = 3\r
+ Top = 2040\r
+ Width = 1455\r
+ End\r
+ Begin VB.TextBox txtCommand \r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 1\r
+ Top = 1680\r
+ Width = 4335\r
+ End\r
+ Begin VB.TextBox txtName \r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 480\r
+ Width = 5295\r
+ End\r
+ Begin VB.Label Label1 \r
+ Caption = "Title: (Use a && before a letter to make it the key for the menu option. Use &&&& to display a &&.)"\r
+ Height = 390\r
+ Left = 120\r
+ TabIndex = 5\r
+ Top = 0\r
+ Width = 5295\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Label Label2 \r
+ Caption = $"EditTItem.frx":000C\r
+ Height = 870\r
+ Left = 120\r
+ TabIndex = 6\r
+ Top = 840\r
+ Width = 5295\r
+ WordWrap = -1 'True\r
+ End\r
+End\r
+Attribute VB_Name = "EditTItem"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Dim ClickedOK As Boolean, Finished As Boolean\r
+Function EditItem(FormCaption As String, cName As String, cCommand As String) As String\r
+Left = ToolList.Left + 330\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = ToolList.Top + 315\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+Caption = FormCaption\r
+txtName = cName\r
+txtCommand = cCommand\r
+Finished = False\r
+ClickedOK = False\r
+Show 1\r
+If ClickedOK = True Then\r
+ EditItem = txtName + vbCrLf + txtCommand\r
+Else\r
+ EditItem = cName + vbCrLf + cCommand\r
+End If\r
+Finished = True\r
+Unload Me\r
+End Function\r
+Private Sub cmdBrowse_Click()\r
+Dim OldFileName As String, OldPath As String\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+CD.Filter = "Programs (*.exe;*.com;*.bat)|*.exe;*.com;*.bat|All Files (*.*)|*.*"\r
+OldFileName = CD.FileName\r
+OldPath = CurDir\r
+If Mid(App.Path, 2, 1) = ":" Then\r
+ ChDrive Left(App.Path, 1)\r
+ ChDir Left(App.Path, 2) + "\"\r
+End If\r
+CD.FileName = ""\r
+CD.hwndOwner = hWnd\r
+If ShowOpen(CD) = False Then GoTo Cancel\r
+txtCommand = Chr(34) + CD.FileName + Chr(34)\r
+Cancel:\r
+CD.FileName = OldFileName\r
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)\r
+ChDir OldPath\r
+End Sub\r
+Private Sub cmdCancel_Click()\r
+Hide\r
+End Sub\r
+Private Sub cmdOK_Click()\r
+ClickedOK = True\r
+Hide\r
+End Sub\r
+Private Sub Form_Unload(Cancel As Integer)\r
+If Finished = False Then\r
+ Cancel = True\r
+ Hide\r
+End If\r
+End Sub\r
diff --git a/FileDialog.bas b/FileDialog.bas
--- a/FileDialog.bas
+++ b/FileDialog.bas
-Attribute VB_Name = "FileDialog"
-Option Explicit
-
-Public NullPtr As String
-
-Type OPENFILENAME
- lStructSize As Long
- hwndOwner As Long
- hInstance As Long
- Filter As String
- CustomFilter As String
- nMaxCustFilter As Long
- FilterIndex As Long
- FileName As String
- MaxFileSize As Long
- FileTitle As String
- MaxFileTitleSize As Long
- InitDir As String
- DialogTitle As String
- Flags As Long
- nFileOffset As Integer
- nFileExtension As Integer
- DefaultExt As String
- lCustData As Long
- lpfnHook As Long
- lpTemplateName As String
-End Type
-
-Type BROWSEINFO
- hwndOwner As Long
- pidlRoot As Long
- DisplayName As String
- Title As String
- Flags As Long
- lpfn As Long
- lParam As Long
- iImage As Long
-End Type
-
-Declare Function CommDlgExtendedError Lib "Comdlg32.dll" () As Long
-Declare Function GetOpenFileName Lib "Comdlg32.dll" _
- Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Boolean
-Declare Function GetSaveFileName Lib "Comdlg32.dll" _
- Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Boolean
-Declare Function SHBrowseForFolder Lib "Shell32.dll" _
- (lpbi As BROWSEINFO) As Long
-Declare Function SHGetPathFromIDList Lib "Shell32.dll" ( _
- pidl As Long, _
- ByRef pszPath As Byte) As Boolean
-
-Public Const OFN_READONLY As Long = &H1
-Public Const OFN_OVERWRITEPROMPT As Long = &H2
-Public Const OFN_HIDEREADONLY As Long = &H4
-Public Const OFN_NOCHANGEDIR As Long = &H8
-Public Const OFN_SHOWHELP As Long = &H10
-Public Const OFN_ENABLEHOOK As Long = &H20
-Public Const OFN_ENABLETEMPLATE As Long = &H40
-Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
-Public Const OFN_NOVALIDATE As Long = &H100
-Public Const OFN_ALLOWMULTISELECT As Long = &H200
-Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
-Public Const OFN_PATHMUSTEXIST As Long = &H800
-Public Const OFN_FILEMUSTEXIST As Long = &H1000
-Public Const OFN_CREATEPROMPT As Long = &H2000
-Public Const OFN_SHAREAWARE As Long = &H4000
-Public Const OFN_NOREADONLYRETURN As Long = &H8000
-Public Const OFN_NOTESTFILECREATE As Long = &H10000
-Public Const OFN_NONETWORKBUTTON As Long = &H20000
-Public Const OFN_NOLONGNAMES As Long = &H40000 ' force no long names for 4.x modules
-Public Const OFN_EXPLORER As Long = &H80000 ' new look commdlg
-Public Const OFN_NODEREFERENCELINKS As Long = &H100000
-Public Const OFN_LONGNAMES As Long = &H200000 ' force long names for 3.x modules
-Public Const OFN_ENABLEINCLUDENOTIFY As Long = &H400000 ' send include message to callback
-Public Const OFN_ENABLESIZING As Long = &H800000
-
-Public Const BIF_RETURNONLYFSDIRS As Long = &H1 ' For finding a folder to start document searching
-Public Const BIF_DONTGOBELOWDOMAIN As Long = &H2 ' For starting the Find Computer
-Public Const BIF_STATUSTEXT As Long = &H4
-Public Const BIF_RETURNFSANCESTORS As Long = &H8
-Public Const BIF_EDITBOX As Long = &H10
-Public Const BIF_VALIDATE As Long = &H20 ' insist on valid result (or CANCEL)
-
-Public Const BIF_BROWSEFORCOMPUTER As Long = &H1000 ' Browsing for Computers.
-Public Const BIF_BROWSEFORPRINTER As Long = &H2000 ' Browsing for Printers
-Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000 ' Browsing for Everything
-
-Function GetPathFromID(ByVal dwID As Long) As String
-Dim buffer(1 To 260) As Byte
-GetPathFromID = NullPtr
-If SHGetPathFromIDList(ByVal dwID, buffer(1)) Then
- GetPathFromID = StrConv(buffer, vbUnicode)
- StripNull GetPathFromID
-End If
-End Function
-Sub ReplaceChar(ByRef TextStr As String, ByVal Char As String, ByVal NewChar As String)
-If Len(Char) > 1 Then Char = Left$(Char, 1)
-If Len(NewChar) > 1 Then NewChar = Left$(NewChar, 1)
-Dim cNum As Long, cNum2 As Long
-For cNum = 1 To Len(TextStr)
- cNum2 = InStr(cNum, TextStr, Char)
- If cNum2 Then
- cNum = cNum2
- Mid$(TextStr, cNum, 1) = NewChar
- Else
- Exit Sub
- End If
-Next cNum
-End Sub
-Sub StripNull(ByRef TextStr As String)
-Dim cNum As Long
-cNum = InStr(1, TextStr, Chr$(0))
-If cNum Then
- TextStr = Left(TextStr, cNum - 1)
-End If
-End Sub
-Sub StripNullMulti(ByRef TextStr As String)
-Dim cNum As Long, cNum2 As Long
-For cNum = 1 To Len(TextStr)
- cNum2 = InStr(cNum, TextStr, Chr$(0))
- If cNum2 Then
- cNum = cNum2
- cNum2 = InStr(cNum + 1, TextStr, Chr$(0))
- If cNum + 1 = cNum2 Or cNum2 = 0 Then
- TextStr = Left(TextStr, cNum - 1)
- Exit Sub
- End If
- Else
- Exit Sub
- End If
-Next cNum
-End Sub
-Sub InitFileDialog(ByRef lpFileDialog As OPENFILENAME)
-lpFileDialog.lStructSize = Len(lpFileDialog)
-lpFileDialog.hwndOwner = 0
-lpFileDialog.hInstance = 0
-lpFileDialog.Filter = NullPtr
-lpFileDialog.CustomFilter = NullPtr
-lpFileDialog.nMaxCustFilter = 0
-lpFileDialog.FilterIndex = 0
-lpFileDialog.FileName = NullPtr
-lpFileDialog.MaxFileSize = 260
-lpFileDialog.FileTitle = NullPtr
-lpFileDialog.MaxFileTitleSize = 260
-lpFileDialog.InitDir = NullPtr
-lpFileDialog.DialogTitle = NullPtr
-lpFileDialog.Flags = 0
-lpFileDialog.nFileOffset = 0
-lpFileDialog.nFileExtension = 0
-lpFileDialog.DefaultExt = NullPtr
-lpFileDialog.lCustData = 0
-lpFileDialog.lpfnHook = 0
-lpFileDialog.lpTemplateName = NullPtr
-End Sub
-Sub InitFolderDialog(ByRef lpFolderDialog As BROWSEINFO)
-lpFolderDialog.hwndOwner = 0
-lpFolderDialog.pidlRoot = 0
-lpFolderDialog.DisplayName = NullPtr
-lpFolderDialog.Title = NullPtr
-lpFolderDialog.Flags = 0
-lpFolderDialog.lpfn = 0
-lpFolderDialog.lParam = 0
-lpFolderDialog.iImage = 0
-End Sub
-Function ShowOpen(ByRef lpFileDialog As OPENFILENAME) As Boolean
-lpFileDialog.lStructSize = Len(lpFileDialog)
-ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
-lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
-If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
- lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
-If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
- lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
-ShowOpen = GetOpenFileName(lpFileDialog)
-lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
-ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
-If lpFileDialog.Flags And (OFN_ALLOWMULTISELECT Or OFN_EXPLORER) Then
- StripNullMulti lpFileDialog.FileName
- StripNullMulti lpFileDialog.FileTitle
-Else
- StripNull lpFileDialog.FileName
- StripNull lpFileDialog.FileTitle
-End If
-End Function
-Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean
-lpFileDialog.lStructSize = Len(lpFileDialog)
-ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
-lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
-If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
- lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
-If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
- lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
-ShowSave = GetSaveFileName(lpFileDialog)
-lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
-ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
-StripNull lpFileDialog.FileName
-StripNull lpFileDialog.FileTitle
-End Function
-Function ShowFolder(ByRef lpFolderDialog As BROWSEINFO) As Long
-If Len(lpFolderDialog.DisplayName) <= 260 Then _
- lpFolderDialog.DisplayName = lpFolderDialog.DisplayName + String$(260 - Len(lpFolderDialog.DisplayName), Chr$(0))
-ShowFolder = SHBrowseForFolder(lpFolderDialog)
-StripNull lpFolderDialog.DisplayName
-End Function
+Attribute VB_Name = "FileDialog"\r
+Option Explicit\r
+\r
+Public NullPtr As String\r
+\r
+Type OPENFILENAME\r
+ lStructSize As Long\r
+ hwndOwner As Long\r
+ hInstance As Long\r
+ Filter As String\r
+ CustomFilter As String\r
+ nMaxCustFilter As Long\r
+ FilterIndex As Long\r
+ FileName As String\r
+ MaxFileSize As Long\r
+ FileTitle As String\r
+ MaxFileTitleSize As Long\r
+ InitDir As String\r
+ DialogTitle As String\r
+ Flags As Long\r
+ nFileOffset As Integer\r
+ nFileExtension As Integer\r
+ DefaultExt As String\r
+ lCustData As Long\r
+ lpfnHook As Long\r
+ lpTemplateName As String\r
+End Type\r
+\r
+Type BROWSEINFO\r
+ hwndOwner As Long\r
+ pidlRoot As Long\r
+ DisplayName As String\r
+ Title As String\r
+ Flags As Long\r
+ lpfn As Long\r
+ lParam As Long\r
+ iImage As Long\r
+End Type\r
+\r
+Declare Function CommDlgExtendedError Lib "Comdlg32.dll" () As Long\r
+Declare Function GetOpenFileName Lib "Comdlg32.dll" _\r
+ Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Boolean\r
+Declare Function GetSaveFileName Lib "Comdlg32.dll" _\r
+ Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Boolean\r
+Declare Function SHBrowseForFolder Lib "Shell32.dll" _\r
+ (lpbi As BROWSEINFO) As Long\r
+Declare Function SHGetPathFromIDList Lib "Shell32.dll" ( _\r
+ pidl As Long, _\r
+ ByRef pszPath As Byte) As Boolean\r
+\r
+Public Const OFN_READONLY As Long = &H1\r
+Public Const OFN_OVERWRITEPROMPT As Long = &H2\r
+Public Const OFN_HIDEREADONLY As Long = &H4\r
+Public Const OFN_NOCHANGEDIR As Long = &H8\r
+Public Const OFN_SHOWHELP As Long = &H10\r
+Public Const OFN_ENABLEHOOK As Long = &H20\r
+Public Const OFN_ENABLETEMPLATE As Long = &H40\r
+Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80\r
+Public Const OFN_NOVALIDATE As Long = &H100\r
+Public Const OFN_ALLOWMULTISELECT As Long = &H200\r
+Public Const OFN_EXTENSIONDIFFERENT As Long = &H400\r
+Public Const OFN_PATHMUSTEXIST As Long = &H800\r
+Public Const OFN_FILEMUSTEXIST As Long = &H1000\r
+Public Const OFN_CREATEPROMPT As Long = &H2000\r
+Public Const OFN_SHAREAWARE As Long = &H4000\r
+Public Const OFN_NOREADONLYRETURN As Long = &H8000\r
+Public Const OFN_NOTESTFILECREATE As Long = &H10000\r
+Public Const OFN_NONETWORKBUTTON As Long = &H20000\r
+Public Const OFN_NOLONGNAMES As Long = &H40000 ' force no long names for 4.x modules\r
+Public Const OFN_EXPLORER As Long = &H80000 ' new look commdlg\r
+Public Const OFN_NODEREFERENCELINKS As Long = &H100000\r
+Public Const OFN_LONGNAMES As Long = &H200000 ' force long names for 3.x modules\r
+Public Const OFN_ENABLEINCLUDENOTIFY As Long = &H400000 ' send include message to callback\r
+Public Const OFN_ENABLESIZING As Long = &H800000\r
+\r
+Public Const BIF_RETURNONLYFSDIRS As Long = &H1 ' For finding a folder to start document searching\r
+Public Const BIF_DONTGOBELOWDOMAIN As Long = &H2 ' For starting the Find Computer\r
+Public Const BIF_STATUSTEXT As Long = &H4\r
+Public Const BIF_RETURNFSANCESTORS As Long = &H8\r
+Public Const BIF_EDITBOX As Long = &H10\r
+Public Const BIF_VALIDATE As Long = &H20 ' insist on valid result (or CANCEL)\r
+\r
+Public Const BIF_BROWSEFORCOMPUTER As Long = &H1000 ' Browsing for Computers.\r
+Public Const BIF_BROWSEFORPRINTER As Long = &H2000 ' Browsing for Printers\r
+Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000 ' Browsing for Everything\r
+\r
+Function GetPathFromID(ByVal dwID As Long) As String\r
+Dim buffer(1 To 260) As Byte\r
+GetPathFromID = NullPtr\r
+If SHGetPathFromIDList(ByVal dwID, buffer(1)) Then\r
+ GetPathFromID = StrConv(buffer, vbUnicode)\r
+ StripNull GetPathFromID\r
+End If\r
+End Function\r
+Sub ReplaceChar(ByRef TextStr As String, ByVal Char As String, ByVal NewChar As String)\r
+If Len(Char) > 1 Then Char = Left$(Char, 1)\r
+If Len(NewChar) > 1 Then NewChar = Left$(NewChar, 1)\r
+Dim cNum As Long, cNum2 As Long\r
+For cNum = 1 To Len(TextStr)\r
+ cNum2 = InStr(cNum, TextStr, Char)\r
+ If cNum2 Then\r
+ cNum = cNum2\r
+ Mid$(TextStr, cNum, 1) = NewChar\r
+ Else\r
+ Exit Sub\r
+ End If\r
+Next cNum\r
+End Sub\r
+Sub StripNull(ByRef TextStr As String)\r
+Dim cNum As Long\r
+cNum = InStr(1, TextStr, Chr$(0))\r
+If cNum Then\r
+ TextStr = Left(TextStr, cNum - 1)\r
+End If\r
+End Sub\r
+Sub StripNullMulti(ByRef TextStr As String)\r
+Dim cNum As Long, cNum2 As Long\r
+For cNum = 1 To Len(TextStr)\r
+ cNum2 = InStr(cNum, TextStr, Chr$(0))\r
+ If cNum2 Then\r
+ cNum = cNum2\r
+ cNum2 = InStr(cNum + 1, TextStr, Chr$(0))\r
+ If cNum + 1 = cNum2 Or cNum2 = 0 Then\r
+ TextStr = Left(TextStr, cNum - 1)\r
+ Exit Sub\r
+ End If\r
+ Else\r
+ Exit Sub\r
+ End If\r
+Next cNum\r
+End Sub\r
+Sub InitFileDialog(ByRef lpFileDialog As OPENFILENAME)\r
+lpFileDialog.lStructSize = Len(lpFileDialog)\r
+lpFileDialog.hwndOwner = 0\r
+lpFileDialog.hInstance = 0\r
+lpFileDialog.Filter = NullPtr\r
+lpFileDialog.CustomFilter = NullPtr\r
+lpFileDialog.nMaxCustFilter = 0\r
+lpFileDialog.FilterIndex = 0\r
+lpFileDialog.FileName = NullPtr\r
+lpFileDialog.MaxFileSize = 260\r
+lpFileDialog.FileTitle = NullPtr\r
+lpFileDialog.MaxFileTitleSize = 260\r
+lpFileDialog.InitDir = NullPtr\r
+lpFileDialog.DialogTitle = NullPtr\r
+lpFileDialog.Flags = 0\r
+lpFileDialog.nFileOffset = 0\r
+lpFileDialog.nFileExtension = 0\r
+lpFileDialog.DefaultExt = NullPtr\r
+lpFileDialog.lCustData = 0\r
+lpFileDialog.lpfnHook = 0\r
+lpFileDialog.lpTemplateName = NullPtr\r
+End Sub\r
+Sub InitFolderDialog(ByRef lpFolderDialog As BROWSEINFO)\r
+lpFolderDialog.hwndOwner = 0\r
+lpFolderDialog.pidlRoot = 0\r
+lpFolderDialog.DisplayName = NullPtr\r
+lpFolderDialog.Title = NullPtr\r
+lpFolderDialog.Flags = 0\r
+lpFolderDialog.lpfn = 0\r
+lpFolderDialog.lParam = 0\r
+lpFolderDialog.iImage = 0\r
+End Sub\r
+Function ShowOpen(ByRef lpFileDialog As OPENFILENAME) As Boolean\r
+lpFileDialog.lStructSize = Len(lpFileDialog)\r
+ReplaceChar lpFileDialog.Filter, "|", Chr$(0)\r
+lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)\r
+If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _\r
+ lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))\r
+If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _\r
+ lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))\r
+ShowOpen = GetOpenFileName(lpFileDialog)\r
+lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)\r
+ReplaceChar lpFileDialog.Filter, Chr$(0), "|"\r
+If lpFileDialog.Flags And (OFN_ALLOWMULTISELECT Or OFN_EXPLORER) Then\r
+ StripNullMulti lpFileDialog.FileName\r
+ StripNullMulti lpFileDialog.FileTitle\r
+Else\r
+ StripNull lpFileDialog.FileName\r
+ StripNull lpFileDialog.FileTitle\r
+End If\r
+End Function\r
+Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean\r
+lpFileDialog.lStructSize = Len(lpFileDialog)\r
+ReplaceChar lpFileDialog.Filter, "|", Chr$(0)\r
+lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)\r
+If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _\r
+ lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))\r
+If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _\r
+ lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))\r
+ShowSave = GetSaveFileName(lpFileDialog)\r
+lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)\r
+ReplaceChar lpFileDialog.Filter, Chr$(0), "|"\r
+StripNull lpFileDialog.FileName\r
+StripNull lpFileDialog.FileTitle\r
+End Function\r
+Function ShowFolder(ByRef lpFolderDialog As BROWSEINFO) As Long\r
+If Len(lpFolderDialog.DisplayName) <= 260 Then _\r
+ lpFolderDialog.DisplayName = lpFolderDialog.DisplayName + String$(260 - Len(lpFolderDialog.DisplayName), Chr$(0))\r
+ShowFolder = SHBrowseForFolder(lpFolderDialog)\r
+StripNull lpFolderDialog.DisplayName\r
+End Function\r
diff --git a/FixIcon.bas b/FixIcon.bas
--- a/FixIcon.bas
+++ b/FixIcon.bas
-Attribute VB_Name = "FixWindowIcon"
-Option Explicit
-
-Private Const WM_SETICON = &H80
-Private Const ICON_SMALL = 0
-Private Const IMAGE_ICON = 1
-Private Const LR_DEFAULTSIZE = &H40
-
-Private Declare Function GetModuleHandle Lib "Kernel32.dll" _
- Alias "GetModuleHandleA" _
- (ByRef lpModuleName As Any) As Long
-Private Declare Function LoadImage Lib "User32.dll" _
- Alias "LoadImageA" ( _
- ByVal hinst As Long, _
- ByRef lpszName As Any, _
- ByVal uType As Long, _
- ByVal cxDesired As Long, _
- ByVal cyDesired As Long, _
- ByVal fuLoad As Long) As Long
-Private Declare Function SendMessageA Lib _
- "User32.dll" _
- (ByVal hWnd As Long, _
- ByVal Msg As Long, _
- ByVal Wp As Long, _
- Lp As Any) As Long
-
-Sub FixIcon(hWnd As Long, lpszName)
-Dim hModule As Long, hIcon As Long, szName As String, nName As Long, Width As Long, Height As Long
-hModule = GetModuleHandle(ByVal 0&)
-If hModule = 0 Then Exit Sub
-Width = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionWidth", -270)) / Screen.TwipsPerPixelX - 2
-Height = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionHeight", -270)) / Screen.TwipsPerPixelY - 2
-If VarType(lpszName) = vbString Then
- szName = lpszName
- hIcon = LoadImage(hModule, szName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
-ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lpszName) = vbLong Then
- nName = lpszName
- hIcon = LoadImage(hModule, ByVal nName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
-End If
-If hIcon = 0 Then Exit Sub
-SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon
-End Sub
+Attribute VB_Name = "FixWindowIcon"\r
+Option Explicit\r
+\r
+Private Const WM_SETICON = &H80\r
+Private Const ICON_SMALL = 0\r
+Private Const IMAGE_ICON = 1\r
+Private Const LR_DEFAULTSIZE = &H40\r
+\r
+Private Declare Function GetModuleHandle Lib "Kernel32.dll" _\r
+ Alias "GetModuleHandleA" _\r
+ (ByRef lpModuleName As Any) As Long\r
+Private Declare Function LoadImage Lib "User32.dll" _\r
+ Alias "LoadImageA" ( _\r
+ ByVal hinst As Long, _\r
+ ByRef lpszName As Any, _\r
+ ByVal uType As Long, _\r
+ ByVal cxDesired As Long, _\r
+ ByVal cyDesired As Long, _\r
+ ByVal fuLoad As Long) As Long\r
+Private Declare Function SendMessageA Lib _\r
+ "User32.dll" _\r
+ (ByVal hWnd As Long, _\r
+ ByVal Msg As Long, _\r
+ ByVal Wp As Long, _\r
+ Lp As Any) As Long\r
+\r
+Sub FixIcon(hWnd As Long, lpszName)\r
+Dim hModule As Long, hIcon As Long, szName As String, nName As Long, Width As Long, Height As Long\r
+hModule = GetModuleHandle(ByVal 0&)\r
+If hModule = 0 Then Exit Sub\r
+Width = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionWidth", -270)) / Screen.TwipsPerPixelX - 2\r
+Height = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionHeight", -270)) / Screen.TwipsPerPixelY - 2\r
+If VarType(lpszName) = vbString Then\r
+ szName = lpszName\r
+ hIcon = LoadImage(hModule, szName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)\r
+ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lpszName) = vbLong Then\r
+ nName = lpszName\r
+ hIcon = LoadImage(hModule, ByVal nName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)\r
+End If\r
+If hIcon = 0 Then Exit Sub\r
+SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon\r
+End Sub\r
diff --git a/FoldName.frm b/FoldName.frm
--- a/FoldName.frm
+++ b/FoldName.frm
-VERSION 4.00
-Begin VB.Form FoldName
- BorderStyle = 3 'Fixed Dialog
- Caption = "Folder name..."
- ClientHeight = 1935
- ClientLeft = 1995
- ClientTop = 2430
- ClientWidth = 4575
- Height = 2340
- Icon = "FoldName.frx":0000
- Left = 1935
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1935
- ScaleWidth = 4575
- ShowInTaskbar = 0 'False
- Top = 2085
- Width = 4695
- Begin VB.TextBox Text1
- Height = 285
- Left = 120
- TabIndex = 1
- Top = 1080
- Width = 4335
- End
- Begin VB.CommandButton Command2
- Cancel = -1 'True
- Caption = "&Cancel"
- Height = 375
- Left = 2640
- TabIndex = 3
- Top = 1440
- Width = 1335
- End
- Begin VB.CommandButton Command1
- Caption = "O&K"
- Default = -1 'True
- Height = 375
- Left = 600
- TabIndex = 2
- Top = 1440
- Width = 1335
- End
- Begin VB.Label Label2
- Caption = "Example: If ""title.wav"" is the original filename, and you type ""music\"" the file will become ""music\title.wav"""
- Height = 495
- Left = 120
- TabIndex = 4
- Top = 600
- Width = 4335
- WordWrap = -1 'True
- End
- Begin VB.Label Label1
- Caption = "The text in the box below will be put at the beginnings of the names of every file you selected."
- Height = 510
- Left = 120
- TabIndex = 0
- Top = 120
- Width = 4335
- WordWrap = -1 'True
- End
-End
-Attribute VB_Name = "FoldName"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-Private Sub Command1_Click()
-AddFolderName = Text1
-Unload Me
-End Sub
-Private Sub Command2_Click()
-AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128)
-Unload Me
-End Sub
-Private Sub Form_Load()
-Left = MpqEx.Left + 330 * 2
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315 * 2
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-Text1 = AddFolderName
-End Sub
+VERSION 4.00\r
+Begin VB.Form FoldName \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Folder name..."\r
+ ClientHeight = 1935\r
+ ClientLeft = 1995\r
+ ClientTop = 2430\r
+ ClientWidth = 4575\r
+ Height = 2340\r
+ Icon = "FoldName.frx":0000\r
+ Left = 1935\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 1935\r
+ ScaleWidth = 4575\r
+ ShowInTaskbar = 0 'False\r
+ Top = 2085\r
+ Width = 4695\r
+ Begin VB.TextBox Text1 \r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 1\r
+ Top = 1080\r
+ Width = 4335\r
+ End\r
+ Begin VB.CommandButton Command2 \r
+ Cancel = -1 'True\r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 2640\r
+ TabIndex = 3\r
+ Top = 1440\r
+ Width = 1335\r
+ End\r
+ Begin VB.CommandButton Command1 \r
+ Caption = "O&K"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 600\r
+ TabIndex = 2\r
+ Top = 1440\r
+ Width = 1335\r
+ End\r
+ Begin VB.Label Label2 \r
+ Caption = "Example: If ""title.wav"" is the original filename, and you type ""music\"" the file will become ""music\title.wav"""\r
+ Height = 495\r
+ Left = 120\r
+ TabIndex = 4\r
+ Top = 600\r
+ Width = 4335\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Label Label1 \r
+ Caption = "The text in the box below will be put at the beginnings of the names of every file you selected."\r
+ Height = 510\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 120\r
+ Width = 4335\r
+ WordWrap = -1 'True\r
+ End\r
+End\r
+Attribute VB_Name = "FoldName"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+Private Sub Command1_Click()\r
+AddFolderName = Text1\r
+Unload Me\r
+End Sub\r
+Private Sub Command2_Click()\r
+AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128)\r
+Unload Me\r
+End Sub\r
+Private Sub Form_Load()\r
+Left = MpqEx.Left + 330 * 2\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315 * 2\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+Text1 = AddFolderName\r
+End Sub\r
diff --git a/MpqStuff.bas b/MpqStuff.bas
--- a/MpqStuff.bas
+++ b/MpqStuff.bas
-Attribute VB_Name = "MpqStuff"
-Option Explicit
-
-Type SHELLEXECUTEINFO
- cbSize As Long
- fMask As Long
- hWnd As Long
- lpVerb As String
- lpFile As String
- lpParameters As String
- lpDirectory As String
- nShow As Long
- hInstApp As Long
-
- ' Optional members
- lpIDList As Long
- lpClass As String
- hkeyClass As Long
- dwHotKey As Long
- hIcon As Long
- hProcess As Long
-End Type
-
-Public Declare Function ShellExecute Lib _
- "Shell32.dll" Alias "ShellExecuteA" _
- (ByVal hWnd As Long, _
- ByVal lpOperation As String, _
- ByVal lpFile As String, _
- ByVal lpParameters As String, _
- ByVal lpDirectory As String, _
- ByVal nShowCmd As Long) As Long
-Public Declare Function ShellExecuteEx Lib _
- "Shell32.dll" Alias "ShellExecuteExA" _
- (sei As SHELLEXECUTEINFO) As Long
-Public Declare Sub SHChangeNotify Lib _
- "Shell32.dll" (ByVal wEventId As Long, _
- ByVal uFlags As Integer, _
- ByVal dwItem1 As Any, _
- ByVal dwItem2 As Any)
-Public Declare Function SendMessageA Lib _
- "User32.dll" _
- (ByVal hWnd As Long, _
- ByVal Msg As Long, _
- ByVal Wp As Long, _
- Lp As Any) As Long
-Declare Function GetLongPathName Lib "Kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
-Private Declare Sub CopyMemory Lib "Kernel32.dll" _
- Alias "RtlMoveMemory" ( _
- ByRef Destination As Any, _
- ByRef Source As Any, _
- ByVal Length As Long)
-
-Public CD As OPENFILENAME, PathInput As BROWSEINFO
-Public GlobalFileList() As String, FileList() As String, CX As Single, CY As Single, NewFile As Boolean, LocaleID As Long, ListFile As String, AddFolderName As String, ExtractPathNum As Long, CopyPathNum As Long, GlobalEncrypt As Boolean, DefaultCompress As Long, DefaultCompressID As Long, DefaultCompressLevel As Long, DefaultMaxFiles As Long, DefaultBlockSize As Long
-Public Const AppKey As String = "HKEY_CURRENT_USER\Software\ShadowFlare\WinMPQ\", SharedAppKey As String = "HKEY_LOCAL_MACHINE\Software\ShadowFlare\WinMPQ\"
-Public Const MPQ_ERROR_INIT_FAILED As Long = &H85000001 'Unspecified error
-Public Const MPQ_ERROR_NO_STAREDIT As Long = &H85000002 'Can't find StarEdit.exe
-Public Const MPQ_ERROR_BAD_STAREDIT As Long = &H85000003 'Bad version of StarEdit.exe. Need SC/BW 1.07
-Public Const MPQ_ERROR_STAREDIT_RUNNING As Long = &H85000004 'StarEdit.exe is running. Must be closed
-Public Const SHCNE_ASSOCCHANGED As Long = &H8000000
-Public Const SHCNF_IDLIST As Long = &H0
-Public Const WM_SETREDRAW As Long = &HB
-Public Const WM_PAINT As Long = &HF
-Const gintMAX_SIZE% = 255
-Public Const SEE_MASK_CLASSNAME As Long = &H1
-Sub AboutSFMpq()
-Dim AboutPage As String, Path As String
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-AboutPage = Path + "sfmpq.dll"
-If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll"
-ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1
-End Sub
-Sub GetCompressFlags(File As String, ByRef cType As Integer, ByRef dwFlags As Long)
-Dim bNum As Long, fExt As String
-dwFlags = MAFA_REPLACE_EXISTING
-If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
-For bNum = 1 To Len(File)
- If InStr(bNum, File, ".") > 0 Then
- bNum = InStr(bNum, File, ".")
- Else
- Exit For
- End If
-Next bNum
-If bNum > 1 Then
- fExt = Mid(File, bNum - 1)
-Else
- fExt = File
-End If
-If LCase(fExt) = ".bik" Then
- cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".smk" Then
- cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".mp3" Then
- cType = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".mpq" Then
- cType = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".scm" Then
- cType = CInt(GetReg(AppKey + "Compression\.scm", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".scx" Then
- cType = CInt(GetReg(AppKey + "Compression\.scx", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".w3m" Then
- cType = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".w3x" Then
- cType = CInt(GetReg(AppKey + "Compression\.w3x", "-2"))
- dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
-ElseIf LCase(fExt) = ".wav" Then
- cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
-Else
- cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID)))
-End If
-End Sub
-
-Function mOpenMpq(FileName As String) As Long
-Dim hMPQ As Long
-mOpenMpq = 0
-hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)
-If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then
- hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)
-End If
-If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then
- mOpenMpq = hMPQ
-End If
-End Function
-Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String
-lpFolderDialog.Title = pCaption
-Dim result As Long
-result = ShowFolder(lpFolderDialog)
-If result = 0 Then Exit Function
-PathInputBox = GetPathFromID(result)
-End Function
-Function GetLongPath(Path As String) As String
- Dim strBuf As String, StrLength As Long
- strBuf = Space$(gintMAX_SIZE)
- StrLength = GetLongPathName(Path, strBuf, gintMAX_SIZE)
- strBuf = Left(strBuf, StrLength)
- If strBuf <> "" Then
- GetLongPath = strBuf
- Else
- GetLongPath = Path
- End If
-End Function
-Sub AddScriptOutput(sOutput As String)
-SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 0, ByVal 0&
-ScriptOut.oText = ScriptOut.oText + sOutput
-SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 1, ByVal 0&
-ScriptOut.oText.SelStart = Len(ScriptOut.oText)
-End Sub
-Function GetFileTitle(FileName As String) As String
-Dim bNum As Long
-If InStr(FileName, "\") > 0 Then
- For bNum = 1 To Len(FileName)
- If InStr(bNum, FileName, "\") > 0 Then
- bNum = InStr(bNum, FileName, "\")
- Else
- Exit For
- End If
- Next bNum
- GetFileTitle = Mid(FileName, bNum)
-Else
- GetFileTitle = FileName
-End If
-End Function
-Function sGetFile(hMPQ As Long, ByVal FileName As String, OutPath As String, ByVal UseFullPath As Long)
-Dim hFile As Long, buffer() As Byte, fLen As Long, cNum As Long
-If SFileOpenFileEx(hMPQ, FileName, 0, hFile) Then
- fLen = SFileGetFileSize(hFile, 0)
- If fLen > 0 Then
- ReDim buffer(fLen - 1)
- Else
- ReDim buffer(0)
- End If
- SFileReadFile hFile, buffer(0), fLen, ByVal 0, ByVal 0
- SFileCloseFile hFile
- If UseFullPath = 0 Then FileName = GetFileTitle(FileName)
- FileName = FullPath(OutPath, FileName)
- On Error Resume Next
- For cNum = 1 To Len(FileName)
- cNum = InStr(cNum, FileName, "\")
- If cNum > 0 Then
- MkDir Left(FileName, cNum)
- Else
- Exit For
- End If
- Next cNum
- If FileExists(FileName) Then Kill FileName
- On Error GoTo 0
- cNum = FreeFile
- On Error GoTo WriteError
- Open FileName For Binary As #cNum
- If fLen > 0 Then Put #cNum, 1, buffer
- Close #cNum
- On Error GoTo 0
-End If
-Exit Function
-WriteError:
-MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ"
-Close #cNum
-End Function
-Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String, ByRef ListedFiles() As FILELISTENTRY) As Boolean
-Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, cNum4 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean, nHash As Long, nHashEntries As Long
-sListFiles = False
-ReDim ListedFiles(0)
-ListedFiles(0).dwFileExists = 0
-If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
- NewFileLists = FileLists
-Else
- UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
- MpqList2 = GetExtension(MpqName)
- MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt"
- MpqList2 = GetFileTitle(MpqName) + ".txt"
- Path = GetLongPath(App.Path)
- If Right(Path, 1) <> "\" Then Path = Path + "\"
- If UseOnlyAutoList Then ListLen = Len(FileLists)
- If FileLists <> "" Then
- FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
- Else
- FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName
- End If
- ReDim nFileLists(0) As String
- If UseOnlyAutoList Then ReDim OldLists(0) As String
- For cNum = 1 To Len(FileLists)
- cNum2 = InStr(cNum, FileLists, vbCrLf)
- If cNum2 = 0 Then
- cNum2 = Len(FileLists) + 1
- End If
- If cNum2 - cNum > 0 Then
- ListName = Mid(FileLists, cNum, cNum2 - cNum)
- If Not IsDir(ListName) Then
- If UseOnlyAutoList And cNum < ListLen Then
- ReDim Preserve OldLists(UBound(OldLists) + 1) As String
- OldLists(UBound(OldLists)) = GetLongPath(ListName)
- End If
- For cNum3 = 1 To Len(ListName)
- If InStr(cNum3, ListName, "\") Then
- cNum3 = InStr(cNum3, ListName, "\")
- If FileExists(Left(ListName, cNum3) + MpqList1) Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
- End If
- If FileExists(Left(ListName, cNum3) + MpqList2) Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
- End If
- Else
- Exit For
- End If
- Next cNum3
- If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
- End If
- Else
- ListName = DirEx(ListName, MpqList1, 6, True) _
- + DirEx(ListName, MpqList2, 6, True)
- For cNum3 = 1 To Len(ListName)
- cNum4 = InStr(cNum3, ListName, vbCrLf)
- If cNum4 = 0 Then
- cNum4 = Len(ListName) + 1
- End If
- If cNum4 - cNum3 > 0 Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Mid(ListName, cNum3, cNum4 - cNum3))
- End If
- cNum3 = cNum4 + 1
- Next cNum3
- End If
- End If
- cNum = cNum2 + 1
- Next cNum
- If UseOnlyAutoList Then
- For cNum = 1 To UBound(nFileLists)
- For cNum2 = 1 To UBound(OldLists)
- If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then
- GoTo StartSearch
- End If
- Next cNum2
- Next cNum
- UseOnlyAutoList = False
- End If
-StartSearch:
- For cNum = 1 To UBound(nFileLists)
- If nFileLists(cNum) <> "" Then
- For cNum2 = 1 To UBound(nFileLists)
- If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
- nFileLists(cNum2) = ""
- End If
- Next cNum2
- End If
- If UseOnlyAutoList Then
- If nFileLists(cNum) <> "" Then
- For cNum2 = 1 To UBound(OldLists)
- If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList1) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList2) Then
- nFileLists(cNum) = ""
- Exit For
- End If
- Next cNum2
- End If
- End If
- If nFileLists(cNum) <> "" Then
- NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf
- End If
- Next cNum
- If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
-End If
-nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE)
-If nHashEntries - 1 < 0 Then Exit Function
-ReDim ListedFiles(nHashEntries - 1)
-sListFiles = SFileListFiles(hMPQ, NewFileLists, ListedFiles(0), 0)
-End Function
-Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)
-Dim cType As Integer, dwFlags As Long
-
-GetCompressFlags File, cType, dwFlags
-
-Select Case cType
-Case -2
-MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0
-Case -1
-MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
-Case -3
-MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
-Case -4
-MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
-Case 0, 1, 2
-MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType
-Case Else
-If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
-Else
- MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0
-End If
-End Select
-End Sub
-Sub mAddAutoFromBuffer(hMPQ As Long, ByRef buffer As Byte, BufSize As Long, MpqPath As String)
-Dim cType As Integer, dwFlags As Long
-
-GetCompressFlags MpqPath, cType, dwFlags
-
-Select Case cType
-Case -2
-MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags, 0, 0
-Case -1
-MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
-Case -3
-MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
-Case -4
-MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
-Case 0, 1, 2
-MpqAddWaveFromBuffer hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, cType
-Case Else
-If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
-Else
- MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0
-End If
-End Select
-End Sub
-
-Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String
-Dim Files() As String, lNum As Long, Folders() As String
-If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"
-ReDim Files(0) As String
-Files(0) = Dir(Path + Filter, Attributes)
-If Files(0) <> "" Then
- Do
- ReDim Preserve Files(UBound(Files) + 1) As String
- Files(UBound(Files)) = Dir
- Loop Until Files(UBound(Files)) = ""
- ReDim Preserve Files(UBound(Files) - 1) As String
-End If
-For lNum = 0 To UBound(Files)
- If Files(lNum) <> "" Then
- If IsDir(Path + Files(lNum)) = False And (Attributes And vbDirectory) <> vbDirectory Then
- DirEx = DirEx + Path + Files(lNum) + vbCrLf
- ElseIf IsDir(Path + Files(lNum)) = True And (Attributes And vbDirectory) Then
- DirEx = DirEx + Path + Files(lNum) + vbCrLf
- End If
- End If
-Next lNum
-If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then
- ReDim Folders(0) As String
- Folders(0) = Dir(Path, vbDirectory)
- If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
- If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
- If Folders(0) <> "" Then
- Do
- ReDim Preserve Folders(UBound(Folders) + 1) As String
- Folders(UBound(Folders)) = Dir
- If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then
- ReDim Preserve Folders(UBound(Folders) - 1) As String
- End If
- Loop Until Folders(UBound(Folders)) = ""
- ReDim Preserve Folders(UBound(Folders) - 1) As String
- End If
- For lNum = 0 To UBound(Folders)
- If Folders(lNum) <> "" Then
- If IsDir(Path + Folders(lNum)) Then
- DirEx = DirEx + DirEx(Path + Folders(lNum), Filter, Attributes, Recurse)
- End If
- End If
- Next lNum
-End If
-End Function
-Function GetExtension(FileName As String) As String
-Dim bNum As Long
-If InStr(FileName, ".") > 0 Then
- For bNum = 1 To Len(FileName)
- If InStr(bNum, FileName, ".") > 0 Then
- bNum = InStr(bNum, FileName, ".")
- Else
- Exit For
- End If
- Next bNum
- GetExtension = Mid(FileName, bNum - 1)
-Else
- GetExtension = ""
-End If
-End Function
-Function IsDir(DirPath As String) As Boolean
-On Error GoTo IsNotDir
-If GetAttr(DirPath) And vbDirectory Then
- IsDir = True
-Else
- IsDir = False
-End If
-Exit Function
-IsNotDir:
-IsDir = False
-End Function
-Function FileExists(FileName As String) As Boolean
-On Error GoTo NoFile
-If (GetAttr(FileName) And vbDirectory) <> vbDirectory Then
- FileExists = True
-Else
- FileExists = False
-End If
-Exit Function
-NoFile:
-FileExists = False
-End Function
-Function IsMPQ(MpqFile As String) As Boolean
-If FindMpqHeader(MpqFile) <> -1 Then
- IsMPQ = True
-Else
- IsMPQ = False
-End If
-End Function
-Sub KillEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean)
-Dim Files() As String, lNum As Long, Folders() As String
-If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"
-ReDim Files(0) As String
-Files(0) = Dir(Path + Filter, Attributes)
-If Files(0) <> "" Then
- Do
- ReDim Preserve Files(UBound(Files) + 1) As String
- Files(UBound(Files)) = Dir
- Loop Until Files(UBound(Files)) = ""
- ReDim Preserve Files(UBound(Files) - 1) As String
-End If
-For lNum = 0 To UBound(Files)
- If Files(lNum) <> "" Then
- If IsDir(Path + Files(lNum)) = False Then
- On Error Resume Next
- Kill Path + Files(lNum)
- On Error GoTo 0
- End If
- End If
-Next lNum
-If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then
- ReDim Folders(0) As String
- Folders(0) = Dir(Path, vbDirectory)
- If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
- If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
- If Folders(0) <> "" Then
- Do
- ReDim Preserve Folders(UBound(Folders) + 1) As String
- Folders(UBound(Folders)) = Dir
- If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then
- ReDim Preserve Folders(UBound(Folders) - 1) As String
- End If
- Loop Until Folders(UBound(Folders)) = ""
- ReDim Preserve Folders(UBound(Folders) - 1) As String
- End If
- For lNum = 0 To UBound(Folders)
- If Folders(lNum) <> "" Then
- If IsDir(Path + Folders(lNum)) Then
- KillEx Path + Folders(lNum), Filter, Attributes, Recurse
- On Error Resume Next
- RmDir Path + Folders(lNum)
- End If
- On Error GoTo 0
- End If
- Next lNum
-End If
-End Sub
-Function FullPath(ByVal BasePath As String, File As String) As String
-If Right(BasePath, 1) <> "\" Then BasePath = BasePath + "\"
-If Mid(File, 2, 1) = ":" Or Left(File, 2) = "\\" Then
- FullPath = File
-ElseIf Left(File, 1) = "\" Then
- FullPath = Left(BasePath, 2) + File
-Else
- FullPath = BasePath + File
-End If
-End Function
-Function MatchesFilter(FileName As String, ByVal Filters As String) As Boolean
-Dim bNum As Long, Filter As String
-If InStr(Filters, ";") Then
- If Right(Filters, 1) <> ";" Then Filters = Filters + ";"
- For bNum = 1 To Len(Filters)
- Filter = Mid(Filters, bNum, InStr(bNum, Filters, ";") - bNum)
- If Right(Filter, 3) = "*.*" Then Filter = Left(Filter, Len(Filter) - 2)
- If LCase(FileName) Like LCase(Filter) Then
- MatchesFilter = True
- Exit Function
- End If
- bNum = InStr(bNum, Filters, ";")
- Next bNum
-Else
- If Right(Filters, 3) = "*.*" Then Filters = Left(Filters, Len(Filters) - 2)
- If LCase(FileName) Like LCase(Filters) Then MatchesFilter = True
-End If
-End Function
-Function RenameWithFilter(FileName As String, OldFilter As String, NewFilter As String) As String
-Dim bNum As Long, Filters() As String, NewFileName As String, bNum2 As Long, bNum3 As Long, bNum4 As Long, bNum5 As Long
-If Right(OldFilter, 3) = "*.*" Then OldFilter = Left(OldFilter, Len(OldFilter) - 2)
-If Right(NewFilter, 3) = "*.*" Then NewFilter = Left(NewFilter, Len(NewFilter) - 2)
-ReDim Filters(0) As String
-bNum4 = 1
-For bNum = 1 To Len(OldFilter)
- Select Case Mid(OldFilter, bNum, 1)
- Case "*"
- bNum2 = InStr(bNum + 1, OldFilter, "*")
- bNum3 = InStr(bNum + 1, OldFilter, "?")
- If bNum2 = 0 And bNum3 = 0 Then
- bNum2 = Len(OldFilter) + 1
- ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then
- bNum2 = bNum3
- End If
- bNum5 = InStr(bNum4, FileName, Mid(OldFilter, bNum + 1, bNum2 - bNum - 1), 1)
- If bNum = Len(OldFilter) Then
- bNum5 = Len(FileName) + 1
- End If
- If bNum5 = 0 Then
- RenameWithFilter = FileName
- Exit Function
- End If
- If bNum > 1 Then
- If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then
- ReDim Preserve Filters(UBound(Filters) + 1) As String
- End If
- Else
- ReDim Preserve Filters(UBound(Filters) + 1) As String
- End If
- Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, bNum5 - bNum4)
- bNum4 = bNum5
- Case "?"
- bNum2 = bNum + 1
- bNum5 = bNum4 + 1
- If bNum > 1 Then
- If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then
- ReDim Preserve Filters(UBound(Filters) + 1) As String
- End If
- Else
- ReDim Preserve Filters(UBound(Filters) + 1) As String
- End If
- Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, 1)
- bNum4 = bNum5
- Case Else
- bNum4 = bNum4 + 1
- End Select
- If bNum4 > Len(FileName) Then
- If (Right(OldFilter, 1) <> "*" Or bNum + 1 < Len(OldFilter)) And bNum < Len(OldFilter) Then
- RenameWithFilter = FileName
- Exit Function
- Else
- Exit For
- End If
- End If
-Next bNum
-NewFileName = NewFilter
-For bNum = 1 To UBound(Filters)
- bNum2 = InStr(bNum, NewFileName, "*")
- bNum3 = InStr(bNum, NewFileName, "?")
- If bNum2 = 0 And bNum3 = 0 Then
- bNum2 = Len(NewFileName) + 1
- ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then
- bNum2 = bNum3
- End If
- If bNum2 > Len(NewFileName) Then
- RenameWithFilter = NewFileName
- Exit Function
- End If
- bNum4 = 0
- For bNum3 = bNum2 To Len(NewFileName)
- Select Case Mid(NewFileName, bNum3, 1)
- Case "*"
- bNum4 = Len(Filters(bNum))
- bNum3 = bNum3 + 1
- Exit For
- Case "?"
- bNum4 = bNum4 + 1
- Case Else
- Exit For
- End Select
- Next bNum3
- NewFileName = Left(NewFileName, bNum2 - 1) + Left(Filters(bNum), bNum4) + Mid(NewFileName, bNum3)
-Next bNum
-Do Until InStr(NewFileName, "*") = 0
- NewFileName = Left(NewFileName, InStr(NewFileName, "*") - 1) + Mid(NewFileName, InStr(NewFileName, "*") + 1)
-Loop
-Do Until InStr(NewFileName, "?") = 0
- NewFileName = Left(NewFileName, InStr(NewFileName, "?") - 1) + Mid(NewFileName, InStr(NewFileName, "?") + 1)
-Loop
-RenameWithFilter = NewFileName
-End Function
-Function MpqDir(MpqFile As String, Filters As String)
-Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String
-Dim hMPQ As Long
-If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then
- If sListFiles(MpqFile, hMPQ, ListFile, Files) Then
- SFileCloseArchive hMPQ
- For fNum = 0 To UBound(Files)
- If Files(fNum).dwFileExists Then
- CurFileName = StrConv(Files(fNum).szFileName, vbUnicode)
- If MatchesFilter(CurFileName, Filters) Then
- NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1)
- If NamePos > 1 Then
- NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1)
- End If
- If NamePos > 0 Then _
- szFileList = szFileList + CurFileName
- End If
- End If
- Next fNum
- MpqDir = MpqDir + CurFileName + vbCrLf
- Else
- SFileCloseArchive hMPQ
- End If
-End If
-End Function
-Sub RunScript(ScriptName As String)
-Dim fNum As Long, Script As String, sLine As String, Param() As String, bNum As Long, EndLine As Long, pNum As Long, EndParam As Long, MpqFile As String, OldDefaultMaxFiles As Long, cType As Integer, lNum As Long, OldPath As String, NewPath As String, Rswitch As Boolean, Files As String, fCount As Long, fEndLine As Long, fLine As String, ScriptNewFile As Boolean, CurPath As String, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, dwFlags
-If FileExists(ScriptName) = False Then
- ScriptOut.Show
- AddScriptOutput "Could not find script " + ScriptName + vbCrLf
- Exit Sub
-End If
-fNum = FreeFile
-Open ScriptName For Binary As #fNum
-Script = String(LOF(fNum), Chr(0))
-Get #fNum, 1, Script
-Close #fNum
-OldPath = CurDir
-If InStr(ScriptName, "\") > 0 Then
- For bNum = 1 To Len(ScriptName)
- If InStr(bNum, ScriptName, "\") > 0 Then
- bNum = InStr(bNum, ScriptName, "\")
- NewPath = Left(ScriptName, bNum)
- End If
- Next bNum
- If Mid(NewPath, 2, 1) = ":" Then ChDrive Left(NewPath, 1)
- ChDir NewPath
-End If
-CurPath = CurDir
-If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf
-ScriptOut.Show
-AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf
-OldDefaultMaxFiles = DefaultMaxFiles
-lNum = 1
-For bNum = 1 To Len(Script)
- EndLine = InStr(bNum, Script, vbCrLf)
- sLine = Mid(Script, bNum, EndLine - bNum)
- If Right(sLine, 1) <> " " Then sLine = sLine + " "
- If sLine <> "" Then
- AddScriptOutput "Line " + CStr(lNum) + ": "
- ReDim Param(0) As String
- For pNum = 1 To Len(sLine)
- If Mid(sLine, pNum, 1) = Chr(34) Then
- pNum = pNum + 1
- EndParam = InStr(pNum, sLine, Chr(34))
- Else
- EndParam = InStr(pNum, sLine, " ")
- End If
- If EndParam = 0 Then EndParam = Len(sLine) + 1
- If pNum <> EndParam Then
- If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
- ReDim Preserve Param(UBound(Param) + 1) As String
- Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
- End If
- End If
- pNum = EndParam
- Next pNum
- If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
- Select Case LCase(Param(1))
- Case "o", "open"
- If Param(2) <> "" Then
- MpqFile = Param(2)
- If Param(3) <> "" And FileExists(MpqFile) = False Then
- DefaultMaxFiles = Param(3)
- End If
- If FileExists(MpqFile) Then
- AddScriptOutput "Opened " + MpqFile + vbCrLf
- Else
- AddScriptOutput "Created new " + MpqFile + vbCrLf
- End If
- NewPath = CurPath
- Else
- AddScriptOutput "Required parameter missing" + vbCrLf
- End If
- Case "n", "new"
- If Param(2) <> "" Then
- MpqFile = Param(2)
- If Param(3) <> "" Then
- DefaultMaxFiles = Param(3)
- End If
- ScriptNewFile = True
- AddScriptOutput "Created new " + MpqFile + vbCrLf
- NewPath = CurPath
- Else
- AddScriptOutput "Required parameter missing" + vbCrLf
- End If
- Case "c", "close"
- If MpqFile <> "" Then
- If LCase(CD.FileName) = LCase(FullPath(NewPath, MpqFile)) Then MpqEx.Timer1.Enabled = True
- AddScriptOutput "Closed " + MpqFile + vbCrLf
- MpqFile = ""
- Else
- AddScriptOutput "No archive open" + vbCrLf
- End If
- Case "p", "pause"
- AddScriptOutput "Pause not supported" + vbCrLf
- Case "a", "add"
- If MpqFile <> "" Then
- cType = 0
- Rswitch = False
- fCount = 0
- Files = ""
- fEndLine = 0
- fLine = ""
- dwFlags = MAFA_REPLACE_EXISTING
- If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
- For pNum = 3 To UBound(Param)
- If LCase(Param(pNum)) = "/wav" Then
- cType = 2
- dwFlags = dwFlags Or MAFA_COMPRESS
- ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
- cType = 1
- dwFlags = dwFlags Or MAFA_COMPRESS
- ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
- cType = -1
- ElseIf LCase(Param(pNum)) = "/r" Then
- Rswitch = True
- End If
- Next pNum
- If Left(Param(3), 1) = "/" Or Param(3) = "" Then
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- Param(3) = ""
- Else
- Param(3) = Param(2)
- End If
- End If
- If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
- If InStr(Param(2), "\") > 0 Then
- For pNum = 1 To Len(Param(2))
- If InStr(pNum, Param(2), "\") > 0 Then
- pNum = InStr(pNum, Param(2), "\")
- Files = Left(Param(2), pNum)
- End If
- Next pNum
- End If
- If ScriptNewFile = True Then
- If FileExists(FullPath(NewPath, MpqFile)) Then Kill FullPath(NewPath, MpqFile)
- ScriptNewFile = False
- End If
- Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
- hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
- If hMPQ = 0 Then
- AddScriptOutput "Can't create archive " + MpqFile + vbCrLf
- GoTo CommandError
- End If
- 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
- If cType = 0 Then
- AddScriptOutput "Adding " + fLine + "..."
- ElseIf cType = 1 Then
- AddScriptOutput "Adding compressed " + fLine + "..."
- ElseIf cType = 2 Then
- AddScriptOutput "Adding compressed WAV " + fLine + "..."
- ElseIf cType = -1 Then
- AddScriptOutput "Adding " + fLine + " (compression auto-select)..."
- End If
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
- If cType = 2 Then
- MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
- ElseIf cType = -1 Then
- mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
- ElseIf cType = 1 Then
- If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0
- End If
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
- End If
- Else
- If cType = 2 Then
- MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
- ElseIf cType = -1 Then
- mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
- ElseIf cType = 1 Then
- If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0
- End If
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
- End If
- End If
- AddScriptOutput " Done" + vbCrLf
- SendMessageA ScriptOut.oText.hWnd, WM_PAINT, 0, &O0
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- MpqCloseUpdatedArchive hMPQ, 0
- If fCount > 1 Then
- AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf
- End If
- Else
- AddScriptOutput " Required parameter missing" + vbCrLf
- End If
- Else
- AddScriptOutput "No archive open" + vbCrLf
- End If
- Case "e", "extract"
- If MpqFile <> "" Then
- If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Extracting " + Param(2) + "..."
- cType = 0
- For pNum = 3 To UBound(Param)
- If LCase(Param(pNum)) = "/fp" Then
- cType = 1
- Exit For
- End If
- Next pNum
- If Left(Param(3), 1) = "/" Then Param(3) = ""
- If Param(3) = "" Then Param(3) = "."
- 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))
- If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
- AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
- GoTo CommandError
- End If
- 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 "Extracting " + fLine + "..."
- sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
- AddScriptOutput " Done" + vbCrLf
-
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- SFileCloseArchive hMPQ
- If fCount > 1 Then
- AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf
- End If
- Else
- If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
- AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
- GoTo CommandError
- End If
- sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
- SFileCloseArchive hMPQ
- AddScriptOutput " Done" + vbCrLf
- End If
- Else
- AddScriptOutput " Required parameter missing" + vbCrLf
- End If
- Else
- AddScriptOutput "No archive open" + vbCrLf
- End If
- Case "r", "ren", "rename"
- If MpqFile <> "" Then
- If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Renaming " + Param(2) + " => " + Param(3) + "..."
- If Param(2) <> "" And Param(3) <> "" Then
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 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 "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
+Attribute VB_Name = "MpqStuff"\r
+Option Explicit\r
+\r
+Type SHELLEXECUTEINFO\r
+ cbSize As Long\r
+ fMask As Long\r
+ hWnd As Long\r
+ lpVerb As String\r
+ lpFile As String\r
+ lpParameters As String\r
+ lpDirectory As String\r
+ nShow As Long\r
+ hInstApp As Long\r
+ \r
+ ' Optional members\r
+ lpIDList As Long\r
+ lpClass As String\r
+ hkeyClass As Long\r
+ dwHotKey As Long\r
+ hIcon As Long\r
+ hProcess As Long\r
+End Type\r
+\r
+Public Declare Function ShellExecute Lib _\r
+ "Shell32.dll" Alias "ShellExecuteA" _\r
+ (ByVal hWnd As Long, _\r
+ ByVal lpOperation As String, _\r
+ ByVal lpFile As String, _\r
+ ByVal lpParameters As String, _\r
+ ByVal lpDirectory As String, _\r
+ ByVal nShowCmd As Long) As Long\r
+Public Declare Function ShellExecuteEx Lib _\r
+ "Shell32.dll" Alias "ShellExecuteExA" _\r
+ (sei As SHELLEXECUTEINFO) As Long\r
+Public Declare Sub SHChangeNotify Lib _\r
+ "Shell32.dll" (ByVal wEventId As Long, _\r
+ ByVal uFlags As Integer, _\r
+ ByVal dwItem1 As Any, _\r
+ ByVal dwItem2 As Any)\r
+Public Declare Function SendMessageA Lib _\r
+ "User32.dll" _\r
+ (ByVal hWnd As Long, _\r
+ ByVal Msg As Long, _\r
+ ByVal Wp As Long, _\r
+ Lp As Any) As Long\r
+Declare Function GetLongPathName Lib "Kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long\r
+Private Declare Sub CopyMemory Lib "Kernel32.dll" _\r
+ Alias "RtlMoveMemory" ( _\r
+ ByRef Destination As Any, _\r
+ ByRef Source As Any, _\r
+ ByVal Length As Long)\r
+\r
+Public CD As OPENFILENAME, PathInput As BROWSEINFO\r
+Public GlobalFileList() As String, FileList() As String, CX As Single, CY As Single, NewFile As Boolean, LocaleID As Long, ListFile As String, AddFolderName As String, ExtractPathNum As Long, CopyPathNum As Long, GlobalEncrypt As Boolean, DefaultCompress As Long, DefaultCompressID As Long, DefaultCompressLevel As Long, DefaultMaxFiles As Long, DefaultBlockSize As Long\r
+Public Const AppKey As String = "HKEY_CURRENT_USER\Software\ShadowFlare\WinMPQ\", SharedAppKey As String = "HKEY_LOCAL_MACHINE\Software\ShadowFlare\WinMPQ\"\r
+Public Const MPQ_ERROR_INIT_FAILED As Long = &H85000001 'Unspecified error\r
+Public Const MPQ_ERROR_NO_STAREDIT As Long = &H85000002 'Can't find StarEdit.exe\r
+Public Const MPQ_ERROR_BAD_STAREDIT As Long = &H85000003 'Bad version of StarEdit.exe. Need SC/BW 1.07\r
+Public Const MPQ_ERROR_STAREDIT_RUNNING As Long = &H85000004 'StarEdit.exe is running. Must be closed\r
+Public Const SHCNE_ASSOCCHANGED As Long = &H8000000\r
+Public Const SHCNF_IDLIST As Long = &H0\r
+Public Const WM_SETREDRAW As Long = &HB\r
+Public Const WM_PAINT As Long = &HF\r
+Const gintMAX_SIZE% = 255\r
+Public Const SEE_MASK_CLASSNAME As Long = &H1\r
+Sub AboutSFMpq()\r
+Dim AboutPage As String, Path As String\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+AboutPage = Path + "sfmpq.dll"\r
+If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll"\r
+ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1\r
+End Sub\r
+Sub GetCompressFlags(File As String, ByRef cType As Integer, ByRef dwFlags As Long)\r
+Dim bNum As Long, fExt As String\r
+dwFlags = MAFA_REPLACE_EXISTING\r
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+For bNum = 1 To Len(File)\r
+ If InStr(bNum, File, ".") > 0 Then\r
+ bNum = InStr(bNum, File, ".")\r
+ Else\r
+ Exit For\r
+ End If\r
+Next bNum\r
+If bNum > 1 Then\r
+ fExt = Mid(File, bNum - 1)\r
+Else\r
+ fExt = File\r
+End If\r
+If LCase(fExt) = ".bik" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".smk" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".mp3" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".mpq" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".scm" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.scm", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".scx" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.scx", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".w3m" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".w3x" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.w3x", "-2"))\r
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)\r
+ElseIf LCase(fExt) = ".wav" Then\r
+ cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))\r
+Else\r
+ cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID)))\r
+End If\r
+End Sub\r
+\r
+Function mOpenMpq(FileName As String) As Long\r
+Dim hMPQ As Long\r
+mOpenMpq = 0\r
+hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)\r
+If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then\r
+ hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)\r
+End If\r
+If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then\r
+ mOpenMpq = hMPQ\r
+End If\r
+End Function\r
+Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String\r
+lpFolderDialog.Title = pCaption\r
+Dim result As Long\r
+result = ShowFolder(lpFolderDialog)\r
+If result = 0 Then Exit Function\r
+PathInputBox = GetPathFromID(result)\r
+End Function\r
+Function GetLongPath(Path As String) As String\r
+ Dim strBuf As String, StrLength As Long\r
+ strBuf = Space$(gintMAX_SIZE)\r
+ StrLength = GetLongPathName(Path, strBuf, gintMAX_SIZE)\r
+ strBuf = Left(strBuf, StrLength)\r
+ If strBuf <> "" Then\r
+ GetLongPath = strBuf\r
+ Else\r
+ GetLongPath = Path\r
+ End If\r
+End Function\r
+Sub AddScriptOutput(sOutput As String)\r
+SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 0, ByVal 0&\r
+ScriptOut.oText = ScriptOut.oText + sOutput\r
+SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 1, ByVal 0&\r
+ScriptOut.oText.SelStart = Len(ScriptOut.oText)\r
+End Sub\r
+Function GetFileTitle(FileName As String) As String\r
+Dim bNum As Long\r
+If InStr(FileName, "\") > 0 Then\r
+ For bNum = 1 To Len(FileName)\r
+ If InStr(bNum, FileName, "\") > 0 Then\r
+ bNum = InStr(bNum, FileName, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ GetFileTitle = Mid(FileName, bNum)\r
+Else\r
+ GetFileTitle = FileName\r
+End If\r
+End Function\r
+Function sGetFile(hMPQ As Long, ByVal FileName As String, OutPath As String, ByVal UseFullPath As Long)\r
+Dim hFile As Long, buffer() As Byte, fLen As Long, cNum As Long\r
+If SFileOpenFileEx(hMPQ, FileName, 0, hFile) Then\r
+ fLen = SFileGetFileSize(hFile, 0)\r
+ If fLen > 0 Then\r
+ ReDim buffer(fLen - 1)\r
+ Else\r
+ ReDim buffer(0)\r
+ End If\r
+ SFileReadFile hFile, buffer(0), fLen, ByVal 0, ByVal 0\r
+ SFileCloseFile hFile\r
+ If UseFullPath = 0 Then FileName = GetFileTitle(FileName)\r
+ FileName = FullPath(OutPath, FileName)\r
+ On Error Resume Next\r
+ For cNum = 1 To Len(FileName)\r
+ cNum = InStr(cNum, FileName, "\")\r
+ If cNum > 0 Then\r
+ MkDir Left(FileName, cNum)\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+ If FileExists(FileName) Then Kill FileName\r
+ On Error GoTo 0\r
+ cNum = FreeFile\r
+ On Error GoTo WriteError\r
+ Open FileName For Binary As #cNum\r
+ If fLen > 0 Then Put #cNum, 1, buffer\r
+ Close #cNum\r
+ On Error GoTo 0\r
+End If\r
+Exit Function\r
+WriteError:\r
+MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ"\r
+Close #cNum\r
+End Function\r
+Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String, ByRef ListedFiles() As FILELISTENTRY) As Boolean\r
+Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, cNum4 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean, nHash As Long, nHashEntries As Long\r
+sListFiles = False\r
+ReDim ListedFiles(0)\r
+ListedFiles(0).dwFileExists = 0\r
+If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then\r
+ NewFileLists = FileLists\r
+Else\r
+ UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)\r
+ MpqList2 = GetExtension(MpqName)\r
+ MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt"\r
+ MpqList2 = GetFileTitle(MpqName) + ".txt"\r
+ Path = GetLongPath(App.Path)\r
+ If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ If UseOnlyAutoList Then ListLen = Len(FileLists)\r
+ If FileLists <> "" Then\r
+ FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName\r
+ Else\r
+ FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName\r
+ End If\r
+ ReDim nFileLists(0) As String\r
+ If UseOnlyAutoList Then ReDim OldLists(0) As String\r
+ For cNum = 1 To Len(FileLists)\r
+ cNum2 = InStr(cNum, FileLists, vbCrLf)\r
+ If cNum2 = 0 Then\r
+ cNum2 = Len(FileLists) + 1\r
+ End If\r
+ If cNum2 - cNum > 0 Then\r
+ ListName = Mid(FileLists, cNum, cNum2 - cNum)\r
+ If Not IsDir(ListName) Then\r
+ If UseOnlyAutoList And cNum < ListLen Then\r
+ ReDim Preserve OldLists(UBound(OldLists) + 1) As String\r
+ OldLists(UBound(OldLists)) = GetLongPath(ListName)\r
+ End If\r
+ For cNum3 = 1 To Len(ListName)\r
+ If InStr(cNum3, ListName, "\") Then\r
+ cNum3 = InStr(cNum3, ListName, "\")\r
+ If FileExists(Left(ListName, cNum3) + MpqList1) Then\r
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String\r
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)\r
+ End If\r
+ If FileExists(Left(ListName, cNum3) + MpqList2) Then\r
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String\r
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)\r
+ End If\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next cNum3\r
+ If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then\r
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String\r
+ nFileLists(UBound(nFileLists)) = GetLongPath(ListName)\r
+ End If\r
+ Else\r
+ ListName = DirEx(ListName, MpqList1, 6, True) _\r
+ + DirEx(ListName, MpqList2, 6, True)\r
+ For cNum3 = 1 To Len(ListName)\r
+ cNum4 = InStr(cNum3, ListName, vbCrLf)\r
+ If cNum4 = 0 Then\r
+ cNum4 = Len(ListName) + 1\r
+ End If\r
+ If cNum4 - cNum3 > 0 Then\r
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String\r
+ nFileLists(UBound(nFileLists)) = GetLongPath(Mid(ListName, cNum3, cNum4 - cNum3))\r
+ End If\r
+ cNum3 = cNum4 + 1\r
+ Next cNum3\r
+ End If\r
+ End If\r
+ cNum = cNum2 + 1\r
+ Next cNum\r
+ If UseOnlyAutoList Then\r
+ For cNum = 1 To UBound(nFileLists)\r
+ For cNum2 = 1 To UBound(OldLists)\r
+ If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then\r
+ GoTo StartSearch\r
+ End If\r
+ Next cNum2\r
+ Next cNum\r
+ UseOnlyAutoList = False\r
+ End If\r
+StartSearch:\r
+ For cNum = 1 To UBound(nFileLists)\r
+ If nFileLists(cNum) <> "" Then\r
+ For cNum2 = 1 To UBound(nFileLists)\r
+ If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then\r
+ nFileLists(cNum2) = ""\r
+ End If\r
+ Next cNum2\r
+ End If\r
+ If UseOnlyAutoList Then\r
+ If nFileLists(cNum) <> "" Then\r
+ For cNum2 = 1 To UBound(OldLists)\r
+ If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList1) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList2) Then\r
+ nFileLists(cNum) = ""\r
+ Exit For\r
+ End If\r
+ Next cNum2\r
+ End If\r
+ End If\r
+ If nFileLists(cNum) <> "" Then\r
+ NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf\r
+ End If\r
+ Next cNum\r
+ If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)\r
+End If\r
+nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE)\r
+If nHashEntries - 1 < 0 Then Exit Function\r
+ReDim ListedFiles(nHashEntries - 1)\r
+sListFiles = SFileListFiles(hMPQ, NewFileLists, ListedFiles(0), 0)\r
+End Function\r
+Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)\r
+Dim cType As Integer, dwFlags As Long\r
+\r
+GetCompressFlags File, cType, dwFlags\r
+\r
+Select Case cType\r
+Case -2\r
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0\r
+Case -1\r
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+Case -3\r
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+Case -4\r
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+Case 0, 1, 2\r
+MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType\r
+Case Else\r
+If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel\r
+Else\r
+ MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0\r
+End If\r
+End Select\r
+End Sub\r
+Sub mAddAutoFromBuffer(hMPQ As Long, ByRef buffer As Byte, BufSize As Long, MpqPath As String)\r
+Dim cType As Integer, dwFlags As Long\r
+\r
+GetCompressFlags MpqPath, cType, dwFlags\r
+\r
+Select Case cType\r
+Case -2\r
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags, 0, 0\r
+Case -1\r
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+Case -3\r
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+Case -4\r
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+Case 0, 1, 2\r
+MpqAddWaveFromBuffer hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, cType\r
+Case Else\r
+If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel\r
+Else\r
+ MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0\r
+End If\r
+End Select\r
+End Sub\r
+\r
+Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String\r
+Dim Files() As String, lNum As Long, Folders() As String\r
+If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"\r
+ReDim Files(0) As String\r
+Files(0) = Dir(Path + Filter, Attributes)\r
+If Files(0) <> "" Then\r
+ Do\r
+ ReDim Preserve Files(UBound(Files) + 1) As String\r
+ Files(UBound(Files)) = Dir\r
+ Loop Until Files(UBound(Files)) = ""\r
+ ReDim Preserve Files(UBound(Files) - 1) As String\r
+End If\r
+For lNum = 0 To UBound(Files)\r
+ If Files(lNum) <> "" Then\r
+ If IsDir(Path + Files(lNum)) = False And (Attributes And vbDirectory) <> vbDirectory Then\r
+ DirEx = DirEx + Path + Files(lNum) + vbCrLf\r
+ ElseIf IsDir(Path + Files(lNum)) = True And (Attributes And vbDirectory) Then\r
+ DirEx = DirEx + Path + Files(lNum) + vbCrLf\r
+ End If\r
+ End If\r
+Next lNum\r
+If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then\r
+ ReDim Folders(0) As String\r
+ Folders(0) = Dir(Path, vbDirectory)\r
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir\r
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir\r
+ If Folders(0) <> "" Then\r
+ Do\r
+ ReDim Preserve Folders(UBound(Folders) + 1) As String\r
+ Folders(UBound(Folders)) = Dir\r
+ If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then\r
+ ReDim Preserve Folders(UBound(Folders) - 1) As String\r
+ End If\r
+ Loop Until Folders(UBound(Folders)) = ""\r
+ ReDim Preserve Folders(UBound(Folders) - 1) As String\r
+ End If\r
+ For lNum = 0 To UBound(Folders)\r
+ If Folders(lNum) <> "" Then\r
+ If IsDir(Path + Folders(lNum)) Then\r
+ DirEx = DirEx + DirEx(Path + Folders(lNum), Filter, Attributes, Recurse)\r
+ End If\r
+ End If\r
+ Next lNum\r
+End If\r
+End Function\r
+Function GetExtension(FileName As String) As String\r
+Dim bNum As Long\r
+If InStr(FileName, ".") > 0 Then\r
+ For bNum = 1 To Len(FileName)\r
+ If InStr(bNum, FileName, ".") > 0 Then\r
+ bNum = InStr(bNum, FileName, ".")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ GetExtension = Mid(FileName, bNum - 1)\r
+Else\r
+ GetExtension = ""\r
+End If\r
+End Function\r
+Function IsDir(DirPath As String) As Boolean\r
+On Error GoTo IsNotDir\r
+If GetAttr(DirPath) And vbDirectory Then\r
+ IsDir = True\r
+Else\r
+ IsDir = False\r
+End If\r
+Exit Function\r
+IsNotDir:\r
+IsDir = False\r
+End Function\r
+Function FileExists(FileName As String) As Boolean\r
+On Error GoTo NoFile\r
+If (GetAttr(FileName) And vbDirectory) <> vbDirectory Then\r
+ FileExists = True\r
+Else\r
+ FileExists = False\r
+End If\r
+Exit Function\r
+NoFile:\r
+FileExists = False\r
+End Function\r
+Function IsMPQ(MpqFile As String) As Boolean\r
+If FindMpqHeader(MpqFile) <> -1 Then\r
+ IsMPQ = True\r
+Else\r
+ IsMPQ = False\r
+End If\r
+End Function\r
+Sub KillEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean)\r
+Dim Files() As String, lNum As Long, Folders() As String\r
+If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"\r
+ReDim Files(0) As String\r
+Files(0) = Dir(Path + Filter, Attributes)\r
+If Files(0) <> "" Then\r
+ Do\r
+ ReDim Preserve Files(UBound(Files) + 1) As String\r
+ Files(UBound(Files)) = Dir\r
+ Loop Until Files(UBound(Files)) = ""\r
+ ReDim Preserve Files(UBound(Files) - 1) As String\r
+End If\r
+For lNum = 0 To UBound(Files)\r
+ If Files(lNum) <> "" Then\r
+ If IsDir(Path + Files(lNum)) = False Then\r
+ On Error Resume Next\r
+ Kill Path + Files(lNum)\r
+ On Error GoTo 0\r
+ End If\r
+ End If\r
+Next lNum\r
+If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then\r
+ ReDim Folders(0) As String\r
+ Folders(0) = Dir(Path, vbDirectory)\r
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir\r
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir\r
+ If Folders(0) <> "" Then\r
+ Do\r
+ ReDim Preserve Folders(UBound(Folders) + 1) As String\r
+ Folders(UBound(Folders)) = Dir\r
+ If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then\r
+ ReDim Preserve Folders(UBound(Folders) - 1) As String\r
+ End If\r
+ Loop Until Folders(UBound(Folders)) = ""\r
+ ReDim Preserve Folders(UBound(Folders) - 1) As String\r
+ End If\r
+ For lNum = 0 To UBound(Folders)\r
+ If Folders(lNum) <> "" Then\r
+ If IsDir(Path + Folders(lNum)) Then\r
+ KillEx Path + Folders(lNum), Filter, Attributes, Recurse\r
+ On Error Resume Next\r
+ RmDir Path + Folders(lNum)\r
+ End If\r
+ On Error GoTo 0\r
+ End If\r
+ Next lNum\r
+End If\r
+End Sub\r
+Function FullPath(ByVal BasePath As String, File As String) As String\r
+If Right(BasePath, 1) <> "\" Then BasePath = BasePath + "\"\r
+If Mid(File, 2, 1) = ":" Or Left(File, 2) = "\\" Then\r
+ FullPath = File\r
+ElseIf Left(File, 1) = "\" Then\r
+ FullPath = Left(BasePath, 2) + File\r
+Else\r
+ FullPath = BasePath + File\r
+End If\r
+End Function\r
+Function MatchesFilter(FileName As String, ByVal Filters As String) As Boolean\r
+Dim bNum As Long, Filter As String\r
+If InStr(Filters, ";") Then\r
+ If Right(Filters, 1) <> ";" Then Filters = Filters + ";"\r
+ For bNum = 1 To Len(Filters)\r
+ Filter = Mid(Filters, bNum, InStr(bNum, Filters, ";") - bNum)\r
+ If Right(Filter, 3) = "*.*" Then Filter = Left(Filter, Len(Filter) - 2)\r
+ If LCase(FileName) Like LCase(Filter) Then\r
+ MatchesFilter = True\r
+ Exit Function\r
+ End If\r
+ bNum = InStr(bNum, Filters, ";")\r
+ Next bNum\r
+Else\r
+ If Right(Filters, 3) = "*.*" Then Filters = Left(Filters, Len(Filters) - 2)\r
+ If LCase(FileName) Like LCase(Filters) Then MatchesFilter = True\r
+End If\r
+End Function\r
+Function RenameWithFilter(FileName As String, OldFilter As String, NewFilter As String) As String\r
+Dim bNum As Long, Filters() As String, NewFileName As String, bNum2 As Long, bNum3 As Long, bNum4 As Long, bNum5 As Long\r
+If Right(OldFilter, 3) = "*.*" Then OldFilter = Left(OldFilter, Len(OldFilter) - 2)\r
+If Right(NewFilter, 3) = "*.*" Then NewFilter = Left(NewFilter, Len(NewFilter) - 2)\r
+ReDim Filters(0) As String\r
+bNum4 = 1\r
+For bNum = 1 To Len(OldFilter)\r
+ Select Case Mid(OldFilter, bNum, 1)\r
+ Case "*"\r
+ bNum2 = InStr(bNum + 1, OldFilter, "*")\r
+ bNum3 = InStr(bNum + 1, OldFilter, "?")\r
+ If bNum2 = 0 And bNum3 = 0 Then\r
+ bNum2 = Len(OldFilter) + 1\r
+ ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then\r
+ bNum2 = bNum3\r
+ End If\r
+ bNum5 = InStr(bNum4, FileName, Mid(OldFilter, bNum + 1, bNum2 - bNum - 1), 1)\r
+ If bNum = Len(OldFilter) Then\r
+ bNum5 = Len(FileName) + 1\r
+ End If\r
+ If bNum5 = 0 Then\r
+ RenameWithFilter = FileName\r
+ Exit Function\r
+ End If\r
+ If bNum > 1 Then\r
+ If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then\r
+ ReDim Preserve Filters(UBound(Filters) + 1) As String\r
+ End If\r
+ Else\r
+ ReDim Preserve Filters(UBound(Filters) + 1) As String\r
+ End If\r
+ Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, bNum5 - bNum4)\r
+ bNum4 = bNum5\r
+ Case "?"\r
+ bNum2 = bNum + 1\r
+ bNum5 = bNum4 + 1\r
+ If bNum > 1 Then\r
+ If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then\r
+ ReDim Preserve Filters(UBound(Filters) + 1) As String\r
+ End If\r
+ Else\r
+ ReDim Preserve Filters(UBound(Filters) + 1) As String\r
+ End If\r
+ Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, 1)\r
+ bNum4 = bNum5\r
+ Case Else\r
+ bNum4 = bNum4 + 1\r
+ End Select\r
+ If bNum4 > Len(FileName) Then\r
+ If (Right(OldFilter, 1) <> "*" Or bNum + 1 < Len(OldFilter)) And bNum < Len(OldFilter) Then\r
+ RenameWithFilter = FileName\r
+ Exit Function\r
+ Else\r
+ Exit For\r
+ End If\r
+ End If\r
+Next bNum\r
+NewFileName = NewFilter\r
+For bNum = 1 To UBound(Filters)\r
+ bNum2 = InStr(bNum, NewFileName, "*")\r
+ bNum3 = InStr(bNum, NewFileName, "?")\r
+ If bNum2 = 0 And bNum3 = 0 Then\r
+ bNum2 = Len(NewFileName) + 1\r
+ ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then\r
+ bNum2 = bNum3\r
+ End If\r
+ If bNum2 > Len(NewFileName) Then\r
+ RenameWithFilter = NewFileName\r
+ Exit Function\r
+ End If\r
+ bNum4 = 0\r
+ For bNum3 = bNum2 To Len(NewFileName)\r
+ Select Case Mid(NewFileName, bNum3, 1)\r
+ Case "*"\r
+ bNum4 = Len(Filters(bNum))\r
+ bNum3 = bNum3 + 1\r
+ Exit For\r
+ Case "?"\r
+ bNum4 = bNum4 + 1\r
+ Case Else\r
+ Exit For\r
+ End Select\r
+ Next bNum3\r
+ NewFileName = Left(NewFileName, bNum2 - 1) + Left(Filters(bNum), bNum4) + Mid(NewFileName, bNum3)\r
+Next bNum\r
+Do Until InStr(NewFileName, "*") = 0\r
+ NewFileName = Left(NewFileName, InStr(NewFileName, "*") - 1) + Mid(NewFileName, InStr(NewFileName, "*") + 1)\r
+Loop\r
+Do Until InStr(NewFileName, "?") = 0\r
+ NewFileName = Left(NewFileName, InStr(NewFileName, "?") - 1) + Mid(NewFileName, InStr(NewFileName, "?") + 1)\r
+Loop\r
+RenameWithFilter = NewFileName\r
+End Function\r
+Function MpqDir(MpqFile As String, Filters As String)\r
+Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String\r
+Dim hMPQ As Long\r
+If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then\r
+ If sListFiles(MpqFile, hMPQ, ListFile, Files) Then\r
+ SFileCloseArchive hMPQ\r
+ For fNum = 0 To UBound(Files)\r
+ If Files(fNum).dwFileExists Then\r
+ CurFileName = StrConv(Files(fNum).szFileName, vbUnicode)\r
+ If MatchesFilter(CurFileName, Filters) Then\r
+ NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1)\r
+ If NamePos > 1 Then\r
+ NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1)\r
+ End If\r
+ If NamePos > 0 Then _\r
+ szFileList = szFileList + CurFileName\r
+ End If\r
+ End If\r
+ Next fNum\r
+ MpqDir = MpqDir + CurFileName + vbCrLf\r
+ Else\r
+ SFileCloseArchive hMPQ\r
+ End If\r
+End If\r
+End Function\r
+Sub RunScript(ScriptName As String)\r
+Dim fNum As Long, Script As String, sLine As String, Param() As String, bNum As Long, EndLine As Long, pNum As Long, EndParam As Long, MpqFile As String, OldDefaultMaxFiles As Long, cType As Integer, lNum As Long, OldPath As String, NewPath As String, Rswitch As Boolean, Files As String, fCount As Long, fEndLine As Long, fLine As String, ScriptNewFile As Boolean, CurPath As String, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, dwFlags\r
+If FileExists(ScriptName) = False Then\r
+ ScriptOut.Show\r
+ AddScriptOutput "Could not find script " + ScriptName + vbCrLf\r
+ Exit Sub\r
+End If\r
+fNum = FreeFile\r
+Open ScriptName For Binary As #fNum\r
+Script = String(LOF(fNum), Chr(0))\r
+Get #fNum, 1, Script\r
+Close #fNum\r
+OldPath = CurDir\r
+If InStr(ScriptName, "\") > 0 Then\r
+ For bNum = 1 To Len(ScriptName)\r
+ If InStr(bNum, ScriptName, "\") > 0 Then\r
+ bNum = InStr(bNum, ScriptName, "\")\r
+ NewPath = Left(ScriptName, bNum)\r
+ End If\r
+ Next bNum\r
+ If Mid(NewPath, 2, 1) = ":" Then ChDrive Left(NewPath, 1)\r
+ ChDir NewPath\r
+End If\r
+CurPath = CurDir\r
+If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf\r
+ScriptOut.Show\r
+AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf\r
+OldDefaultMaxFiles = DefaultMaxFiles\r
+lNum = 1\r
+For bNum = 1 To Len(Script)\r
+ EndLine = InStr(bNum, Script, vbCrLf)\r
+ sLine = Mid(Script, bNum, EndLine - bNum)\r
+ If Right(sLine, 1) <> " " Then sLine = sLine + " "\r
+ If sLine <> "" Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ ReDim Param(0) As String\r
+ For pNum = 1 To Len(sLine)\r
+ If Mid(sLine, pNum, 1) = Chr(34) Then\r
+ pNum = pNum + 1\r
+ EndParam = InStr(pNum, sLine, Chr(34))\r
+ Else\r
+ EndParam = InStr(pNum, sLine, " ")\r
+ End If\r
+ If EndParam = 0 Then EndParam = Len(sLine) + 1\r
+ If pNum <> EndParam Then\r
+ If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then\r
+ ReDim Preserve Param(UBound(Param) + 1) As String\r
+ Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))\r
+ End If\r
+ End If\r
+ pNum = EndParam\r
+ Next pNum\r
+ If UBound(Param) < 3 Then ReDim Preserve Param(3) As String\r
+ Select Case LCase(Param(1))\r
+ Case "o", "open"\r
+ If Param(2) <> "" Then\r
+ MpqFile = Param(2)\r
+ If Param(3) <> "" And FileExists(MpqFile) = False Then\r
+ DefaultMaxFiles = Param(3)\r
+ End If\r
+ If FileExists(MpqFile) Then\r
+ AddScriptOutput "Opened " + MpqFile + vbCrLf\r
+ Else\r
+ AddScriptOutput "Created new " + MpqFile + vbCrLf\r
+ End If\r
+ NewPath = CurPath\r
+ Else\r
+ AddScriptOutput "Required parameter missing" + vbCrLf\r
+ End If\r
+ Case "n", "new"\r
+ If Param(2) <> "" Then\r
+ MpqFile = Param(2)\r
+ If Param(3) <> "" Then\r
+ DefaultMaxFiles = Param(3)\r
+ End If\r
+ ScriptNewFile = True\r
+ AddScriptOutput "Created new " + MpqFile + vbCrLf\r
+ NewPath = CurPath\r
+ Else\r
+ AddScriptOutput "Required parameter missing" + vbCrLf\r
+ End If\r
+ Case "c", "close"\r
+ If MpqFile <> "" Then\r
+ If LCase(CD.FileName) = LCase(FullPath(NewPath, MpqFile)) Then MpqEx.Timer1.Enabled = True\r
+ AddScriptOutput "Closed " + MpqFile + vbCrLf\r
+ MpqFile = ""\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "p", "pause"\r
+ AddScriptOutput "Pause not supported" + vbCrLf\r
+ Case "a", "add"\r
+ If MpqFile <> "" Then\r
+ cType = 0\r
+ Rswitch = False\r
+ fCount = 0\r
+ Files = ""\r
+ fEndLine = 0\r
+ fLine = ""\r
+ dwFlags = MAFA_REPLACE_EXISTING\r
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+ For pNum = 3 To UBound(Param)\r
+ If LCase(Param(pNum)) = "/wav" Then\r
+ cType = 2\r
+ dwFlags = dwFlags Or MAFA_COMPRESS\r
+ ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then\r
+ cType = 1\r
+ dwFlags = dwFlags Or MAFA_COMPRESS\r
+ ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then\r
+ cType = -1\r
+ ElseIf LCase(Param(pNum)) = "/r" Then\r
+ Rswitch = True\r
+ End If\r
+ Next pNum\r
+ If Left(Param(3), 1) = "/" Or Param(3) = "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Param(3) = ""\r
+ Else\r
+ Param(3) = Param(2)\r
+ End If\r
+ End If\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ If InStr(Param(2), "\") > 0 Then\r
+ For pNum = 1 To Len(Param(2))\r
+ If InStr(pNum, Param(2), "\") > 0 Then\r
+ pNum = InStr(pNum, Param(2), "\")\r
+ Files = Left(Param(2), pNum)\r
+ End If\r
+ Next pNum\r
+ End If\r
+ If ScriptNewFile = True Then\r
+ If FileExists(FullPath(NewPath, MpqFile)) Then Kill FullPath(NewPath, MpqFile)\r
+ ScriptNewFile = False\r
+ End If\r
+ Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ = 0 Then\r
+ AddScriptOutput "Can't create archive " + MpqFile + vbCrLf\r
+ GoTo CommandError\r
+ End If\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If pNum > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ End If\r
+ If cType = 0 Then\r
+ AddScriptOutput "Adding " + fLine + "..."\r
+ ElseIf cType = 1 Then\r
+ AddScriptOutput "Adding compressed " + fLine + "..."\r
+ ElseIf cType = 2 Then\r
+ AddScriptOutput "Adding compressed WAV " + fLine + "..."\r
+ ElseIf cType = -1 Then\r
+ AddScriptOutput "Adding " + fLine + " (compression auto-select)..."\r
+ End If\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
+ If cType = 2 Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0\r
+ ElseIf cType = -1 Then\r
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine\r
+ ElseIf cType = 1 Then\r
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0\r
+ End If\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0\r
+ End If\r
+ Else\r
+ If cType = 2 Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0\r
+ ElseIf cType = -1 Then\r
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)\r
+ ElseIf cType = 1 Then\r
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0\r
+ End If\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0\r
+ End If\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ SendMessageA ScriptOut.oText.hWnd, WM_PAINT, 0, &O0\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If fCount > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "e", "extract"\r
+ If MpqFile <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Extracting " + Param(2) + "..."\r
+ cType = 0\r
+ For pNum = 3 To UBound(Param)\r
+ If LCase(Param(pNum)) = "/fp" Then\r
+ cType = 1\r
+ Exit For\r
+ End If\r
+ Next pNum\r
+ If Left(Param(3), 1) = "/" Then Param(3) = ""\r
+ If Param(3) = "" Then Param(3) = "."\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))\r
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then\r
+ AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf\r
+ GoTo CommandError\r
+ End If\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If pNum > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ End If\r
+ AddScriptOutput "Extracting " + fLine + "..."\r
+ sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType\r
+ AddScriptOutput " Done" + vbCrLf\r
+ \r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ SFileCloseArchive hMPQ\r
+ If fCount > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf\r
+ End If\r
+ Else\r
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then\r
+ AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf\r
+ GoTo CommandError\r
+ End If\r
+ sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType\r
+ SFileCloseArchive hMPQ\r
+ AddScriptOutput " Done" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "r", "ren", "rename"\r
+ If MpqFile <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Renaming " + Param(2) + " => " + Param(3) + "..."\r
+ If Param(2) <> "" And Param(3) <> "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If pNum > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ End If\r
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
+ AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..."\r
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, fLine2\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ Else\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If fCount > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "You must use wildcards with new name" + vbCrLf\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, Param(3)\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ Else\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ End If\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "m", "move"\r
+ If MpqFile <> "" Then\r
+ For pNum = 1 To Len(Param(2))\r
+ If InStr(bNum, Param(2), "\") Then\r
+ bNum = InStr(bNum, Param(2), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next pNum\r
+ fLineTitle = Mid(Param(2), bNum)\r
+ If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
+ Param(3) = Param(3) + fLineTitle\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Moving " + Param(2) + " => " + Param(3) + "..."\r
+ If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If pNum > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ End If\r
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
+ AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..."\r
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, fLine2\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ Else\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If fCount > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, Param(3)\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ Else\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ End If\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "d", "del", "delete"\r
+ If MpqFile <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Deleting " + Param(2) + "..."\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If pNum > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": "\r
+ End If\r
+ AddScriptOutput "Deleting " + fLine + "..."\r
+ MpqDeleteFile hMPQ, fLine\r
+ AddScriptOutput " Done" + vbCrLf\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If fCount > 1 Then\r
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ MpqDeleteFile hMPQ, Param(2)\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "f", "flush", "compact"\r
+ If MpqFile <> "" Then\r
+ AddScriptOutput "Flushing " + MpqFile + "..."\r
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))\r
+ If hMPQ Then\r
+ MpqCompactArchive hMPQ\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ AddScriptOutput " Done" + vbCrLf\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "l", "list"\r
+ If MpqFile <> "" Then\r
+ If Param(2) <> "" Then\r
+ AddScriptOutput "Creating list..."\r
+ If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))\r
+ Param(2) = Param(3)\r
+ Else\r
+ Files = MpqDir(FullPath(NewPath, MpqFile), "*")\r
+ End If\r
+ fNum = FreeFile\r
+ Open FullPath(CurPath, Param(2)) For Binary As #fNum\r
+ Put #fNum, 1, Files\r
+ Close #fNum\r
+ AddScriptOutput " Done" + vbCrLf\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "No archive open" + vbCrLf\r
+ End If\r
+ Case "s", "script"\r
+ AddScriptOutput "Running script " + Param(2) + "..." + vbCrLf + vbCrLf\r
+ If Param(2) <> "" Then\r
+ RunScript FullPath(CurPath, Param(2))\r
+ Else\r
+ AddScriptOutput " Required parameter missing" + vbCrLf\r
+ End If\r
+ AddScriptOutput vbCrLf + "Continuing with previous script..." + vbCrLf\r
+ Case "x", "exit", "quit"\r
+ Unload MpqEx\r
+ Case Else\r
+ If Left(Param(1), 1) <> ";" Then\r
+ If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then\r
+ On Error Resume Next\r
+ ChDir Param(2)\r
+ On Error GoTo 0\r
+ CurPath = CurDir\r
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf\r
+ ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then\r
+ On Error Resume Next\r
+ ChDir Mid(Param(1), 3)\r
+ On Error GoTo 0\r
+ CurPath = CurDir\r
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf\r
+ ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then\r
+ On Error Resume Next\r
+ ChDir Mid(Param(1), 6)\r
+ On Error GoTo 0\r
+ CurPath = CurDir\r
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf\r
+ ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then\r
+ On Error Resume Next\r
+ ChDrive Left(Param(1), 2)\r
+ On Error GoTo 0\r
+ CurPath = CurDir\r
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf\r
+ Else\r
+ AddScriptOutput "Running command " + sLine + "..."\r
+ Shell "command.com /c " + sLine, 1\r
+ AddScriptOutput " Done" + vbCrLf\r
+ End If\r
+ Else\r
+ AddScriptOutput "Comment " + sLine + vbCrLf\r
+ End If\r
+ End Select\r
+ End If\r
+CommandError:\r
+ lNum = lNum + 1\r
+ bNum = EndLine + 1\r
+Next bNum\r
+DefaultMaxFiles = OldDefaultMaxFiles\r
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)\r
+ChDir OldPath\r
+End Sub\r
+Function FindMpqHeader(MpqFile As String) As Long\r
+ If FileExists(MpqFile) = False Then\r
+ FindMpqHeader = -1\r
+ Exit Function\r
+ End If\r
+ Dim hFile\r
+ hFile = FreeFile\r
+ Open MpqFile For Binary As #hFile\r
+ Dim FileLen As Long\r
+ FileLen = LOF(hFile)\r
+ Dim pbuf As String\r
+ pbuf = String(32, Chr(0))\r
+ Dim i As Long\r
+ For i = 0 To FileLen - 1 Step 512\r
+ Get #hFile, 1 + i, pbuf\r
+ If Left(pbuf, 4) = "MPQ" + Chr(26) Or Left(pbuf, 4) = "BN3" + Chr(26) Then\r
+ ' Storm no longer does this, so this shouldn't either\r
+ 'FileLen = FileLen - i\r
+ 'If JBytes(pbuf, 9, 4) = FileLen\r
+ ' FileMpqHeader = i\r
+ ' Close #hFile\r
+ ' Exit Function\r
+ 'Else\r
+ ' FileLen = FileLen + i\r
+ 'End If\r
+ FindMpqHeader = i\r
+ Close #hFile\r
+ Exit Function\r
+ End If\r
+ Next i\r
+ FindMpqHeader = -1\r
+ Close #hFile\r
+End Function\r
+Function GetNumMpqFiles(MpqFile As String) As Long\r
+Dim fNum As Long, Text As String, MpqHeader As Long\r
+fNum = FreeFile\r
+Text = String(4, Chr(0))\r
+MpqHeader = FindMpqHeader(MpqFile)\r
+If MpqHeader > -1 Then\r
+ Open MpqFile For Binary As #fNum\r
+ Get #fNum, MpqHeader + 29, GetNumMpqFiles\r
+ Close #fNum\r
+End If\r
+End Function\r
diff --git a/Options.frm b/Options.frm
--- a/Options.frm
+++ b/Options.frm
-VERSION 4.00
-Begin VB.Form Options
- BorderStyle = 3 'Fixed Dialog
- Caption = "Options"
- ClientHeight = 4695
- ClientLeft = 1665
- ClientTop = 2085
- ClientWidth = 5415
- Height = 5100
- Icon = "Options.frx":0000
- KeyPreview = -1 'True
- Left = 1605
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4695
- ScaleWidth = 5415
- ShowInTaskbar = 0 'False
- Top = 1740
- Width = 5535
- Begin VB.CommandButton Command2
- Caption = "&Cancel"
- Height = 375
- Left = 3120
- TabIndex = 1
- Top = 4200
- Width = 1335
- End
- Begin VB.CommandButton Command1
- Caption = "O&k"
- Height = 375
- Left = 960
- TabIndex = 0
- Top = 4200
- Width = 1335
- End
- Begin VB.PictureBox TabDisps
- BorderStyle = 0 'None
- Height = 3495
- Index = 1
- Left = 240
- ScaleHeight = 3495
- ScaleWidth = 4995
- TabIndex = 35
- TabStop = 0 'False
- Top = 480
- Width = 4995
- Begin VB.TextBox Text5
- Height = 285
- Left = 2280
- MaxLength = 2
- TabIndex = 5
- Text = "3"
- Top = 1200
- Width = 1215
- End
- Begin VB.TextBox Text1
- Height = 285
- Left = 0
- MaxLength = 6
- TabIndex = 3
- Text = "1024"
- Top = 600
- Width = 1215
- End
- Begin VB.TextBox Text2
- Height = 285
- Left = 0
- TabIndex = 4
- Text = "0"
- Top = 1200
- Width = 1215
- End
- Begin VB.CheckBox Check2
- Caption = "&Associate WinMPQ with MPQ Archives"
- Height = 255
- Left = 0
- TabIndex = 6
- Top = 1680
- Value = 2 'Grayed
- Width = 3375
- End
- Begin VB.CheckBox Check4
- Caption = "Use &wildcards in filenames for drag and drop"
- Height = 255
- Left = 0
- TabIndex = 8
- Top = 2400
- Value = 2 'Grayed
- Width = 3735
- End
- Begin VB.CheckBox Check5
- Caption = "Automatically update &modified files"
- Height = 255
- Left = 0
- TabIndex = 7
- Top = 2160
- Value = 2 'Grayed
- Width = 3015
- End
- Begin VB.Label ActualBlockSize
- Caption = "4 KB"
- Height = 255
- Left = 3600
- TabIndex = 56
- Top = 1200
- Width = 1215
- End
- Begin VB.Label Label13
- AutoSize = -1 'True
- Caption = "Block size for new archives (default is 3)"
- Height = 390
- Left = 2280
- TabIndex = 55
- Top = 720
- Width = 2055
- WordWrap = -1 'True
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Maximum files for new archives: (this cannot be changed for an existing archive)"
- Height = 495
- Left = 0
- TabIndex = 38
- Top = 120
- Width = 4335
- WordWrap = -1 'True
- End
- Begin VB.Label Label2
- AutoSize = -1 'True
- Caption = "Locale ID for adding files"
- Height = 195
- Left = 0
- TabIndex = 37
- Top = 960
- Width = 1755
- End
- Begin VB.Label Label3
- Caption = $"Options.frx":000C
- Height = 855
- Left = 0
- TabIndex = 36
- Top = 2640
- Width = 4935
- End
- End
- Begin VB.PictureBox TabDisps
- BorderStyle = 0 'None
- Height = 3495
- Index = 2
- Left = 240
- ScaleHeight = 3495
- ScaleWidth = 4935
- TabIndex = 41
- TabStop = 0 'False
- Top = 480
- Visible = 0 'False
- Width = 4935
- Begin VB.CommandButton cmdAddFolder
- Caption = "Add &Folder..."
- Height = 375
- Left = 3480
- TabIndex = 11
- Top = 1320
- Width = 1335
- End
- Begin VB.CheckBox Check8
- Caption = "Do not use above lists when one is found by above option"
- Height = 375
- Left = 0
- TabIndex = 14
- Top = 2880
- Value = 2 'Grayed
- Width = 3375
- End
- Begin VB.CheckBox Check7
- Caption = "Use file lists for similarly named archives"
- Height = 195
- Left = 0
- TabIndex = 13
- Top = 2640
- Width = 3375
- End
- Begin VB.CommandButton cmdDelList
- Caption = "&Remove"
- Height = 375
- Left = 3480
- TabIndex = 12
- Top = 1920
- Width = 1335
- End
- Begin VB.ListBox FileLists
- Height = 2205
- Left = 0
- TabIndex = 9
- Top = 360
- Width = 3375
- End
- Begin VB.CommandButton cmdAddList
- Caption = "&Add List File..."
- Height = 375
- Left = 3480
- TabIndex = 10
- Top = 720
- Width = 1335
- End
- Begin VB.Label Label11
- Caption = "Note: Each file list added will increase the load time for archives."
- Height = 255
- Left = 0
- TabIndex = 52
- Top = 3240
- Width = 4815
- End
- Begin VB.Label Label10
- AutoSize = -1 'True
- Caption = "File Lists:"
- Height = 195
- Left = 0
- TabIndex = 51
- Top = 120
- Width = 645
- End
- End
- Begin VB.PictureBox TabDisps
- BorderStyle = 0 'None
- Height = 3495
- Index = 5
- Left = 240
- ScaleHeight = 3495
- ScaleWidth = 4935
- TabIndex = 39
- TabStop = 0 'False
- Top = 480
- Visible = 0 'False
- Width = 4935
- Begin VB.CommandButton Command4
- Caption = "&Reset size/position"
- Height = 375
- Left = 360
- TabIndex = 17
- Top = 840
- Width = 1695
- End
- Begin VB.CheckBox Check3
- Caption = "Display &confirmation boxes"
- Height = 255
- Left = 0
- TabIndex = 15
- Top = 120
- Value = 2 'Grayed
- Width = 2415
- End
- Begin VB.CheckBox Check1
- Caption = "&Save last window size and position"
- Height = 255
- Left = 0
- TabIndex = 16
- Top = 480
- Value = 2 'Grayed
- Width = 3015
- End
- Begin VB.Frame Frame1
- Caption = "Startup Path"
- Height = 1215
- Left = 0
- TabIndex = 40
- Top = 2280
- Width = 4935
- Begin VB.OptionButton Option1
- Caption = "Last &open folder"
- Height = 255
- Index = 0
- Left = 120
- TabIndex = 18
- Top = 240
- Value = -1 'True
- Width = 1575
- End
- Begin VB.OptionButton Option1
- Caption = "A&pplication folder"
- Height = 255
- Index = 1
- Left = 1680
- TabIndex = 19
- Top = 240
- Width = 1695
- End
- Begin VB.OptionButton Option1
- Caption = "&User-defined folder"
- Height = 255
- Index = 2
- Left = 120
- TabIndex = 20
- Top = 480
- Width = 1695
- End
- Begin VB.TextBox Text3
- Enabled = 0 'False
- Height = 285
- Left = 120
- TabIndex = 21
- Top = 840
- Width = 3615
- End
- Begin VB.CommandButton Command5
- Caption = "&Folder..."
- Enabled = 0 'False
- Height = 285
- Left = 3840
- TabIndex = 22
- Top = 840
- Width = 975
- End
- End
- End
- Begin VB.PictureBox TabDisps
- BorderStyle = 0 'None
- Height = 3495
- Index = 4
- Left = 240
- ScaleHeight = 3495
- ScaleWidth = 4935
- TabIndex = 43
- TabStop = 0 'False
- Top = 480
- Visible = 0 'False
- Width = 4935
- Begin VB.ListBox Actions
- Height = 1215
- IntegralHeight = 0 'False
- Left = 3120
- TabIndex = 24
- Top = 2280
- Width = 1815
- End
- Begin MSComctlLib.ListView FileTypes
- Height = 2535
- Left = 0
- TabIndex = 23
- Top = 960
- Width = 3015
- _ExtentX = 5318
- _ExtentY = 4471
- View = 3
- LabelEdit = 1
- Sorted = -1 'True
- MultiSelect = -1 'True
- LabelWrap = -1 'True
- HideSelection = -1 'True
- _Version = 393217
- ForeColor = -2147483640
- BackColor = -2147483643
- BorderStyle = 1
- Appearance = 1
- NumItems = 1
- BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- Text = "Registered file types:"
- Object.Width = 2540
- EndProperty
- End
- Begin VB.Label Label9
- AutoSize = -1 'True
- Caption = "File extensions:"
- Height = 195
- Left = 3120
- TabIndex = 50
- Top = 960
- Width = 1080
- End
- Begin VB.Label Label7
- AutoSize = -1 'True
- Caption = "Default action:"
- Height = 195
- Left = 3120
- TabIndex = 48
- Top = 2040
- Width = 1035
- End
- Begin VB.Label Label8
- Height = 855
- Left = 3120
- TabIndex = 49
- Top = 1200
- Width = 1755
- End
- Begin VB.Label Label6
- AutoSize = -1 'True
- Caption = $"Options.frx":00F6
- Height = 855
- Left = 0
- TabIndex = 47
- Top = 120
- Width = 4935
- WordWrap = -1 'True
- End
- End
- Begin VB.PictureBox TabDisps
- BorderStyle = 0 'None
- Height = 3495
- Index = 3
- Left = 240
- ScaleHeight = 3495
- ScaleWidth = 4935
- TabIndex = 42
- TabStop = 0 'False
- Top = 480
- Visible = 0 'False
- Width = 4935
- Begin VB.ComboBox Combo3
- Height = 315
- ItemData = "Options.frx":01CE
- Left = 2880
- List = "Options.frx":01F3
- Style = 2 'Dropdown List
- TabIndex = 34
- Top = 3120
- Width = 1815
- End
- Begin VB.ComboBox Combo2
- Height = 315
- ItemData = "Options.frx":0245
- Left = 1200
- List = "Options.frx":0252
- Style = 2 'Dropdown List
- TabIndex = 33
- Top = 3120
- Width = 1455
- End
- Begin VB.ListBox List1
- Height = 1815
- ItemData = "Options.frx":0270
- Left = 0
- List = "Options.frx":0272
- Sorted = -1 'True
- TabIndex = 27
- Top = 720
- Width = 1575
- End
- Begin VB.TextBox Text4
- Height = 285
- Left = 0
- TabIndex = 25
- Top = 360
- Width = 855
- End
- Begin VB.CommandButton cmdAdd
- Caption = "&Add"
- Height = 285
- Left = 960
- TabIndex = 26
- Top = 360
- Width = 615
- End
- Begin VB.CommandButton Command6
- Caption = "&Remove"
- Height = 255
- Left = 0
- TabIndex = 28
- Top = 2640
- Width = 1095
- End
- Begin VB.ComboBox Combo1
- Enabled = 0 'False
- Height = 315
- ItemData = "Options.frx":0274
- Left = 1800
- List = "Options.frx":0287
- Style = 2 'Dropdown List
- TabIndex = 29
- Top = 720
- Width = 2535
- End
- Begin VB.Frame Frame2
- Caption = "Audio Compression"
- Height = 1335
- Left = 1800
- TabIndex = 44
- Top = 1200
- Visible = 0 'False
- Width = 2535
- Begin VB.OptionButton AudioC
- Caption = "Medium"
- Height = 255
- Index = 0
- Left = 120
- TabIndex = 31
- Top = 600
- Value = -1 'True
- Width = 2175
- End
- Begin VB.OptionButton AudioC
- Caption = "Highest (Least space)"
- Height = 255
- Index = 1
- Left = 120
- TabIndex = 32
- Top = 960
- Width = 2175
- End
- Begin VB.OptionButton AudioC
- Caption = "Lowest (Best quality)"
- Height = 255
- Index = 2
- Left = 120
- TabIndex = 30
- Top = 240
- Width = 2175
- End
- End
- Begin VB.Label ZLibLabel
- AutoSize = -1 'True
- Caption = "Deflate Compression Level"
- Height = 195
- Left = 2880
- TabIndex = 54
- Top = 2880
- Width = 1890
- End
- Begin VB.Label Label12
- AutoSize = -1 'True
- Caption = "Default Compression"
- Height = 195
- Left = 1200
- TabIndex = 53
- Top = 2880
- Width = 1455
- End
- Begin VB.Label Label5
- Caption = "Compression type"
- Height = 255
- Left = 1800
- TabIndex = 46
- Top = 480
- Width = 1935
- End
- Begin VB.Label Label4
- Caption = "File Extension"
- Height = 255
- Left = 0
- TabIndex = 45
- Top = 120
- Width = 1215
- End
- End
- Begin MSComctlLib.TabStrip Tabs
- Height = 3975
- Left = 120
- TabIndex = 2
- Top = 120
- Width = 5175
- _ExtentX = 9128
- _ExtentY = 7011
- HotTracking = -1 'True
- _Version = 393216
- BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
- NumTabs = 5
- BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
- Caption = "General"
- ImageVarType = 2
- EndProperty
- BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
- Caption = "File Lists"
- ImageVarType = 2
- EndProperty
- BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
- Caption = "Compression Auto-Selection"
- ImageVarType = 2
- EndProperty
- BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628}
- Caption = "File Associations"
- ImageVarType = 2
- EndProperty
- BeginProperty Tab5 {1EFB659A-857C-11D1-B16A-00C0F0283628}
- Caption = "Other"
- ImageVarType = 2
- EndProperty
- EndProperty
- End
-End
-Attribute VB_Name = "Options"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Dim OldFileName As String, NewListFile As String
-Dim NewExtNames() As String, NewExtComp() As Integer
-Dim ActID() As String
-
-Private Sub Check8_Click()
-If Check8.Value = 1 Then Check8.Value = 2
-End Sub
-Private Sub cmdAdd_Click()
-Dim xNum As Integer
-If Text4 <> "" Then
- If Left(Text4, 1) <> "." Then Text4 = "." + Text4
- For xNum = 1 To UBound(NewExtNames)
- If Text4 = NewExtNames(xNum) Then Exit Sub
- Next xNum
- List1.AddItem Text4
- ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
- NewExtNames(UBound(NewExtNames)) = Text4
- ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
- NewExtComp(UBound(NewExtComp)) = -1
- Text4 = ""
-End If
-End Sub
-
-Private Sub cmdAddFolder_Click()
-Dim lNum As Long
-Dim Path As String
-PathInput.hwndOwner = hWnd
-Path = PathInputBox(PathInput, "Add Listfile Folder", "")
-If Path = "" Then GoTo Cancel
-FileLists.AddItem Path
-If FileLists.ListCount > 0 Then
- NewListFile = FileLists.List(0)
-Else
- NewListFile = ""
-End If
-For lNum = 1 To FileLists.ListCount - 1
- NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
-Next lNum
-Cancel:
-End Sub
-Private Sub cmdAddList_Click()
-Dim lNum As Long
-CD.Flags = &H1000 Or &H4 Or &H2
-CD.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
-CD.hwndOwner = hWnd
-If ShowOpen(CD) = False Then GoTo Cancel
-FileLists.AddItem CD.FileName
-If FileLists.ListCount > 0 Then
- NewListFile = FileLists.List(0)
-Else
- NewListFile = ""
-End If
-For lNum = 1 To FileLists.ListCount - 1
- NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
-Next lNum
-Cancel:
-End Sub
-Private Sub cmdDelList_Click()
-Dim lNum As Long
-If FileLists.ListIndex > -1 Then
- FileLists.RemoveItem FileLists.ListIndex
- If FileLists.ListCount > 0 Then
- NewListFile = FileLists.List(0)
- Else
- NewListFile = ""
- End If
- For lNum = 1 To FileLists.ListCount - 1
- NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
- Next lNum
-End If
-End Sub
-Private Sub Combo1_Click()
-Dim xNum As Integer
-For xNum = 1 To UBound(NewExtNames)
- If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
-Next xNum
-If UBound(NewExtNames) = 0 Then xNum = 0
-If Combo1.ListIndex = 3 Then
- Frame2.Visible = True
- NewExtComp(xNum) = Combo1.ListIndex - 3
-Else
- Frame2.Visible = False
- If Combo1.ListIndex < 2 Then
- NewExtComp(xNum) = Combo1.ListIndex - 2
- Else
- If Combo1.ListIndex = 2 Then
- NewExtComp(xNum) = -3
- Else
- NewExtComp(xNum) = -4
- End If
- End If
-End If
-End Sub
-Private Sub AudioC_Click(Index As Integer)
-Dim xNum As Integer
-For xNum = 1 To UBound(NewExtNames)
- If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
-Next xNum
-If UBound(NewExtNames) = 0 Then xNum = 0
-NewExtComp(xNum) = Index
-End Sub
-Private Sub Check1_Click()
-If Check1.Value = 1 Then Check1.Value = 2
-End Sub
-
-Private Sub Check2_Click()
-If Check2.Value = 1 Then Check2.Value = 2
-End Sub
-
-Private Sub Check3_Click()
-If Check3.Value = 1 Then Check3.Value = 2
-End Sub
-
-Private Sub Check4_Click()
-If Check4.Value = 1 Then Check4.Value = 2
-End Sub
-
-Private Sub Check5_Click()
-If Check5.Value = 1 Then Check5.Value = 2
-End Sub
-Private Sub Command1_Click()
-Dim Path As String, BatKey As String
-Dim xNum As Integer, ExtList As String
-Dim dItem As String, ndItem As String, aNum As Long
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Text1_LostFocus
-Text2_LostFocus
-DefaultMaxFiles = Text1
-DefaultBlockSize = Text5
-LocaleID = Text2
-SFileSetLocale (LocaleID)
-NewKey AppKey
-SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD
-SetReg AppKey + "DefaultBlockSize", Text5, REG_DWORD
-SetReg AppKey + "LocaleID", Text2, REG_DWORD
-If Check1.Value > 0 Then
- SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD
-Else
- SetReg AppKey + "SaveWindowStatus", 0, REG_DWORD
-End If
-If Check3.Value > 0 Then
- SetReg AppKey + "ShowConfirmation", 1, REG_DWORD
-Else
- SetReg AppKey + "ShowConfirmation", 0, REG_DWORD
-End If
-If Check4.Value > 0 Then
- SetReg AppKey + "UseDragDropWildcards", 1, REG_DWORD
-Else
- SetReg AppKey + "UseDragDropWildcards", 0, REG_DWORD
-End If
-If Check5.Value > 0 Then
- SetReg AppKey + "CheckModDateTime", 1, REG_DWORD
-Else
- SetReg AppKey + "CheckModDateTime", 0, REG_DWORD
- MpqEx.Timer1.Enabled = False
-End If
-If Check7.Value > 0 Then
- SetReg AppKey + "AutofindFileLists", 1, REG_DWORD
-Else
- SetReg AppKey + "AutofindFileLists", 0, REG_DWORD
-End If
-If Check8.Value > 0 Then
- SetReg AppKey + "UseOnlyAutofindLists", 1, REG_DWORD
-Else
- SetReg AppKey + "UseOnlyAutofindLists", 0, REG_DWORD
-End If
-If Check2.Value > 0 Then
- NewKey "HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive"
- NewKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
- SetReg "HKEY_CLASSES_ROOT\.mpq\ShellNew\NullFile", ""
- NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\", "MPQ Archive"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\DefaultIcon\", Path + App.EXEName + ".exe,1"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)
- BatKey = "HKEY_CLASSES_ROOT\" + GetReg("HKEY_CLASSES_ROOT\.bat\", "batfile") + "\"
- NewKey "HKEY_CLASSES_ROOT\.mscript\", "Mpq.Script"
- NewKey "HKEY_CLASSES_ROOT\.mbat\", "Mpq.Script"
- NewKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
- SetReg "HKEY_CLASSES_ROOT\.mscript\ShellNew\NullFile", ""
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\", "Mo'PaQ 2000 Script"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\DefaultIcon\", GetReg(BatKey + "DefaultIcon\", "C:\WINDOWS\SYSTEM\shell32.dll,-153")
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\command\", GetReg(BatKey + "shell\edit\command\", "C:\WINDOWS\NOTEPAD.EXE %1")
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\", "&Run"
- NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " script " + Chr(34) + "%1" + Chr(34)
-Else
- If GetReg("HKEY_CLASSES_ROOT\.mpq\") = "Mpq.Archive" Then
- DelKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
- DelKey "HKEY_CLASSES_ROOT\.mpq\"
- SetReg "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", "not used"
- DelKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
- DelKey "HKEY_CLASSES_ROOT\.mscript\"
- DelKey "HKEY_CLASSES_ROOT\.mbat\"
- End If
-End If
-SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, vbNullString, vbNullString
-If Option1(0).Value = True Then
- SetReg AppKey + "StartupPathType", 0, REG_DWORD
- Text3 = CurDir
-ElseIf Option1(1).Value = True Then
- SetReg AppKey + "StartupPathType", 1, REG_DWORD
- Text3 = App.Path
-ElseIf Option1(2).Value = True Then
- SetReg AppKey + "StartupPathType", 2, REG_DWORD
-End If
-Path = Text3
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-If IsDir(Path) Then
- SetReg AppKey + "StartupPath", Text3
- ChDir Text3
-End If
-Select Case Combo2.ListIndex
-Case 0
-DefaultCompressID = -1
-DefaultCompress = MAFA_COMPRESS_STANDARD
-Case 1
-DefaultCompressID = -3
-DefaultCompress = MAFA_COMPRESS_DEFLATE
-Case 2
-DefaultCompressID = -4
-DefaultCompress = MAFA_COMPRESS_BZIP2
-End Select
-DefaultCompressLevel = Combo3.ListIndex - 1
-SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD
-SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD
-DelKey AppKey + "Compression\"
-NewKey AppKey + "Compression\"
-For xNum = 1 To UBound(NewExtNames)
- ExtList = ExtList + NewExtNames(xNum)
- SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))
-Next xNum
-SetReg AppKey + "Compression\List", ExtList
-NewKey SharedAppKey + "FileDefaultActions\"
-For aNum = 1 To FileTypes.ListItems.Count
- dItem = GetReg("HKEY_CLASSES_ROOT\" + FileTypes.ListItems.Item(aNum).Key + "\shell\", "open")
- dItem = GetReg(SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, dItem)
- ndItem = FileTypes.ListItems.Item(aNum).Tag
- If LCase(dItem) <> LCase(ndItem) And ndItem <> "" Then
- SetReg SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, ndItem
- End If
-Next aNum
-Hide
-If LCase(ListFile) <> LCase(NewListFile) Then
- ListFile = NewListFile
- SetReg AppKey + "ListFile", ListFile
- CD.FileName = OldFileName
- If FileExists(OldFileName) Then MpqEx.OpenMpq
-End If
-Unload Me
-End Sub
-Private Sub Command2_Click()
-Unload Me
-End Sub
-Private Sub Command4_Click()
-DelReg AppKey + "Status\WindowState"
-DelReg AppKey + "Status\WindowHeight"
-DelReg AppKey + "Status\WindowLeft"
-DelReg AppKey + "Status\WindowTop"
-DelReg AppKey + "Status\WindowWidth"
-Check1.Value = 0
-End Sub
-Private Sub Command5_Click()
-Dim Path As String
-PathInput.hwndOwner = hWnd
-Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
-If Path <> "" Then Text3 = Path
-End Sub
-Private Sub Command6_Click()
-Dim xNum As Integer
-If List1.ListIndex > -1 Then
- For xNum = 1 To UBound(NewExtNames)
- If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
- Next xNum
- If xNum < UBound(NewExtNames) Then
- For xNum = xNum To UBound(NewExtNames) - 1
- NewExtNames(xNum) = NewExtNames(xNum + 1)
- NewExtComp(xNum) = NewExtComp(xNum + 1)
- Next xNum
- End If
- ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String
- ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer
- On Error Resume Next
- List1.RemoveItem List1.ListIndex
-End If
-End Sub
-Private Sub Form_Load()
-Dim Path As String, PathType As Integer, NewFileListNames As String
-Dim ExtList As String
-Dim aExt As String, aName As String, aNum As Long, DCompType As Long
-On Error Resume Next
-Left = MpqEx.Left + 330
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Text1 = DefaultMaxFiles
-Text5 = DefaultBlockSize
-Text2 = LocaleID
-OldFileName = CD.FileName
-CD.FileName = ""
-NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
-For aNum = 1 To Len(NewListFile)
- If InStr(aNum, NewListFile, vbCrLf) Then
- aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum)
- If FileExists(aName) Or IsDir(aName) Then
- FileLists.AddItem aName
- NewFileListNames = NewFileListNames + aName + vbCrLf
- End If
- aNum = InStr(aNum, NewListFile, vbCrLf) + 1
- Else
- aName = Mid(NewListFile, aNum)
- If FileExists(aName) Or IsDir(aName) Then
- FileLists.AddItem aName
- NewFileListNames = NewFileListNames + aName
- End If
- Exit For
- End If
-Next aNum
-NewListFile = NewFileListNames
-If Right(NewListFile, 2) = vbCrLf Then NewListFile = Left(NewListFile, Len(NewListFile) - 2)
-If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.Value = 0
-If GetReg(AppKey + "ShowConfirmation", 1) > 0 Then Check3.Value = 1 Else Check3.Value = 0
-If GetReg(AppKey + "UseDragDropWildcards", 1) > 0 Then Check4.Value = 1 Else Check4.Value = 0
-If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Check5.Value = 1 Else Check5.Value = 0
-If GetReg(AppKey + "AutofindFileLists", 0) > 0 Then Check7.Value = 1 Else Check7.Value = 0
-If GetReg(AppKey + "UseOnlyAutofindLists", 1) > 0 Then Check8.Value = 1 Else Check8.Value = 0
-If GetReg("HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive") = "Mpq.Archive" And InStr(1, GetReg("HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)), App.EXEName + ".exe", 1) > 0 Then Check2.Value = 1 Else Check2.Value = 0
-Text3 = GetReg(AppKey + "StartupPath", CurDir)
-PathType = GetReg(AppKey + "StartupPathType", 0)
-If PathType < 0 Then PathType = 0
-If PathType > 2 Then PathType = 2
-Option1(PathType).Value = True
-If PathType = 0 Then
- Text3 = CurDir
-ElseIf PathType = 1 Then
- Text3 = App.Path
-End If
-ReDim NewExtNames(0) As String
-ReDim NewExtComp(0) As Integer
-Combo1.ListIndex = 1
-DCompType = GetReg(AppKey + "DefaultCompress", -1)
-Select Case DCompType
-Case -3
-Combo2.ListIndex = 1
-Case -4
-Combo2.ListIndex = 2
-Case Else
-Combo2.ListIndex = 0
-End Select
-Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1
-ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.scm.scx.w3m.w3x.wav")
-If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then
-Do
- ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
- ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
- If InStr(2, ExtList, ".") > 0 Then
- NewExtNames(UBound(NewExtNames)) = Left(ExtList, InStr(2, ExtList, ".") - 1)
- Else
- NewExtNames(UBound(NewExtNames)) = ExtList
- End If
- ExtList = Mid(ExtList, Len(NewExtNames(UBound(NewExtNames))) + 1)
- List1.AddItem NewExtNames(UBound(NewExtNames))
- If LCase(NewExtNames(UBound(NewExtNames))) = ".bik" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scm" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scm", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scx" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scx", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3x" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3x", "-2"))
- ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))
- Else
- NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\" + NewExtNames(UBound(NewExtNames)), "-1"))
- End If
-Loop Until ExtList = ""
-End If
-Do
- aExt = EnumKey("HKEY_CLASSES_ROOT\", aNum)
- If Left(aExt, 1) = "." Then
- aName = GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")
- If aName <> "" Then
- On Error GoTo AlreadyExists
- FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt)
- On Error Resume Next
- End If
- ElseIf LCase(aExt) = "*" Then
- FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
- If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files"
- ElseIf LCase(aExt) = "unknown" Then
- FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
- If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File"
- End If
- aNum = aNum + 1
-Loop Until aExt = ""
-Exit Sub
-AlreadyExists:
- FileTypes.ListItems.Item(aName).ToolTipText = FileTypes.ListItems.Item(aName).ToolTipText + " " + UCase(aExt)
-Resume Next
-End Sub
-Private Sub Form_Resize()
-FileTypes.ColumnHeaders.Item(1).Width = FileTypes.Width - 30 * Screen.TwipsPerPixelX
-End Sub
-
-Private Sub Form_Unload(Cancel As Integer)
-CD.FileName = OldFileName
-End Sub
-Private Sub List1_Click()
-Dim xNum As Integer, OldExtComp As Integer
-If List1.ListIndex > -1 Then
- Combo1.Enabled = True
- For xNum = 1 To UBound(NewExtNames)
- If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
- Next xNum
- Select Case NewExtComp(xNum)
- Case -2
- AudioC(0).Value = True
- Combo1.ListIndex = 0
- Case -1
- AudioC(0).Value = True
- Combo1.ListIndex = 1
- Case -3
- AudioC(0).Value = True
- Combo1.ListIndex = 2
- Case -4
- AudioC(0).Value = True
- Combo1.ListIndex = 4
- Case 0, 1, 2
- OldExtComp = NewExtComp(xNum)
- Combo1.ListIndex = 3
- AudioC(OldExtComp).Value = True
- Case Else
- AudioC(0).Value = True
- Combo1.ListIndex = 1
- End Select
-Else
- Combo1.ListIndex = 1
- Combo1.Enabled = False
-End If
-End Sub
-Private Sub Option1_Click(Index As Integer)
-If Index = 2 Then
- Text3.Enabled = True
- Command5.Enabled = True
-Else
- Text3.Enabled = False
- Command5.Enabled = False
-End If
-End Sub
-Private Sub Tabs_Click()
-Dim TabDisp As PictureBox
-For Each TabDisp In TabDisps
- TabDisp.Visible = False
-Next TabDisp
-TabDisps(Tabs.SelectedItem.Index).Visible = True
-End Sub
-Private Sub Text1_KeyPress(KeyAscii As Integer)
-If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
-End Sub
-
-Private Sub Text5_Change()
-On Error Resume Next
-If Text5 <> "" Then
- If Text5 > 23 Then Text5 = 23
- If Text5 <= 23 Then _
- ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB"
-Else
- ActualBlockSize = ""
-End If
-On Error GoTo 0
-End Sub
-Private Sub Text5_KeyPress(KeyAscii As Integer)
-If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
-End Sub
-Private Sub Text1_LostFocus()
-If Text1 = "" Then Text1 = 0
-'If Text1 < 16 Then Text1 = 16
-'If Text1 > 262144 Then Text1 = 262144
-End Sub
-Private Sub Text5_LostFocus()
-If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE
-If Text5 > 23 Then Text5 = 23
-End Sub
-Private Sub Text2_KeyPress(KeyAscii As Integer)
-Dim NewValue As Long
-If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0
-On Error GoTo TooBig
-If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text2 + Chr(KeyAscii))
-On Error GoTo 0
-Exit Sub
-TooBig:
-KeyAscii = 0
-End Sub
-Private Sub Text2_LostFocus()
-If Text2 = "" Then Text2 = 0
-End Sub
-Private Sub Text4_GotFocus()
-cmdAdd.Default = True
-End Sub
-Private Sub Text4_LostFocus()
-Command1.Default = True
-End Sub
-Private Sub Actions_Click()
-On Error GoTo NotSelected
-FileTypes.SelectedItem.Tag = FileTypes.SelectedItem.Tag
-On Error GoTo 0
-If FileTypes.SelectedItem.Selected = True Then
- FileTypes.SelectedItem.Tag = ActID(Actions.ListIndex + 1)
-End If
-NotSelected:
-End Sub
-Private Sub FileTypes_ItemClick(ByVal Item As ListItem)
-Dim aNum As Long, aItem As String, aName As String, bNum As Long, dItem As String
-Label8 = Item.ToolTipText
-Actions.Clear
-ReDim ActID(0) As String
-aName = Item.Key
-Do
- aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
- If aItem <> "" Then
- If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
- Actions.AddItem "Open with..."
- Else
- Actions.AddItem GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", UCase(Left(aItem, 1)) + Mid(aItem, 2))
- End If
- ReDim Preserve ActID(UBound(ActID) + 1) As String
- ActID(UBound(ActID)) = aItem
- aNum = aNum + 1
- End If
-Loop Until aItem = ""
-If Item.Tag = "" Then
- dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
- dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
-Else
- dItem = Item.Tag
-End If
-If Actions.ListCount > 0 Then Actions.ListIndex = 0
-For bNum = 0 To Actions.ListCount - 1
- If LCase(ActID(bNum + 1)) = LCase(dItem) Then
- Actions.ListIndex = bNum
- End If
-Next bNum
-Item.Tag = dItem
-End Sub
+VERSION 4.00\r
+Begin VB.Form Options \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Options"\r
+ ClientHeight = 4695\r
+ ClientLeft = 1665\r
+ ClientTop = 2085\r
+ ClientWidth = 5415\r
+ Height = 5100\r
+ Icon = "Options.frx":0000\r
+ KeyPreview = -1 'True\r
+ Left = 1605\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 4695\r
+ ScaleWidth = 5415\r
+ ShowInTaskbar = 0 'False\r
+ Top = 1740\r
+ Width = 5535\r
+ Begin VB.CommandButton Command2 \r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 3120\r
+ TabIndex = 1\r
+ Top = 4200\r
+ Width = 1335\r
+ End\r
+ Begin VB.CommandButton Command1 \r
+ Caption = "O&k"\r
+ Height = 375\r
+ Left = 960\r
+ TabIndex = 0\r
+ Top = 4200\r
+ Width = 1335\r
+ End\r
+ Begin VB.PictureBox TabDisps \r
+ BorderStyle = 0 'None\r
+ Height = 3495\r
+ Index = 1\r
+ Left = 240\r
+ ScaleHeight = 3495\r
+ ScaleWidth = 4995\r
+ TabIndex = 35\r
+ TabStop = 0 'False\r
+ Top = 480\r
+ Width = 4995\r
+ Begin VB.TextBox Text5 \r
+ Height = 285\r
+ Left = 2280\r
+ MaxLength = 2\r
+ TabIndex = 5\r
+ Text = "3"\r
+ Top = 1200\r
+ Width = 1215\r
+ End\r
+ Begin VB.TextBox Text1 \r
+ Height = 285\r
+ Left = 0\r
+ MaxLength = 6\r
+ TabIndex = 3\r
+ Text = "1024"\r
+ Top = 600\r
+ Width = 1215\r
+ End\r
+ Begin VB.TextBox Text2 \r
+ Height = 285\r
+ Left = 0\r
+ TabIndex = 4\r
+ Text = "0"\r
+ Top = 1200\r
+ Width = 1215\r
+ End\r
+ Begin VB.CheckBox Check2 \r
+ Caption = "&Associate WinMPQ with MPQ Archives"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 6\r
+ Top = 1680\r
+ Value = 2 'Grayed\r
+ Width = 3375\r
+ End\r
+ Begin VB.CheckBox Check4 \r
+ Caption = "Use &wildcards in filenames for drag and drop"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 8\r
+ Top = 2400\r
+ Value = 2 'Grayed\r
+ Width = 3735\r
+ End\r
+ Begin VB.CheckBox Check5 \r
+ Caption = "Automatically update &modified files"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 7\r
+ Top = 2160\r
+ Value = 2 'Grayed\r
+ Width = 3015\r
+ End\r
+ Begin VB.Label ActualBlockSize \r
+ Caption = "4 KB"\r
+ Height = 255\r
+ Left = 3600\r
+ TabIndex = 56\r
+ Top = 1200\r
+ Width = 1215\r
+ End\r
+ Begin VB.Label Label13 \r
+ AutoSize = -1 'True\r
+ Caption = "Block size for new archives (default is 3)"\r
+ Height = 390\r
+ Left = 2280\r
+ TabIndex = 55\r
+ Top = 720\r
+ Width = 2055\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Label Label1 \r
+ AutoSize = -1 'True\r
+ Caption = "Maximum files for new archives: (this cannot be changed for an existing archive)"\r
+ Height = 495\r
+ Left = 0\r
+ TabIndex = 38\r
+ Top = 120\r
+ Width = 4335\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Label Label2 \r
+ AutoSize = -1 'True\r
+ Caption = "Locale ID for adding files"\r
+ Height = 195\r
+ Left = 0\r
+ TabIndex = 37\r
+ Top = 960\r
+ Width = 1755\r
+ End\r
+ Begin VB.Label Label3 \r
+ Caption = $"Options.frx":000C\r
+ Height = 855\r
+ Left = 0\r
+ TabIndex = 36\r
+ Top = 2640\r
+ Width = 4935\r
+ End\r
+ End\r
+ Begin VB.PictureBox TabDisps \r
+ BorderStyle = 0 'None\r
+ Height = 3495\r
+ Index = 2\r
+ Left = 240\r
+ ScaleHeight = 3495\r
+ ScaleWidth = 4935\r
+ TabIndex = 41\r
+ TabStop = 0 'False\r
+ Top = 480\r
+ Visible = 0 'False\r
+ Width = 4935\r
+ Begin VB.CommandButton cmdAddFolder \r
+ Caption = "Add &Folder..."\r
+ Height = 375\r
+ Left = 3480\r
+ TabIndex = 11\r
+ Top = 1320\r
+ Width = 1335\r
+ End\r
+ Begin VB.CheckBox Check8 \r
+ Caption = "Do not use above lists when one is found by above option"\r
+ Height = 375\r
+ Left = 0\r
+ TabIndex = 14\r
+ Top = 2880\r
+ Value = 2 'Grayed\r
+ Width = 3375\r
+ End\r
+ Begin VB.CheckBox Check7 \r
+ Caption = "Use file lists for similarly named archives"\r
+ Height = 195\r
+ Left = 0\r
+ TabIndex = 13\r
+ Top = 2640\r
+ Width = 3375\r
+ End\r
+ Begin VB.CommandButton cmdDelList \r
+ Caption = "&Remove"\r
+ Height = 375\r
+ Left = 3480\r
+ TabIndex = 12\r
+ Top = 1920\r
+ Width = 1335\r
+ End\r
+ Begin VB.ListBox FileLists \r
+ Height = 2205\r
+ Left = 0\r
+ TabIndex = 9\r
+ Top = 360\r
+ Width = 3375\r
+ End\r
+ Begin VB.CommandButton cmdAddList \r
+ Caption = "&Add List File..."\r
+ Height = 375\r
+ Left = 3480\r
+ TabIndex = 10\r
+ Top = 720\r
+ Width = 1335\r
+ End\r
+ Begin VB.Label Label11 \r
+ Caption = "Note: Each file list added will increase the load time for archives."\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 52\r
+ Top = 3240\r
+ Width = 4815\r
+ End\r
+ Begin VB.Label Label10 \r
+ AutoSize = -1 'True\r
+ Caption = "File Lists:"\r
+ Height = 195\r
+ Left = 0\r
+ TabIndex = 51\r
+ Top = 120\r
+ Width = 645\r
+ End\r
+ End\r
+ Begin VB.PictureBox TabDisps \r
+ BorderStyle = 0 'None\r
+ Height = 3495\r
+ Index = 5\r
+ Left = 240\r
+ ScaleHeight = 3495\r
+ ScaleWidth = 4935\r
+ TabIndex = 39\r
+ TabStop = 0 'False\r
+ Top = 480\r
+ Visible = 0 'False\r
+ Width = 4935\r
+ Begin VB.CommandButton Command4 \r
+ Caption = "&Reset size/position"\r
+ Height = 375\r
+ Left = 360\r
+ TabIndex = 17\r
+ Top = 840\r
+ Width = 1695\r
+ End\r
+ Begin VB.CheckBox Check3 \r
+ Caption = "Display &confirmation boxes"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 15\r
+ Top = 120\r
+ Value = 2 'Grayed\r
+ Width = 2415\r
+ End\r
+ Begin VB.CheckBox Check1 \r
+ Caption = "&Save last window size and position"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 16\r
+ Top = 480\r
+ Value = 2 'Grayed\r
+ Width = 3015\r
+ End\r
+ Begin VB.Frame Frame1 \r
+ Caption = "Startup Path"\r
+ Height = 1215\r
+ Left = 0\r
+ TabIndex = 40\r
+ Top = 2280\r
+ Width = 4935\r
+ Begin VB.OptionButton Option1 \r
+ Caption = "Last &open folder"\r
+ Height = 255\r
+ Index = 0\r
+ Left = 120\r
+ TabIndex = 18\r
+ Top = 240\r
+ Value = -1 'True\r
+ Width = 1575\r
+ End\r
+ Begin VB.OptionButton Option1 \r
+ Caption = "A&pplication folder"\r
+ Height = 255\r
+ Index = 1\r
+ Left = 1680\r
+ TabIndex = 19\r
+ Top = 240\r
+ Width = 1695\r
+ End\r
+ Begin VB.OptionButton Option1 \r
+ Caption = "&User-defined folder"\r
+ Height = 255\r
+ Index = 2\r
+ Left = 120\r
+ TabIndex = 20\r
+ Top = 480\r
+ Width = 1695\r
+ End\r
+ Begin VB.TextBox Text3 \r
+ Enabled = 0 'False\r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 21\r
+ Top = 840\r
+ Width = 3615\r
+ End\r
+ Begin VB.CommandButton Command5 \r
+ Caption = "&Folder..."\r
+ Enabled = 0 'False\r
+ Height = 285\r
+ Left = 3840\r
+ TabIndex = 22\r
+ Top = 840\r
+ Width = 975\r
+ End\r
+ End\r
+ End\r
+ Begin VB.PictureBox TabDisps \r
+ BorderStyle = 0 'None\r
+ Height = 3495\r
+ Index = 4\r
+ Left = 240\r
+ ScaleHeight = 3495\r
+ ScaleWidth = 4935\r
+ TabIndex = 43\r
+ TabStop = 0 'False\r
+ Top = 480\r
+ Visible = 0 'False\r
+ Width = 4935\r
+ Begin VB.ListBox Actions \r
+ Height = 1215\r
+ IntegralHeight = 0 'False\r
+ Left = 3120\r
+ TabIndex = 24\r
+ Top = 2280\r
+ Width = 1815\r
+ End\r
+ Begin MSComctlLib.ListView FileTypes \r
+ Height = 2535\r
+ Left = 0\r
+ TabIndex = 23\r
+ Top = 960\r
+ Width = 3015\r
+ _ExtentX = 5318\r
+ _ExtentY = 4471\r
+ View = 3\r
+ LabelEdit = 1\r
+ Sorted = -1 'True\r
+ MultiSelect = -1 'True\r
+ LabelWrap = -1 'True\r
+ HideSelection = -1 'True\r
+ _Version = 393217\r
+ ForeColor = -2147483640\r
+ BackColor = -2147483643\r
+ BorderStyle = 1\r
+ Appearance = 1\r
+ NumItems = 1\r
+ BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ Text = "Registered file types:"\r
+ Object.Width = 2540\r
+ EndProperty\r
+ End\r
+ Begin VB.Label Label9 \r
+ AutoSize = -1 'True\r
+ Caption = "File extensions:"\r
+ Height = 195\r
+ Left = 3120\r
+ TabIndex = 50\r
+ Top = 960\r
+ Width = 1080\r
+ End\r
+ Begin VB.Label Label7 \r
+ AutoSize = -1 'True\r
+ Caption = "Default action:"\r
+ Height = 195\r
+ Left = 3120\r
+ TabIndex = 48\r
+ Top = 2040\r
+ Width = 1035\r
+ End\r
+ Begin VB.Label Label8 \r
+ Height = 855\r
+ Left = 3120\r
+ TabIndex = 49\r
+ Top = 1200\r
+ Width = 1755\r
+ End\r
+ Begin VB.Label Label6 \r
+ AutoSize = -1 'True\r
+ Caption = $"Options.frx":00F6\r
+ Height = 855\r
+ Left = 0\r
+ TabIndex = 47\r
+ Top = 120\r
+ Width = 4935\r
+ WordWrap = -1 'True\r
+ End\r
+ End\r
+ Begin VB.PictureBox TabDisps \r
+ BorderStyle = 0 'None\r
+ Height = 3495\r
+ Index = 3\r
+ Left = 240\r
+ ScaleHeight = 3495\r
+ ScaleWidth = 4935\r
+ TabIndex = 42\r
+ TabStop = 0 'False\r
+ Top = 480\r
+ Visible = 0 'False\r
+ Width = 4935\r
+ Begin VB.ComboBox Combo3 \r
+ Height = 315\r
+ ItemData = "Options.frx":01CE\r
+ Left = 2880\r
+ List = "Options.frx":01F3\r
+ Style = 2 'Dropdown List\r
+ TabIndex = 34\r
+ Top = 3120\r
+ Width = 1815\r
+ End\r
+ Begin VB.ComboBox Combo2 \r
+ Height = 315\r
+ ItemData = "Options.frx":0245\r
+ Left = 1200\r
+ List = "Options.frx":0252\r
+ Style = 2 'Dropdown List\r
+ TabIndex = 33\r
+ Top = 3120\r
+ Width = 1455\r
+ End\r
+ Begin VB.ListBox List1 \r
+ Height = 1815\r
+ ItemData = "Options.frx":0270\r
+ Left = 0\r
+ List = "Options.frx":0272\r
+ Sorted = -1 'True\r
+ TabIndex = 27\r
+ Top = 720\r
+ Width = 1575\r
+ End\r
+ Begin VB.TextBox Text4 \r
+ Height = 285\r
+ Left = 0\r
+ TabIndex = 25\r
+ Top = 360\r
+ Width = 855\r
+ End\r
+ Begin VB.CommandButton cmdAdd \r
+ Caption = "&Add"\r
+ Height = 285\r
+ Left = 960\r
+ TabIndex = 26\r
+ Top = 360\r
+ Width = 615\r
+ End\r
+ Begin VB.CommandButton Command6 \r
+ Caption = "&Remove"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 28\r
+ Top = 2640\r
+ Width = 1095\r
+ End\r
+ Begin VB.ComboBox Combo1 \r
+ Enabled = 0 'False\r
+ Height = 315\r
+ ItemData = "Options.frx":0274\r
+ Left = 1800\r
+ List = "Options.frx":0287\r
+ Style = 2 'Dropdown List\r
+ TabIndex = 29\r
+ Top = 720\r
+ Width = 2535\r
+ End\r
+ Begin VB.Frame Frame2 \r
+ Caption = "Audio Compression"\r
+ Height = 1335\r
+ Left = 1800\r
+ TabIndex = 44\r
+ Top = 1200\r
+ Visible = 0 'False\r
+ Width = 2535\r
+ Begin VB.OptionButton AudioC \r
+ Caption = "Medium"\r
+ Height = 255\r
+ Index = 0\r
+ Left = 120\r
+ TabIndex = 31\r
+ Top = 600\r
+ Value = -1 'True\r
+ Width = 2175\r
+ End\r
+ Begin VB.OptionButton AudioC \r
+ Caption = "Highest (Least space)"\r
+ Height = 255\r
+ Index = 1\r
+ Left = 120\r
+ TabIndex = 32\r
+ Top = 960\r
+ Width = 2175\r
+ End\r
+ Begin VB.OptionButton AudioC \r
+ Caption = "Lowest (Best quality)"\r
+ Height = 255\r
+ Index = 2\r
+ Left = 120\r
+ TabIndex = 30\r
+ Top = 240\r
+ Width = 2175\r
+ End\r
+ End\r
+ Begin VB.Label ZLibLabel \r
+ AutoSize = -1 'True\r
+ Caption = "Deflate Compression Level"\r
+ Height = 195\r
+ Left = 2880\r
+ TabIndex = 54\r
+ Top = 2880\r
+ Width = 1890\r
+ End\r
+ Begin VB.Label Label12 \r
+ AutoSize = -1 'True\r
+ Caption = "Default Compression"\r
+ Height = 195\r
+ Left = 1200\r
+ TabIndex = 53\r
+ Top = 2880\r
+ Width = 1455\r
+ End\r
+ Begin VB.Label Label5 \r
+ Caption = "Compression type"\r
+ Height = 255\r
+ Left = 1800\r
+ TabIndex = 46\r
+ Top = 480\r
+ Width = 1935\r
+ End\r
+ Begin VB.Label Label4 \r
+ Caption = "File Extension"\r
+ Height = 255\r
+ Left = 0\r
+ TabIndex = 45\r
+ Top = 120\r
+ Width = 1215\r
+ End\r
+ End\r
+ Begin MSComctlLib.TabStrip Tabs \r
+ Height = 3975\r
+ Left = 120\r
+ TabIndex = 2\r
+ Top = 120\r
+ Width = 5175\r
+ _ExtentX = 9128\r
+ _ExtentY = 7011\r
+ HotTracking = -1 'True\r
+ _Version = 393216\r
+ BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} \r
+ NumTabs = 5\r
+ BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} \r
+ Caption = "General"\r
+ ImageVarType = 2\r
+ EndProperty\r
+ BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} \r
+ Caption = "File Lists"\r
+ ImageVarType = 2\r
+ EndProperty\r
+ BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} \r
+ Caption = "Compression Auto-Selection"\r
+ ImageVarType = 2\r
+ EndProperty\r
+ BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} \r
+ Caption = "File Associations"\r
+ ImageVarType = 2\r
+ EndProperty\r
+ BeginProperty Tab5 {1EFB659A-857C-11D1-B16A-00C0F0283628} \r
+ Caption = "Other"\r
+ ImageVarType = 2\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+End\r
+Attribute VB_Name = "Options"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Dim OldFileName As String, NewListFile As String\r
+Dim NewExtNames() As String, NewExtComp() As Integer\r
+Dim ActID() As String\r
+\r
+Private Sub Check8_Click()\r
+If Check8.Value = 1 Then Check8.Value = 2\r
+End Sub\r
+Private Sub cmdAdd_Click()\r
+Dim xNum As Integer\r
+If Text4 <> "" Then\r
+ If Left(Text4, 1) <> "." Then Text4 = "." + Text4\r
+ For xNum = 1 To UBound(NewExtNames)\r
+ If Text4 = NewExtNames(xNum) Then Exit Sub\r
+ Next xNum\r
+ List1.AddItem Text4\r
+ ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String\r
+ NewExtNames(UBound(NewExtNames)) = Text4\r
+ ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer\r
+ NewExtComp(UBound(NewExtComp)) = -1\r
+ Text4 = ""\r
+End If\r
+End Sub\r
+\r
+Private Sub cmdAddFolder_Click()\r
+Dim lNum As Long\r
+Dim Path As String\r
+PathInput.hwndOwner = hWnd\r
+Path = PathInputBox(PathInput, "Add Listfile Folder", "")\r
+If Path = "" Then GoTo Cancel\r
+FileLists.AddItem Path\r
+If FileLists.ListCount > 0 Then\r
+ NewListFile = FileLists.List(0)\r
+Else\r
+ NewListFile = ""\r
+End If\r
+For lNum = 1 To FileLists.ListCount - 1\r
+ NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)\r
+Next lNum\r
+Cancel:\r
+End Sub\r
+Private Sub cmdAddList_Click()\r
+Dim lNum As Long\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+CD.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"\r
+CD.hwndOwner = hWnd\r
+If ShowOpen(CD) = False Then GoTo Cancel\r
+FileLists.AddItem CD.FileName\r
+If FileLists.ListCount > 0 Then\r
+ NewListFile = FileLists.List(0)\r
+Else\r
+ NewListFile = ""\r
+End If\r
+For lNum = 1 To FileLists.ListCount - 1\r
+ NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)\r
+Next lNum\r
+Cancel:\r
+End Sub\r
+Private Sub cmdDelList_Click()\r
+Dim lNum As Long\r
+If FileLists.ListIndex > -1 Then\r
+ FileLists.RemoveItem FileLists.ListIndex\r
+ If FileLists.ListCount > 0 Then\r
+ NewListFile = FileLists.List(0)\r
+ Else\r
+ NewListFile = ""\r
+ End If\r
+ For lNum = 1 To FileLists.ListCount - 1\r
+ NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)\r
+ Next lNum\r
+End If\r
+End Sub\r
+Private Sub Combo1_Click()\r
+Dim xNum As Integer\r
+For xNum = 1 To UBound(NewExtNames)\r
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For\r
+Next xNum\r
+If UBound(NewExtNames) = 0 Then xNum = 0\r
+If Combo1.ListIndex = 3 Then\r
+ Frame2.Visible = True\r
+ NewExtComp(xNum) = Combo1.ListIndex - 3\r
+Else\r
+ Frame2.Visible = False\r
+ If Combo1.ListIndex < 2 Then\r
+ NewExtComp(xNum) = Combo1.ListIndex - 2\r
+ Else\r
+ If Combo1.ListIndex = 2 Then\r
+ NewExtComp(xNum) = -3\r
+ Else\r
+ NewExtComp(xNum) = -4\r
+ End If\r
+ End If\r
+End If\r
+End Sub\r
+Private Sub AudioC_Click(Index As Integer)\r
+Dim xNum As Integer\r
+For xNum = 1 To UBound(NewExtNames)\r
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For\r
+Next xNum\r
+If UBound(NewExtNames) = 0 Then xNum = 0\r
+NewExtComp(xNum) = Index\r
+End Sub\r
+Private Sub Check1_Click()\r
+If Check1.Value = 1 Then Check1.Value = 2\r
+End Sub\r
+\r
+Private Sub Check2_Click()\r
+If Check2.Value = 1 Then Check2.Value = 2\r
+End Sub\r
+\r
+Private Sub Check3_Click()\r
+If Check3.Value = 1 Then Check3.Value = 2\r
+End Sub\r
+\r
+Private Sub Check4_Click()\r
+If Check4.Value = 1 Then Check4.Value = 2\r
+End Sub\r
+\r
+Private Sub Check5_Click()\r
+If Check5.Value = 1 Then Check5.Value = 2\r
+End Sub\r
+Private Sub Command1_Click()\r
+Dim Path As String, BatKey As String\r
+Dim xNum As Integer, ExtList As String\r
+Dim dItem As String, ndItem As String, aNum As Long\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Text1_LostFocus\r
+Text2_LostFocus\r
+DefaultMaxFiles = Text1\r
+DefaultBlockSize = Text5\r
+LocaleID = Text2\r
+SFileSetLocale (LocaleID)\r
+NewKey AppKey\r
+SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD\r
+SetReg AppKey + "DefaultBlockSize", Text5, REG_DWORD\r
+SetReg AppKey + "LocaleID", Text2, REG_DWORD\r
+If Check1.Value > 0 Then\r
+ SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "SaveWindowStatus", 0, REG_DWORD\r
+End If\r
+If Check3.Value > 0 Then\r
+ SetReg AppKey + "ShowConfirmation", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "ShowConfirmation", 0, REG_DWORD\r
+End If\r
+If Check4.Value > 0 Then\r
+ SetReg AppKey + "UseDragDropWildcards", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "UseDragDropWildcards", 0, REG_DWORD\r
+End If\r
+If Check5.Value > 0 Then\r
+ SetReg AppKey + "CheckModDateTime", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "CheckModDateTime", 0, REG_DWORD\r
+ MpqEx.Timer1.Enabled = False\r
+End If\r
+If Check7.Value > 0 Then\r
+ SetReg AppKey + "AutofindFileLists", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "AutofindFileLists", 0, REG_DWORD\r
+End If\r
+If Check8.Value > 0 Then\r
+ SetReg AppKey + "UseOnlyAutofindLists", 1, REG_DWORD\r
+Else\r
+ SetReg AppKey + "UseOnlyAutofindLists", 0, REG_DWORD\r
+End If\r
+If Check2.Value > 0 Then\r
+ NewKey "HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive"\r
+ NewKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"\r
+ SetReg "HKEY_CLASSES_ROOT\.mpq\ShellNew\NullFile", ""\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\", "MPQ Archive"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\DefaultIcon\", Path + App.EXEName + ".exe,1"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)\r
+ BatKey = "HKEY_CLASSES_ROOT\" + GetReg("HKEY_CLASSES_ROOT\.bat\", "batfile") + "\"\r
+ NewKey "HKEY_CLASSES_ROOT\.mscript\", "Mpq.Script"\r
+ NewKey "HKEY_CLASSES_ROOT\.mbat\", "Mpq.Script"\r
+ NewKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"\r
+ SetReg "HKEY_CLASSES_ROOT\.mscript\ShellNew\NullFile", ""\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\", "Mo'PaQ 2000 Script"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\DefaultIcon\", GetReg(BatKey + "DefaultIcon\", "C:\WINDOWS\SYSTEM\shell32.dll,-153")\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\command\", GetReg(BatKey + "shell\edit\command\", "C:\WINDOWS\NOTEPAD.EXE %1")\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\", "&Run"\r
+ NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " script " + Chr(34) + "%1" + Chr(34)\r
+Else\r
+ If GetReg("HKEY_CLASSES_ROOT\.mpq\") = "Mpq.Archive" Then\r
+ DelKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"\r
+ DelKey "HKEY_CLASSES_ROOT\.mpq\"\r
+ SetReg "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", "not used"\r
+ DelKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"\r
+ DelKey "HKEY_CLASSES_ROOT\.mscript\"\r
+ DelKey "HKEY_CLASSES_ROOT\.mbat\"\r
+ End If\r
+End If\r
+SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, vbNullString, vbNullString\r
+If Option1(0).Value = True Then\r
+ SetReg AppKey + "StartupPathType", 0, REG_DWORD\r
+ Text3 = CurDir\r
+ElseIf Option1(1).Value = True Then\r
+ SetReg AppKey + "StartupPathType", 1, REG_DWORD\r
+ Text3 = App.Path\r
+ElseIf Option1(2).Value = True Then\r
+ SetReg AppKey + "StartupPathType", 2, REG_DWORD\r
+End If\r
+Path = Text3\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+If IsDir(Path) Then\r
+ SetReg AppKey + "StartupPath", Text3\r
+ ChDir Text3\r
+End If\r
+Select Case Combo2.ListIndex\r
+Case 0\r
+DefaultCompressID = -1\r
+DefaultCompress = MAFA_COMPRESS_STANDARD\r
+Case 1\r
+DefaultCompressID = -3\r
+DefaultCompress = MAFA_COMPRESS_DEFLATE\r
+Case 2\r
+DefaultCompressID = -4\r
+DefaultCompress = MAFA_COMPRESS_BZIP2\r
+End Select\r
+DefaultCompressLevel = Combo3.ListIndex - 1\r
+SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD\r
+SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD\r
+DelKey AppKey + "Compression\"\r
+NewKey AppKey + "Compression\"\r
+For xNum = 1 To UBound(NewExtNames)\r
+ ExtList = ExtList + NewExtNames(xNum)\r
+ SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))\r
+Next xNum\r
+SetReg AppKey + "Compression\List", ExtList\r
+NewKey SharedAppKey + "FileDefaultActions\"\r
+For aNum = 1 To FileTypes.ListItems.Count\r
+ dItem = GetReg("HKEY_CLASSES_ROOT\" + FileTypes.ListItems.Item(aNum).Key + "\shell\", "open")\r
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, dItem)\r
+ ndItem = FileTypes.ListItems.Item(aNum).Tag\r
+ If LCase(dItem) <> LCase(ndItem) And ndItem <> "" Then\r
+ SetReg SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, ndItem\r
+ End If\r
+Next aNum\r
+Hide\r
+If LCase(ListFile) <> LCase(NewListFile) Then\r
+ ListFile = NewListFile\r
+ SetReg AppKey + "ListFile", ListFile\r
+ CD.FileName = OldFileName\r
+ If FileExists(OldFileName) Then MpqEx.OpenMpq\r
+End If\r
+Unload Me\r
+End Sub\r
+Private Sub Command2_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub Command4_Click()\r
+DelReg AppKey + "Status\WindowState"\r
+DelReg AppKey + "Status\WindowHeight"\r
+DelReg AppKey + "Status\WindowLeft"\r
+DelReg AppKey + "Status\WindowTop"\r
+DelReg AppKey + "Status\WindowWidth"\r
+Check1.Value = 0\r
+End Sub\r
+Private Sub Command5_Click()\r
+Dim Path As String\r
+PathInput.hwndOwner = hWnd\r
+Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)\r
+If Path <> "" Then Text3 = Path\r
+End Sub\r
+Private Sub Command6_Click()\r
+Dim xNum As Integer\r
+If List1.ListIndex > -1 Then\r
+ For xNum = 1 To UBound(NewExtNames)\r
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For\r
+ Next xNum\r
+ If xNum < UBound(NewExtNames) Then\r
+ For xNum = xNum To UBound(NewExtNames) - 1\r
+ NewExtNames(xNum) = NewExtNames(xNum + 1)\r
+ NewExtComp(xNum) = NewExtComp(xNum + 1)\r
+ Next xNum\r
+ End If\r
+ ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String\r
+ ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer\r
+ On Error Resume Next\r
+ List1.RemoveItem List1.ListIndex\r
+End If\r
+End Sub\r
+Private Sub Form_Load()\r
+Dim Path As String, PathType As Integer, NewFileListNames As String\r
+Dim ExtList As String\r
+Dim aExt As String, aName As String, aNum As Long, DCompType As Long\r
+On Error Resume Next\r
+Left = MpqEx.Left + 330\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Text1 = DefaultMaxFiles\r
+Text5 = DefaultBlockSize\r
+Text2 = LocaleID\r
+OldFileName = CD.FileName\r
+CD.FileName = ""\r
+NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")\r
+For aNum = 1 To Len(NewListFile)\r
+ If InStr(aNum, NewListFile, vbCrLf) Then\r
+ aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum)\r
+ If FileExists(aName) Or IsDir(aName) Then\r
+ FileLists.AddItem aName\r
+ NewFileListNames = NewFileListNames + aName + vbCrLf\r
+ End If\r
+ aNum = InStr(aNum, NewListFile, vbCrLf) + 1\r
+ Else\r
+ aName = Mid(NewListFile, aNum)\r
+ If FileExists(aName) Or IsDir(aName) Then\r
+ FileLists.AddItem aName\r
+ NewFileListNames = NewFileListNames + aName\r
+ End If\r
+ Exit For\r
+ End If\r
+Next aNum\r
+NewListFile = NewFileListNames\r
+If Right(NewListFile, 2) = vbCrLf Then NewListFile = Left(NewListFile, Len(NewListFile) - 2)\r
+If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.Value = 0\r
+If GetReg(AppKey + "ShowConfirmation", 1) > 0 Then Check3.Value = 1 Else Check3.Value = 0\r
+If GetReg(AppKey + "UseDragDropWildcards", 1) > 0 Then Check4.Value = 1 Else Check4.Value = 0\r
+If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Check5.Value = 1 Else Check5.Value = 0\r
+If GetReg(AppKey + "AutofindFileLists", 0) > 0 Then Check7.Value = 1 Else Check7.Value = 0\r
+If GetReg(AppKey + "UseOnlyAutofindLists", 1) > 0 Then Check8.Value = 1 Else Check8.Value = 0\r
+If GetReg("HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive") = "Mpq.Archive" And InStr(1, GetReg("HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)), App.EXEName + ".exe", 1) > 0 Then Check2.Value = 1 Else Check2.Value = 0\r
+Text3 = GetReg(AppKey + "StartupPath", CurDir)\r
+PathType = GetReg(AppKey + "StartupPathType", 0)\r
+If PathType < 0 Then PathType = 0\r
+If PathType > 2 Then PathType = 2\r
+Option1(PathType).Value = True\r
+If PathType = 0 Then\r
+ Text3 = CurDir\r
+ElseIf PathType = 1 Then\r
+ Text3 = App.Path\r
+End If\r
+ReDim NewExtNames(0) As String\r
+ReDim NewExtComp(0) As Integer\r
+Combo1.ListIndex = 1\r
+DCompType = GetReg(AppKey + "DefaultCompress", -1)\r
+Select Case DCompType\r
+Case -3\r
+Combo2.ListIndex = 1\r
+Case -4\r
+Combo2.ListIndex = 2\r
+Case Else\r
+Combo2.ListIndex = 0\r
+End Select\r
+Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1\r
+ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.scm.scx.w3m.w3x.wav")\r
+If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then\r
+Do\r
+ ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String\r
+ ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer\r
+ If InStr(2, ExtList, ".") > 0 Then\r
+ NewExtNames(UBound(NewExtNames)) = Left(ExtList, InStr(2, ExtList, ".") - 1)\r
+ Else\r
+ NewExtNames(UBound(NewExtNames)) = ExtList\r
+ End If\r
+ ExtList = Mid(ExtList, Len(NewExtNames(UBound(NewExtNames))) + 1)\r
+ List1.AddItem NewExtNames(UBound(NewExtNames))\r
+ If LCase(NewExtNames(UBound(NewExtNames))) = ".bik" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scm" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scm", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scx" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scx", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3x" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3x", "-2"))\r
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))\r
+ Else\r
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\" + NewExtNames(UBound(NewExtNames)), "-1"))\r
+ End If\r
+Loop Until ExtList = ""\r
+End If\r
+Do\r
+ aExt = EnumKey("HKEY_CLASSES_ROOT\", aNum)\r
+ If Left(aExt, 1) = "." Then\r
+ aName = GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")\r
+ If aName <> "" Then\r
+ On Error GoTo AlreadyExists\r
+ FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt)\r
+ On Error Resume Next\r
+ End If\r
+ ElseIf LCase(aExt) = "*" Then\r
+ FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""\r
+ If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files"\r
+ ElseIf LCase(aExt) = "unknown" Then\r
+ FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""\r
+ If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File"\r
+ End If\r
+ aNum = aNum + 1\r
+Loop Until aExt = ""\r
+Exit Sub\r
+AlreadyExists:\r
+ FileTypes.ListItems.Item(aName).ToolTipText = FileTypes.ListItems.Item(aName).ToolTipText + " " + UCase(aExt)\r
+Resume Next\r
+End Sub\r
+Private Sub Form_Resize()\r
+FileTypes.ColumnHeaders.Item(1).Width = FileTypes.Width - 30 * Screen.TwipsPerPixelX\r
+End Sub\r
+\r
+Private Sub Form_Unload(Cancel As Integer)\r
+CD.FileName = OldFileName\r
+End Sub\r
+Private Sub List1_Click()\r
+Dim xNum As Integer, OldExtComp As Integer\r
+If List1.ListIndex > -1 Then\r
+ Combo1.Enabled = True\r
+ For xNum = 1 To UBound(NewExtNames)\r
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For\r
+ Next xNum\r
+ Select Case NewExtComp(xNum)\r
+ Case -2\r
+ AudioC(0).Value = True\r
+ Combo1.ListIndex = 0\r
+ Case -1\r
+ AudioC(0).Value = True\r
+ Combo1.ListIndex = 1\r
+ Case -3\r
+ AudioC(0).Value = True\r
+ Combo1.ListIndex = 2\r
+ Case -4\r
+ AudioC(0).Value = True\r
+ Combo1.ListIndex = 4\r
+ Case 0, 1, 2\r
+ OldExtComp = NewExtComp(xNum)\r
+ Combo1.ListIndex = 3\r
+ AudioC(OldExtComp).Value = True\r
+ Case Else\r
+ AudioC(0).Value = True\r
+ Combo1.ListIndex = 1\r
+ End Select\r
+Else\r
+ Combo1.ListIndex = 1\r
+ Combo1.Enabled = False\r
+End If\r
+End Sub\r
+Private Sub Option1_Click(Index As Integer)\r
+If Index = 2 Then\r
+ Text3.Enabled = True\r
+ Command5.Enabled = True\r
+Else\r
+ Text3.Enabled = False\r
+ Command5.Enabled = False\r
+End If\r
+End Sub\r
+Private Sub Tabs_Click()\r
+Dim TabDisp As PictureBox\r
+For Each TabDisp In TabDisps\r
+ TabDisp.Visible = False\r
+Next TabDisp\r
+TabDisps(Tabs.SelectedItem.Index).Visible = True\r
+End Sub\r
+Private Sub Text1_KeyPress(KeyAscii As Integer)\r
+If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0\r
+End Sub\r
+\r
+Private Sub Text5_Change()\r
+On Error Resume Next\r
+If Text5 <> "" Then\r
+ If Text5 > 23 Then Text5 = 23\r
+ If Text5 <= 23 Then _\r
+ ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB"\r
+Else\r
+ ActualBlockSize = ""\r
+End If\r
+On Error GoTo 0\r
+End Sub\r
+Private Sub Text5_KeyPress(KeyAscii As Integer)\r
+If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0\r
+End Sub\r
+Private Sub Text1_LostFocus()\r
+If Text1 = "" Then Text1 = 0\r
+'If Text1 < 16 Then Text1 = 16\r
+'If Text1 > 262144 Then Text1 = 262144\r
+End Sub\r
+Private Sub Text5_LostFocus()\r
+If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE\r
+If Text5 > 23 Then Text5 = 23\r
+End Sub\r
+Private Sub Text2_KeyPress(KeyAscii As Integer)\r
+Dim NewValue As Long\r
+If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0\r
+On Error GoTo TooBig\r
+If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text2 + Chr(KeyAscii))\r
+On Error GoTo 0\r
+Exit Sub\r
+TooBig:\r
+KeyAscii = 0\r
+End Sub\r
+Private Sub Text2_LostFocus()\r
+If Text2 = "" Then Text2 = 0\r
+End Sub\r
+Private Sub Text4_GotFocus()\r
+cmdAdd.Default = True\r
+End Sub\r
+Private Sub Text4_LostFocus()\r
+Command1.Default = True\r
+End Sub\r
+Private Sub Actions_Click()\r
+On Error GoTo NotSelected\r
+FileTypes.SelectedItem.Tag = FileTypes.SelectedItem.Tag\r
+On Error GoTo 0\r
+If FileTypes.SelectedItem.Selected = True Then\r
+ FileTypes.SelectedItem.Tag = ActID(Actions.ListIndex + 1)\r
+End If\r
+NotSelected:\r
+End Sub\r
+Private Sub FileTypes_ItemClick(ByVal Item As ListItem)\r
+Dim aNum As Long, aItem As String, aName As String, bNum As Long, dItem As String\r
+Label8 = Item.ToolTipText\r
+Actions.Clear\r
+ReDim ActID(0) As String\r
+aName = Item.Key\r
+Do\r
+ aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)\r
+ If aItem <> "" Then\r
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then\r
+ Actions.AddItem "Open with..."\r
+ Else\r
+ Actions.AddItem GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
+ End If\r
+ ReDim Preserve ActID(UBound(ActID) + 1) As String\r
+ ActID(UBound(ActID)) = aItem\r
+ aNum = aNum + 1\r
+ End If\r
+Loop Until aItem = ""\r
+If Item.Tag = "" Then\r
+ dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")\r
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)\r
+Else\r
+ dItem = Item.Tag\r
+End If\r
+If Actions.ListCount > 0 Then Actions.ListIndex = 0\r
+For bNum = 0 To Actions.ListCount - 1\r
+ If LCase(ActID(bNum + 1)) = LCase(dItem) Then\r
+ Actions.ListIndex = bNum\r
+ End If\r
+Next bNum\r
+Item.Tag = dItem\r
+End Sub\r
diff --git a/Registry.bas b/Registry.bas
--- a/Registry.bas
+++ b/Registry.bas
-Attribute VB_Name = "RegistryFunctions"
-Option Explicit
-
-Private Const HKEY_CLASSES_ROOT = &H80000000
-Private Const HKEY_CURRENT_USER = &H80000001
-Private Const HKEY_LOCAL_MACHINE = &H80000002
-Private Const HKEY_USERS = &H80000003
-Private Const HKEY_PERFORMANCE_DATA = &H80000004
-Private Const HKEY_CURRENT_CONFIG = &H80000005
-Private Const HKEY_DYN_DATA = &H80000006
-Private Const STANDARD_RIGHTS_ALL = &H1F0000
-Private Const KEY_QUERY_VALUE = &H1
-Private Const KEY_SET_VALUE = &H2
-Private Const KEY_CREATE_SUB_KEY = &H4
-Private Const KEY_ENUMERATE_SUB_KEYS = &H8
-Private Const KEY_NOTIFY = &H10
-Private Const SYNCHRONIZE = &H100000
-Private Const KEY_CREATE_LINK = &H20
-Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
- KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
- Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
- KEY_CREATE_LINK) And (Not SYNCHRONIZE))
-Private Const REG_OPTION_NON_VOLATILE = 0
-Global Const REG_NONE = 0
-Global Const REG_SZ = 1
-Global Const REG_EXPAND_SZ = 2
-Global Const REG_BINARY = 3
-Global Const REG_DWORD = 4
-Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' Same as REG_DWORD
-Global Const REG_DWORD_BIG_ENDIAN = 5
-Global Const REG_LINK = 6
-Global Const REG_MULTI_SZ = 7
-Global Const REG_RESOURCE_LIST = 8
-Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9
-Global Const REG_RESOURCE_REQUIREMENTS_LIST = 10
-
-Private Const REG_CREATED_NEW_KEY = &H1
-Private Const REG_OPENED_EXISTING_KEY = &H2
-
-Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
- (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
- ByVal samDesired As Long, phkResult As Long) As Long
-Private Declare Function RegCloseKey Lib "advapi32.dll" _
- (ByVal hKey As Long) As Long
-Private Declare Function RegEnumValue Lib "advapi32.dll" _
- Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _
- As Long, lpValueName As String, lpcbValueName As Long, ByVal _
- lpReserved As Long, lpType As Long, lpData As Any, lpcbData As _
- Long) As Long
-Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
- Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex _
- As Long, lpName As String, lpcbName As Long, ByVal _
- lpReserved As Long, lpClass As String, lpcbClass As _
- Long, lpftLastWriteTime As Any) As Long
-Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
- Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
- As String, ByVal lpReserved As Long, lpType As Long, lpData As _
- Any, lpcbData As Long) As Long
-Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
- Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey _
- As String, ByVal Reserved As Long, ByVal lpClass As String, _
- ByVal dwOptions As Long, ByVal samDesired As Long, _
- lpSecurityAttributes As Any, phkResult _
- As Long, lpdwDisposition As Long) As Long
-Private Declare Function RegSetValueEx Lib "advapi32.dll" _
- Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
- As String, ByVal Reserved As Long, ByVal dwType As Long, _
- lpData As Any, ByVal cbData As Long) As Long
-Private Declare Function RegDeleteValue Lib "advapi32.dll" _
- Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _
- lpValueName As String) As Long
-Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
- "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
-Sub ConvertValueName(Path As String, ByRef hKey As Long, ByRef Key As String, ValueName As String)
-Dim Data As String, bNum As Long
-Data = Mid$(Path, 1, InStr(Path, "\") - 1)
-Select Case Data
-Case "HKEY_CLASSES_ROOT"
-hKey = HKEY_CLASSES_ROOT
-Case "HKEY_CURRENT_USER"
-hKey = HKEY_CURRENT_USER
-Case "HKEY_LOCAL_MACHINE"
-hKey = HKEY_LOCAL_MACHINE
-Case "HKEY_USERS"
-hKey = HKEY_USERS
-Case "HKEY_PERFORMANCE_DATA"
-hKey = HKEY_PERFORMANCE_DATA
-Case "HKEY_CURRENT_CONFIG"
-hKey = HKEY_CURRENT_CONFIG
-Case "HKEY_DYN_DATA"
-hKey = HKEY_DYN_DATA
-End Select
-bNum = 1
-Do Until InStr(bNum, Path, "\") = 0
-bNum = InStr(bNum, Path, "\") + 1
-Loop
-On Error Resume Next
-Key = Mid$(Path, Len(Data) + 2, bNum - 2 - (Len(Data) + 1))
-ValueName = Mid$(Path, bNum)
-On Error GoTo 0
-End Sub
-Function GetReg(Path As String, Optional Default)
-Attribute GetReg.VB_Description = "Reads a value from the registry."
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long, NumData As Long
-ConvertValueName Path, hKey, Key, ValueName
-If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
- If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, vLen) = 0 Then
- Data = String$(vLen, Chr$(0))
- If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
- If RegQueryValueEx(kHandle, ValueName, 0&, 0&, NumData, vLen) = 0 Then
- GetReg = NumData
- End If
- Else
- If RegQueryValueEx(kHandle, ValueName, 0&, 0&, ByVal Data, vLen) = 0 Then
- If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then
- Data = Left$(Data, vLen - 1)
- If Data <> "" Then GetReg = Data
- Else
- GetReg = Data
- End If
- End If
- End If
- End If
- RegCloseKey kHandle
- If Not IsEmpty(GetReg) Then Exit Function
-End If
-If Not IsError(Default) Then GetReg = Default
-End Function
-Function GetRegType(Path As String) As Long
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long
-ConvertValueName Path, hKey, Key, ValueName
-If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
- If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, ByVal 0&) Then
- GetRegType = vType
- End If
- RegCloseKey kHandle
-End If
-End Function
-Function EnumReg(ByVal Path As String, Index As Long) As String
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long
-If Right$(Path, 1) <> "\" Then Path = Path + "\"
-ConvertValueName Path, hKey, Key, ValueName
-ValueName = ""
-If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
- vLen = 255
- Data = String$(255, Chr$(0))
- If RegEnumValue(kHandle, Index, ByVal Data, vLen, 0&, 0&, ByVal 0&, 0&) = 0 Then
- Data = Left$(Data, vLen)
- If Data = String$(255, Chr$(0)) Then Data = ""
- EnumReg = Data
- End If
- RegCloseKey kHandle
-End If
-End Function
-Function EnumKey(ByVal Path As String, Index As Long) As String
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long
-If Right$(Path, 1) <> "\" Then Path = Path + "\"
-ConvertValueName Path, hKey, Key, ValueName
-ValueName = ""
-If RegOpenKeyEx(hKey, Key, 0&, KEY_ENUMERATE_SUB_KEYS, kHandle) = 0 Then
- vLen = 255
- Data = String$(255, Chr$(0))
- If RegEnumKeyEx(kHandle, Index, ByVal Data, vLen, 0&, ByVal 0&, 0&, ByVal 0&) = 0 Then
- Data = Left$(Data, vLen)
- If Data = String$(255, Chr$(0)) Then Data = ""
- EnumKey = Data
- End If
- RegCloseKey kHandle
-End If
-End Function
-Sub MultiStringToArray(MultiString As String, ByRef StrArray() As String)
-Dim cNum As Long, cNum2 As Long
-ReDim StrArray(0)
-For cNum = 1 To Len(MultiString)
- cNum2 = InStr(cNum, MultiString, Chr(0))
- If cNum2 = 0 Then cNum2 = Len(MultiString) + 1
- ReDim Preserve StrArray(UBound(StrArray) + 1)
- StrArray(UBound(StrArray)) = Mid$(MultiString, cNum, cNum2 - cNum)
- cNum = cNum2
-Next cNum
-End Sub
-Sub ArrayToMultiString(StrArray() As String, ByRef MultiString As String)
-Dim sNum As Long
-MultiString = ""
-For sNum = 1 To UBound(StrArray)
- MultiString = MultiString + StrArray(sNum) + Chr$(0)
-Next sNum
-End Sub
-Sub NewKey(ByVal Path As String, Optional Default, Optional vType)
-Attribute NewKey.VB_Description = "Creates a new key in the registry."
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Temp As Long, Setg As String, NumData As Long
-If Right$(Path, 1) <> "\" Then Path = Path + "\"
-ConvertValueName Path, hKey, Key, ValueName
-ValueName = ""
-If RegCreateKeyEx(hKey, Key, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, ByVal 0&, kHandle, Temp) = 0 Then
- If Not IsError(Default) Then
- If IsError(vType) Then vType = REG_SZ
- If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
- NumData = Default
- RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4
- Else
- Setg = Default
- If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _
- Setg = Setg + Chr$(0)
- RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)
- End If
- End If
- RegCloseKey kHandle
-End If
-End Sub
-Sub SetReg(Path As String, NewValue, Optional vType)
-Attribute SetReg.VB_Description = "Writes a value to the registry."
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Setg As String, NumData As Long
-ConvertValueName Path, hKey, Key, ValueName
-If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then
- If IsError(vType) Then vType = REG_SZ
- If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
- NumData = NewValue
- RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4
- Else
- Setg = NewValue
- If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _
- Setg = Setg + Chr$(0)
- RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)
- End If
- RegCloseKey kHandle
-End If
-End Sub
-Sub DelReg(Path As String)
-Attribute DelReg.VB_Description = "Deletes a value from the registry."
-Dim hKey As Long, kHandle As Long, Key As String, ValueName As String
-ConvertValueName Path, hKey, Key, ValueName
-If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then
- RegDeleteValue kHandle, ValueName
- RegCloseKey kHandle
-End If
-End Sub
-Sub DelKey(ByVal Path As String)
-Attribute DelKey.VB_Description = "Deletes a key from the registry."
-Dim hKey As Long, Key As String, Data As String
-If Right$(Path, 1) <> "\" Then Path = Path + "\"
-ConvertValueName Path, hKey, Key, Data
-RegDeleteKey hKey, Key
-End Sub
+Attribute VB_Name = "RegistryFunctions"\r
+Option Explicit\r
+\r
+Private Const HKEY_CLASSES_ROOT = &H80000000\r
+Private Const HKEY_CURRENT_USER = &H80000001\r
+Private Const HKEY_LOCAL_MACHINE = &H80000002\r
+Private Const HKEY_USERS = &H80000003\r
+Private Const HKEY_PERFORMANCE_DATA = &H80000004\r
+Private Const HKEY_CURRENT_CONFIG = &H80000005\r
+Private Const HKEY_DYN_DATA = &H80000006\r
+Private Const STANDARD_RIGHTS_ALL = &H1F0000\r
+Private Const KEY_QUERY_VALUE = &H1\r
+Private Const KEY_SET_VALUE = &H2\r
+Private Const KEY_CREATE_SUB_KEY = &H4\r
+Private Const KEY_ENUMERATE_SUB_KEYS = &H8\r
+Private Const KEY_NOTIFY = &H10\r
+Private Const SYNCHRONIZE = &H100000\r
+Private Const KEY_CREATE_LINK = &H20\r
+Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _\r
+ KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _\r
+ Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _\r
+ KEY_CREATE_LINK) And (Not SYNCHRONIZE))\r
+Private Const REG_OPTION_NON_VOLATILE = 0\r
+Global Const REG_NONE = 0\r
+Global Const REG_SZ = 1\r
+Global Const REG_EXPAND_SZ = 2\r
+Global Const REG_BINARY = 3\r
+Global Const REG_DWORD = 4\r
+Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' Same as REG_DWORD\r
+Global Const REG_DWORD_BIG_ENDIAN = 5\r
+Global Const REG_LINK = 6\r
+Global Const REG_MULTI_SZ = 7\r
+Global Const REG_RESOURCE_LIST = 8\r
+Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9\r
+Global Const REG_RESOURCE_REQUIREMENTS_LIST = 10\r
+\r
+Private Const REG_CREATED_NEW_KEY = &H1\r
+Private Const REG_OPENED_EXISTING_KEY = &H2\r
+\r
+Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _\r
+ (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _\r
+ ByVal samDesired As Long, phkResult As Long) As Long\r
+Private Declare Function RegCloseKey Lib "advapi32.dll" _\r
+ (ByVal hKey As Long) As Long\r
+Private Declare Function RegEnumValue Lib "advapi32.dll" _\r
+ Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _\r
+ As Long, lpValueName As String, lpcbValueName As Long, ByVal _\r
+ lpReserved As Long, lpType As Long, lpData As Any, lpcbData As _\r
+ Long) As Long\r
+Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _\r
+ Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex _\r
+ As Long, lpName As String, lpcbName As Long, ByVal _\r
+ lpReserved As Long, lpClass As String, lpcbClass As _\r
+ Long, lpftLastWriteTime As Any) As Long\r
+Private Declare Function RegQueryValueEx Lib "advapi32.dll" _\r
+ Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _\r
+ As String, ByVal lpReserved As Long, lpType As Long, lpData As _\r
+ Any, lpcbData As Long) As Long\r
+Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _\r
+ Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey _\r
+ As String, ByVal Reserved As Long, ByVal lpClass As String, _\r
+ ByVal dwOptions As Long, ByVal samDesired As Long, _\r
+ lpSecurityAttributes As Any, phkResult _\r
+ As Long, lpdwDisposition As Long) As Long\r
+Private Declare Function RegSetValueEx Lib "advapi32.dll" _\r
+ Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _\r
+ As String, ByVal Reserved As Long, ByVal dwType As Long, _\r
+ lpData As Any, ByVal cbData As Long) As Long\r
+Private Declare Function RegDeleteValue Lib "advapi32.dll" _\r
+ Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _\r
+ lpValueName As String) As Long\r
+Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _\r
+ "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long\r
+Sub ConvertValueName(Path As String, ByRef hKey As Long, ByRef Key As String, ValueName As String)\r
+Dim Data As String, bNum As Long\r
+Data = Mid$(Path, 1, InStr(Path, "\") - 1)\r
+Select Case Data\r
+Case "HKEY_CLASSES_ROOT"\r
+hKey = HKEY_CLASSES_ROOT\r
+Case "HKEY_CURRENT_USER"\r
+hKey = HKEY_CURRENT_USER\r
+Case "HKEY_LOCAL_MACHINE"\r
+hKey = HKEY_LOCAL_MACHINE\r
+Case "HKEY_USERS"\r
+hKey = HKEY_USERS\r
+Case "HKEY_PERFORMANCE_DATA"\r
+hKey = HKEY_PERFORMANCE_DATA\r
+Case "HKEY_CURRENT_CONFIG"\r
+hKey = HKEY_CURRENT_CONFIG\r
+Case "HKEY_DYN_DATA"\r
+hKey = HKEY_DYN_DATA\r
+End Select\r
+bNum = 1\r
+Do Until InStr(bNum, Path, "\") = 0\r
+bNum = InStr(bNum, Path, "\") + 1\r
+Loop\r
+On Error Resume Next\r
+Key = Mid$(Path, Len(Data) + 2, bNum - 2 - (Len(Data) + 1))\r
+ValueName = Mid$(Path, bNum)\r
+On Error GoTo 0\r
+End Sub\r
+Function GetReg(Path As String, Optional Default)\r
+Attribute GetReg.VB_Description = "Reads a value from the registry."\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long, NumData As Long\r
+ConvertValueName Path, hKey, Key, ValueName\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
+ If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, vLen) = 0 Then\r
+ Data = String$(vLen, Chr$(0))\r
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
+ If RegQueryValueEx(kHandle, ValueName, 0&, 0&, NumData, vLen) = 0 Then\r
+ GetReg = NumData\r
+ End If\r
+ Else\r
+ If RegQueryValueEx(kHandle, ValueName, 0&, 0&, ByVal Data, vLen) = 0 Then\r
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then\r
+ Data = Left$(Data, vLen - 1)\r
+ If Data <> "" Then GetReg = Data\r
+ Else\r
+ GetReg = Data\r
+ End If\r
+ End If\r
+ End If\r
+ End If\r
+ RegCloseKey kHandle\r
+ If Not IsEmpty(GetReg) Then Exit Function\r
+End If\r
+If Not IsError(Default) Then GetReg = Default\r
+End Function\r
+Function GetRegType(Path As String) As Long\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long\r
+ConvertValueName Path, hKey, Key, ValueName\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
+ If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, ByVal 0&) Then\r
+ GetRegType = vType\r
+ End If\r
+ RegCloseKey kHandle\r
+End If\r
+End Function\r
+Function EnumReg(ByVal Path As String, Index As Long) As String\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long\r
+If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
+ConvertValueName Path, hKey, Key, ValueName\r
+ValueName = ""\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then\r
+ vLen = 255\r
+ Data = String$(255, Chr$(0))\r
+ If RegEnumValue(kHandle, Index, ByVal Data, vLen, 0&, 0&, ByVal 0&, 0&) = 0 Then\r
+ Data = Left$(Data, vLen)\r
+ If Data = String$(255, Chr$(0)) Then Data = ""\r
+ EnumReg = Data\r
+ End If\r
+ RegCloseKey kHandle\r
+End If\r
+End Function\r
+Function EnumKey(ByVal Path As String, Index As Long) As String\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long\r
+If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
+ConvertValueName Path, hKey, Key, ValueName\r
+ValueName = ""\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_ENUMERATE_SUB_KEYS, kHandle) = 0 Then\r
+ vLen = 255\r
+ Data = String$(255, Chr$(0))\r
+ If RegEnumKeyEx(kHandle, Index, ByVal Data, vLen, 0&, ByVal 0&, 0&, ByVal 0&) = 0 Then\r
+ Data = Left$(Data, vLen)\r
+ If Data = String$(255, Chr$(0)) Then Data = ""\r
+ EnumKey = Data\r
+ End If\r
+ RegCloseKey kHandle\r
+End If\r
+End Function\r
+Sub MultiStringToArray(MultiString As String, ByRef StrArray() As String)\r
+Dim cNum As Long, cNum2 As Long\r
+ReDim StrArray(0)\r
+For cNum = 1 To Len(MultiString)\r
+ cNum2 = InStr(cNum, MultiString, Chr(0))\r
+ If cNum2 = 0 Then cNum2 = Len(MultiString) + 1\r
+ ReDim Preserve StrArray(UBound(StrArray) + 1)\r
+ StrArray(UBound(StrArray)) = Mid$(MultiString, cNum, cNum2 - cNum)\r
+ cNum = cNum2\r
+Next cNum\r
+End Sub\r
+Sub ArrayToMultiString(StrArray() As String, ByRef MultiString As String)\r
+Dim sNum As Long\r
+MultiString = ""\r
+For sNum = 1 To UBound(StrArray)\r
+ MultiString = MultiString + StrArray(sNum) + Chr$(0)\r
+Next sNum\r
+End Sub\r
+Sub NewKey(ByVal Path As String, Optional Default, Optional vType)\r
+Attribute NewKey.VB_Description = "Creates a new key in the registry."\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Temp As Long, Setg As String, NumData As Long\r
+If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
+ConvertValueName Path, hKey, Key, ValueName\r
+ValueName = ""\r
+If RegCreateKeyEx(hKey, Key, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, ByVal 0&, kHandle, Temp) = 0 Then\r
+ If Not IsError(Default) Then\r
+ If IsError(vType) Then vType = REG_SZ\r
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
+ NumData = Default\r
+ RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4\r
+ Else\r
+ Setg = Default\r
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _\r
+ Setg = Setg + Chr$(0)\r
+ RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)\r
+ End If\r
+ End If\r
+ RegCloseKey kHandle\r
+End If\r
+End Sub\r
+Sub SetReg(Path As String, NewValue, Optional vType)\r
+Attribute SetReg.VB_Description = "Writes a value to the registry."\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Setg As String, NumData As Long\r
+ConvertValueName Path, hKey, Key, ValueName\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then\r
+ If IsError(vType) Then vType = REG_SZ\r
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then\r
+ NumData = NewValue\r
+ RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4\r
+ Else\r
+ Setg = NewValue\r
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _\r
+ Setg = Setg + Chr$(0)\r
+ RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)\r
+ End If\r
+ RegCloseKey kHandle\r
+End If\r
+End Sub\r
+Sub DelReg(Path As String)\r
+Attribute DelReg.VB_Description = "Deletes a value from the registry."\r
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String\r
+ConvertValueName Path, hKey, Key, ValueName\r
+If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then\r
+ RegDeleteValue kHandle, ValueName\r
+ RegCloseKey kHandle\r
+End If\r
+End Sub\r
+Sub DelKey(ByVal Path As String)\r
+Attribute DelKey.VB_Description = "Deletes a key from the registry."\r
+Dim hKey As Long, Key As String, Data As String\r
+If Right$(Path, 1) <> "\" Then Path = Path + "\"\r
+ConvertValueName Path, hKey, Key, Data\r
+RegDeleteKey hKey, Key\r
+End Sub\r
diff --git a/SFmpqapi.bas b/SFmpqapi.bas
--- a/SFmpqapi.bas
+++ b/SFmpqapi.bas
-Attribute VB_Name = "SFmpqapi"
-Option Explicit
-
-' ShadowFlare MPQ API Library. (c) ShadowFlare Software 2002
-
-' All functions below are actual functions that are part of this
-' library and do not need any additional dll files. It does not
-' even require Storm to be able to decompress or compress files.
-
-' This library emulates the interface of Lmpqapi and Storm MPQ
-' functions, so it may be used as a replacement for them in
-' MPQ extractors/archivers without even needing to recompile
-' the program that uses Lmpqapi or Storm. It has a few features
-' not included in Lmpqapi and Storm, such as extra flags for some
-' functions, setting the locale ID of existing files, and adding
-' files without having to write them somewhere else first. Also,
-' MPQ handles used by functions prefixed with "SFile" and "Mpq"
-' can be used interchangably; all functions use the same type
-' of MPQ handles. You cannot, however, use handles from this
-' library with storm or lmpqapi or vice-versa. Doing so will
-' most likely result in a crash.
-
-' Revision History:
-' 06/12/2002 1.07 (ShadowFlare)
-' - No longer requires Storm.dll to compress or decompress
-' Warcraft III files
-' - Added SFileListFiles for getting names and information
-' about all of the files in an archive
-' - Fixed a bug with renaming and deleting files
-' - Fixed a bug with adding wave compressed files with
-' low compression setting
-' - Added a check in MpqOpenArchiveForUpdate for proper
-' dwMaximumFilesInArchive values (should be a number that
-' is a power of 2). If it is not a proper value, it will
-' be rounded up to the next higher power of 2
-
-' 05/09/2002 1.06 (ShadowFlare)
-' - Compresses files without Storm.dll!
-' - If Warcraft III is installed, this library will be able to
-' find Storm.dll on its own. (Storm.dll is needed to
-' decompress Warcraft III files)
-' - Fixed a bug where an embedded archive and the file that
-' contains it would be corrupted if the archive was modified
-' - Able to open all .w3m maps now
-
-' 29/06/2002 1.05 (ShadowFlare)
-' - Supports decompressing files from Warcraft III MPQ archives
-' if using Storm.dll from Warcraft III
-' - Added MpqAddFileToArchiveEx and MpqAddFileFromBufferEx for
-' using extra compression types
-
-' 29/05/2002 1.04 (ShadowFlare)
-' - Files can be compressed now!
-' - Fixed a bug in SFileReadFile when reading data not aligned
-' to the block size
-' - Optimized some of SFileReadFile's code. It can read files
-' faster now
-' - SFile functions may now be used to access files not in mpq
-' archives as you can with the real storm functions
-' - MpqCompactArchive will no longer corrupt files with the
-' MODCRYPTKEY flag as long as the file is either compressed,
-' listed in "(listfile)", is "(listfile)", or is located in
-' the same place in the compacted archive; so it is safe
-' enough to use it on almost any archive
-' - Added MpqAddWaveFromBuffer
-' - Better handling of archives with no files
-' - Fixed compression with COMPRESS2 flag
-
-' 15/05/2002 1.03 (ShadowFlare)
-' - Supports adding files with the compression attribute (does
-' not actually compress files). Now archives created with
-' this dll can have files added to them through lmpqapi
-' without causing staredit to crash
-' - SFileGetBasePath and SFileSetBasePath work more like their
-' Storm equivalents now
-' - Implemented MpqCompactArchive, but it is not finished yet.
-' In its current state, I would recommend against using it
-' on archives that contain files with the MODCRYPTKEY flag,
-' since it will corrupt any files with that flag
-' - Added SFMpqGetVersionString2 which may be used in Visual
-' Basic to get the version string
-
-' 07/05/2002 1.02 (ShadowFlare)
-' - SFileReadFile no longer passes the lpOverlapped parameter it
-' receives to ReadFile. This is what was causing the function
-' to fail when used in Visual Basic
-' - Added support for more Storm MPQ functions
-' - GetLastError may now be used to get information about why a
-' function failed
-
-' 01/05/2002 1.01 (ShadowFlare)
-' - Added ordinals for Storm MPQ functions
-' - Fixed MPQ searching functionality of SFileOpenFileEx
-' - Added a check for whether a valid handle is given when
-' SFileCloseArchive is called
-' - Fixed functionality of SFileSetArchivePriority when multiple
-' files are open
-' - File renaming works for all filenames now
-' - SFileReadFile no longer reallocates the buffer for each block
-' that is decompressed. This should make SFileReadFile at least
-' a little faster
-
-' 30/04/2002 1.00 (ShadowFlare)
-' - First version.
-' - Compression not yet supported
-' - Does not use SetLastError yet, so GetLastError will not return any
-' errors that have to do with this library
-' - MpqCompactArchive not implemented
-
-' This library is freeware, you can do anything you want with it but with
-' one exception. If you use it in your program, you must specify this fact
-' in Help|About box or in similar way. You can obtain version string using
-' SFMpqGetVersionString call.
-
-' THIS LIBRARY IS DISTRIBUTED "AS IS". NO WARRANTY OF ANY KIND IS EXPRESSED
-' OR IMPLIED. YOU USE AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR
-' DATA LOSS, DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING
-' OR MISUSING THIS SOFTWARE.
-
-' Any comments or suggestions are accepted at blakflare@hotmail.com (ShadowFlare)
-
-Type SFMPQVERSION
- Major As Integer
- Minor As Integer
- Revision As Integer
- Subrevision As Integer
-End Type
-
-' MpqInitialize does nothing. It is only provided for
-' compatibility with MPQ archivers that use lmpqapi.
-Declare Function MpqInitialize Lib "SFmpq.dll" () As Boolean
-
-Declare Function MpqGetVersionString Lib "SFmpq.dll" () As String
-Declare Function MpqGetVersion Lib "SFmpq.dll" () As Single
-
-Declare Sub SFMpqDestroy Lib "SFmpq.dll" () ' This no longer needs to be called. It is only provided for compatibility with older versions
-
-' SFMpqGetVersionString2's return value is the required length of the buffer plus
-' the terminating null, so use SFMpqGetVersionString2(ByVal 0&, 0) to get the length.
-Declare Function SFMpqGetVersionString Lib "SFmpq.dll" () As String
-Declare Function SFMpqGetVersionString2 Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Long
-Declare Function SFMpqGetVersion Lib "SFmpq.dll" () As SFMPQVERSION
-
-' General error codes
-Public Const MPQ_ERROR_MPQ_INVALID As Long = &H85200065
-Public Const MPQ_ERROR_FILE_NOT_FOUND As Long = &H85200066
-Public Const MPQ_ERROR_DISK_FULL As Long = &H85200068 'Physical write file to MPQ failed. Not sure of exact meaning
-Public Const MPQ_ERROR_HASH_TABLE_FULL As Long = &H85200069
-Public Const MPQ_ERROR_ALREADY_EXISTS As Long = &H8520006A
-Public Const MPQ_ERROR_BAD_OPEN_MODE As Long = &H8520006C 'When MOAU_READ_ONLY is used without MOAU_OPEN_EXISTING
-
-Public Const MPQ_ERROR_COMPACT_ERROR As Long = &H85300001
-
-' MpqOpenArchiveForUpdate flags
-Public Const MOAU_CREATE_NEW As Long = &H0
-Public Const MOAU_CREATE_ALWAYS As Long = &H8 'Was wrongly named MOAU_CREATE_NEW
-Public Const MOAU_OPEN_EXISTING As Long = &H4
-Public Const MOAU_OPEN_ALWAYS As Long = &H20
-Public Const MOAU_READ_ONLY As Long = &H10 'Must be used with MOAU_OPEN_EXISTING
-Public Const MOAU_MAINTAIN_LISTFILE As Long = &H1
-
-' MpqOpenArchiveForUpdateEx constants
-Public Const DEFAULT_BLOCK_SIZE As Long = 3 ' 512 << number = block size
-Public Const USE_DEFAULT_BLOCK_SIZE As Long = &HFFFF ' Use default block size that is defined internally
-
-' MpqAddFileToArchive flags
-Public Const MAFA_EXISTS As Long = &H80000000 'Will be added if not present
-Public Const MAFA_UNKNOWN40000000 As Long = &H40000000
-Public Const MAFA_MODCRYPTKEY As Long = &H20000
-Public Const MAFA_ENCRYPT As Long = &H10000
-Public Const MAFA_COMPRESS As Long = &H200
-Public Const MAFA_COMPRESS2 As Long = &H100
-Public Const MAFA_REPLACE_EXISTING As Long = &H1
-
-' MpqAddFileToArchiveEx compression flags
-Public Const MAFA_COMPRESS_STANDARD As Long = &H8 'Standard PKWare DCL compression
-Public Const MAFA_COMPRESS_DEFLATE As Long = &H2 'ZLib's deflate compression
-Public Const MAFA_COMPRESS_WAVE As Long = &H81 'Standard wave compression
-Public Const MAFA_COMPRESS_WAVE2 As Long = &H41 'Unused wave compression
-
-' Flags for individual compression types used for wave compression
-Public Const MAFA_COMPRESS_WAVECOMP1 As Long = &H80 'Main compressor for standard wave compression
-Public Const MAFA_COMPRESS_WAVECOMP2 As Long = &H40 'Main compressor for unused wave compression
-Public Const MAFA_COMPRESS_WAVECOMP3 As Long = &H1 'Secondary compressor for wave compression
-
-' ZLib deflate compression level constants (used with MpqAddFileToArchiveEx and MpqAddFileFromBufferEx)
-Public Const Z_NO_COMPRESSION As Long = 0
-Public Const Z_BEST_SPEED As Long = 1
-Public Const Z_BEST_COMPRESSION As Long = 9
-Public Const Z_DEFAULT_COMPRESSION As Long = (-1)
-
-' MpqAddWAVToArchive quality flags
-Public Const MAWA_QUALITY_HIGH As Long = 1
-Public Const MAWA_QUALITY_MEDIUM As Long = 0
-Public Const MAWA_QUALITY_LOW As Long = 2
-
-' SFileGetFileInfo flags
-Public Const SFILE_INFO_BLOCK_SIZE As Long = &H1 'Block size in MPQ
-Public Const SFILE_INFO_HASH_TABLE_SIZE As Long = &H2 'Hash table size in MPQ
-Public Const SFILE_INFO_NUM_FILES As Long = &H3 'Number of files in MPQ
-Public Const SFILE_INFO_TYPE As Long = &H4 'Is Long a file or an MPQ?
-Public Const SFILE_INFO_SIZE As Long = &H5 'Size of MPQ or uncompressed file
-Public Const SFILE_INFO_COMPRESSED_SIZE As Long = &H6 'Size of compressed file
-Public Const SFILE_INFO_FLAGS As Long = &H7 'File flags (compressed, etc.), file attributes if a file not in an archive
-Public Const SFILE_INFO_PARENT As Long = &H8 'Handle of MPQ that file is in
-Public Const SFILE_INFO_POSITION As Long = &H9 'Position of file pointer in files
-Public Const SFILE_INFO_LOCALEID As Long = &HA 'Locale ID of file in MPQ
-Public Const SFILE_INFO_PRIORITY As Long = &HB 'Priority of open MPQ
-Public Const SFILE_INFO_HASH_INDEX As Long = &HC 'Hash index of file in MPQ
-
-' SFileListFiles flags
-Public Const SFILE_LIST_MEMORY_LIST As Long = &H1 ' Specifies that lpFilelists is a file list from memory, rather than being a list of file lists
-Public Const SFILE_LIST_ONLY_KNOWN As Long = &H2 ' Only list files that the function finds a name for
-Public Const SFILE_LIST_ONLY_UNKNOWN As Long = &H4 ' Only list files that the function does not find a name for
-
-Public Const SFILE_TYPE_MPQ As Long = &H1
-Public Const SFILE_TYPE_FILE As Long = &H2
-
-Public Const INVALID_HANDLE_VALUE As Long = -1
-
-Public Const FILE_BEGIN As Long = 0
-Public Const FILE_CURRENT As Long = 1
-Public Const FILE_END As Long = 2
-
-Public Const SFILE_OPEN_HARD_DISK_FILE As Long = &H0 'Open archive without regard to the drive type it resides on
-Public Const SFILE_OPEN_CD_ROM_FILE As Long = &H1 'Open the archive only if it is on a CD-ROM
-Public Const SFILE_OPEN_ALLOW_WRITE As Long = &H8000 'Open file with write access
-
-Public Const SFILE_SEARCH_CURRENT_ONLY As Long = &H0 'Used with SFileOpenFileEx; only the archive with the handle specified will be searched for the file
-Public Const SFILE_SEARCH_ALL_OPEN As Long = &H1 'SFileOpenFileEx will look through all open archives for the file
-
-Type FILELISTENTRY
- dwFileExists As Long ' Nonzero if this entry is used
- lcLocale As Long ' Locale ID of file
- dwCompressedSize As Long ' Compressed size of file
- dwFullSize As Long ' Uncompressed size of file
- dwFlags As Long ' Flags for file
- szFileName(259) As Byte
-End Type
-
-' Storm functions implemented by this library
-Declare Function SFileOpenArchive Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwPriority As Long, ByVal dwFlags As Long, ByRef hMPQ As Long) As Boolean
-Declare Function SFileCloseArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean
-Declare Function SFileGetArchiveName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
-Declare Function SFileOpenFile Lib "SFmpq.dll" (ByVal lpFileName As String, ByRef hFile As Long) As Boolean
-Declare Function SFileOpenFileEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal dwSearchScope As Long, ByRef hFile As Long) As Boolean
-Declare Function SFileCloseFile Lib "SFmpq.dll" (ByVal hFile As Long) As Boolean
-Declare Function SFileGetFileSize Lib "SFmpq.dll" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
-Declare Function SFileGetFileArchive Lib "SFmpq.dll" (ByVal hFile As Long, ByRef hMPQ As Long) As Boolean
-Declare Function SFileGetFileName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
-Declare Function SFileSetFilePointer Lib "SFmpq.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lplDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
-Declare Function SFileReadFile Lib "SFmpq.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByRef lpOverlapped As Any) As Boolean
-Declare Function SFileSetLocale Lib "SFmpq.dll" (ByVal nNewLocale As Long) As Long
-Declare Function SFileGetBasePath Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
-Declare Function SFileSetBasePath Lib "SFmpq.dll" (ByVal lpNewBasePath As String) As Boolean
-
-' Extra storm-related functions
-Declare Function SFileGetFileInfo Lib "SFmpq.dll" (ByVal hFile As Long, ByVal dwInfoType As Long) As Long
-Declare Function SFileSetArchivePriority Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwPriority As Long) As Boolean
-Declare Function SFileFindMpqHeader Lib "SFmpq.dll" (ByVal hFile As Long) As Long
-Declare Function SFileListFiles Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileLists As String, ByRef lpListBuffer As FILELISTENTRY, ByVal dwFlags As Long) As Boolean
-
-' Archive editing functions implemented by this library
-Declare Function MpqOpenArchiveForUpdate Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long) As Long
-Declare Function MpqCloseUpdatedArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwUnknown2 As Long) As Long
-Declare Function MpqAddFileToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long) As Boolean
-Declare Function MpqAddWaveToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean
-Declare Function MpqRenameFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpcOldFileName As String, ByVal lpcNewFileName As String) As Boolean
-Declare Function MpqDeleteFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String) As Boolean
-Declare Function MpqCompactArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean
-
-' Extra archive editing functions
-Declare Function MpqOpenArchiveForUpdateEx Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long, ByVal dwBlockSize As Long) As Long
-Declare Function MpqAddFileToArchiveEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean
-Declare Function MpqAddFileFromBufferEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean
-Declare Function MpqAddFileFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long) As Boolean
-Declare Function MpqAddWaveFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean
-Declare Function MpqSetFileLocale Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal nOldLocale As Long, ByVal nNewLocale As Long) As Boolean
-
-' These functions do nothing. They are only provided for
-' compatibility with MPQ extractors that use storm.
-Declare Function SFileDestroy Lib "SFmpq.dll" () As Boolean
-Declare Sub StormDestroy Lib "SFmpq.dll" ()
-
-' Returns 0 if the dll version is equal to the version your program was compiled
-' with, 1 if the dll is newer, -1 if the dll is older.
-Function SFMpqCompareVersion() As Long
- Dim ExeVersion As SFMPQVERSION, DllVersion As SFMPQVERSION
- With ExeVersion
- .Major = 1
- .Minor = 0
- .Revision = 7
- .Subrevision = 4
- End With
- DllVersion = SFMpqGetVersion()
- If DllVersion.Major > ExeVersion.Major Then
- SFMpqCompareVersion = 1
- Exit Function
- ElseIf DllVersion.Major < ExeVersion.Major Then
- SFMpqCompareVersion = -1
- Exit Function
- End If
- If DllVersion.Minor > ExeVersion.Minor Then
- SFMpqCompareVersion = 1
- Exit Function
- ElseIf DllVersion.Minor < ExeVersion.Minor Then
- SFMpqCompareVersion = -1
- Exit Function
- End If
- If DllVersion.Revision > ExeVersion.Revision Then
- SFMpqCompareVersion = 1
- Exit Function
- ElseIf DllVersion.Revision < ExeVersion.Revision Then
- SFMpqCompareVersion = -1
- Exit Function
- End If
- If DllVersion.Subrevision > ExeVersion.Subrevision Then
- SFMpqCompareVersion = 1
- Exit Function
- ElseIf DllVersion.Subrevision < ExeVersion.Subrevision Then
- SFMpqCompareVersion = -1
- Exit Function
- End If
- SFMpqCompareVersion = 0
-End Function
-
+Attribute VB_Name = "SFmpqapi"\r
+Option Explicit\r
+\r
+' ShadowFlare MPQ API Library. (c) ShadowFlare Software 2002\r
+\r
+' All functions below are actual functions that are part of this\r
+' library and do not need any additional dll files. It does not\r
+' even require Storm to be able to decompress or compress files.\r
+\r
+' This library emulates the interface of Lmpqapi and Storm MPQ\r
+' functions, so it may be used as a replacement for them in\r
+' MPQ extractors/archivers without even needing to recompile\r
+' the program that uses Lmpqapi or Storm. It has a few features\r
+' not included in Lmpqapi and Storm, such as extra flags for some\r
+' functions, setting the locale ID of existing files, and adding\r
+' files without having to write them somewhere else first. Also,\r
+' MPQ handles used by functions prefixed with "SFile" and "Mpq"\r
+' can be used interchangably; all functions use the same type\r
+' of MPQ handles. You cannot, however, use handles from this\r
+' library with storm or lmpqapi or vice-versa. Doing so will\r
+' most likely result in a crash.\r
+\r
+' Revision History:\r
+' 06/12/2002 1.07 (ShadowFlare)\r
+' - No longer requires Storm.dll to compress or decompress\r
+' Warcraft III files\r
+' - Added SFileListFiles for getting names and information\r
+' about all of the files in an archive\r
+' - Fixed a bug with renaming and deleting files\r
+' - Fixed a bug with adding wave compressed files with\r
+' low compression setting\r
+' - Added a check in MpqOpenArchiveForUpdate for proper\r
+' dwMaximumFilesInArchive values (should be a number that\r
+' is a power of 2). If it is not a proper value, it will\r
+' be rounded up to the next higher power of 2\r
+\r
+' 05/09/2002 1.06 (ShadowFlare)\r
+' - Compresses files without Storm.dll!\r
+' - If Warcraft III is installed, this library will be able to\r
+' find Storm.dll on its own. (Storm.dll is needed to\r
+' decompress Warcraft III files)\r
+' - Fixed a bug where an embedded archive and the file that\r
+' contains it would be corrupted if the archive was modified\r
+' - Able to open all .w3m maps now\r
+\r
+' 29/06/2002 1.05 (ShadowFlare)\r
+' - Supports decompressing files from Warcraft III MPQ archives\r
+' if using Storm.dll from Warcraft III\r
+' - Added MpqAddFileToArchiveEx and MpqAddFileFromBufferEx for\r
+' using extra compression types\r
+\r
+' 29/05/2002 1.04 (ShadowFlare)\r
+' - Files can be compressed now!\r
+' - Fixed a bug in SFileReadFile when reading data not aligned\r
+' to the block size\r
+' - Optimized some of SFileReadFile's code. It can read files\r
+' faster now\r
+' - SFile functions may now be used to access files not in mpq\r
+' archives as you can with the real storm functions\r
+' - MpqCompactArchive will no longer corrupt files with the\r
+' MODCRYPTKEY flag as long as the file is either compressed,\r
+' listed in "(listfile)", is "(listfile)", or is located in\r
+' the same place in the compacted archive; so it is safe\r
+' enough to use it on almost any archive\r
+' - Added MpqAddWaveFromBuffer\r
+' - Better handling of archives with no files\r
+' - Fixed compression with COMPRESS2 flag\r
+\r
+' 15/05/2002 1.03 (ShadowFlare)\r
+' - Supports adding files with the compression attribute (does\r
+' not actually compress files). Now archives created with\r
+' this dll can have files added to them through lmpqapi\r
+' without causing staredit to crash\r
+' - SFileGetBasePath and SFileSetBasePath work more like their\r
+' Storm equivalents now\r
+' - Implemented MpqCompactArchive, but it is not finished yet.\r
+' In its current state, I would recommend against using it\r
+' on archives that contain files with the MODCRYPTKEY flag,\r
+' since it will corrupt any files with that flag\r
+' - Added SFMpqGetVersionString2 which may be used in Visual\r
+' Basic to get the version string\r
+\r
+' 07/05/2002 1.02 (ShadowFlare)\r
+' - SFileReadFile no longer passes the lpOverlapped parameter it\r
+' receives to ReadFile. This is what was causing the function\r
+' to fail when used in Visual Basic\r
+' - Added support for more Storm MPQ functions\r
+' - GetLastError may now be used to get information about why a\r
+' function failed\r
+\r
+' 01/05/2002 1.01 (ShadowFlare)\r
+' - Added ordinals for Storm MPQ functions\r
+' - Fixed MPQ searching functionality of SFileOpenFileEx\r
+' - Added a check for whether a valid handle is given when\r
+' SFileCloseArchive is called\r
+' - Fixed functionality of SFileSetArchivePriority when multiple\r
+' files are open\r
+' - File renaming works for all filenames now\r
+' - SFileReadFile no longer reallocates the buffer for each block\r
+' that is decompressed. This should make SFileReadFile at least\r
+' a little faster\r
+\r
+' 30/04/2002 1.00 (ShadowFlare)\r
+' - First version.\r
+' - Compression not yet supported\r
+' - Does not use SetLastError yet, so GetLastError will not return any\r
+' errors that have to do with this library\r
+' - MpqCompactArchive not implemented\r
+\r
+' This library is freeware, you can do anything you want with it but with\r
+' one exception. If you use it in your program, you must specify this fact\r
+' in Help|About box or in similar way. You can obtain version string using\r
+' SFMpqGetVersionString call.\r
+\r
+' THIS LIBRARY IS DISTRIBUTED "AS IS". NO WARRANTY OF ANY KIND IS EXPRESSED\r
+' OR IMPLIED. YOU USE AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR\r
+' DATA LOSS, DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING\r
+' OR MISUSING THIS SOFTWARE.\r
+\r
+' Any comments or suggestions are accepted at blakflare@hotmail.com (ShadowFlare)\r
+\r
+Type SFMPQVERSION\r
+ Major As Integer\r
+ Minor As Integer\r
+ Revision As Integer\r
+ Subrevision As Integer\r
+End Type\r
+\r
+' MpqInitialize does nothing. It is only provided for\r
+' compatibility with MPQ archivers that use lmpqapi.\r
+Declare Function MpqInitialize Lib "SFmpq.dll" () As Boolean\r
+\r
+Declare Function MpqGetVersionString Lib "SFmpq.dll" () As String\r
+Declare Function MpqGetVersion Lib "SFmpq.dll" () As Single\r
+\r
+Declare Sub SFMpqDestroy Lib "SFmpq.dll" () ' This no longer needs to be called. It is only provided for compatibility with older versions\r
+\r
+' SFMpqGetVersionString2's return value is the required length of the buffer plus\r
+' the terminating null, so use SFMpqGetVersionString2(ByVal 0&, 0) to get the length.\r
+Declare Function SFMpqGetVersionString Lib "SFmpq.dll" () As String\r
+Declare Function SFMpqGetVersionString2 Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Long\r
+Declare Function SFMpqGetVersion Lib "SFmpq.dll" () As SFMPQVERSION\r
+\r
+' General error codes\r
+Public Const MPQ_ERROR_MPQ_INVALID As Long = &H85200065\r
+Public Const MPQ_ERROR_FILE_NOT_FOUND As Long = &H85200066\r
+Public Const MPQ_ERROR_DISK_FULL As Long = &H85200068 'Physical write file to MPQ failed. Not sure of exact meaning\r
+Public Const MPQ_ERROR_HASH_TABLE_FULL As Long = &H85200069\r
+Public Const MPQ_ERROR_ALREADY_EXISTS As Long = &H8520006A\r
+Public Const MPQ_ERROR_BAD_OPEN_MODE As Long = &H8520006C 'When MOAU_READ_ONLY is used without MOAU_OPEN_EXISTING\r
+\r
+Public Const MPQ_ERROR_COMPACT_ERROR As Long = &H85300001\r
+\r
+' MpqOpenArchiveForUpdate flags\r
+Public Const MOAU_CREATE_NEW As Long = &H0\r
+Public Const MOAU_CREATE_ALWAYS As Long = &H8 'Was wrongly named MOAU_CREATE_NEW\r
+Public Const MOAU_OPEN_EXISTING As Long = &H4\r
+Public Const MOAU_OPEN_ALWAYS As Long = &H20\r
+Public Const MOAU_READ_ONLY As Long = &H10 'Must be used with MOAU_OPEN_EXISTING\r
+Public Const MOAU_MAINTAIN_LISTFILE As Long = &H1\r
+\r
+' MpqOpenArchiveForUpdateEx constants\r
+Public Const DEFAULT_BLOCK_SIZE As Long = 3 ' 512 << number = block size\r
+Public Const USE_DEFAULT_BLOCK_SIZE As Long = &HFFFF ' Use default block size that is defined internally\r
+\r
+' MpqAddFileToArchive flags\r
+Public Const MAFA_EXISTS As Long = &H80000000 'Will be added if not present\r
+Public Const MAFA_UNKNOWN40000000 As Long = &H40000000\r
+Public Const MAFA_MODCRYPTKEY As Long = &H20000\r
+Public Const MAFA_ENCRYPT As Long = &H10000\r
+Public Const MAFA_COMPRESS As Long = &H200\r
+Public Const MAFA_COMPRESS2 As Long = &H100\r
+Public Const MAFA_REPLACE_EXISTING As Long = &H1\r
+\r
+' MpqAddFileToArchiveEx compression flags\r
+Public Const MAFA_COMPRESS_STANDARD As Long = &H8 'Standard PKWare DCL compression\r
+Public Const MAFA_COMPRESS_DEFLATE As Long = &H2 'ZLib's deflate compression\r
+Public Const MAFA_COMPRESS_WAVE As Long = &H81 'Standard wave compression\r
+Public Const MAFA_COMPRESS_WAVE2 As Long = &H41 'Unused wave compression\r
+\r
+' Flags for individual compression types used for wave compression\r
+Public Const MAFA_COMPRESS_WAVECOMP1 As Long = &H80 'Main compressor for standard wave compression\r
+Public Const MAFA_COMPRESS_WAVECOMP2 As Long = &H40 'Main compressor for unused wave compression\r
+Public Const MAFA_COMPRESS_WAVECOMP3 As Long = &H1 'Secondary compressor for wave compression\r
+\r
+' ZLib deflate compression level constants (used with MpqAddFileToArchiveEx and MpqAddFileFromBufferEx)\r
+Public Const Z_NO_COMPRESSION As Long = 0\r
+Public Const Z_BEST_SPEED As Long = 1\r
+Public Const Z_BEST_COMPRESSION As Long = 9\r
+Public Const Z_DEFAULT_COMPRESSION As Long = (-1)\r
+\r
+' MpqAddWAVToArchive quality flags\r
+Public Const MAWA_QUALITY_HIGH As Long = 1\r
+Public Const MAWA_QUALITY_MEDIUM As Long = 0\r
+Public Const MAWA_QUALITY_LOW As Long = 2\r
+\r
+' SFileGetFileInfo flags\r
+Public Const SFILE_INFO_BLOCK_SIZE As Long = &H1 'Block size in MPQ\r
+Public Const SFILE_INFO_HASH_TABLE_SIZE As Long = &H2 'Hash table size in MPQ\r
+Public Const SFILE_INFO_NUM_FILES As Long = &H3 'Number of files in MPQ\r
+Public Const SFILE_INFO_TYPE As Long = &H4 'Is Long a file or an MPQ?\r
+Public Const SFILE_INFO_SIZE As Long = &H5 'Size of MPQ or uncompressed file\r
+Public Const SFILE_INFO_COMPRESSED_SIZE As Long = &H6 'Size of compressed file\r
+Public Const SFILE_INFO_FLAGS As Long = &H7 'File flags (compressed, etc.), file attributes if a file not in an archive\r
+Public Const SFILE_INFO_PARENT As Long = &H8 'Handle of MPQ that file is in\r
+Public Const SFILE_INFO_POSITION As Long = &H9 'Position of file pointer in files\r
+Public Const SFILE_INFO_LOCALEID As Long = &HA 'Locale ID of file in MPQ\r
+Public Const SFILE_INFO_PRIORITY As Long = &HB 'Priority of open MPQ\r
+Public Const SFILE_INFO_HASH_INDEX As Long = &HC 'Hash index of file in MPQ\r
+\r
+' SFileListFiles flags\r
+Public Const SFILE_LIST_MEMORY_LIST As Long = &H1 ' Specifies that lpFilelists is a file list from memory, rather than being a list of file lists\r
+Public Const SFILE_LIST_ONLY_KNOWN As Long = &H2 ' Only list files that the function finds a name for\r
+Public Const SFILE_LIST_ONLY_UNKNOWN As Long = &H4 ' Only list files that the function does not find a name for\r
+\r
+Public Const SFILE_TYPE_MPQ As Long = &H1\r
+Public Const SFILE_TYPE_FILE As Long = &H2\r
+\r
+Public Const INVALID_HANDLE_VALUE As Long = -1\r
+\r
+Public Const FILE_BEGIN As Long = 0\r
+Public Const FILE_CURRENT As Long = 1\r
+Public Const FILE_END As Long = 2\r
+\r
+Public Const SFILE_OPEN_HARD_DISK_FILE As Long = &H0 'Open archive without regard to the drive type it resides on\r
+Public Const SFILE_OPEN_CD_ROM_FILE As Long = &H1 'Open the archive only if it is on a CD-ROM\r
+Public Const SFILE_OPEN_ALLOW_WRITE As Long = &H8000 'Open file with write access\r
+\r
+Public Const SFILE_SEARCH_CURRENT_ONLY As Long = &H0 'Used with SFileOpenFileEx; only the archive with the handle specified will be searched for the file\r
+Public Const SFILE_SEARCH_ALL_OPEN As Long = &H1 'SFileOpenFileEx will look through all open archives for the file\r
+\r
+Type FILELISTENTRY\r
+ dwFileExists As Long ' Nonzero if this entry is used\r
+ lcLocale As Long ' Locale ID of file\r
+ dwCompressedSize As Long ' Compressed size of file\r
+ dwFullSize As Long ' Uncompressed size of file\r
+ dwFlags As Long ' Flags for file\r
+ szFileName(259) As Byte\r
+End Type\r
+\r
+' Storm functions implemented by this library\r
+Declare Function SFileOpenArchive Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwPriority As Long, ByVal dwFlags As Long, ByRef hMPQ As Long) As Boolean\r
+Declare Function SFileCloseArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean\r
+Declare Function SFileGetArchiveName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean\r
+Declare Function SFileOpenFile Lib "SFmpq.dll" (ByVal lpFileName As String, ByRef hFile As Long) As Boolean\r
+Declare Function SFileOpenFileEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal dwSearchScope As Long, ByRef hFile As Long) As Boolean\r
+Declare Function SFileCloseFile Lib "SFmpq.dll" (ByVal hFile As Long) As Boolean\r
+Declare Function SFileGetFileSize Lib "SFmpq.dll" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long\r
+Declare Function SFileGetFileArchive Lib "SFmpq.dll" (ByVal hFile As Long, ByRef hMPQ As Long) As Boolean\r
+Declare Function SFileGetFileName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean\r
+Declare Function SFileSetFilePointer Lib "SFmpq.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lplDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long\r
+Declare Function SFileReadFile Lib "SFmpq.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByRef lpOverlapped As Any) As Boolean\r
+Declare Function SFileSetLocale Lib "SFmpq.dll" (ByVal nNewLocale As Long) As Long\r
+Declare Function SFileGetBasePath Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean\r
+Declare Function SFileSetBasePath Lib "SFmpq.dll" (ByVal lpNewBasePath As String) As Boolean\r
+\r
+' Extra storm-related functions\r
+Declare Function SFileGetFileInfo Lib "SFmpq.dll" (ByVal hFile As Long, ByVal dwInfoType As Long) As Long\r
+Declare Function SFileSetArchivePriority Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwPriority As Long) As Boolean\r
+Declare Function SFileFindMpqHeader Lib "SFmpq.dll" (ByVal hFile As Long) As Long\r
+Declare Function SFileListFiles Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileLists As String, ByRef lpListBuffer As FILELISTENTRY, ByVal dwFlags As Long) As Boolean\r
+\r
+' Archive editing functions implemented by this library\r
+Declare Function MpqOpenArchiveForUpdate Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long) As Long\r
+Declare Function MpqCloseUpdatedArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwUnknown2 As Long) As Long\r
+Declare Function MpqAddFileToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long) As Boolean\r
+Declare Function MpqAddWaveToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean\r
+Declare Function MpqRenameFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpcOldFileName As String, ByVal lpcNewFileName As String) As Boolean\r
+Declare Function MpqDeleteFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String) As Boolean\r
+Declare Function MpqCompactArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean\r
+\r
+' Extra archive editing functions\r
+Declare Function MpqOpenArchiveForUpdateEx Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long, ByVal dwBlockSize As Long) As Long\r
+Declare Function MpqAddFileToArchiveEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean\r
+Declare Function MpqAddFileFromBufferEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean\r
+Declare Function MpqAddFileFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long) As Boolean\r
+Declare Function MpqAddWaveFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean\r
+Declare Function MpqSetFileLocale Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal nOldLocale As Long, ByVal nNewLocale As Long) As Boolean\r
+\r
+' These functions do nothing. They are only provided for\r
+' compatibility with MPQ extractors that use storm.\r
+Declare Function SFileDestroy Lib "SFmpq.dll" () As Boolean\r
+Declare Sub StormDestroy Lib "SFmpq.dll" ()\r
+\r
+' Returns 0 if the dll version is equal to the version your program was compiled\r
+' with, 1 if the dll is newer, -1 if the dll is older.\r
+Function SFMpqCompareVersion() As Long\r
+ Dim ExeVersion As SFMPQVERSION, DllVersion As SFMPQVERSION\r
+ With ExeVersion\r
+ .Major = 1\r
+ .Minor = 0\r
+ .Revision = 7\r
+ .Subrevision = 4\r
+ End With\r
+ DllVersion = SFMpqGetVersion()\r
+ If DllVersion.Major > ExeVersion.Major Then\r
+ SFMpqCompareVersion = 1\r
+ Exit Function\r
+ ElseIf DllVersion.Major < ExeVersion.Major Then\r
+ SFMpqCompareVersion = -1\r
+ Exit Function\r
+ End If\r
+ If DllVersion.Minor > ExeVersion.Minor Then\r
+ SFMpqCompareVersion = 1\r
+ Exit Function\r
+ ElseIf DllVersion.Minor < ExeVersion.Minor Then\r
+ SFMpqCompareVersion = -1\r
+ Exit Function\r
+ End If\r
+ If DllVersion.Revision > ExeVersion.Revision Then\r
+ SFMpqCompareVersion = 1\r
+ Exit Function\r
+ ElseIf DllVersion.Revision < ExeVersion.Revision Then\r
+ SFMpqCompareVersion = -1\r
+ Exit Function\r
+ End If\r
+ If DllVersion.Subrevision > ExeVersion.Subrevision Then\r
+ SFMpqCompareVersion = 1\r
+ Exit Function\r
+ ElseIf DllVersion.Subrevision < ExeVersion.Subrevision Then\r
+ SFMpqCompareVersion = -1\r
+ Exit Function\r
+ End If\r
+ SFMpqCompareVersion = 0\r
+End Function\r
+\r
diff --git a/ScriptOut.frm b/ScriptOut.frm
--- a/ScriptOut.frm
+++ b/ScriptOut.frm
-VERSION 4.00
-Begin VB.Form ScriptOut
- BorderStyle = 3 'Fixed Dialog
- Caption = "Script Output"
- ClientHeight = 4575
- ClientLeft = 480
- ClientTop = 1275
- ClientWidth = 9615
- Height = 4980
- Icon = "ScriptOut.frx":0000
- Left = 420
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4575
- ScaleWidth = 9615
- ShowInTaskbar = 0 'False
- Top = 930
- Width = 9735
- Begin VB.TextBox oText
- BackColor = &H8000000F&
- BorderStyle = 0 'None
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Terminal"
- Size = 9
- Charset = 255
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 4575
- Left = 0
- Locked = -1 'True
- MultiLine = -1 'True
- TabIndex = 0
- Top = 0
- Width = 9615
- End
-End
-Attribute VB_Name = "ScriptOut"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Private Sub Form_Load()
-Left = (Screen.Width - Width) / 2
-Top = (Screen.Height - Height) / 2
-End Sub
-Private Sub oText_Change()
-If Len(oText) > 8192 Then oText = Right(oText, 8192)
-End Sub
+VERSION 4.00\r
+Begin VB.Form ScriptOut \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Script Output"\r
+ ClientHeight = 4575\r
+ ClientLeft = 480\r
+ ClientTop = 1275\r
+ ClientWidth = 9615\r
+ Height = 4980\r
+ Icon = "ScriptOut.frx":0000\r
+ Left = 420\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 4575\r
+ ScaleWidth = 9615\r
+ ShowInTaskbar = 0 'False\r
+ Top = 930\r
+ Width = 9735\r
+ Begin VB.TextBox oText \r
+ BackColor = &H8000000F&\r
+ BorderStyle = 0 'None\r
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} \r
+ Name = "Terminal"\r
+ Size = 9\r
+ Charset = 255\r
+ Weight = 400\r
+ Underline = 0 'False\r
+ Italic = 0 'False\r
+ Strikethrough = 0 'False\r
+ EndProperty\r
+ Height = 4575\r
+ Left = 0\r
+ Locked = -1 'True\r
+ MultiLine = -1 'True\r
+ TabIndex = 0\r
+ Top = 0\r
+ Width = 9615\r
+ End\r
+End\r
+Attribute VB_Name = "ScriptOut"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Private Sub Form_Load()\r
+Left = (Screen.Width - Width) / 2\r
+Top = (Screen.Height - Height) / 2\r
+End Sub\r
+Private Sub oText_Change()\r
+If Len(oText) > 8192 Then oText = Right(oText, 8192)\r
+End Sub\r
diff --git a/ToolList.frm b/ToolList.frm
--- a/ToolList.frm
+++ b/ToolList.frm
-VERSION 4.00
-Begin VB.Form ToolList
- BorderStyle = 3 'Fixed Dialog
- Caption = "Add/Remove Tools"
- ClientHeight = 2775
- ClientLeft = 1575
- ClientTop = 1815
- ClientWidth = 4065
- Height = 3180
- Icon = "ToolList.frx":0000
- Left = 1515
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 2775
- ScaleWidth = 4065
- ShowInTaskbar = 0 'False
- Top = 1470
- Width = 4185
- Begin VB.CommandButton Command2
- Cancel = -1 'True
- Caption = "&Cancel"
- Height = 375
- Left = 1920
- TabIndex = 3
- Top = 2400
- Width = 1455
- End
- Begin VB.CommandButton cmdOK
- Caption = "O&K"
- Default = -1 'True
- Height = 375
- Left = 240
- TabIndex = 2
- Top = 2400
- Width = 1455
- End
- Begin VB.ListBox tList
- Height = 2370
- IntegralHeight = 0 'False
- Left = 0
- TabIndex = 1
- Top = 0
- Width = 3600
- End
- Begin MSComctlLib.Toolbar Toolbar1
- Height = 450
- Left = 3600
- TabIndex = 0
- Top = 0
- Width = 495
- _ExtentX = 873
- _ExtentY = 794
- ButtonWidth = 820
- ButtonHeight = 794
- AllowCustomize = 0 'False
- Style = 1
- ImageList = "ImageList1"
- DisabledImageList= "ImageList2"
- HotImageList = "ImageList3"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 6
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "Add"
- ToolTipText = "Add a program to the list."
- ImageIndex = 1
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "Remove"
- ToolTipText = "Remove selected program from the list."
- ImageIndex = 2
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "Edit"
- ToolTipText = "Edit properties for selected program."
- ImageIndex = 3
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "Up"
- ToolTipText = "Move selected program up in the list."
- ImageIndex = 4
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "Down"
- ToolTipText = "Move selected program down in the list."
- ImageIndex = 5
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList3
- Left = 3360
- Top = 2400
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 24
- ImageHeight = 24
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 5
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":000C
- Key = ""
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":00D8
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0188
- Key = ""
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0238
- Key = ""
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0310
- Key = ""
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList2
- Left = 1560
- Top = 2400
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 24
- ImageHeight = 24
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 5
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":03E8
- Key = ""
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":04C4
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0574
- Key = ""
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0654
- Key = ""
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0734
- Key = ""
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList1
- Left = 0
- Top = 2280
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 24
- ImageHeight = 24
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 5
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0810
- Key = ""
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":08EC
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":09A8
- Key = ""
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0A6C
- Key = ""
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "ToolList.frx":0B4C
- Key = ""
- EndProperty
- EndProperty
- End
-End
-Attribute VB_Name = "ToolList"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Dim tCommands() As String
-Private Sub cmdOK_Click()
-Dim tNum As Long
-DelKey AppKey + "Tools\"
-NewKey AppKey + "Tools\"
-For tNum = 0 To tList.ListCount - 1
- SetReg AppKey + "Tools\Name" + CStr(tNum), tList.List(tNum)
- SetReg AppKey + "Tools\Command" + CStr(tNum), tCommands(tNum + 1)
-Next tNum
-Unload Me
-End Sub
-Private Sub Command2_Click()
-Unload Me
-End Sub
-Private Sub Form_Load()
-Dim tNum As Long, ToolName As String, ToolCommand
-Left = MpqEx.Left + 330
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-ReDim tCommands(0) As String
-Do
- ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
- ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
- If ToolName = "" Then ToolName = ToolCommand
- If ToolName <> "" Then
- ReDim Preserve tCommands(UBound(tCommands) + 1) As String
- tCommands(UBound(tCommands)) = ToolCommand
- tList.AddItem ToolName
- End If
- tNum = tNum + 1
-Loop Until ToolName = ""
-End Sub
-Private Sub tList_Click()
-If tList.ListIndex > -1 Then
- Toolbar1.Buttons.Item("Remove").Enabled = True
- Toolbar1.Buttons.Item("Edit").Enabled = True
-Else
- Toolbar1.Buttons.Item("Remove").Enabled = False
- Toolbar1.Buttons.Item("Edit").Enabled = False
-End If
-If tList.ListIndex > 0 Then
- Toolbar1.Buttons.Item("Up").Enabled = True
-Else
- Toolbar1.Buttons.Item("Up").Enabled = False
-End If
-If tList.ListIndex < tList.ListCount - 1 And tList.ListIndex > -1 Then
- Toolbar1.Buttons.Item("Down").Enabled = True
-Else
- Toolbar1.Buttons.Item("Down").Enabled = False
-End If
-End Sub
-Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
-Dim TempText As String, tNum As Long
-Select Case Button.Key
-Case "Add"
- TempText = EditTItem.EditItem("Add Command", "", "")
- If TempText <> vbCrLf Then
- tList.AddItem Left(TempText, InStr(TempText, vbCrLf) - 1)
- ReDim Preserve tCommands(UBound(tCommands) + 1) As String
- tCommands(UBound(tCommands)) = Mid(TempText, InStr(TempText, vbCrLf) + 2)
- tList.ListIndex = tList.ListCount - 1
- End If
-Case "Remove"
- For tNum = tList.ListIndex + 1 To tList.ListCount - 1
- tCommands(tNum) = tCommands(tNum + 1)
- Next tNum
- ReDim Preserve tCommands(UBound(tCommands) - 1) As String
- tList.RemoveItem tList.ListIndex
- tList_Click
-Case "Edit"
- TempText = EditTItem.EditItem("Edit Command", tList.List(tList.ListIndex), tCommands(tList.ListIndex + 1))
- tList.List(tList.ListIndex) = Left(TempText, InStr(TempText, vbCrLf) - 1)
- tCommands(tList.ListIndex + 1) = Mid(TempText, InStr(TempText, vbCrLf) + 2)
-Case "Up"
- TempText = tList.List(tList.ListIndex)
- tList.List(tList.ListIndex) = tList.List(tList.ListIndex - 1)
- tList.List(tList.ListIndex - 1) = TempText
- TempText = tCommands(tList.ListIndex + 1)
- tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex)
- tCommands(tList.ListIndex) = TempText
- tList.ListIndex = tList.ListIndex - 1
-Case "Down"
- TempText = tList.List(tList.ListIndex)
- tList.List(tList.ListIndex) = tList.List(tList.ListIndex + 1)
- tList.List(tList.ListIndex + 1) = TempText
- TempText = tCommands(tList.ListIndex + 1)
- tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex + 2)
- tCommands(tList.ListIndex + 2) = TempText
- tList.ListIndex = tList.ListIndex + 1
-End Select
-End Sub
+VERSION 4.00\r
+Begin VB.Form ToolList \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Add/Remove Tools"\r
+ ClientHeight = 2775\r
+ ClientLeft = 1575\r
+ ClientTop = 1815\r
+ ClientWidth = 4065\r
+ Height = 3180\r
+ Icon = "ToolList.frx":0000\r
+ Left = 1515\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 2775\r
+ ScaleWidth = 4065\r
+ ShowInTaskbar = 0 'False\r
+ Top = 1470\r
+ Width = 4185\r
+ Begin VB.CommandButton Command2 \r
+ Cancel = -1 'True\r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 1920\r
+ TabIndex = 3\r
+ Top = 2400\r
+ Width = 1455\r
+ End\r
+ Begin VB.CommandButton cmdOK \r
+ Caption = "O&K"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 240\r
+ TabIndex = 2\r
+ Top = 2400\r
+ Width = 1455\r
+ End\r
+ Begin VB.ListBox tList \r
+ Height = 2370\r
+ IntegralHeight = 0 'False\r
+ Left = 0\r
+ TabIndex = 1\r
+ Top = 0\r
+ Width = 3600\r
+ End\r
+ Begin MSComctlLib.Toolbar Toolbar1 \r
+ Height = 450\r
+ Left = 3600\r
+ TabIndex = 0\r
+ Top = 0\r
+ Width = 495\r
+ _ExtentX = 873\r
+ _ExtentY = 794\r
+ ButtonWidth = 820\r
+ ButtonHeight = 794\r
+ AllowCustomize = 0 'False\r
+ Style = 1\r
+ ImageList = "ImageList1"\r
+ DisabledImageList= "ImageList2"\r
+ HotImageList = "ImageList3"\r
+ _Version = 393216\r
+ BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} \r
+ NumButtons = 6\r
+ BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Key = "Add"\r
+ ToolTipText = "Add a program to the list."\r
+ ImageIndex = 1\r
+ EndProperty\r
+ BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Key = "Remove"\r
+ ToolTipText = "Remove selected program from the list."\r
+ ImageIndex = 2\r
+ EndProperty\r
+ BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Key = "Edit"\r
+ ToolTipText = "Edit properties for selected program."\r
+ ImageIndex = 3\r
+ EndProperty\r
+ BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Style = 3\r
+ EndProperty\r
+ BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Key = "Up"\r
+ ToolTipText = "Move selected program up in the list."\r
+ ImageIndex = 4\r
+ EndProperty\r
+ BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Key = "Down"\r
+ ToolTipText = "Move selected program down in the list."\r
+ ImageIndex = 5\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin MSComctlLib.ImageList ImageList3 \r
+ Left = 3360\r
+ Top = 2400\r
+ _ExtentX = 1005\r
+ _ExtentY = 1005\r
+ BackColor = -2147483643\r
+ ImageWidth = 24\r
+ ImageHeight = 24\r
+ MaskColor = 12632256\r
+ _Version = 393216\r
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} \r
+ NumListImages = 5\r
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":000C\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":00D8\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0188\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0238\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0310\r
+ Key = ""\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin MSComctlLib.ImageList ImageList2 \r
+ Left = 1560\r
+ Top = 2400\r
+ _ExtentX = 1005\r
+ _ExtentY = 1005\r
+ BackColor = -2147483643\r
+ ImageWidth = 24\r
+ ImageHeight = 24\r
+ MaskColor = 12632256\r
+ _Version = 393216\r
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} \r
+ NumListImages = 5\r
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":03E8\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":04C4\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0574\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0654\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0734\r
+ Key = ""\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin MSComctlLib.ImageList ImageList1 \r
+ Left = 0\r
+ Top = 2280\r
+ _ExtentX = 1005\r
+ _ExtentY = 1005\r
+ BackColor = -2147483643\r
+ ImageWidth = 24\r
+ ImageHeight = 24\r
+ MaskColor = 12632256\r
+ _Version = 393216\r
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} \r
+ NumListImages = 5\r
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0810\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":08EC\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":09A8\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0A6C\r
+ Key = ""\r
+ EndProperty\r
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "ToolList.frx":0B4C\r
+ Key = ""\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+End\r
+Attribute VB_Name = "ToolList"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Dim tCommands() As String\r
+Private Sub cmdOK_Click()\r
+Dim tNum As Long\r
+DelKey AppKey + "Tools\"\r
+NewKey AppKey + "Tools\"\r
+For tNum = 0 To tList.ListCount - 1\r
+ SetReg AppKey + "Tools\Name" + CStr(tNum), tList.List(tNum)\r
+ SetReg AppKey + "Tools\Command" + CStr(tNum), tCommands(tNum + 1)\r
+Next tNum\r
+Unload Me\r
+End Sub\r
+Private Sub Command2_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub Form_Load()\r
+Dim tNum As Long, ToolName As String, ToolCommand\r
+Left = MpqEx.Left + 330\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+ReDim tCommands(0) As String\r
+Do\r
+ ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))\r
+ ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))\r
+ If ToolName = "" Then ToolName = ToolCommand\r
+ If ToolName <> "" Then\r
+ ReDim Preserve tCommands(UBound(tCommands) + 1) As String\r
+ tCommands(UBound(tCommands)) = ToolCommand\r
+ tList.AddItem ToolName\r
+ End If\r
+ tNum = tNum + 1\r
+Loop Until ToolName = ""\r
+End Sub\r
+Private Sub tList_Click()\r
+If tList.ListIndex > -1 Then\r
+ Toolbar1.Buttons.Item("Remove").Enabled = True\r
+ Toolbar1.Buttons.Item("Edit").Enabled = True\r
+Else\r
+ Toolbar1.Buttons.Item("Remove").Enabled = False\r
+ Toolbar1.Buttons.Item("Edit").Enabled = False\r
+End If\r
+If tList.ListIndex > 0 Then\r
+ Toolbar1.Buttons.Item("Up").Enabled = True\r
+Else\r
+ Toolbar1.Buttons.Item("Up").Enabled = False\r
+End If\r
+If tList.ListIndex < tList.ListCount - 1 And tList.ListIndex > -1 Then\r
+ Toolbar1.Buttons.Item("Down").Enabled = True\r
+Else\r
+ Toolbar1.Buttons.Item("Down").Enabled = False\r
+End If\r
+End Sub\r
+Private Sub Toolbar1_ButtonClick(ByVal Button As Button)\r
+Dim TempText As String, tNum As Long\r
+Select Case Button.Key\r
+Case "Add"\r
+ TempText = EditTItem.EditItem("Add Command", "", "")\r
+ If TempText <> vbCrLf Then\r
+ tList.AddItem Left(TempText, InStr(TempText, vbCrLf) - 1)\r
+ ReDim Preserve tCommands(UBound(tCommands) + 1) As String\r
+ tCommands(UBound(tCommands)) = Mid(TempText, InStr(TempText, vbCrLf) + 2)\r
+ tList.ListIndex = tList.ListCount - 1\r
+ End If\r
+Case "Remove"\r
+ For tNum = tList.ListIndex + 1 To tList.ListCount - 1\r
+ tCommands(tNum) = tCommands(tNum + 1)\r
+ Next tNum\r
+ ReDim Preserve tCommands(UBound(tCommands) - 1) As String\r
+ tList.RemoveItem tList.ListIndex\r
+ tList_Click\r
+Case "Edit"\r
+ TempText = EditTItem.EditItem("Edit Command", tList.List(tList.ListIndex), tCommands(tList.ListIndex + 1))\r
+ tList.List(tList.ListIndex) = Left(TempText, InStr(TempText, vbCrLf) - 1)\r
+ tCommands(tList.ListIndex + 1) = Mid(TempText, InStr(TempText, vbCrLf) + 2)\r
+Case "Up"\r
+ TempText = tList.List(tList.ListIndex)\r
+ tList.List(tList.ListIndex) = tList.List(tList.ListIndex - 1)\r
+ tList.List(tList.ListIndex - 1) = TempText\r
+ TempText = tCommands(tList.ListIndex + 1)\r
+ tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex)\r
+ tCommands(tList.ListIndex) = TempText\r
+ tList.ListIndex = tList.ListIndex - 1\r
+Case "Down"\r
+ TempText = tList.List(tList.ListIndex)\r
+ tList.List(tList.ListIndex) = tList.List(tList.ListIndex + 1)\r
+ tList.List(tList.ListIndex + 1) = TempText\r
+ TempText = tCommands(tList.ListIndex + 1)\r
+ tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex + 2)\r
+ tCommands(tList.ListIndex + 2) = TempText\r
+ tList.ListIndex = tList.ListIndex + 1\r
+End Select\r
+End Sub\r
diff --git a/WinMPQ.vbp b/WinMPQ.vbp
--- a/WinMPQ.vbp
+++ b/WinMPQ.vbp
-Form=listing.frm
-Module=MpqStuff; MpqStuff.bas
-Module=RegistryFunctions; Registry.bas
-Module=FileDialog; FileDialog.bas
-Module=FixWindowIcon; FixIcon.bas
-Module=SFmpqapi; SFmpqapi.bas
-Module=CwadLib; CwadLib.bas
-Form=Options.frm
-Form=ScriptOut.frm
-Form=About.frm
-Form=FoldName.frm
-Form=ToolList.frm
-Form=EditTItem.frm
-Form=frmMpq.frm
-Form=frmAddToList.frm
-Form=ChLCID.frm
-Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
-ProjWinSize=83,934,212,163
-ProjWinShow=2
-IconForm="MpqEx"
-HelpFile=""
-ResFile32="WinMPQ.res"
-Title="WinMPQ"
-ExeName32="WinMPQ.exe"
-Name="WinMPQ"
-HelpContextID="0"
-StartMode=0
-VersionCompatible32="0"
-MajorVer=1
-MinorVer=65
-RevisionVer=0
-AutoIncrementVer=0
-ServerSupportFiles=0
-VersionCompanyName="ShadowFlare Software"
-VersionFileDescription="ShadowFlare MPQ Archiver"
-VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2009"
-VersionProductName="WinMPQ"
+Form=listing.frm\r
+Module=MpqStuff; MpqStuff.bas\r
+Module=RegistryFunctions; Registry.bas\r
+Module=FileDialog; FileDialog.bas\r
+Module=FixWindowIcon; FixIcon.bas\r
+Module=SFmpqapi; SFmpqapi.bas\r
+Module=CwadLib; CwadLib.bas\r
+Form=Options.frm\r
+Form=ScriptOut.frm\r
+Form=About.frm\r
+Form=FoldName.frm\r
+Form=ToolList.frm\r
+Form=EditTItem.frm\r
+Form=frmMpq.frm\r
+Form=frmAddToList.frm\r
+Form=ChLCID.frm\r
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx\r
+ProjWinSize=83,934,212,163\r
+ProjWinShow=2\r
+IconForm="MpqEx"\r
+HelpFile=""\r
+ResFile32="WinMPQ.res"\r
+Title="WinMPQ"\r
+ExeName32="WinMPQ.exe"\r
+Name="WinMPQ"\r
+HelpContextID="0"\r
+StartMode=0\r
+VersionCompatible32="0"\r
+MajorVer=1\r
+MinorVer=65\r
+RevisionVer=0\r
+AutoIncrementVer=0\r
+ServerSupportFiles=0\r
+VersionCompanyName="ShadowFlare Software"\r
+VersionFileDescription="ShadowFlare MPQ Archiver"\r
+VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2009"\r
+VersionProductName="WinMPQ"\r
diff --git a/frmAddToList.frm b/frmAddToList.frm
--- a/frmAddToList.frm
+++ b/frmAddToList.frm
-VERSION 4.00
-Begin VB.Form frmAddToList
- BorderStyle = 3 'Fixed Dialog
- Caption = "Add file to listing..."
- ClientHeight = 1695
- ClientLeft = 2190
- ClientTop = 2610
- ClientWidth = 4335
- Height = 2100
- Icon = "frmAddToList.frx":0000
- Left = 2130
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1695
- ScaleWidth = 4335
- ShowInTaskbar = 0 'False
- Top = 2265
- Width = 4455
- Begin VB.CommandButton Command2
- Cancel = -1 'True
- Caption = "&Cancel"
- Height = 375
- Left = 2400
- TabIndex = 3
- Top = 1200
- Width = 1335
- End
- Begin VB.CommandButton Command1
- Caption = "O&K"
- Default = -1 'True
- Height = 375
- Left = 600
- TabIndex = 2
- Top = 1200
- Width = 1335
- End
- Begin VB.TextBox Text1
- Height = 285
- Left = 120
- TabIndex = 1
- Top = 840
- Width = 4095
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "If you know the name of a file, but it is not listed, type in the name here and it will be added to the list of files shown."
- Height = 585
- Left = 120
- TabIndex = 0
- Top = 120
- Width = 4095
- WordWrap = -1 'True
- End
-End
-Attribute VB_Name = "frmAddToList"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Private Sub Command1_Click()
-MpqEx.List.Sorted = False
-MpqEx.AddToListing Text1
-MpqEx.List.Sorted = True
-MpqEx.RemoveDuplicates
-Unload Me
-End Sub
-Private Sub Command2_Click()
-Unload Me
-End Sub
-Private Sub Form_Load()
-Left = MpqEx.Left + 330 * 2
-If Left < 0 Then Left = 0
-If Left + Width > Screen.Width Then Left = Screen.Width - Width
-Top = MpqEx.Top + 315 * 2
-If Top < 0 Then Top = 0
-If Top + Height > Screen.Height Then Top = Screen.Height - Height
-End Sub
+VERSION 4.00\r
+Begin VB.Form frmAddToList \r
+ BorderStyle = 3 'Fixed Dialog\r
+ Caption = "Add file to listing..."\r
+ ClientHeight = 1695\r
+ ClientLeft = 2190\r
+ ClientTop = 2610\r
+ ClientWidth = 4335\r
+ Height = 2100\r
+ Icon = "frmAddToList.frx":0000\r
+ Left = 2130\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ MinButton = 0 'False\r
+ ScaleHeight = 1695\r
+ ScaleWidth = 4335\r
+ ShowInTaskbar = 0 'False\r
+ Top = 2265\r
+ Width = 4455\r
+ Begin VB.CommandButton Command2 \r
+ Cancel = -1 'True\r
+ Caption = "&Cancel"\r
+ Height = 375\r
+ Left = 2400\r
+ TabIndex = 3\r
+ Top = 1200\r
+ Width = 1335\r
+ End\r
+ Begin VB.CommandButton Command1 \r
+ Caption = "O&K"\r
+ Default = -1 'True\r
+ Height = 375\r
+ Left = 600\r
+ TabIndex = 2\r
+ Top = 1200\r
+ Width = 1335\r
+ End\r
+ Begin VB.TextBox Text1 \r
+ Height = 285\r
+ Left = 120\r
+ TabIndex = 1\r
+ Top = 840\r
+ Width = 4095\r
+ End\r
+ Begin VB.Label Label1 \r
+ AutoSize = -1 'True\r
+ Caption = "If you know the name of a file, but it is not listed, type in the name here and it will be added to the list of files shown."\r
+ Height = 585\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 120\r
+ Width = 4095\r
+ WordWrap = -1 'True\r
+ End\r
+End\r
+Attribute VB_Name = "frmAddToList"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Private Sub Command1_Click()\r
+MpqEx.List.Sorted = False\r
+MpqEx.AddToListing Text1\r
+MpqEx.List.Sorted = True\r
+MpqEx.RemoveDuplicates\r
+Unload Me\r
+End Sub\r
+Private Sub Command2_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub Form_Load()\r
+Left = MpqEx.Left + 330 * 2\r
+If Left < 0 Then Left = 0\r
+If Left + Width > Screen.Width Then Left = Screen.Width - Width\r
+Top = MpqEx.Top + 315 * 2\r
+If Top < 0 Then Top = 0\r
+If Top + Height > Screen.Height Then Top = Screen.Height - Height\r
+End Sub\r
diff --git a/frmMpq.frm b/frmMpq.frm
--- a/frmMpq.frm
+++ b/frmMpq.frm
-VERSION 4.00
-Begin VB.Form frmMpq
- BorderStyle = 1 'Fixed Single
- Caption = "MPQ Embedder"
- ClientHeight = 1695
- ClientLeft = 3045
- ClientTop = 2730
- ClientWidth = 2775
- Height = 2385
- Icon = "frmMpq.frx":0000
- Left = 2985
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 1695
- ScaleWidth = 2775
- Top = 2100
- Width = 2895
- Begin VB.CommandButton cmdSaveEXE
- Caption = "Save &EXE"
- Enabled = 0 'False
- Height = 375
- Left = 1440
- TabIndex = 3
- Top = 1200
- Width = 1215
- End
- Begin VB.CommandButton cmdRemove
- Caption = "&Remove"
- Enabled = 0 'False
- Height = 375
- Left = 120
- TabIndex = 2
- Top = 1200
- Width = 1215
- End
- Begin VB.CommandButton cmdSaveMPQ
- Caption = "Save &MPQ"
- Enabled = 0 'False
- Height = 375
- Left = 1440
- TabIndex = 1
- Top = 720
- Width = 1215
- End
- Begin VB.CommandButton cmdAdd
- Caption = "&Add"
- Enabled = 0 'False
- Height = 375
- Left = 120
- TabIndex = 0
- Top = 720
- Width = 1215
- End
- Begin VB.Label Label1
- Height = 615
- Left = 120
- TabIndex = 4
- Top = 120
- Width = 2565
- WordWrap = -1 'True
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFOpen
- Caption = "&Open..."
- End
- Begin VB.Menu mnuFSep
- Caption = "-"
- End
- Begin VB.Menu mnuFExit
- Caption = "E&xit"
- End
- End
- Begin VB.Menu mnuRun
- Caption = "&Run EXE"
- Enabled = 0 'False
- End
- Begin VB.Menu mnuHelp
- Caption = "&Help"
- Begin VB.Menu mnuHReadme
- Caption = "View &Readme..."
- End
- Begin VB.Menu mnuHSep
- Caption = "-"
- End
- Begin VB.Menu mnuHAbout
- Caption = "&About..."
- End
- End
-End
-Attribute VB_Name = "frmMpq"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Dim MpqHeader As Long, IsEXE As Boolean, FileDialog As OPENFILENAME
-Private Sub cmdAdd_Click()
-Dim OldFileName As String, NewMpqHeader As Long, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
-FileDialog.Flags = &H1000 Or &H4 Or &H2
-FileDialog.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"
-OldFileName = FileDialog.FileName
-FileDialog.hwndOwner = hWnd
-If ShowOpen(FileDialog) = False Then GoTo Cancel
-NewMpqHeader = FindMpqHeader(FileDialog.FileName)
-If NewMpqHeader = -1 Then
- MsgBox "This file does not contain an MPQ archive.", , "MPQ Embedder"
- GoTo Cancel
-End If
-fNum = FreeFile
-Open FileDialog.FileName For Binary As #fNum
-fNum2 = FreeFile
-Open OldFileName For Binary As #fNum2
-If MpqHeader / 512 <> Int(MpqHeader / 512) Then
- bNum = MsgBox("The file you are adding the MPQ archive to" + vbCrLf + "is not the proper size; therefore, most MPQ" + vbCrLf + "archive readers will not be able to read it." + vbCrLf + "Do you want to increase the size of the file," + vbCrLf + "so other programs can read it?", vbQuestion Or vbYesNo Or vbDefaultButton1, "MPQ Embedder")
- If bNum = vbYes Then
- Text = String(512 - (MpqHeader - Int(MpqHeader / 512) * 512), Chr(0))
- Put #fNum2, MpqHeader + 1, Text
- MpqHeader = MpqHeader + Len(Text)
- End If
-End If
-For bNum = NewMpqHeader + 1 To LOF(fNum) Step 2 ^ 20
- Text = String(2 ^ 20, Chr(0))
- If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
- Get #fNum, bNum, Text
- Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
- Else
- Text = String(LOF(fNum) - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
- Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
- End If
-Next bNum
-Close #fNum2
-Close #fNum
-cmdAdd.Enabled = False
-cmdRemove.Enabled = True
-cmdSaveMPQ.Enabled = True
-cmdSaveEXE.Enabled = True
-If MpqHeader / 512 = Int(MpqHeader / 512) Then
- Label1.Caption = "This file contains an MPQ archive."
-Else
- Label1.Caption = "This file contains an MPQ archive, but other programs may not be able to read it."
-End If
-Cancel:
-FileDialog.FileName = OldFileName
-End Sub
-Private Sub cmdRemove_Click()
-Dim fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
-bNum = MsgBox("Are you sure you want to permanently" + vbCrLf + "remove the MPQ archive from this file?", vbQuestion Or vbYesNo Or vbDefaultButton2, "MPQ Embedder")
-If bNum = vbNo Then Exit Sub
-fNum = FreeFile
-Open FileDialog.FileName For Binary As #fNum
-fNum2 = FreeFile
-If Dir(FileDialog.FileName + ".remove") <> "" Then Kill FileDialog.FileName + ".remove"
-Open FileDialog.FileName + ".remove" For Binary As #fNum2
-For bNum = 1 To MpqHeader Step 2 ^ 20
- Text = String(2 ^ 20, Chr(0))
- If MpqHeader - bNum + 1 >= 2 ^ 20 Then
- Get #fNum, bNum, Text
- Put #fNum2, bNum, Text
- Else
- Text = String(MpqHeader - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
- Put #fNum2, bNum, Text
- End If
-Next bNum
-Close #fNum2
-Close #fNum
-Kill FileDialog.FileName
-Name FileDialog.FileName + ".remove" As FileDialog.FileName
-cmdAdd.Enabled = True
-cmdRemove.Enabled = False
-cmdSaveMPQ.Enabled = False
-cmdSaveEXE.Enabled = True
-Label1.Caption = "This file does not contain an MPQ archive."
-End Sub
-Private Sub cmdSaveEXE_Click()
-Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
-FileDialog.Flags = &H1000 Or &H4 Or &H2
-FileDialog.Filter = "File (*.*)|*.*"
-FileDialog.DefaultExt = ""
-OldFileName = FileDialog.FileName
-FileDialog.FileName = FileDialog.FileName
-FileDialog.hwndOwner = hWnd
-If ShowSave(FileDialog) = False Then GoTo Cancel
-fNum = FreeFile
-Open OldFileName For Binary As #fNum
-fNum2 = FreeFile
-If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
-Open FileDialog.FileName For Binary As #fNum2
-For bNum = 1 To MpqHeader Step 2 ^ 20
- Text = String(2 ^ 20, Chr(0))
- If MpqHeader - bNum + 1 >= 2 ^ 20 Then
- Get #fNum, bNum, Text
- Put #fNum2, bNum, Text
- Else
- Text = String(MpqHeader - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
- Put #fNum2, bNum, Text
- End If
-Next bNum
-Close #fNum2
-Close #fNum
-Cancel:
-FileDialog.FileName = OldFileName
-End Sub
-Private Sub cmdSaveMPQ_Click()
-Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
-FileDialog.Flags = &H1000 Or &H4 Or &H2
-FileDialog.Filter = "MPQ Archive (*.mpq)|*.mpq"
-FileDialog.DefaultExt = "mpq"
-OldFileName = FileDialog.FileName
-FileDialog.FileName = FileDialog.FileName + ".mpq"
-FileDialog.hwndOwner = hWnd
-If ShowSave(FileDialog) = False Then GoTo Cancel
-fNum = FreeFile
-Open OldFileName For Binary As #fNum
-fNum2 = FreeFile
-If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
-Open FileDialog.FileName For Binary As #fNum2
-For bNum = MpqHeader + 1 To LOF(fNum) Step 2 ^ 20
- Text = String(2 ^ 20, Chr(0))
- If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
- Get #fNum, bNum, Text
- Put #fNum2, bNum - MpqHeader, Text
- Else
- Text = String(LOF(fNum) - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
- Put #fNum2, bNum - MpqHeader, Text
- End If
-Next bNum
-Close #fNum2
-Close #fNum
-Cancel:
-FileDialog.FileName = OldFileName
-End Sub
-
-Private Sub Form_Load()
-FileDialog = CD
-End Sub
-Private Sub mnuFExit_Click()
-Unload Me
-End Sub
-Private Sub mnuFOpen_Click()
-Dim OldFileName As String, OldMpqHeader As Long, fNum As Long, Text As String
-FileDialog.Flags = &H1000 Or &H4 Or &H2
-FileDialog.Filter = "All Files (*.*)|*.*"
-OldFileName = FileDialog.FileName
-OldMpqHeader = MpqHeader
-FileDialog.hwndOwner = hWnd
-If ShowOpen(FileDialog) = False Then GoTo Cancel
-If FileLen(FileDialog.FileName) = 0 Then
- MsgBox "This is an empty file.", vbExclamation, "MPQ Embedder"
- GoTo Cancel
-End If
-fNum = FreeFile
-Open FileDialog.FileName For Binary As #fNum
-Text = String(2, Chr(0))
-If LOF(fNum) >= 2 Then Get #fNum, 1, Text
-Close #fNum
-If Text = "MZ" Then IsEXE = True Else IsEXE = False
-If IsEXE Then mnuRun.Enabled = True Else mnuRun.Enabled = False
-MpqHeader = FindMpqHeader(FileDialog.FileName)
-If MpqHeader <= -1 Then
- cmdAdd.Enabled = True
- cmdRemove.Enabled = False
- cmdSaveMPQ.Enabled = False
- cmdSaveEXE.Enabled = True
- MpqHeader = FileLen(FileDialog.FileName)
- Label1.Caption = "This file does not contain an MPQ archive."
-ElseIf MpqHeader = 0 Then
- cmdAdd.Enabled = False
- cmdRemove.Enabled = False
- cmdSaveMPQ.Enabled = True
- cmdSaveEXE.Enabled = False
- Label1.Caption = "This file is an MPQ archive."
-ElseIf MpqHeader > 0 Then
- cmdAdd.Enabled = False
- cmdRemove.Enabled = True
- cmdSaveMPQ.Enabled = True
- cmdSaveEXE.Enabled = True
- If MpqHeader / 512 = Int(MpqHeader / 512) Then
- Label1.Caption = "This file contains an MPQ archive."
- Else
- Label1.Caption = "This file contains an MPQ archive, but other programs may be unable to read it."
- End If
-End If
-Exit Sub
-Cancel:
-FileDialog.FileName = OldFileName
-MpqHeader = OldMpqHeader
-End Sub
-Private Sub mnuHAbout_Click()
-About.Show 1
-End Sub
-Private Sub mnuHReadme_Click()
-Dim Path As String
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-If Dir(Path + "WMpqEmbed.rtf") = "" Then MsgBox "Could not find WMpqEmbed.rtf!", vbCritical, "MPQ Embedder"
-ShellExecute hWnd, vbNullString, Path + "WMpqEmbed.rtf", vbNullString, vbNullString, 1
-End Sub
-Private Sub mnuRun_Click()
-On Error GoTo NotExecutable
-Shell FileDialog.FileName, 1
-Exit Sub
-NotExecutable:
-MsgBox "This file is not a .exe file.", vbInformation, "MPQ Embedder"
-End Sub
+VERSION 4.00\r
+Begin VB.Form frmMpq \r
+ BorderStyle = 1 'Fixed Single\r
+ Caption = "MPQ Embedder"\r
+ ClientHeight = 1695\r
+ ClientLeft = 3045\r
+ ClientTop = 2730\r
+ ClientWidth = 2775\r
+ Height = 2385\r
+ Icon = "frmMpq.frx":0000\r
+ Left = 2985\r
+ LinkTopic = "Form1"\r
+ MaxButton = 0 'False\r
+ ScaleHeight = 1695\r
+ ScaleWidth = 2775\r
+ Top = 2100\r
+ Width = 2895\r
+ Begin VB.CommandButton cmdSaveEXE \r
+ Caption = "Save &EXE"\r
+ Enabled = 0 'False\r
+ Height = 375\r
+ Left = 1440\r
+ TabIndex = 3\r
+ Top = 1200\r
+ Width = 1215\r
+ End\r
+ Begin VB.CommandButton cmdRemove \r
+ Caption = "&Remove"\r
+ Enabled = 0 'False\r
+ Height = 375\r
+ Left = 120\r
+ TabIndex = 2\r
+ Top = 1200\r
+ Width = 1215\r
+ End\r
+ Begin VB.CommandButton cmdSaveMPQ \r
+ Caption = "Save &MPQ"\r
+ Enabled = 0 'False\r
+ Height = 375\r
+ Left = 1440\r
+ TabIndex = 1\r
+ Top = 720\r
+ Width = 1215\r
+ End\r
+ Begin VB.CommandButton cmdAdd \r
+ Caption = "&Add"\r
+ Enabled = 0 'False\r
+ Height = 375\r
+ Left = 120\r
+ TabIndex = 0\r
+ Top = 720\r
+ Width = 1215\r
+ End\r
+ Begin VB.Label Label1 \r
+ Height = 615\r
+ Left = 120\r
+ TabIndex = 4\r
+ Top = 120\r
+ Width = 2565\r
+ WordWrap = -1 'True\r
+ End\r
+ Begin VB.Menu mnuFile \r
+ Caption = "&File"\r
+ Begin VB.Menu mnuFOpen \r
+ Caption = "&Open..."\r
+ End\r
+ Begin VB.Menu mnuFSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuFExit \r
+ Caption = "E&xit"\r
+ End\r
+ End\r
+ Begin VB.Menu mnuRun \r
+ Caption = "&Run EXE"\r
+ Enabled = 0 'False\r
+ End\r
+ Begin VB.Menu mnuHelp \r
+ Caption = "&Help"\r
+ Begin VB.Menu mnuHReadme \r
+ Caption = "View &Readme..."\r
+ End\r
+ Begin VB.Menu mnuHSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuHAbout \r
+ Caption = "&About..."\r
+ End\r
+ End\r
+End\r
+Attribute VB_Name = "frmMpq"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Dim MpqHeader As Long, IsEXE As Boolean, FileDialog As OPENFILENAME\r
+Private Sub cmdAdd_Click()\r
+Dim OldFileName As String, NewMpqHeader As Long, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long\r
+FileDialog.Flags = &H1000 Or &H4 Or &H2\r
+FileDialog.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"\r
+OldFileName = FileDialog.FileName\r
+FileDialog.hwndOwner = hWnd\r
+If ShowOpen(FileDialog) = False Then GoTo Cancel\r
+NewMpqHeader = FindMpqHeader(FileDialog.FileName)\r
+If NewMpqHeader = -1 Then\r
+ MsgBox "This file does not contain an MPQ archive.", , "MPQ Embedder"\r
+ GoTo Cancel\r
+End If\r
+fNum = FreeFile\r
+Open FileDialog.FileName For Binary As #fNum\r
+fNum2 = FreeFile\r
+Open OldFileName For Binary As #fNum2\r
+If MpqHeader / 512 <> Int(MpqHeader / 512) Then\r
+ bNum = MsgBox("The file you are adding the MPQ archive to" + vbCrLf + "is not the proper size; therefore, most MPQ" + vbCrLf + "archive readers will not be able to read it." + vbCrLf + "Do you want to increase the size of the file," + vbCrLf + "so other programs can read it?", vbQuestion Or vbYesNo Or vbDefaultButton1, "MPQ Embedder")\r
+ If bNum = vbYes Then\r
+ Text = String(512 - (MpqHeader - Int(MpqHeader / 512) * 512), Chr(0))\r
+ Put #fNum2, MpqHeader + 1, Text\r
+ MpqHeader = MpqHeader + Len(Text)\r
+ End If\r
+End If\r
+For bNum = NewMpqHeader + 1 To LOF(fNum) Step 2 ^ 20\r
+ Text = String(2 ^ 20, Chr(0))\r
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text\r
+ Else\r
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text\r
+ End If\r
+Next bNum\r
+Close #fNum2\r
+Close #fNum\r
+cmdAdd.Enabled = False\r
+cmdRemove.Enabled = True\r
+cmdSaveMPQ.Enabled = True\r
+cmdSaveEXE.Enabled = True\r
+If MpqHeader / 512 = Int(MpqHeader / 512) Then\r
+ Label1.Caption = "This file contains an MPQ archive."\r
+Else\r
+ Label1.Caption = "This file contains an MPQ archive, but other programs may not be able to read it."\r
+End If\r
+Cancel:\r
+FileDialog.FileName = OldFileName\r
+End Sub\r
+Private Sub cmdRemove_Click()\r
+Dim fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long\r
+bNum = MsgBox("Are you sure you want to permanently" + vbCrLf + "remove the MPQ archive from this file?", vbQuestion Or vbYesNo Or vbDefaultButton2, "MPQ Embedder")\r
+If bNum = vbNo Then Exit Sub\r
+fNum = FreeFile\r
+Open FileDialog.FileName For Binary As #fNum\r
+fNum2 = FreeFile\r
+If Dir(FileDialog.FileName + ".remove") <> "" Then Kill FileDialog.FileName + ".remove"\r
+Open FileDialog.FileName + ".remove" For Binary As #fNum2\r
+For bNum = 1 To MpqHeader Step 2 ^ 20\r
+ Text = String(2 ^ 20, Chr(0))\r
+ If MpqHeader - bNum + 1 >= 2 ^ 20 Then\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum, Text\r
+ Else\r
+ Text = String(MpqHeader - bNum + 1, Chr(0))\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum, Text\r
+ End If\r
+Next bNum\r
+Close #fNum2\r
+Close #fNum\r
+Kill FileDialog.FileName\r
+Name FileDialog.FileName + ".remove" As FileDialog.FileName\r
+cmdAdd.Enabled = True\r
+cmdRemove.Enabled = False\r
+cmdSaveMPQ.Enabled = False\r
+cmdSaveEXE.Enabled = True\r
+Label1.Caption = "This file does not contain an MPQ archive."\r
+End Sub\r
+Private Sub cmdSaveEXE_Click()\r
+Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long\r
+FileDialog.Flags = &H1000 Or &H4 Or &H2\r
+FileDialog.Filter = "File (*.*)|*.*"\r
+FileDialog.DefaultExt = ""\r
+OldFileName = FileDialog.FileName\r
+FileDialog.FileName = FileDialog.FileName\r
+FileDialog.hwndOwner = hWnd\r
+If ShowSave(FileDialog) = False Then GoTo Cancel\r
+fNum = FreeFile\r
+Open OldFileName For Binary As #fNum\r
+fNum2 = FreeFile\r
+If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName\r
+Open FileDialog.FileName For Binary As #fNum2\r
+For bNum = 1 To MpqHeader Step 2 ^ 20\r
+ Text = String(2 ^ 20, Chr(0))\r
+ If MpqHeader - bNum + 1 >= 2 ^ 20 Then\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum, Text\r
+ Else\r
+ Text = String(MpqHeader - bNum + 1, Chr(0))\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum, Text\r
+ End If\r
+Next bNum\r
+Close #fNum2\r
+Close #fNum\r
+Cancel:\r
+FileDialog.FileName = OldFileName\r
+End Sub\r
+Private Sub cmdSaveMPQ_Click()\r
+Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long\r
+FileDialog.Flags = &H1000 Or &H4 Or &H2\r
+FileDialog.Filter = "MPQ Archive (*.mpq)|*.mpq"\r
+FileDialog.DefaultExt = "mpq"\r
+OldFileName = FileDialog.FileName\r
+FileDialog.FileName = FileDialog.FileName + ".mpq"\r
+FileDialog.hwndOwner = hWnd\r
+If ShowSave(FileDialog) = False Then GoTo Cancel\r
+fNum = FreeFile\r
+Open OldFileName For Binary As #fNum\r
+fNum2 = FreeFile\r
+If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName\r
+Open FileDialog.FileName For Binary As #fNum2\r
+For bNum = MpqHeader + 1 To LOF(fNum) Step 2 ^ 20\r
+ Text = String(2 ^ 20, Chr(0))\r
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum - MpqHeader, Text\r
+ Else\r
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))\r
+ Get #fNum, bNum, Text\r
+ Put #fNum2, bNum - MpqHeader, Text\r
+ End If\r
+Next bNum\r
+Close #fNum2\r
+Close #fNum\r
+Cancel:\r
+FileDialog.FileName = OldFileName\r
+End Sub\r
+\r
+Private Sub Form_Load()\r
+FileDialog = CD\r
+End Sub\r
+Private Sub mnuFExit_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub mnuFOpen_Click()\r
+Dim OldFileName As String, OldMpqHeader As Long, fNum As Long, Text As String\r
+FileDialog.Flags = &H1000 Or &H4 Or &H2\r
+FileDialog.Filter = "All Files (*.*)|*.*"\r
+OldFileName = FileDialog.FileName\r
+OldMpqHeader = MpqHeader\r
+FileDialog.hwndOwner = hWnd\r
+If ShowOpen(FileDialog) = False Then GoTo Cancel\r
+If FileLen(FileDialog.FileName) = 0 Then\r
+ MsgBox "This is an empty file.", vbExclamation, "MPQ Embedder"\r
+ GoTo Cancel\r
+End If\r
+fNum = FreeFile\r
+Open FileDialog.FileName For Binary As #fNum\r
+Text = String(2, Chr(0))\r
+If LOF(fNum) >= 2 Then Get #fNum, 1, Text\r
+Close #fNum\r
+If Text = "MZ" Then IsEXE = True Else IsEXE = False\r
+If IsEXE Then mnuRun.Enabled = True Else mnuRun.Enabled = False\r
+MpqHeader = FindMpqHeader(FileDialog.FileName)\r
+If MpqHeader <= -1 Then\r
+ cmdAdd.Enabled = True\r
+ cmdRemove.Enabled = False\r
+ cmdSaveMPQ.Enabled = False\r
+ cmdSaveEXE.Enabled = True\r
+ MpqHeader = FileLen(FileDialog.FileName)\r
+ Label1.Caption = "This file does not contain an MPQ archive."\r
+ElseIf MpqHeader = 0 Then\r
+ cmdAdd.Enabled = False\r
+ cmdRemove.Enabled = False\r
+ cmdSaveMPQ.Enabled = True\r
+ cmdSaveEXE.Enabled = False\r
+ Label1.Caption = "This file is an MPQ archive."\r
+ElseIf MpqHeader > 0 Then\r
+ cmdAdd.Enabled = False\r
+ cmdRemove.Enabled = True\r
+ cmdSaveMPQ.Enabled = True\r
+ cmdSaveEXE.Enabled = True\r
+ If MpqHeader / 512 = Int(MpqHeader / 512) Then\r
+ Label1.Caption = "This file contains an MPQ archive."\r
+ Else\r
+ Label1.Caption = "This file contains an MPQ archive, but other programs may be unable to read it."\r
+ End If\r
+End If\r
+Exit Sub\r
+Cancel:\r
+FileDialog.FileName = OldFileName\r
+MpqHeader = OldMpqHeader\r
+End Sub\r
+Private Sub mnuHAbout_Click()\r
+About.Show 1\r
+End Sub\r
+Private Sub mnuHReadme_Click()\r
+Dim Path As String\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+If Dir(Path + "WMpqEmbed.rtf") = "" Then MsgBox "Could not find WMpqEmbed.rtf!", vbCritical, "MPQ Embedder"\r
+ShellExecute hWnd, vbNullString, Path + "WMpqEmbed.rtf", vbNullString, vbNullString, 1\r
+End Sub\r
+Private Sub mnuRun_Click()\r
+On Error GoTo NotExecutable\r
+Shell FileDialog.FileName, 1\r
+Exit Sub\r
+NotExecutable:\r
+MsgBox "This file is not a .exe file.", vbInformation, "MPQ Embedder"\r
+End Sub\r
diff --git a/listing.frm b/listing.frm
--- a/listing.frm
+++ b/listing.frm
-VERSION 4.00
-Begin VB.Form MpqEx
- Caption = "WinMPQ"
- ClientHeight = 3510
- ClientLeft = 1245
- ClientTop = 1785
- ClientWidth = 6690
- Height = 4200
- Icon = "listing.frx":0000
- KeyPreview = -1 'True
- Left = 1185
- LinkTopic = "Form1"
- ScaleHeight = 3510
- ScaleWidth = 6690
- Top = 1155
- Width = 6810
- Begin VB.Timer Timer1
- Enabled = 0 'False
- Interval = 2500
- Left = 6120
- Top = 2160
- End
- Begin VB.TextBox txtCommand
- BackColor = &H8000000F&
- Height = 285
- Left = 1440
- TabIndex = 1
- Top = 2880
- Width = 4695
- End
- Begin VB.CommandButton cmdGo
- Caption = "Go"
- Height = 285
- Left = 6120
- TabIndex = 2
- Top = 2880
- Width = 495
- End
- Begin VB.ComboBox mFilter
- Height = 315
- ItemData = "listing.frx":27A2
- Left = 5220
- List = "listing.frx":27A9
- Sorted = -1 'True
- TabIndex = 3
- Text = "*"
- Top = 30
- Width = 675
- End
- Begin MSComctlLib.Toolbar Toolbar
- Align = 1 'Align Top
- Height = 345
- Left = 0
- TabIndex = 5
- Top = 0
- Width = 6690
- _ExtentX = 11800
- _ExtentY = 609
- ButtonWidth = 1561
- ButtonHeight = 556
- Wrappable = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 8
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "New"
- Key = "New"
- Description = "Create a new archive"
- ToolTipText = "Create a new archive"
- ImageIndex = 1
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "Open"
- Key = "Open"
- Description = "Open an existing archive"
- ToolTipText = "Open an existing archive"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "Add"
- Key = "Add"
- Description = "Add files to the archive"
- ToolTipText = "Add files to the archive"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "Add Folder"
- Key = "Add Folder"
- Description = "Add files from a folder and its subfolders"
- ToolTipText = "Add files from a folder and its subfolders"
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "Extract"
- Key = "Extract"
- Description = "Extract files from the archive"
- ToolTipText = "Extract files from the archive"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "Compact"
- Key = "Compact"
- Description = "Clear deleted files from the archive"
- ToolTipText = "Clear deleted files from the archive"
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "filterspace"
- Style = 4
- Object.Width = 675
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Caption = "List"
- Key = "List"
- EndProperty
- EndProperty
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = " MPQ2k &Command "
- Height = 195
- Left = 0
- TabIndex = 6
- Top = 2880
- Width = 1425
- End
- Begin MSComctlLib.ImageList ImageList1
- Left = 6120
- Top = 1560
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 1
- ImageHeight = 1
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 1
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "listing.frx":27B0
- Key = ""
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.StatusBar StatBar
- Align = 2 'Align Bottom
- Height = 300
- Left = 0
- TabIndex = 4
- Top = 3210
- Width = 6690
- _ExtentX = 11800
- _ExtentY = 529
- _Version = 393216
- BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
- NumPanels = 2
- BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- AutoSize = 1
- Object.Width = 5664
- MinWidth = 2
- Key = "FileInfo"
- EndProperty
- BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- AutoSize = 1
- Object.Width = 5664
- MinWidth = 2
- Key = "MpqInfo"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ListView List
- Height = 2295
- Left = 0
- TabIndex = 0
- Top = 360
- Width = 6015
- _ExtentX = 10610
- _ExtentY = 4048
- View = 3
- Arrange = 2
- Sorted = -1 'True
- MultiSelect = -1 'True
- LabelWrap = -1 'True
- HideSelection = -1 'True
- OLEDragMode = 1
- OLEDropMode = 1
- AllowReorder = -1 'True
- _Version = 393217
- ForeColor = -2147483640
- BackColor = -2147483643
- BorderStyle = 1
- Appearance = 1
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- OLEDragMode = 1
- OLEDropMode = 1
- NumItems = 6
- BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- Key = "N"
- Text = "Name"
- Object.Width = 5080
- EndProperty
- BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- Alignment = 1
- SubItemIndex = 1
- Key = "S"
- Text = "Size"
- Object.Width = 1905
- EndProperty
- BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- Alignment = 1
- SubItemIndex = 2
- Key = "R"
- Text = "Ratio"
- Object.Width = 1129
- EndProperty
- BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- Alignment = 1
- SubItemIndex = 3
- Key = "PK"
- Text = "Packed"
- Object.Width = 1905
- EndProperty
- BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- SubItemIndex = 4
- Key = "LCID"
- Text = "Locale ID"
- Object.Width = 1129
- EndProperty
- BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
- SubItemIndex = 5
- Key = "A"
- Text = "Attributes"
- Object.Width = 1129
- EndProperty
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFNew
- Caption = "&New..."
- Shortcut = ^N
- End
- Begin VB.Menu mnuFOpen
- Caption = "&Open..."
- Shortcut = ^O
- End
- Begin VB.Menu mnuFReopen
- Caption = "&Reopen Mpq"
- Shortcut = {F5}
- End
- Begin VB.Menu mnuFScript
- Caption = "Run Mo'PaQ 2000 &Script..."
- Shortcut = ^S
- End
- Begin VB.Menu mnuFSep
- Caption = "-"
- End
- Begin VB.Menu mnuFExit
- Caption = "E&xit"
- End
- Begin VB.Menu mnuFRecent
- Caption = "-"
- Index = 0
- Visible = 0 'False
- End
- End
- Begin VB.Menu mnuMpq
- Caption = "&Mpq"
- Enabled = 0 'False
- Begin VB.Menu mnuMItem
- Caption = "&Open"
- Index = 0
- Visible = 0 'False
- End
- Begin VB.Menu mnuMSep1
- Caption = "-"
- Visible = 0 'False
- End
- Begin VB.Menu mnuMExtract
- Caption = "&Extract"
- Shortcut = ^E
- End
- Begin VB.Menu mnuMDelete
- Caption = "&Delete Del or"
- Shortcut = ^D
- End
- Begin VB.Menu mnuMRename
- Caption = "Rena&me"
- Shortcut = ^R
- End
- Begin VB.Menu mnuMChLCID
- Caption = "Change Locale &ID..."
- Shortcut = ^I
- End
- Begin VB.Menu mnuMSep2
- Caption = "-"
- End
- Begin VB.Menu mnuMAdd
- Caption = "&Add..."
- Shortcut = ^{INSERT}
- End
- Begin VB.Menu mnuMAddFolder
- Caption = "Add &Folder..."
- Shortcut = ^F
- End
- Begin VB.Menu mnuMCompression
- Caption = "&Compression"
- Begin VB.Menu mnuMCAuto
- Caption = "Auto-Select"
- Checked = -1 'True
- Shortcut = {F4}
- End
- Begin VB.Menu mnuMCSep
- Caption = "-"
- End
- Begin VB.Menu mnuMCNone
- Caption = "&None"
- Shortcut = {F2}
- End
- Begin VB.Menu mnuMCStandard
- Caption = "&Standard"
- Shortcut = {F3}
- End
- Begin VB.Menu mnuMCDeflate
- Caption = "&Deflate"
- Shortcut = {F9}
- End
- Begin VB.Menu mnuMCBzip2
- Caption = "&Bzip2"
- Shortcut = ^{F11}
- End
- Begin VB.Menu mnuMCAudio
- Caption = "&Audio"
- Begin VB.Menu mnuMCALowest
- Caption = "&Lowest (Best quality)"
- Shortcut = {F6}
- End
- Begin VB.Menu mnuMCAMedium
- Caption = "&Medium"
- Shortcut = {F7}
- End
- Begin VB.Menu mnuMCAHighest
- Caption = "&Highest (Least space)"
- Shortcut = {F8}
- End
- End
- End
- Begin VB.Menu mnuMEncrypt
- Caption = "Encr&ypt Files"
- End
- Begin VB.Menu mnuMCompact
- Caption = "Com&pact"
- Shortcut = ^P
- End
- Begin VB.Menu mnuMAddToList
- Caption = "Add File to Li&sting..."
- Shortcut = ^K
- End
- Begin VB.Menu mnuMSaveList
- Caption = "Save File &List..."
- Shortcut = ^L
- End
- End
- Begin VB.Menu mnuTools
- Caption = "&Tools"
- Begin VB.Menu mnuTItem
- Caption = "(Empty)"
- Enabled = 0 'False
- Index = 0
- End
- Begin VB.Menu mnuTSep
- Caption = "-"
- End
- Begin VB.Menu mnuTMpqEmbed
- Caption = "MPQ Embedder"
- End
- Begin VB.Menu mnuTSep2
- Caption = "-"
- End
- Begin VB.Menu mnuTAdd
- Caption = "&Add/Remove..."
- End
- End
- Begin VB.Menu mnuOptions
- Caption = "&Options..."
- End
- Begin VB.Menu mnuHelp
- Caption = "&Help"
- Begin VB.Menu mnuHReadme
- Caption = "View &Readme..."
- Shortcut = {F1}
- End
- Begin VB.Menu mnuHSep
- Caption = "-"
- End
- Begin VB.Menu mnuHAbout
- Caption = "&About..."
- End
- End
- Begin VB.Menu mnuPopup
- Caption = "Popup Menu"
- Visible = 0 'False
- Begin VB.Menu mnuPItem
- Caption = "&Open"
- Index = 0
- End
- Begin VB.Menu mnuPSep1
- Caption = "-"
- End
- Begin VB.Menu mnuPTools
- Caption = "&Tools"
- Begin VB.Menu mnuPTItem
- Caption = "(Empty)"
- Index = 0
- End
- End
- Begin VB.Menu mnuPSep2
- Caption = "-"
- End
- Begin VB.Menu mnuPExtract
- Caption = "&Extract"
- End
- Begin VB.Menu mnuPDelete
- Caption = "&Delete"
- End
- Begin VB.Menu mnuPRename
- Caption = "Rena&me"
- End
- Begin VB.Menu mnuPChLCID
- Caption = "Change Locale &ID..."
- End
- End
-End
-Attribute VB_Name = "MpqEx"
-Attribute VB_Creatable = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Dim txtCommandHasFocus As Boolean, ShiftState As Boolean
-Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date
-Sub AddRecentFile(rFileName As String)
-Dim bNum As Long, fNum As Long
-NewKey AppKey + "Recent\"
-For bNum = 1 To 8
- If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
- For fNum = bNum To 7
- If Not IsEmpty(GetReg(AppKey + "Recent\File" + CStr(fNum + 1))) Then
- SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
- Else
- Exit For
- End If
- Next fNum
- SetReg AppKey + "Recent\File" + CStr(fNum), rFileName
- Exit For
- End If
-Next bNum
-If fNum = 0 Then
- For bNum = 1 To 8
- If IsEmpty(GetReg(AppKey + "Recent\File" + CStr(bNum))) Then
- SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
- Exit For
- ElseIf bNum = 8 Then
- For fNum = 1 To 7
- SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
- Next fNum
- SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
- End If
- Next bNum
-End If
-BuildRecentFileList
-End Sub
-Sub BuildMpqActionList()
-Dim Shift As Integer
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo 0
-If List.SelectedItem.Selected = True Then
- Shift = 0
- If ShiftState = True Then Shift = vbShiftMask
- mnuMItem(0).Visible = True
- mnuMSep1.Visible = True
- BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem
-Else
- GoTo NotSelected
-End If
-Exit Sub
-NotSelected:
-Dim PItem As Menu
-For Each PItem In mnuMItem
- If PItem.Index <> 0 Then Unload PItem
-Next PItem
-mnuMItem(0).Visible = False
-mnuMSep1.Visible = False
-End Sub
-Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)
-Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String
-mnuRoot.Tag = 0
-For Each PItem In mnuItem
- If PItem.Index <> 0 Then Unload PItem
-Next PItem
-If InStr(FileName, ".") = 0 Then
- GoSub AddGlobal
-Else
- For bNum = 1 To Len(FileName)
- If InStr(bNum, FileName, ".") > 0 Then
- bNum = InStr(bNum, FileName, ".")
- Else
- Exit For
- End If
- Next bNum
- aName = Mid(FileName, bNum - 1)
- aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")
- If aName = "" Then
- GoSub AddGlobal
- Exit Sub
- End If
- dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
- dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
- If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\command\")) Then
- If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\")) Then
- mnuItem(0).Caption = "Op&en with..."
- Else
- mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
- End If
- mnuItem(0).Tag = dItem
- mnuRoot.Tag = 1
- aNum = 0
- bNum = 1
- Else
- aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)
- If aItem = "" Then
- GoSub AddGlobal
- Exit Sub
- End If
- If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
- If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
- mnuItem(0).Caption = "Op&en with..."
- Else
- mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
- End If
- mnuItem(0).Tag = aItem
- mnuRoot.Tag = 1
- aNum = 1
- bNum = 1
- Else
- aNum = 1
- bNum = 0
- End If
- End If
- Do
- aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
- If aItem <> "" Then
- If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\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\" + aName + "\shell\" + aItem + "\")) Then
- mnuItem(bNum).Caption = "Op&en with..."
- Else
- mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\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 = ""
- 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
- dItem = ""
- If bNum = 0 Then
- dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")
- dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)
- If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then
- If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then
- mnuItem(bNum).Caption = "Op&en with..."
- Else
- mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
- End If
- mnuItem(bNum).Tag = dItem
- bNum = bNum + 1
- End If
- End If
- Do
- aItem = EnumKey("HKEY_CLASSES_ROOT\Unknown\shell\", aNum)
- If aItem <> "" Then
- If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\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\Unknown\shell\" + aItem + "\")) Then
- mnuItem(bNum).Caption = "Op&en with..."
- Else
- mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
- End If
- mnuItem(bNum).Tag = aItem
- bNum = bNum + 1
- End If
- aNum = aNum + 1
- End If
- Loop Until aItem = ""
-Return
-End Sub
-Sub ChangeLCID(NewLCID As Long)
-Dim fNum As Long, hMPQ As Long
-fNum = 1
-hMPQ = mOpenMpq(CD.FileName)
-If hMPQ Then
- Do While fNum <= List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Changing locale ID of " + List.ListItems.Item(fNum).Tag + " to " + CStr(NewLCID) + "..."
- MousePointer = 11
- MpqSetFileLocale hMPQ, List.ListItems.Item(fNum).Tag, List.ListItems.Item(fNum).ListSubItems(4).Tag, NewLCID
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- List.ListItems.Item(fNum).ListSubItems(4).Tag = NewLCID
- List.ListItems.Item(fNum).ListSubItems(4).Text = NewLCID
- End If
- fNum = fNum + 1
- Loop
- MpqCloseUpdatedArchive hMPQ, 0
-End If
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-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 mnuMCBzip2.Checked Then
- MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
- 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
- If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
- For fNum = bNum To 7
- SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
- Next fNum
- DelReg AppKey + "Recent\File" + CStr(8)
- Exit For
- End If
-Next bNum
-BuildRecentFileList
-End Sub
-Sub AddToListing(AddedFile As String)
-Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, hFile As Long
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
- L1 = AddedFile
- fSize = SFileGetFileSize(hFile, 0)
- cSize = SFileGetFileInfo(hFile, 6)
- If fSize / 1024 > 0 And fSize / 1024 < 1 Then
- L2 = "<1KB"
- ElseIf fSize = 0 Then
- L2 = "0KB"
- Else
- L2 = CStr(Int(fSize / 1024)) + "KB"
- End If
- If cSize / 1024 > 0 And cSize / 1024 < 1 Then
- L4 = "<1KB"
- ElseIf cSize = 0 Then
- L4 = "0KB"
- Else
- L4 = CStr(Int(cSize / 1024)) + "KB"
- End If
- If fSize <> 0 Then
- L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
- Else
- L3 = "0%"
- End If
- fFlags = SFileGetFileInfo(hFile, 7)
- L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
- If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
- If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
- If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
- On Error Resume Next
- lIndex = List.ListItems.Add(, L1, L1).Index
- On Error GoTo 0
- If lIndex = 0 Then
- lIndex = List.ListItems.Item(L1).Index
- List.ListItems.Item(L1).ListSubItems.Clear
- End If
- List.ListItems.Item(lIndex).Tag = L1
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
- If fSize <> 0 Then
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
- Else
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
- End If
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
- SFileCloseFile hFile
- End If
- SFileCloseArchive hMPQ
-End If
-End Sub
-Sub FileActionClick(mnuRoot As Menu, mnuItem, Index As Integer)
-Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Path = Path + "Temp_extract\"
-If ExtractPathNum = -1 Then
- fNum = 0
- Do
- If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
- fNum = fNum + 1
- Loop
- ExtractPathNum = fNum
-End If
-Path = Path + CStr(ExtractPathNum) + "\"
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
- For bNum = 1 To UBound(OpenFiles)
- If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
- AlreadyInList = True
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- Exit For
- End If
- Next bNum
- If AlreadyInList = False Then
- ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
- OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- End If
- End If
- StatBar.Style = 1
- StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
- fName = List.ListItems.Item(fNum).Tag
- ExecuteFile Path + fName, Index, mnuRoot, mnuItem
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
- End If
-Next fNum
-SFileCloseArchive hMPQ
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-End Sub
-Sub MpqAddToListing(hMPQ As Long, AddedFile As String)
-Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hFile As Long
-If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
- L1 = AddedFile
- fSize = SFileGetFileSize(hFile, 0)
- cSize = SFileGetFileInfo(hFile, 6)
- If fSize / 1024 > 0 And fSize / 1024 < 1 Then
- L2 = "<1KB"
- ElseIf fSize = 0 Then
- L2 = "0KB"
- Else
- L2 = CStr(Int(fSize / 1024)) + "KB"
- End If
- If cSize / 1024 > 0 And cSize / 1024 < 1 Then
- L4 = "<1KB"
- ElseIf cSize = 0 Then
- L4 = "0KB"
- Else
- L4 = CStr(Int(cSize / 1024)) + "KB"
- End If
- If fSize <> 0 Then
- L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
- Else
- L3 = "0%"
- End If
- fFlags = SFileGetFileInfo(hFile, 7)
- L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
- If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
- If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
- If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
- On Error Resume Next
- lIndex = List.ListItems.Add(, L1, L1).Index
- On Error GoTo 0
- If lIndex = 0 Then
- lIndex = List.ListItems.Item(L1).Index
- List.ListItems.Item(L1).ListSubItems.Clear
- End If
- List.ListItems.Item(lIndex).Tag = L1
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
- If fSize <> 0 Then
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
- Else
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
- End If
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
- SFileCloseFile hFile
-End If
-End Sub
-Sub RemoveFromListing(RemovedFile As String)
-Dim FileCount As Long
-On Error GoTo FileRemoved
-Do
-List.ListItems.Remove RemovedFile
-FileCount = FileCount + 1
-Loop
-FileRemoved:
-If FileCount = 0 Then
- For FileCount = 1 To List.ListItems.Count
- If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then
- List.ListItems.Remove FileCount
- Exit Sub
- End If
- Next FileCount
-End If
-End Sub
-Sub RenameInListing(OldName As String, NewName As String)
-Dim lIndex As Long
-If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName
-On Error GoTo RenameError
-lIndex = List.ListItems.Item(OldName).Index
-List.ListItems.Item(lIndex).Text = NewName
-List.ListItems.Item(lIndex).Tag = NewName
-On Error Resume Next
-List.ListItems.Item(lIndex).Key = NewName
-On Error GoTo 0
-Exit Sub
-RenameError:
-For lIndex = 1 To List.ListItems.Count
- If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then
- List.ListItems.Item(lIndex).Text = NewName
- List.ListItems.Item(lIndex).Tag = NewName
- On Error Resume Next
- List.ListItems.Item(lIndex).Key = NewName
- On Error GoTo 0
- Exit Sub
- End If
-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, 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
-CurPath = CurDir
-If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
-sLine = CmdLine
-If Right(sLine, 1) <> " " Then sLine = sLine + " "
-If sLine <> "" Then
- ReDim Param(0) As String
- For pNum = 1 To Len(sLine)
- If Mid(sLine, pNum, 1) = Chr(34) Then
- pNum = pNum + 1
- EndParam = InStr(pNum, sLine, Chr(34))
- Else
- EndParam = InStr(pNum, sLine, " ")
- End If
- If EndParam = 0 Then EndParam = Len(sLine) + 1
- If pNum <> EndParam Then
- If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
- ReDim Preserve Param(UBound(Param) + 1) As String
- Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
- End If
- End If
- pNum = EndParam
- Next pNum
- If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
- Select Case LCase(Param(1))
- Case "?", "h", "help"
- mnuHReadme_Click
- Case "o", "open"
- OldFileName = CD.FileName
- If Param(2) <> "" Then
- CD.FileName = FullPath(CurPath, Param(2))
- End If
- If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then
- DefaultMaxFiles = Param(3)
- End If
- If FileExists(CD.FileName) Then
- OpenMpq
- If CD.FileName = "" Then
- CD.FileName = OldFileName
- StatBar.SimpleText = "The file does not contain an MPQ archive."
- Else
- StatBar.SimpleText = "Opened " + CD.FileName
- AddRecentFile CD.FileName
- End If
- ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then
- ReDim FileList(0) As String
- List.ListItems.Clear
- ShowSelected
- ShowTotal
- NewFile = True
- ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
- mnuMpq.Enabled = True
- For Each TItem In mnuTItem
- TItem.Enabled = True
- Next TItem
- Toolbar.Buttons.Item("Add").Enabled = True
- Toolbar.Buttons.Item("Add Folder").Enabled = True
- Toolbar.Buttons.Item("Extract").Enabled = True
- Toolbar.Buttons.Item("Compact").Enabled = True
- Toolbar.Buttons.Item("List").Enabled = True
- If InStr(CD.FileName, "\") > 0 Then
- For bNum = 1 To Len(CD.FileName)
- If InStr(bNum, CD.FileName, "\") > 0 Then
- bNum = InStr(bNum, CD.FileName, "\")
- Else
- Exit For
- End If
- Next bNum
- End If
- Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
- StatBar.SimpleText = "Created new " + CD.FileName
- AddRecentFile CD.FileName
- ElseIf CD.FileName = "" Then
- StatBar.SimpleText = "Required parameter missing"
- End If
- Case "n", "new"
- If Param(2) <> "" Then
- CD.FileName = FullPath(CurPath, Param(2))
- If Param(3) <> "" Then
- DefaultMaxFiles = Param(3)
- End If
- If CD.FileName <> "" Then
- ReDim FileList(0) As String
- List.ListItems.Clear
- ShowSelected
- ShowTotal
- NewFile = True
- ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
- mnuMpq.Enabled = True
- For Each TItem In mnuTItem
- TItem.Enabled = True
- Next TItem
- Toolbar.Buttons.Item("Add").Enabled = True
- Toolbar.Buttons.Item("Add Folder").Enabled = True
- Toolbar.Buttons.Item("Extract").Enabled = True
- Toolbar.Buttons.Item("Compact").Enabled = True
- Toolbar.Buttons.Item("List").Enabled = True
- If InStr(CD.FileName, "\") > 0 Then
- For bNum = 1 To Len(CD.FileName)
- If InStr(bNum, CD.FileName, "\") > 0 Then
- bNum = InStr(bNum, CD.FileName, "\")
- Else
- Exit For
- End If
- Next bNum
- End If
- Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
- StatBar.SimpleText = "Created new " + CD.FileName
- AddRecentFile CD.FileName
- End If
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Case "c", "close"
- StatBar.SimpleText = "Close is for scripts only"
- Case "p", "pause"
- StatBar.SimpleText = "Pause not supported"
- Case "a", "add"
- If CD.FileName <> "" Then
- ReDim FileShortNames(0) As String
- cType = 0
- Rswitch = False
- fCount = 0
- Files = ""
- fEndLine = 0
- fLine = ""
- dwFlags = MAFA_REPLACE_EXISTING
- If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
- For pNum = 3 To UBound(Param)
- If LCase(Param(pNum)) = "/wav" Then
- cType = 2
- dwFlags = dwFlags Or MAFA_COMPRESS
- ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
- cType = 1
- dwFlags = dwFlags Or MAFA_COMPRESS
- ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
- cType = -1
- ElseIf LCase(Param(pNum)) = "/r" Then
- Rswitch = True
- End If
- Next pNum
- If Left(Param(3), 1) = "/" Or Param(3) = "" Then
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- Param(3) = ""
- Else
- Param(3) = Param(2)
- End If
- End If
- If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
- If InStr(Param(2), "\") > 0 Then
- For pNum = 1 To Len(Param(2))
- If InStr(pNum, Param(2), "\") > 0 Then
- pNum = InStr(pNum, Param(2), "\")
- Files = Left(Param(2), pNum)
- End If
- Next pNum
- End If
- MousePointer = 11
- If NewFile = True Then
- If FileExists(CD.FileName) Then Kill CD.FileName
- NewFile = False
- End If
- Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
- List.Sorted = False
- FileFilter = mFilter
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ = 0 Then
- StatBar.SimpleText = "Can't create archive " + CD.FileName
- Exit Sub
- End If
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- If cType = 0 Then
- StatBar.SimpleText = "Adding " + fLine + "..."
- ElseIf cType = 1 Then
- StatBar.SimpleText = "Adding compressed " + fLine + "..."
- ElseIf cType = 2 Then
- StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."
- ElseIf cType = -1 Then
- StatBar.SimpleText = "Adding " + fLine + " (compression auto-select)..."
- End If
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
- If cType = 2 Then
- MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
- ElseIf cType = -1 Then
- mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
- ElseIf cType = 1 Then
- If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0
- End If
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- mFilter.AddItem "*" + GetExtension(Param(3) + fLine)
- For cNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
- mFilter.RemoveItem cNum
- Exit For
- End If
- Next cNum
- If MatchesFilter(Param(3) + fLine, FileFilter) Then
- ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
- FileShortNames(UBound(FileShortNames)) = Param(3) + fLine
- End If
- Else
- If cType = 2 Then
- MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
- ElseIf cType = -1 Then
- mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
- ElseIf cType = 1 Then
- If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0
- End If
- Else
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- mFilter.AddItem "*" + GetExtension(Param(3))
- For cNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
- mFilter.RemoveItem cNum
- Exit For
- End If
- Next cNum
- If MatchesFilter(Param(3), FileFilter) Then
- ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
- FileShortNames(UBound(FileShortNames)) = Param(3)
- End If
- End If
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- MpqCloseUpdatedArchive hMPQ, 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- If UBound(FileShortNames) > 1 Then
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- StatBar.SimpleText = "Adding files to listing... 0% complete"
- For pNum = 1 To UBound(FileShortNames)
- If MatchesFilter(FileShortNames(pNum), FileFilter) Then
- MpqAddToListing hMPQ, FileShortNames(pNum)
- End If
- On Error Resume Next
- StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"
- On Error GoTo 0
- Next pNum
- SFileCloseArchive hMPQ
- End If
- ElseIf UBound(FileShortNames) = 1 Then
- AddToListing FileShortNames(1)
- End If
- MousePointer = 0
- If MatchesFilter("(listfile)", FileFilter) Then
- AddToListing "(listfile)"
- End If
- mFilter = FileFilter
- List.Sorted = True
- RemoveDuplicates
- ShowTotal
- If fCount > 1 Then
- StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"
- End If
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "e", "extract"
- If CD.FileName <> "" Then
- If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Extracting " + Param(2) + "..."
- cType = 0
- For pNum = 3 To UBound(Param)
- If LCase(Param(pNum)) = "/fp" Then
- cType = 1
- Exit For
- End If
- Next pNum
- If Left(Param(3), 1) = "/" Then Param(3) = ""
- If Param(3) = "" Then Param(3) = "."
- If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
- MousePointer = 11
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- Files = MpqDir(CD.FileName, Param(2))
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
- StatBar.SimpleText = "Can't open archive " + CD.FileName
- Exit Sub
- End If
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- StatBar.SimpleText = "Extracting " + fLine + "..."
- sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- SFileCloseArchive hMPQ
- If fCount > 1 Then
- StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"
- End If
- Else
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
- StatBar.SimpleText = "Can't open archive " + CD.FileName
- Exit Sub
- End If
- sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
- SFileCloseArchive hMPQ
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- End If
- MousePointer = 0
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "r", "ren", "rename"
- If CD.FileName <> "" Then
- If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."
- If Param(2) <> "" And Param(3) <> "" Then
- If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
- If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then
- Files = MpqDir(CD.FileName, Param(2))
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
- StatBar.SimpleText = "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
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing fLine, fLine2
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- MpqCloseUpdatedArchive hMPQ, 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- End If
- If fCount > 1 Then
- StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"
- End If
- Else
- StatBar.SimpleText = "You must use wildcards with new name"
- End If
- Else
- hMPQ = mOpenMpq(CD.FileName)
- 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
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing Param(2), Param(3)
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- End If
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "m", "move"
- If CD.FileName <> "" Then
- For pNum = 1 To Len(Param(2))
- If InStr(pNum, Param(2), "\") Then
- pNum = InStr(pNum, Param(2), "\")
- Else
- Exit For
- End If
- Next pNum
- fLineTitle = Mid(Param(2), pNum)
- 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 StatBar.SimpleText = "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(CD.FileName, Param(2))
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
- StatBar.SimpleText = "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
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing fLine, fLine2
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- MpqCloseUpdatedArchive hMPQ, 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- End If
- If fCount > 1 Then
- StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"
- End If
- Else
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
- SFileCloseFile hFile
- MpqDeleteFile hFile, Param(3)
- MpqRenameFile hFile, Param(2), Param(3)
- Else
- MpqRenameFile hFile, Param(2), Param(3)
- End If
- MpqCloseUpdatedArchive hMPQ, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing Param(2), Param(3)
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- End If
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "d", "del", "delete"
- If CD.FileName <> "" Then
- If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "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(CD.FileName, Param(2))
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- StatBar.SimpleText = "Deleting " + fLine + "..."
- MpqDeleteFile hMPQ, fLine
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RemoveFromListing fLine
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
- MpqCloseUpdatedArchive hMPQ, 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- End If
- If fCount > 1 Then
- StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
- End If
- Else
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- MpqDeleteFile hMPQ, Param(2)
- MpqCloseUpdatedArchive hMPQ, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RemoveFromListing Param(2)
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- End If
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "f", "flush", "compact"
- If CD.FileName <> "" Then
- MousePointer = 11
- StatBar.SimpleText = "Flushing " + CD.FileName + "..."
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- MpqCompactArchive hMPQ
- MpqCloseUpdatedArchive hMPQ, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- MousePointer = 0
- OpenMpq
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "l", "list"
- If CD.FileName <> "" Then
- If Param(2) <> "" Then
- StatBar.SimpleText = "Creating list..."
- MousePointer = 11
- If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
- Files = MpqDir(CD.FileName, Param(2))
- Param(2) = Param(3)
- Else
- Files = MpqDir(CD.FileName, "*")
- End If
- fNum = FreeFile
- Open FullPath(CurPath, Param(2)) For Binary As #fNum
- Put #fNum, 1, Files
- Close #fNum
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- MousePointer = 0
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Else
- StatBar.SimpleText = "No archive open"
- End If
- Case "s", "script"
- StatBar.SimpleText = "Running script " + Param(2) + "..."
- If Param(2) <> "" Then
- MousePointer = 11
- RunScript FullPath(CurPath, Param(2))
- MousePointer = 0
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- Else
- StatBar.SimpleText = "Required parameter missing"
- End If
- Case "x", "exit", "quit"
- Unload Me
- 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
- txtCommand_GotFocus
- 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
- txtCommand_GotFocus
- 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
- txtCommand_GotFocus
- 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
- txtCommand_GotFocus
- Else
- Shell "command.com /k " + sLine, 1
- End If
- End If
- End Select
-End If
-End Sub
-Sub BuildRecentFileList()
-Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu
-For Each RItem In mnuFRecent
- If RItem.Index <> 0 Then Unload RItem
-Next RItem
-rNum2 = 1
-For rNum = 8 To 1 Step -1
- RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))
- If FileExists(RecentFile) Then
- mnuFRecent(0).Visible = True
- On Error Resume Next
- Load mnuFRecent(rNum2)
- On Error GoTo 0
- mnuFRecent(rNum2).Tag = RecentFile
- If TextWidth(RecentFile) > TextWidth("________________________________") Then
- FirstSep = InStr(RecentFile, "\")
- If FirstSep > 0 Then
- For LastSep = FirstSep + 1 To Len(RecentFile)
- If InStr(LastSep, RecentFile, "\") > 0 Then
- LastSep = InStr(LastSep, RecentFile, "\")
- Else
- Exit For
- End If
- Next LastSep
- RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)
- End If
- End If
- mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile
- rNum2 = rNum2 + 1
- End If
- If rNum2 > 4 Then Exit For
-Next rNum
-End Sub
-Sub BuildToolsList()
-Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu
-For Each TItem In mnuTItem
- If TItem.Index <> 0 Then Unload TItem
-Next TItem
-For Each TItem In mnuPTItem
- If TItem.Index <> 0 Then Unload TItem
-Next TItem
-mnuTItem(0).Caption = "(Empty)"
-mnuPTItem(0).Caption = mnuTItem(0).Caption
-mnuTItem(0).Tag = ""
-mnuPTItem(0).Tag = ""
-Do
- ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
- ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
- If ToolName = "" Then ToolName = ToolCommand
- If ToolName <> "" Then
- On Error Resume Next
- Load mnuTItem(tNum)
- Load mnuPTItem(tNum)
- On Error GoTo 0
- mnuTItem(tNum).Tag = ToolCommand
- mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag
- If InStr(ToolName, "&") = 0 And tNum < 9 Then
- mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName
- ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then
- mnuTItem(tNum).Caption = "&0 " + ToolName
- Else
- mnuTItem(tNum).Caption = ToolName
- End If
- mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption
- End If
- tNum = tNum + 1
-Loop Until ToolName = ""
-End Sub
-Sub OpenMpq()
-Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long, FileEntries() As FILELISTENTRY
-On Error Resume Next
-If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
- ReDim FileList(0) As String
- List.ListItems.Clear
- ShowSelected
- ShowTotal
- NewFile = True
- On Error GoTo 0
- 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"
- Exit Sub
-End If
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
- CD.FileName = ""
- MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"
- Exit Sub
-End If
-StatBar.Style = 1
-StatBar.SimpleText = "Loading list..."
-MousePointer = 11
-Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
-ReDim FileList(0) As String
-#If InternalListing Then
-FileList(0) = "(listfile)"
-If Mpq.FileExists(CD.FileName, "(listfile)") Then
- FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)
-#Else
- sListFiles CD.FileName, hMPQ, ListFile, FileEntries
-#End If
- For bNum = 1 To Len(FileCont)
- If InStr(bNum, FileCont, vbCrLf) > 0 Then
- ReDim Preserve FileList(UBound(FileList) + 1) As String
- FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)
- bNum = InStr(bNum, FileCont, vbCrLf) + 1
- Else
- ReDim Preserve FileList(UBound(FileList) + 1) As String
- FileList(UBound(FileList)) = Mid(FileCont, bNum)
- Exit For
- End If
- Next bNum
-#If InternalListing Then
-End If
-nFiles = UBound(FileList)
-ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String
-For bNum = nFiles + 1 To UBound(FileList)
- FileList(bNum) = GlobalFileList(bNum - nFiles)
-Next bNum
-#End If
-Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long
-SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&
-List.ListItems.Clear
-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
-#End If
- If FileEntries(fNum).dwFileExists Then
- MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)
- StripNull MpqFileName
- mFilter.AddItem "*" + GetExtension(MpqFileName)
- For bNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then
- mFilter.RemoveItem bNum
- Exit For
- End If
- Next bNum
- If MatchesFilter(MpqFileName, FileFilter) Then
- L1 = MpqFileName
- fSize = FileEntries(fNum).dwFullSize
- cSize = FileEntries(fNum).dwCompressedSize
- If fSize / 1024 > 0 And fSize / 1024 < 1 Then
- L2 = "<1KB"
- ElseIf fSize = 0 Then
- L2 = "0KB"
- Else
- L2 = CStr(Int(fSize / 1024)) + "KB"
- End If
- If cSize / 1024 > 0 And cSize / 1024 < 1 Then
- L4 = "<1KB"
- ElseIf cSize = 0 Then
- L4 = "0KB"
- Else
- L4 = CStr(Int(cSize / 1024)) + "KB"
- End If
- If fSize <> 0 Then
- L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
- Else
- L3 = "0%"
- End If
- fFlags = FileEntries(fNum).dwFlags
- L6 = CStr(FileEntries(fNum).lcLocale)
- If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
- If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
- If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
- lIndex = 0
- On Error Resume Next
- lIndex = List.ListItems.Add(, , L1).Index
- On Error GoTo 0
- If lIndex = 0 Then
- lIndex = List.ListItems.Item(L1).Index
- List.ListItems.Item(L1).ListSubItems.Clear
- End If
- List.ListItems.Item(lIndex).Tag = L1
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
- If fSize <> 0 Then
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
- Else
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
- End If
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
- End If
- End If
-#If InternalListing Then
- End If
-#End If
- On Error Resume Next
- StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"
- On Error GoTo 0
-Next fNum
-SFileCloseArchive hMPQ
-List.Sorted = True
-'#If InternalListing Then
-RemoveDuplicates
-'#End If
-On Error Resume Next
-List.SelectedItem.Selected = False
-On Error GoTo 0
-SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&
-ShowSelected
-ShowTotal
-NewFile = False
-mFilter = FileFilter
-FileOpened:
-ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
-If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-mnuMpq.Enabled = True
-For Each TItem In mnuTItem
- TItem.Enabled = True
-Next TItem
-Toolbar.Buttons.Item("Add").Enabled = True
-Toolbar.Buttons.Item("Add Folder").Enabled = True
-Toolbar.Buttons.Item("Extract").Enabled = True
-Toolbar.Buttons.Item("Compact").Enabled = True
-Toolbar.Buttons.Item("List").Enabled = True
-StatBar.Style = 0
-StatBar.SimpleText = ""
-If InStr(CD.FileName, "\") > 0 Then
- For bNum = 1 To Len(CD.FileName)
- If InStr(bNum, CD.FileName, "\") > 0 Then
- bNum = InStr(bNum, CD.FileName, "\")
- Else
- Exit For
- End If
- Next bNum
-End If
-Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
-AddRecentFile CD.FileName
-MousePointer = 0
-End Sub
-
-Sub RemoveDuplicates()
-Dim fNum As Long
-fNum = 1
-Do While fNum <= List.ListItems.Count - 1
- If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) And List.ListItems.Item(fNum).ListSubItems(4).Tag = List.ListItems.Item(fNum + 1).ListSubItems(4).Tag Then
- List.ListItems.Remove (fNum)
- fNum = fNum - 1
- End If
- fNum = fNum + 1
-Loop
-End Sub
-Sub ShowSelected()
-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
- If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
- sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
- Else
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
- fSize = SFileGetFileSize(hFile, 0)
- SFileCloseFile hFile
- End If
- SFileCloseArchive hMPQ
- End If
- If fSize / 1024 > 0 And fSize / 1024 < 1 Then
- L2 = "<1KB"
- ElseIf fSize = 0 Then
- L2 = "0KB"
- Else
- L2 = CStr(Int(fSize / 1024)) + "KB"
- End If
- List.ListItems.Item(fNum).ListSubItems(1).Text = L2
- List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
- sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
- End If
- End If
-Next fNum
-If sSize / 1024 > 0 And sSize / 1024 < 1 Then
- StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
-ElseIf sSize = 0 Then
- StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
-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 Currency
-On Error Resume Next
-For fNum = 1 To List.ListItems.Count
- nFiles = nFiles + 1
- If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
- tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
- End If
-Next fNum
-If tSize / 1024 > 0 And tSize / 1024 < 1 Then
- StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
-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
-RunMpq2kCommand txtCommand
-txtCommand = ""
-If StatBar.SimpleText = "" Then txtCommand_GotFocus
-End Sub
-
-Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
-If KeyCode = vbKeyShift Then
- ShiftState = True
- BuildMpqActionList
-End If
-End Sub
-Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
-If KeyCode = vbKeyShift Then
- ShiftState = False
- BuildMpqActionList
-End If
-End Sub
-Private Sub Form_Load()
-Dim FileName As String, bNum As Long, CurPath As String, CurPath2 As String, CurPathType As Integer, sLine As String, Param() As String, pNum As Long, EndParam As Long, ParamCutout As String, OldStartPath As String, NewStartPath As String, ErrorText As String
-Dim Path
-Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
-NewKey AppKey
-SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
-SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
-FixIcon hWnd, 1
-InitFileDialog CD
-CD.hwndOwner = hWnd
-CD.DefaultExt = "mpq"
-CD.MaxFileSize = 5120
-InitFolderDialog PathInput
-PathInput.hwndOwner = hWnd
-PathInput.Flags = BIF_RETURNONLYFSDIRS
-ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
-ChDir App.Path
-'If Mpq.MpqInitialize = False Then
-' ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: "
-' Select Case Mpq.LastError
-' Case MPQ_ERROR_NO_STAREDIT
-' ErrorText = ErrorText + "Can't find StarEdit.exe"
-' Case MPQ_ERROR_BAD_STAREDIT
-' ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07"
-' Case MPQ_ERROR_STAREDIT_RUNNING
-' ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this"
-' Case Else
-' ErrorText = ErrorText + "Unknown"
-' End Select
-' MsgBox ErrorText
-' End
-'End If
-ExtractPathNum = -1
-CopyPathNum = -1
-OldStartPath = CurDir
-CurPath = GetReg(AppKey + "StartupPath", CurDir)
-CurPathType = GetReg(AppKey + "StartupPathType", 0)
-If CurPathType < 0 Then CurPathType = 0
-If CurPathType > 2 Then CurPathType = 2
-If CurPathType = 1 Then
- CurPath = App.Path
-End If
-CurPath2 = CurPath
-If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
-If IsDir(CurPath2) Then
- If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
- ChDir CurPath
-End If
-NewStartPath = CurDir
-On Error Resume Next
-Height = GetReg(AppKey + "Status\WindowHeight", Height)
-Left = GetReg(AppKey + "Status\WindowLeft", Left)
-Top = GetReg(AppKey + "Status\WindowTop", Top)
-Width = GetReg(AppKey + "Status\WindowWidth", Width)
-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)
-Select Case DefaultCompressID
-Case -3
-DefaultCompress = MAFA_COMPRESS_DEFLATE
-Case Else
-DefaultCompress = MAFA_COMPRESS_STANDARD
-End Select
-DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
-BuildRecentFileList
-BuildToolsList
-On Error GoTo 0
-SFileSetLocale LocaleID
-ReDim GlobalFileList(0) As String
-#If InternalListing Then
-If FileExists(ListFile) Then
- Open ListFile For Input As #1
- Do While Not EOF(1)
- ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
- Line Input #1, GlobalFileList(UBound(GlobalFileList))
- Loop
- Close #1
-End If
-#End If
-FileName = Trim(Command)
-If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
-If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
-FileName = Trim(FileName)
-If FileExists(FileName) Then
- CD.FileName = FileName
- Show
- OpenMpq
- Exit Sub
-End If
-ReDim FileList(0) As String
-If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
-sLine = Command
-If Right(sLine, 1) <> " " Then sLine = sLine + " "
-If sLine <> "" Then
- ReDim Param(0) As String
- For pNum = 1 To Len(sLine)
- If Mid(sLine, pNum, 1) = Chr(34) Then
- pNum = pNum + 1
- EndParam = InStr(pNum, sLine, Chr(34))
- If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
- Else
- EndParam = InStr(pNum, sLine, " ")
- If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
- End If
- If EndParam = 0 Then EndParam = Len(sLine) + 1
- If pNum <> EndParam Then
- If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
- ReDim Preserve Param(UBound(Param) + 1) As String
- Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
- End If
- End If
- pNum = EndParam
- Next pNum
- If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
- Select Case LCase(Param(1))
- Case "o", "open", "n", "new"
- Show
- If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
- ChDir OldStartPath
- RunMpq2kCommand sLine
- Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
- If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
- ChDir OldStartPath
- CD.FileName = FullPath(CurDir, Param(2))
- sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
- RunMpq2kCommand sLine
- If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
- ChDir NewStartPath
- Unload Me
- Case "s", "script"
- Show
- If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
- ChDir OldStartPath
- RunMpq2kCommand sLine
- If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
- ChDir NewStartPath
- End Select
-End If
-End Sub
-Private Sub Form_Resize()
-On Error Resume Next
-If WindowState <> 1 Then
- List.Top = Toolbar.Height
- List.Width = ScaleWidth
- List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
- Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
- txtCommand.Top = List.Top + List.Height
- txtCommand.Left = Label1.Width
- 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
-End Sub
-Private Sub Form_Unload(Cancel As Integer)
-Dim Path As String
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-On Error Resume Next
-If ExtractPathNum > -1 Then
- KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
- RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
-End If
-If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
- KillEx Path + "Temp_extract\", "*", 6, True
- RmDir Path + "Temp_extract\"
-End If
-If CopyPathNum > -1 Then
- KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
- RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
-End If
-If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
- KillEx Path + "Temp_copy\", "*", 6, True
- RmDir Path + "Temp_copy\"
-End If
-If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
- NewKey AppKey
- NewKey AppKey + "Status\"
- If WindowState = 1 Then WindowState = 0
- SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
- WindowState = 0
- SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
- SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
- SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
- SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
-End If
-If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
- SetReg AppKey + "StartupPath", CurDir
-End If
-End
-End Sub
-Private Sub Label1_Click()
-txtCommand.SetFocus
-End Sub
-Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
-Dim result As Long, hMPQ As Long, hFile As Long
-If List.SelectedItem.Text <> NewString Then
- If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- result = vbYes
- Else
- result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
- End If
- If result = vbYes Then
- List.SelectedItem.Tag = NewString
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
- SFileCloseFile hFile
- SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
- MpqDeleteFile hMPQ, NewString
- MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
- SFileSetLocale LocaleID
- RemoveDuplicates
- Else
- SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
- MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
- SFileSetLocale LocaleID
- End If
- MpqCloseUpdatedArchive hMPQ, 0
- On Error Resume Next
- List.SelectedItem.Key = NewString
- On Error GoTo 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- End If
- Else
- Cancel = True
- End If
-End If
-ShowSelected
-End Sub
-Private Sub List_Click()
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo NotClick
-List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
-On Error GoTo 0
-ShowSelected
-Exit Sub
-NotClick:
-List.SelectedItem.Selected = False
-NotSelected:
-ShowSelected
-BuildMpqActionList
-End Sub
-Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
-If List.SortKey = ColumnHeader.Index - 1 Then
- If List.SortOrder = 0 Then
- List.SortOrder = 1
- Else
- List.SortOrder = 0
- End If
-Else
- List.SortOrder = 0
- List.SortKey = ColumnHeader.Index - 1
-End If
-End Sub
-Private Sub List_DblClick()
-Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo NotClick
-List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
-On Error GoTo 0
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Path = Path + "Temp_extract\"
-If ExtractPathNum = -1 Then
- fNum = 0
- Do
- If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
- fNum = fNum + 1
- Loop
- ExtractPathNum = fNum
-End If
-Path = Path + CStr(ExtractPathNum) + "\"
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
- For bNum = 1 To UBound(OpenFiles)
- If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
- AlreadyInList = True
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- Exit For
- End If
- Next bNum
- If AlreadyInList = False Then
- ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
- OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- End If
- End If
- StatBar.Style = 1
- StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
- fName = List.ListItems.Item(fNum).Tag
- BuildPopup Path + fName, 0, mnuPopup, mnuPItem
- ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
- End If
-Next fNum
-SFileCloseArchive hMPQ
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-Exit Sub
-NotClick:
-List.SelectedItem.Selected = False
-NotSelected:
-End Sub
-Private Sub List_ItemClick(ByVal Item As ListItem)
-BuildMpqActionList
-End Sub
-Private Sub List_KeyPress(KeyAscii As Integer)
-If KeyAscii = 13 Then List_DblClick
-End Sub
-Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
-Dim fNum As Long, fSelect As Long
-If KeyCode = vbKeyDelete Then
- mnuMDelete_Click
-ElseIf (Shift And vbCtrlMask) And KeyCode = vbKeyA Then
- fSelect = List.SelectedItem.Index
- For fNum = 1 To List.ListItems.Count
- List.ListItems.Item(fNum).Selected = True
- Next fNum
- List.ListItems.Item(fSelect).Selected = True
-ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
- On Error GoTo NotSelected
- List.SelectedItem.Tag = List.SelectedItem.Tag
- On Error GoTo 0
- If List.SelectedItem.Selected = True Then
- BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
- PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
- End If
-End If
-NotSelected:
-End Sub
-Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
-CX = X
-CY = Y
-If Button And vbRightButton Then
- On Error GoTo NotSelected
- List.SelectedItem.Tag = List.SelectedItem.Tag
- On Error GoTo NotClick
- List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
- On Error GoTo 0
- BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
- PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
-End If
-NotClick:
-NotSelected:
-End Sub
-Private Sub List_OLECompleteDrag(Effect As Long)
-List.Tag = ""
-End Sub
-Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
-Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, Path2 As String, cNum As Long, FileFilter As String
-Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long
-If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
-For fNum = 1 To Data.Files.Count
- Path = Data.Files.Item(fNum)
- If Right(Path, 1) <> "\" Then Path = Path + "\"
- If IsDir(Path) Then
- Path = Path + "*"
- Data.Files.Remove fNum
- Data.Files.Add Path, fNum
- End If
-Next fNum
-Path = Data.Files.Item(1)
-For bNum = 1 To Len(Path)
- If InStr(bNum, Path, "\") > 0 Then
- For fNum = 1 To Data.Files.Count
- If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
- Next fNum
- bNum = InStr(bNum, Path, "\")
- Else
- Exit For
- End If
-Next bNum
-PathFound:
-Path = Left(Path, bNum - 1)
-ReDim Files(0) As String
-Files(0) = Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-ReDim Preserve Files(Data.Files.Count) As String
-For bNum = 1 To Data.Files.Count
- Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
- For fNum = 1 To Len(Files(bNum))
- If InStr(fNum, Files(bNum), "\") > 0 Then
- fNum = InStr(fNum, Files(bNum), "\")
- Else
- Exit For
- End If
- Next fNum
- FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
-Next bNum
-If FolderFiles = "" Then Exit Sub
-ReDim Preserve Files(0) As String
-For bNum = 1 To Len(FolderFiles)
- ReDim Preserve Files(UBound(Files) + 1) As String
- If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
- Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
- bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
- Else
- Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
- Exit For
- End If
-Next bNum
-FoldName.Show 1
-If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
-If UBound(Files) > 1 Then
- ReDim ShortFiles(UBound(Files)) As String
- For bNum = 0 To UBound(Files)
- ShortFiles(bNum) = AddFolderName + Files(bNum)
- Next bNum
- If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
- For bNum = 1 To UBound(Files)
- Files(bNum) = FullPath(Files(0), Files(bNum))
- Next bNum
-Else
- For bNum = 1 To Len(Files(1))
- If InStr(bNum, Files(1), "\") > 0 Then
- bNum = InStr(bNum, Files(1), "\")
- Else
- Exit For
- End If
- Next bNum
- ReDim ShortFiles(UBound(Files)) As String
- ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
- Files(1) = FullPath(Files(0), Files(1))
-End If
-If NewFile = True Then
- If FileExists(CD.FileName) Then Kill CD.FileName
- NewFile = False
-End If
-List.Sorted = False
-FileFilter = mFilter
-hMPQ = mOpenMpq(CD.FileName)
-If hMPQ = 0 Then
- StatBar.SimpleText = "Can't create archive " + CD.FileName
- Exit Sub
-End If
-dwFlags = MAFA_REPLACE_EXISTING
-If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
-For bNum = 1 To UBound(Files)
- StatBar.Style = 1
- StatBar.SimpleText = "Adding " + Files(bNum) + "..."
- MousePointer = 11
- If mnuMCNone.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
- ElseIf mnuMCStandard.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
- ElseIf mnuMCDeflate.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
- ElseIf mnuMCBzip2.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
- ElseIf mnuMCAMedium.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
- ElseIf mnuMCAHighest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
- ElseIf mnuMCALowest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
- ElseIf mnuMCAuto.Checked Then
- mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
- For cNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
- mFilter.RemoveItem cNum
- Exit For
- End If
- Next cNum
-Next bNum
-MpqCloseUpdatedArchive hMPQ, 0
-If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- StatBar.SimpleText = "Adding files to listing... 0% complete"
- For bNum = 1 To UBound(Files)
- If MatchesFilter(ShortFiles(bNum), FileFilter) Then
- MpqAddToListing hMPQ, ShortFiles(bNum)
- End If
- On Error Resume Next
- StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
- On Error GoTo 0
- Next bNum
- SFileCloseArchive hMPQ
-End If
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-If MatchesFilter("(listfile)", FileFilter) Then
- AddToListing "(listfile)"
-End If
-mFilter = FileFilter
-List.Sorted = True
-RemoveDuplicates
-ShowTotal
-Cancel:
-End Sub
-Private Sub List_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
-If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
- Effect = ccOLEDropEffectNone
-Else
- Effect = ccOLEDropEffectCopy
-End If
-End Sub
-Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
-Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Path = Path + "Temp_copy\"
-If CopyPathNum = -1 Then
- fNum = 0
- Do
- If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
- fNum = fNum + 1
- Loop
- CopyPathNum = fNum
-End If
-Path = Path + CStr(CopyPathNum) + "\"
-KillEx Path, "*", 6, True
-fCount = 0
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
- Data.Files.Add Path + List.ListItems.Item(fNum).Tag
- End If
- fCount = fCount + 1
- If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
- End If
-Next fNum
-SFileCloseArchive hMPQ
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
- Data.Files.Add Path + "*"
-ElseIf fCount = 1 Then
- Data.Files.Add FirstFile
-End If
-End Sub
-Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
-Data.SetData , ccCFFiles
-AllowedEffects = ccOLEDropEffectCopy
-List.Tag = "WinMPQ"
-End Sub
-Private Sub mFilter_KeyPress(KeyAscii As Integer)
-If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
- If NewFile = False Then OpenMpq
-End If
-End Sub
-Private Sub mnuFExit_Click()
-Unload Me
-End Sub
-Private Sub mnuFile_Click()
-If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
-End Sub
-Private Sub mnuFRecent_Click(Index As Integer)
-Dim OldFileName As String
-OldFileName = CD.FileName
-CD.FileName = mnuFRecent(Index).Tag
-If FileExists(CD.FileName) = False Then
- CD.FileName = OldFileName
- MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
- DelRecentFile mnuFRecent(Index).Tag
- Exit Sub
-End If
-OpenMpq
-If CD.FileName = "" Then
- CD.FileName = OldFileName
- DelRecentFile mnuFRecent(Index).Tag
-End If
-End Sub
-Private Sub mnuFReopen_Click()
-OpenMpq
-End Sub
-
-Private Sub mnuFScript_Click()
-Dim OldFileName As String, OldPath As String
-CD.Flags = &H1000 Or &H4 Or &H2
-CD.Filter = "All Files (*.*)|*.*"
-OldFileName = CD.FileName
-OldPath = CurDir
-CD.hwndOwner = hWnd
-If ShowOpen(CD) = False Then GoTo Cancel
-StatBar.Style = 1
-StatBar.SimpleText = "Running script " + CD.FileName + "..."
-MousePointer = 11
-RunScript CD.FileName
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-CD.FileName = OldFileName
-Cancel:
-If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
-ChDir OldPath
-End Sub
-Private Sub mnuHAbout_Click()
-About.Show 1
-End Sub
-Private Sub mnuHReadme_Click()
-Dim Path As String
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-If FileExists(Path + "WinMPQ.rtf") Then
- ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
-Else
- MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
-End If
-End Sub
-Private Sub mnuMAdd_Click()
-Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
-Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long
-CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
-CD.Filter = "All Files (*.*)|*.*"
-OldFileName = CD.FileName
-CD.hwndOwner = hWnd
-If ShowOpen(CD) = False Then GoTo Cancel
-ReDim Files(0) As String
-bNum = 1
-If InStr(1, CD.FileName, Chr(0)) > 0 Then
- Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
- bNum = InStr(1, CD.FileName, Chr(0)) + 1
-Else
- Files(0) = Mid(CD.FileName, 1)
-End If
-For bNum = bNum To Len(CD.FileName)
- ReDim Preserve Files(UBound(Files) + 1) As String
- If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
- Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
- bNum = InStr(bNum, CD.FileName, Chr(0))
- Else
- Files(UBound(Files)) = Mid(CD.FileName, bNum)
- Exit For
- End If
-Next bNum
-CD.FileName = OldFileName
-FoldName.Show 1
-If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
-If UBound(Files) > 1 Then
- ReDim ShortFiles(UBound(Files)) As String
- For bNum = 0 To UBound(Files)
- ShortFiles(bNum) = AddFolderName + Files(bNum)
- Next bNum
- If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
- For bNum = 1 To UBound(Files)
- Files(bNum) = FullPath(Files(0), Files(bNum))
- Next bNum
-Else
- For bNum = 1 To Len(Files(1))
- If InStr(bNum, Files(1), "\") > 0 Then
- bNum = InStr(bNum, Files(1), "\")
- Else
- Exit For
- End If
- Next bNum
- ReDim ShortFiles(UBound(Files)) As String
- ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
- Files(1) = FullPath(Files(0), Files(1))
-End If
-If NewFile = True Then
- If FileExists(CD.FileName) Then Kill CD.FileName
- NewFile = False
-End If
-List.Sorted = False
-FileFilter = mFilter
-hMPQ = mOpenMpq(CD.FileName)
-If hMPQ = 0 Then
- StatBar.SimpleText = "Can't create archive " + CD.FileName
- Exit Sub
-End If
-dwFlags = MAFA_REPLACE_EXISTING
-If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
-For bNum = 1 To UBound(Files)
- StatBar.Style = 1
- StatBar.SimpleText = "Adding " + Files(bNum) + "..."
- MousePointer = 11
- If mnuMCNone.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
- ElseIf mnuMCStandard.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
- ElseIf mnuMCDeflate.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
- ElseIf mnuMCBzip2.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
- ElseIf mnuMCAMedium.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
- ElseIf mnuMCAHighest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
- ElseIf mnuMCALowest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
- ElseIf mnuMCAuto.Checked Then
- mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
- For cNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
- mFilter.RemoveItem cNum
- Exit For
- End If
- Next cNum
-Next bNum
-MpqCloseUpdatedArchive hMPQ, 0
-If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- StatBar.SimpleText = "Adding files to listing... 0% complete"
- For bNum = 1 To UBound(Files)
- If MatchesFilter(ShortFiles(bNum), FileFilter) Then
- MpqAddToListing hMPQ, ShortFiles(bNum)
- End If
- On Error Resume Next
- StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
- On Error GoTo 0
- Next bNum
- SFileCloseArchive hMPQ
-End If
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-If MatchesFilter("(listfile)", FileFilter) Then
- AddToListing "(listfile)"
-End If
-mFilter = FileFilter
-List.Sorted = True
-RemoveDuplicates
-ShowTotal
-Cancel:
-End Sub
-Private Sub mnuMAddFolder_Click()
-Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, cNum As Long, FileFilter As String, hMPQ As Long
-Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, dwFlags As Long
-PathInput.hwndOwner = hWnd
-Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
-If Path = "" Then GoTo Cancel
-FolderFiles = DirEx(Path, "*", 6, True)
-If FolderFiles = "" Then Exit Sub
-ReDim Files(0) As String
-Files(0) = Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-For bNum = 1 To Len(FolderFiles)
- ReDim Preserve Files(UBound(Files) + 1) As String
- If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
- Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
- bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
- Else
- Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
- Exit For
- End If
-Next bNum
-FoldName.Show 1
-If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
-If UBound(Files) > 1 Then
- ReDim ShortFiles(UBound(Files)) As String
- For bNum = 0 To UBound(Files)
- ShortFiles(bNum) = AddFolderName + Files(bNum)
- Next bNum
- If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
- For bNum = 1 To UBound(Files)
- Files(bNum) = FullPath(Files(0), Files(bNum))
- Next bNum
-Else
- For bNum = 1 To Len(Files(1))
- If InStr(bNum, Files(1), "\") > 0 Then
- bNum = InStr(bNum, Files(1), "\")
- Else
- Exit For
- End If
- Next bNum
- ReDim ShortFiles(UBound(Files)) As String
- ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
- Files(1) = FullPath(Files(0), Files(1))
-End If
-If NewFile = True Then
- If FileExists(CD.FileName) Then Kill CD.FileName
- NewFile = False
-End If
-List.Sorted = False
-FileFilter = mFilter
-hMPQ = mOpenMpq(CD.FileName)
-If hMPQ = 0 Then
- StatBar.SimpleText = "Can't create archive " + CD.FileName
- Exit Sub
-End If
-dwFlags = MAFA_REPLACE_EXISTING
-If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
-For bNum = 1 To UBound(Files)
- StatBar.Style = 1
- StatBar.SimpleText = "Adding " + Files(bNum) + "..."
- MousePointer = 11
- If mnuMCNone.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
- ElseIf mnuMCStandard.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
- ElseIf mnuMCDeflate.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
- ElseIf mnuMCBzip2.Checked Then
- MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
- ElseIf mnuMCAMedium.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
- ElseIf mnuMCAHighest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
- ElseIf mnuMCALowest.Checked Then
- MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
- ElseIf mnuMCAuto.Checked Then
- mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
- For cNum = 1 To mFilter.ListCount - 1
- If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
- mFilter.RemoveItem cNum
- Exit For
- End If
- Next cNum
-Next bNum
-MpqCloseUpdatedArchive hMPQ, 0
-If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
- StatBar.SimpleText = "Adding files to listing... 0% complete"
- For bNum = 1 To UBound(Files)
- If MatchesFilter(ShortFiles(bNum), FileFilter) Then
- MpqAddToListing hMPQ, ShortFiles(bNum)
- End If
- On Error Resume Next
- StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
- On Error GoTo 0
- Next bNum
- SFileCloseArchive hMPQ
-End If
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-If MatchesFilter("(listfile)", FileFilter) Then
- AddToListing "(listfile)"
-End If
-mFilter = FileFilter
-List.Sorted = True
-RemoveDuplicates
-ShowTotal
-Cancel:
-End Sub
-
-Private Sub mnuMAddToList_Click()
-frmAddToList.Show 1
-End Sub
-Private Sub mnuMCAHighest_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = True
-mnuMCAuto.Checked = False
-End Sub
-Private Sub mnuMCALowest_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = True
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-
-
-Private Sub mnuMCAMedium_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = True
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-Private Sub mnuMCAuto_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = True
-End Sub
-
-Private Sub mnuMCBzip2_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = True
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-
-Private Sub mnuMCDeflate_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = True
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-
-
-Private Sub mnuMChLCID_Click()
-Dim fNum As Long
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo 0
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- GoTo FileSelected
- End If
-Next fNum
-GoTo NotSelected
-FileSelected:
-ChLCID.Show 1
-Exit Sub
-NotSelected:
-MsgBox "No files are selected.", , "WinMPQ"
-End Sub
-Private Sub mnuMCNone_Click()
-mnuMCNone.Checked = True
-mnuMCStandard.Checked = False
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-Private Sub mnuMCompact_Click()
-Dim fNum As Long, result As Long, hMPQ As Long
-If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- result = vbYes
-Else
- result = MsgBox("Uncompressed files with an 'X' in the attributes column and are not" + vbCrLf + "listed in (listfile) may be corrupted or deleted by the compacting process." + vbCrLf + "(Note: These files are fairly rare) Continue with compact?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
-End If
-If result = vbYes Then
- StatBar.Style = 1
- StatBar.SimpleText = "Compacting " + CD.FileName + "..."
- MousePointer = 11
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- MpqCompactArchive hMPQ
- MpqCloseUpdatedArchive hMPQ, 0
- End If
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- StatBar.Style = 0
- StatBar.SimpleText = ""
- MousePointer = 0
- OpenMpq
-End If
-End Sub
-Private Sub mnuMCStandard_Click()
-mnuMCNone.Checked = False
-mnuMCStandard.Checked = True
-mnuMCDeflate.Checked = False
-mnuMCBzip2.Checked = False
-mnuMCALowest.Checked = False
-mnuMCAMedium.Checked = False
-mnuMCAHighest.Checked = False
-mnuMCAuto.Checked = False
-End Sub
-Private Sub mnuMDelete_Click()
-Dim fNum As Long, result As Long, hMPQ As Long
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo 0
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- GoTo FileSelected
- End If
-Next fNum
-GoTo NotSelected
-FileSelected:
- If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- result = vbYes
- Else
- result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
- End If
- If result = vbYes Then
- fNum = 1
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- Do While fNum <= List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
- SFileSetLocale LocaleID
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- List.ListItems.Remove (fNum)
- fNum = fNum - 1
- End If
- fNum = fNum + 1
- Loop
- MpqCloseUpdatedArchive hMPQ, 0
- End If
- End If
- StatBar.Style = 0
- StatBar.SimpleText = ""
- MousePointer = 0
- ShowSelected
- ShowTotal
-Exit Sub
-NotSelected:
-MsgBox "No files are selected.", , "WinMPQ"
-End Sub
-Private Sub mnuMEncrypt_Click()
-If mnuMEncrypt.Checked = False Then
- mnuMEncrypt.Checked = True
- GlobalEncrypt = True
-Else
- mnuMEncrypt.Checked = False
- GlobalEncrypt = False
-End If
-End Sub
-Private Sub mnuMExtract_Click()
-Dim fNum As Long, Path As String, result As Long, hMPQ As Long
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo 0
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- GoTo FileSelected
- End If
-Next fNum
-GoTo NotSelected
-FileSelected:
-PathInput.hwndOwner = hWnd
-Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
-If Path = "" Then Exit Sub
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
-For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- End If
-Next fNum
-SFileCloseArchive hMPQ
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-Exit Sub
-NotSelected:
-If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- result = vbYes
-Else
- result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
-End If
-If result = vbYes Then
- PathInput.hwndOwner = hWnd
- Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
- If Path = "" Then Exit Sub
- If Right(Path, 1) <> "\" Then Path = Path + "\"
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
- For fNum = 1 To List.ListItems.Count
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- Next fNum
- SFileCloseArchive hMPQ
- StatBar.Style = 0
- StatBar.SimpleText = ""
- MousePointer = 0
-End If
-End Sub
-Private Sub mnuFNew_Click()
-Dim TItem As Menu
-CD.Flags = &H1000 Or &H4 Or &H2
-CD.DefaultExt = "mpq"
-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
-List.ListItems.Clear
-ShowSelected
-ShowTotal
-NewFile = True
-ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
-mnuMpq.Enabled = True
-For Each TItem In mnuTItem
- TItem.Enabled = True
-Next TItem
-Toolbar.Buttons.Item("Add").Enabled = True
-Toolbar.Buttons.Item("Add Folder").Enabled = True
-Toolbar.Buttons.Item("Extract").Enabled = True
-Toolbar.Buttons.Item("Compact").Enabled = True
-Toolbar.Buttons.Item("List").Enabled = True
-Caption = "WinMPQ - " + CD.FileTitle
-AddRecentFile CD.FileName
-Cancel:
-End Sub
-Private Sub mnuFOpen_Click()
-Dim OldFileName As String
-CD.Flags = &H1000 Or &H4 Or &H2
-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
-OpenMpq
-If CD.FileName = "" Then CD.FileName = OldFileName
-Cancel:
-End Sub
-Private Sub mnuMItem_Click(Index As Integer)
-FileActionClick mnuMpq, mnuMItem, Index
-End Sub
-Private Sub mnuMRename_Click()
-List.StartLabelEdit
-End Sub
-Private Sub mnuMSaveList_Click()
-Dim fNum As Long, fList As String, OldFileName As String
-CD.Flags = &H1000 Or &H4 Or &H2
-CD.DefaultExt = "txt"
-CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
-OldFileName = CD.FileName
-CD.FileName = CD.FileName + ".txt"
-CD.hwndOwner = hWnd
-If ShowSave(CD) = False Then GoTo Cancel
-StatBar.Style = 1
-StatBar.SimpleText = "Creating list..."
-MousePointer = 11
-For fNum = 1 To List.ListItems.Count
- fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
-Next fNum
-fNum = FreeFile
-Open CD.FileName For Binary As #fNum
-Put #fNum, 1, fList
-Close #fNum
-Cancel:
-CD.FileName = OldFileName
-StatBar.Style = 0
-StatBar.SimpleText = ""
-MousePointer = 0
-End Sub
-Private Sub mnuOptions_Click()
-Options.Show 1
-End Sub
-
-Private Sub mnuPChLCID_Click()
-mnuMChLCID_Click
-End Sub
-Private Sub mnuPDelete_Click()
-mnuMDelete_Click
-End Sub
-Private Sub mnuPExtract_Click()
-mnuMExtract_Click
-End Sub
-Private Sub mnuPItem_Click(Index As Integer)
-FileActionClick mnuPopup, mnuPItem, Index
-End Sub
-Private Sub mnuPRename_Click()
-mnuMRename_Click
-End Sub
-Private Sub mnuPTItem_Click(Index As Integer)
-mnuTItem_Click Index
-End Sub
-Private Sub mnuTAdd_Click()
-ToolList.Show 1
-BuildToolsList
-End Sub
-Private Sub mnuTItem_Click(Index As Integer)
-Dim Param As String, bNum As Long, FileName As String, Path As String, fNum As Long, AlreadyInList As Boolean, UseFile As Boolean, NewParam As String, FileNameList As String, hMPQ As Long
-Param = mnuTItem(Index).Tag
-On Error GoTo NoProgram
-If Param = "" Then Err.Raise 53
-On Error GoTo 0
-Do
- If InStr(1, Param, "%mpq", 1) Then
- bNum = InStr(1, Param, "%mpq", 1)
- Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
- End If
-Loop While InStr(1, Param, "%mpq", 1)
-NewParam = Param
-On Error GoTo NotSelected
-List.SelectedItem.Tag = List.SelectedItem.Tag
-On Error GoTo 0
-If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
-NotSelected:
-If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
- Path = App.Path
- If Right(Path, 1) <> "\" Then Path = Path + "\"
- Path = Path + "Temp_extract\"
- If ExtractPathNum = -1 Then
- fNum = 0
- Do
- If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
- fNum = fNum + 1
- Loop
- ExtractPathNum = fNum
- End If
- Path = Path + CStr(ExtractPathNum) + "\"
- If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
- For fNum = 1 To List.ListItems.Count
- If List.ListItems.Item(fNum).Selected Then
- StatBar.Style = 1
- StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
- MousePointer = 11
- SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
- sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
- SFileSetLocale LocaleID
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
- For bNum = 1 To UBound(OpenFiles)
- If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
- AlreadyInList = True
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- Exit For
- End If
- Next bNum
- If AlreadyInList = False Then
- ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
- OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
- If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
- End If
- End If
- StatBar.Style = 1
- StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
- FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
- UseFile = True
- Param = NewParam
- Do
- If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
- If FileName <> "" Then
- Param = Param + " " + FileName
- End If
- ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
- bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
- If FileName <> "" Then
- Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
- Else
- Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
- End If
- ElseIf InStr(Param, "%1") Then
- bNum = InStr(Param, "%1")
- If FileName <> "" Then
- Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
- Else
- Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
- End If
- End If
- Loop While InStr(Param, "%1")
- On Error GoTo NoProgram
- Shell Param, 1
- On Error GoTo 0
- If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
- End If
- Next fNum
- SFileCloseArchive hMPQ
-ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- On Error GoTo NoProgram
- Shell Param, 1
- On Error GoTo 0
- Timer1.Enabled = True
-Else
- MsgBox "No files are selected.", , "WinMPQ"
-End If
-If FileName <> "" Then
- StatBar.Style = 0
- StatBar.SimpleText = ""
- MousePointer = 0
-End If
-Exit Sub
-NoProgram:
-If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
-End Sub
-
-Private Sub mnuTMpqEmbed_Click()
-frmMpq.Show
-End Sub
-Private Sub Timer1_Timer()
-Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
-If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
-Path = App.Path
-If Right(Path, 1) <> "\" Then Path = Path + "\"
-Path = Path + "Temp_extract\"
-Path = Path + CStr(ExtractPathNum) + "\"
-For fNum = 1 To UBound(OpenFiles)
- If FileExists(FullPath(Path, OpenFiles(fNum))) Then
- If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
- If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- result = vbYes
- Else
- result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
- End If
- If FileExists(FullPath(Path, OpenFiles(fNum))) Then
- OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
- If result = vbYes Then
- List.Sorted = False
- StatBar.Style = 1
- StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
- MousePointer = 11
- dwFlags = MAFA_REPLACE_EXISTING
- If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
- hMPQ = mOpenMpq(CD.FileName)
- If hMPQ Then
- If mnuMCNone.Checked Then
- MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
- ElseIf mnuMCStandard.Checked Then
- MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
- ElseIf mnuMCDeflate.Checked Then
- MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
- ElseIf mnuMCBzip2.Checked Then
- MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
- ElseIf mnuMCAMedium.Checked Then
- MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
- ElseIf mnuMCAHighest.Checked Then
- MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
- ElseIf mnuMCALowest.Checked Then
- MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
- ElseIf mnuMCAuto.Checked Then
- mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
- End If
- End If
- MpqAddToListing hMPQ, OpenFiles(fNum)
- MpqCloseUpdatedArchive hMPQ, 0
- If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- StatBar.Style = 0
- StatBar.SimpleText = ""
- MousePointer = 0
- List.Sorted = True
- RemoveDuplicates
- ShowTotal
- End If
- End If
- End If
- Else
- For bNum = fNum To UBound(OpenFiles) - 1
- OpenFiles(bNum) = OpenFiles(bNum + 1)
- OpenFileDates(bNum) = OpenFileDates(bNum + 1)
- Next bNum
- ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
- fNum = fNum - 1
- If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
- End If
- If fNum >= UBound(OpenFiles) Then Exit For
-Next fNum
-If FileExists(CD.FileName) Then
- If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
-Else
- OpenMpq
-End If
-End Sub
-Private Sub Toolbar_ButtonClick(ByVal Button As Button)
-Select Case Button.Key
-Case "New"
- mnuFNew_Click
-Case "Open"
- mnuFOpen_Click
-Case "Add"
- mnuMAdd_Click
-Case "Add Folder"
- mnuMAddFolder_Click
-Case "Extract"
- mnuMExtract_Click
-Case "Compact"
- mnuMCompact_Click
-Case "List"
- If NewFile = False Then OpenMpq
-End Select
-End Sub
-Private Sub txtCommand_GotFocus()
-cmdGo.Default = True
-txtCommandHasFocus = True
-StatBar.Style = 1
-StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
-End Sub
-Private Sub txtCommand_LostFocus()
-cmdGo.Default = False
-txtCommandHasFocus = False
-StatBar.Style = 0
-StatBar.SimpleText = ""
-End Sub
+VERSION 4.00\r
+Begin VB.Form MpqEx \r
+ Caption = "WinMPQ"\r
+ ClientHeight = 3510\r
+ ClientLeft = 1245\r
+ ClientTop = 1785\r
+ ClientWidth = 6690\r
+ Height = 4200\r
+ Icon = "listing.frx":0000\r
+ KeyPreview = -1 'True\r
+ Left = 1185\r
+ LinkTopic = "Form1"\r
+ ScaleHeight = 3510\r
+ ScaleWidth = 6690\r
+ Top = 1155\r
+ Width = 6810\r
+ Begin VB.Timer Timer1 \r
+ Enabled = 0 'False\r
+ Interval = 2500\r
+ Left = 6120\r
+ Top = 2160\r
+ End\r
+ Begin VB.TextBox txtCommand \r
+ BackColor = &H8000000F&\r
+ Height = 285\r
+ Left = 1440\r
+ TabIndex = 1\r
+ Top = 2880\r
+ Width = 4695\r
+ End\r
+ Begin VB.CommandButton cmdGo \r
+ Caption = "Go"\r
+ Height = 285\r
+ Left = 6120\r
+ TabIndex = 2\r
+ Top = 2880\r
+ Width = 495\r
+ End\r
+ Begin VB.ComboBox mFilter \r
+ Height = 315\r
+ ItemData = "listing.frx":27A2\r
+ Left = 5220\r
+ List = "listing.frx":27A9\r
+ Sorted = -1 'True\r
+ TabIndex = 3\r
+ Text = "*"\r
+ Top = 30\r
+ Width = 675\r
+ End\r
+ Begin MSComctlLib.Toolbar Toolbar \r
+ Align = 1 'Align Top\r
+ Height = 345\r
+ Left = 0\r
+ TabIndex = 5\r
+ Top = 0\r
+ Width = 6690\r
+ _ExtentX = 11800\r
+ _ExtentY = 609\r
+ ButtonWidth = 1561\r
+ ButtonHeight = 556\r
+ Wrappable = 0 'False\r
+ Appearance = 1\r
+ Style = 1\r
+ ImageList = "ImageList1"\r
+ _Version = 393216\r
+ BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} \r
+ NumButtons = 8\r
+ BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Caption = "New"\r
+ Key = "New"\r
+ Description = "Create a new archive"\r
+ ToolTipText = "Create a new archive"\r
+ ImageIndex = 1\r
+ EndProperty\r
+ BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Caption = "Open"\r
+ Key = "Open"\r
+ Description = "Open an existing archive"\r
+ ToolTipText = "Open an existing archive"\r
+ EndProperty\r
+ BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Caption = "Add"\r
+ Key = "Add"\r
+ Description = "Add files to the archive"\r
+ ToolTipText = "Add files to the archive"\r
+ EndProperty\r
+ BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Caption = "Add Folder"\r
+ Key = "Add Folder"\r
+ Description = "Add files from a folder and its subfolders"\r
+ ToolTipText = "Add files from a folder and its subfolders"\r
+ EndProperty\r
+ BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Caption = "Extract"\r
+ Key = "Extract"\r
+ Description = "Extract files from the archive"\r
+ ToolTipText = "Extract files from the archive"\r
+ EndProperty\r
+ BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Caption = "Compact"\r
+ Key = "Compact"\r
+ Description = "Clear deleted files from the archive"\r
+ ToolTipText = "Clear deleted files from the archive"\r
+ EndProperty\r
+ BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Key = "filterspace"\r
+ Style = 4\r
+ Object.Width = 675\r
+ EndProperty\r
+ BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
+ Enabled = 0 'False\r
+ Caption = "List"\r
+ Key = "List"\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin VB.Label Label1 \r
+ AutoSize = -1 'True\r
+ Caption = " MPQ2k &Command "\r
+ Height = 195\r
+ Left = 0\r
+ TabIndex = 6\r
+ Top = 2880\r
+ Width = 1425\r
+ End\r
+ Begin MSComctlLib.ImageList ImageList1 \r
+ Left = 6120\r
+ Top = 1560\r
+ _ExtentX = 1005\r
+ _ExtentY = 1005\r
+ BackColor = -2147483643\r
+ ImageWidth = 1\r
+ ImageHeight = 1\r
+ MaskColor = 12632256\r
+ _Version = 393216\r
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} \r
+ NumListImages = 1\r
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
+ Picture = "listing.frx":27B0\r
+ Key = ""\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin MSComctlLib.StatusBar StatBar \r
+ Align = 2 'Align Bottom\r
+ Height = 300\r
+ Left = 0\r
+ TabIndex = 4\r
+ Top = 3210\r
+ Width = 6690\r
+ _ExtentX = 11800\r
+ _ExtentY = 529\r
+ _Version = 393216\r
+ BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} \r
+ NumPanels = 2\r
+ BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} \r
+ AutoSize = 1\r
+ Object.Width = 5664\r
+ MinWidth = 2\r
+ Key = "FileInfo"\r
+ EndProperty\r
+ BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} \r
+ AutoSize = 1\r
+ Object.Width = 5664\r
+ MinWidth = 2\r
+ Key = "MpqInfo"\r
+ EndProperty\r
+ EndProperty\r
+ End\r
+ Begin MSComctlLib.ListView List \r
+ Height = 2295\r
+ Left = 0\r
+ TabIndex = 0\r
+ Top = 360\r
+ Width = 6015\r
+ _ExtentX = 10610\r
+ _ExtentY = 4048\r
+ View = 3\r
+ Arrange = 2\r
+ Sorted = -1 'True\r
+ MultiSelect = -1 'True\r
+ LabelWrap = -1 'True\r
+ HideSelection = -1 'True\r
+ OLEDragMode = 1\r
+ OLEDropMode = 1\r
+ AllowReorder = -1 'True\r
+ _Version = 393217\r
+ ForeColor = -2147483640\r
+ BackColor = -2147483643\r
+ BorderStyle = 1\r
+ Appearance = 1\r
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} \r
+ Name = "MS Sans Serif"\r
+ Size = 8.25\r
+ Charset = 0\r
+ Weight = 400\r
+ Underline = 0 'False\r
+ Italic = 0 'False\r
+ Strikethrough = 0 'False\r
+ EndProperty\r
+ OLEDragMode = 1\r
+ OLEDropMode = 1\r
+ NumItems = 6\r
+ BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ Key = "N"\r
+ Text = "Name"\r
+ Object.Width = 5080\r
+ EndProperty\r
+ BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ Alignment = 1\r
+ SubItemIndex = 1\r
+ Key = "S"\r
+ Text = "Size"\r
+ Object.Width = 1905\r
+ EndProperty\r
+ BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ Alignment = 1\r
+ SubItemIndex = 2\r
+ Key = "R"\r
+ Text = "Ratio"\r
+ Object.Width = 1129\r
+ EndProperty\r
+ BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ Alignment = 1\r
+ SubItemIndex = 3\r
+ Key = "PK"\r
+ Text = "Packed"\r
+ Object.Width = 1905\r
+ EndProperty\r
+ BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ SubItemIndex = 4\r
+ Key = "LCID"\r
+ Text = "Locale ID"\r
+ Object.Width = 1129\r
+ EndProperty\r
+ BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
+ SubItemIndex = 5\r
+ Key = "A"\r
+ Text = "Attributes"\r
+ Object.Width = 1129\r
+ EndProperty\r
+ End\r
+ Begin VB.Menu mnuFile \r
+ Caption = "&File"\r
+ Begin VB.Menu mnuFNew \r
+ Caption = "&New..."\r
+ Shortcut = ^N\r
+ End\r
+ Begin VB.Menu mnuFOpen \r
+ Caption = "&Open..."\r
+ Shortcut = ^O\r
+ End\r
+ Begin VB.Menu mnuFReopen \r
+ Caption = "&Reopen Mpq"\r
+ Shortcut = {F5}\r
+ End\r
+ Begin VB.Menu mnuFScript \r
+ Caption = "Run Mo'PaQ 2000 &Script..."\r
+ Shortcut = ^S\r
+ End\r
+ Begin VB.Menu mnuFSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuFExit \r
+ Caption = "E&xit"\r
+ End\r
+ Begin VB.Menu mnuFRecent \r
+ Caption = "-"\r
+ Index = 0\r
+ Visible = 0 'False\r
+ End\r
+ End\r
+ Begin VB.Menu mnuMpq \r
+ Caption = "&Mpq"\r
+ Enabled = 0 'False\r
+ Begin VB.Menu mnuMItem \r
+ Caption = "&Open"\r
+ Index = 0\r
+ Visible = 0 'False\r
+ End\r
+ Begin VB.Menu mnuMSep1 \r
+ Caption = "-"\r
+ Visible = 0 'False\r
+ End\r
+ Begin VB.Menu mnuMExtract \r
+ Caption = "&Extract"\r
+ Shortcut = ^E\r
+ End\r
+ Begin VB.Menu mnuMDelete \r
+ Caption = "&Delete Del or"\r
+ Shortcut = ^D\r
+ End\r
+ Begin VB.Menu mnuMRename \r
+ Caption = "Rena&me"\r
+ Shortcut = ^R\r
+ End\r
+ Begin VB.Menu mnuMChLCID \r
+ Caption = "Change Locale &ID..."\r
+ Shortcut = ^I\r
+ End\r
+ Begin VB.Menu mnuMSep2 \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuMAdd \r
+ Caption = "&Add..."\r
+ Shortcut = ^{INSERT}\r
+ End\r
+ Begin VB.Menu mnuMAddFolder \r
+ Caption = "Add &Folder..."\r
+ Shortcut = ^F\r
+ End\r
+ Begin VB.Menu mnuMCompression \r
+ Caption = "&Compression"\r
+ Begin VB.Menu mnuMCAuto \r
+ Caption = "Auto-Select"\r
+ Checked = -1 'True\r
+ Shortcut = {F4}\r
+ End\r
+ Begin VB.Menu mnuMCSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuMCNone \r
+ Caption = "&None"\r
+ Shortcut = {F2}\r
+ End\r
+ Begin VB.Menu mnuMCStandard \r
+ Caption = "&Standard"\r
+ Shortcut = {F3}\r
+ End\r
+ Begin VB.Menu mnuMCDeflate \r
+ Caption = "&Deflate"\r
+ Shortcut = {F9}\r
+ End\r
+ Begin VB.Menu mnuMCBzip2 \r
+ Caption = "&Bzip2"\r
+ Shortcut = ^{F11}\r
+ End\r
+ Begin VB.Menu mnuMCAudio \r
+ Caption = "&Audio"\r
+ Begin VB.Menu mnuMCALowest \r
+ Caption = "&Lowest (Best quality)"\r
+ Shortcut = {F6}\r
+ End\r
+ Begin VB.Menu mnuMCAMedium \r
+ Caption = "&Medium"\r
+ Shortcut = {F7}\r
+ End\r
+ Begin VB.Menu mnuMCAHighest \r
+ Caption = "&Highest (Least space)"\r
+ Shortcut = {F8}\r
+ End\r
+ End\r
+ End\r
+ Begin VB.Menu mnuMEncrypt \r
+ Caption = "Encr&ypt Files"\r
+ End\r
+ Begin VB.Menu mnuMCompact \r
+ Caption = "Com&pact"\r
+ Shortcut = ^P\r
+ End\r
+ Begin VB.Menu mnuMAddToList \r
+ Caption = "Add File to Li&sting..."\r
+ Shortcut = ^K\r
+ End\r
+ Begin VB.Menu mnuMSaveList \r
+ Caption = "Save File &List..."\r
+ Shortcut = ^L\r
+ End\r
+ End\r
+ Begin VB.Menu mnuTools \r
+ Caption = "&Tools"\r
+ Begin VB.Menu mnuTItem \r
+ Caption = "(Empty)"\r
+ Enabled = 0 'False\r
+ Index = 0\r
+ End\r
+ Begin VB.Menu mnuTSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuTMpqEmbed \r
+ Caption = "MPQ Embedder"\r
+ End\r
+ Begin VB.Menu mnuTSep2 \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuTAdd \r
+ Caption = "&Add/Remove..."\r
+ End\r
+ End\r
+ Begin VB.Menu mnuOptions \r
+ Caption = "&Options..."\r
+ End\r
+ Begin VB.Menu mnuHelp \r
+ Caption = "&Help"\r
+ Begin VB.Menu mnuHReadme \r
+ Caption = "View &Readme..."\r
+ Shortcut = {F1}\r
+ End\r
+ Begin VB.Menu mnuHSep \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuHAbout \r
+ Caption = "&About..."\r
+ End\r
+ End\r
+ Begin VB.Menu mnuPopup \r
+ Caption = "Popup Menu"\r
+ Visible = 0 'False\r
+ Begin VB.Menu mnuPItem \r
+ Caption = "&Open"\r
+ Index = 0\r
+ End\r
+ Begin VB.Menu mnuPSep1 \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuPTools \r
+ Caption = "&Tools"\r
+ Begin VB.Menu mnuPTItem \r
+ Caption = "(Empty)"\r
+ Index = 0\r
+ End\r
+ End\r
+ Begin VB.Menu mnuPSep2 \r
+ Caption = "-"\r
+ End\r
+ Begin VB.Menu mnuPExtract \r
+ Caption = "&Extract"\r
+ End\r
+ Begin VB.Menu mnuPDelete \r
+ Caption = "&Delete"\r
+ End\r
+ Begin VB.Menu mnuPRename \r
+ Caption = "Rena&me"\r
+ End\r
+ Begin VB.Menu mnuPChLCID \r
+ Caption = "Change Locale &ID..."\r
+ End\r
+ End\r
+End\r
+Attribute VB_Name = "MpqEx"\r
+Attribute VB_Creatable = False\r
+Attribute VB_Exposed = False\r
+Option Explicit\r
+\r
+Dim txtCommandHasFocus As Boolean, ShiftState As Boolean\r
+Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date\r
+Sub AddRecentFile(rFileName As String)\r
+Dim bNum As Long, fNum As Long\r
+NewKey AppKey + "Recent\"\r
+For bNum = 1 To 8\r
+ If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then\r
+ For fNum = bNum To 7\r
+ If Not IsEmpty(GetReg(AppKey + "Recent\File" + CStr(fNum + 1))) Then\r
+ SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next fNum\r
+ SetReg AppKey + "Recent\File" + CStr(fNum), rFileName\r
+ Exit For\r
+ End If\r
+Next bNum\r
+If fNum = 0 Then\r
+ For bNum = 1 To 8\r
+ If IsEmpty(GetReg(AppKey + "Recent\File" + CStr(bNum))) Then\r
+ SetReg AppKey + "Recent\File" + CStr(bNum), rFileName\r
+ Exit For\r
+ ElseIf bNum = 8 Then\r
+ For fNum = 1 To 7\r
+ SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
+ Next fNum\r
+ SetReg AppKey + "Recent\File" + CStr(bNum), rFileName\r
+ End If\r
+ Next bNum\r
+End If\r
+BuildRecentFileList\r
+End Sub\r
+Sub BuildMpqActionList()\r
+Dim Shift As Integer\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+If List.SelectedItem.Selected = True Then\r
+ Shift = 0\r
+ If ShiftState = True Then Shift = vbShiftMask\r
+ mnuMItem(0).Visible = True\r
+ mnuMSep1.Visible = True\r
+ BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem\r
+Else\r
+ GoTo NotSelected\r
+End If\r
+Exit Sub\r
+NotSelected:\r
+Dim PItem As Menu\r
+For Each PItem In mnuMItem\r
+ If PItem.Index <> 0 Then Unload PItem\r
+Next PItem\r
+mnuMItem(0).Visible = False\r
+mnuMSep1.Visible = False\r
+End Sub\r
+Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)\r
+Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String\r
+mnuRoot.Tag = 0\r
+For Each PItem In mnuItem\r
+ If PItem.Index <> 0 Then Unload PItem\r
+Next PItem\r
+If InStr(FileName, ".") = 0 Then\r
+ GoSub AddGlobal\r
+Else\r
+ For bNum = 1 To Len(FileName)\r
+ If InStr(bNum, FileName, ".") > 0 Then\r
+ bNum = InStr(bNum, FileName, ".")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ aName = Mid(FileName, bNum - 1)\r
+ aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")\r
+ If aName = "" Then\r
+ GoSub AddGlobal\r
+ Exit Sub\r
+ End If\r
+ dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")\r
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)\r
+ If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\command\")) Then\r
+ If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\")) Then\r
+ mnuItem(0).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
+ End If\r
+ mnuItem(0).Tag = dItem\r
+ mnuRoot.Tag = 1\r
+ aNum = 0\r
+ bNum = 1\r
+ Else\r
+ aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)\r
+ If aItem = "" Then\r
+ GoSub AddGlobal\r
+ Exit Sub\r
+ End If\r
+ If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then\r
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then\r
+ mnuItem(0).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
+ End If\r
+ mnuItem(0).Tag = aItem\r
+ mnuRoot.Tag = 1\r
+ aNum = 1\r
+ bNum = 1\r
+ Else\r
+ aNum = 1\r
+ bNum = 0\r
+ End If\r
+ End If\r
+ Do\r
+ aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)\r
+ If aItem <> "" Then\r
+ If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then\r
+ On Error Resume Next\r
+ Load mnuItem(bNum)\r
+ On Error GoTo 0\r
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then\r
+ mnuItem(bNum).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
+ End If\r
+ mnuItem(bNum).Tag = aItem\r
+ mnuRoot.Tag = mnuRoot.Tag + 1\r
+ bNum = bNum + 1\r
+ End If\r
+ aNum = aNum + 1\r
+ End If\r
+ Loop Until aItem = ""\r
+ GoSub AddGlobal\r
+ If Shift And vbShiftMask Then GoSub AddUnknown\r
+End If\r
+Exit Sub\r
+AddGlobal:\r
+ aNum = 0\r
+ bNum = mnuRoot.Tag\r
+ dItem = ""\r
+ If bNum = 0 Then\r
+ dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open")\r
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem)\r
+ If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then\r
+ If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then\r
+ mnuItem(bNum).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
+ End If\r
+ mnuItem(bNum).Tag = dItem\r
+ mnuRoot.Tag = mnuRoot.Tag + 1\r
+ bNum = bNum + 1\r
+ End If\r
+ End If\r
+ Do\r
+ aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum)\r
+ If aItem <> "" Then\r
+ If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then\r
+ On Error Resume Next\r
+ Load mnuItem(bNum)\r
+ On Error GoTo 0\r
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then\r
+ mnuItem(bNum).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
+ End If\r
+ mnuItem(bNum).Tag = aItem\r
+ mnuRoot.Tag = mnuRoot.Tag + 1\r
+ bNum = bNum + 1\r
+ End If\r
+ aNum = aNum + 1\r
+ End If\r
+ Loop Until aItem = ""\r
+ If bNum = 0 Then\r
+ GoSub AddUnknown\r
+ Exit Sub\r
+ End If\r
+Return\r
+AddUnknown:\r
+ aNum = 0\r
+ bNum = mnuRoot.Tag\r
+ dItem = ""\r
+ If bNum = 0 Then\r
+ dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")\r
+ dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)\r
+ If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then\r
+ If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then\r
+ mnuItem(bNum).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
+ End If\r
+ mnuItem(bNum).Tag = dItem\r
+ bNum = bNum + 1\r
+ End If\r
+ End If\r
+ Do\r
+ aItem = EnumKey("HKEY_CLASSES_ROOT\Unknown\shell\", aNum)\r
+ If aItem <> "" Then\r
+ If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\command\")) Then\r
+ On Error Resume Next\r
+ Load mnuItem(bNum)\r
+ On Error GoTo 0\r
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\")) Then\r
+ mnuItem(bNum).Caption = "Op&en with..."\r
+ Else\r
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
+ End If\r
+ mnuItem(bNum).Tag = aItem\r
+ bNum = bNum + 1\r
+ End If\r
+ aNum = aNum + 1\r
+ End If\r
+ Loop Until aItem = ""\r
+Return\r
+End Sub\r
+Sub ChangeLCID(NewLCID As Long)\r
+Dim fNum As Long, hMPQ As Long\r
+fNum = 1\r
+hMPQ = mOpenMpq(CD.FileName)\r
+If hMPQ Then\r
+ Do While fNum <= List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Changing locale ID of " + List.ListItems.Item(fNum).Tag + " to " + CStr(NewLCID) + "..."\r
+ MousePointer = 11\r
+ MpqSetFileLocale hMPQ, List.ListItems.Item(fNum).Tag, List.ListItems.Item(fNum).ListSubItems(4).Tag, NewLCID\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ List.ListItems.Item(fNum).ListSubItems(4).Tag = NewLCID\r
+ List.ListItems.Item(fNum).ListSubItems(4).Text = NewLCID\r
+ End If\r
+ fNum = fNum + 1\r
+ Loop\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+End If\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+ShowSelected\r
+ShowTotal\r
+End Sub\r
+Sub ConvertCwad()\r
+ 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\r
+\r
+ If CWadOpenArchive(CD.FileName, 0, hCwad) Then\r
+ 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"\r
+ CwadName = CD.FileName\r
+ CD.Flags = &H1000 Or &H4 Or &H2\r
+ CD.DefaultExt = "mpq"\r
+ CD.Filter = "Mpq Archive (*.mpq)|*.mpq"\r
+ CD.hwndOwner = hWnd\r
+ CD.FileName = CwadName + ".mpq"\r
+ If ShowSave(CD) Then\r
+ If CD.FileName = CwadName Then\r
+ MsgBox "Cannot overwrite source archive.", vbExclamation, "WinMPQ"\r
+ CWadCloseArchive hCwad\r
+ Exit Sub\r
+ End If\r
+\r
+ BufSize = CWadListFiles(hCwad, ListBuffer, 0)\r
+ If BufSize > 0 Then ListBuffer = String$(BufSize - 1, Chr$(0))\r
+ CWadListFiles hCwad, ListBuffer, BufSize\r
+ MultiStringToArray ListBuffer, Files\r
+\r
+ If FileExists(CD.FileName) Then Kill CD.FileName\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ = 0 Then\r
+ StatBar.SimpleText = "Can't create archive " + CD.FileName\r
+ Else\r
+ dwFlags = MAFA_REPLACE_EXISTING\r
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+\r
+ For nFile = 1 To UBound(Files)\r
+ If CWadOpenFile(hCwad, Files(nFile), 0, hFile) Then\r
+ fLen = CWadGetFileSize(hFile)\r
+\r
+ If fLen > 0 Then\r
+ ReDim buffer(fLen - 1)\r
+ Else\r
+ ReDim buffer(0)\r
+ End If\r
+\r
+ CWadSetFilePointer hFile, 0, FILE_BEGIN\r
+ CWadReadFile hFile, buffer(0), fLen, fLen\r
+ CWadCloseFile hFile\r
+\r
+ StatBar.SimpleText = "Adding " + Files(nFile) + "..."\r
+ MousePointer = 11\r
+ If mnuMCNone.Checked Then\r
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags, 0, 0\r
+ ElseIf mnuMCStandard.Checked Then\r
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+ ElseIf mnuMCDeflate.Checked Then\r
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+ ElseIf mnuMCBzip2.Checked Then\r
+ MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+ ElseIf mnuMCAMedium.Checked Then\r
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 0\r
+ ElseIf mnuMCAHighest.Checked Then\r
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 1\r
+ ElseIf mnuMCALowest.Checked Then\r
+ MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 2\r
+ ElseIf mnuMCAuto.Checked Then\r
+ mAddAutoFromBuffer hMPQ, buffer(0), fLen, Files(nFile)\r
+ End If\r
+ End If\r
+ Next nFile\r
+\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ Else\r
+ CD.FileName = CwadName\r
+ End If\r
+\r
+ CWadCloseArchive hCwad\r
+ End If\r
+End Sub\r
+\r
+Sub DelRecentFile(rFileName As String)\r
+Dim bNum As Long, fNum As Long\r
+For bNum = 1 To 8\r
+ If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then\r
+ For fNum = bNum To 7\r
+ SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
+ Next fNum\r
+ DelReg AppKey + "Recent\File" + CStr(8)\r
+ Exit For\r
+ End If\r
+Next bNum\r
+BuildRecentFileList\r
+End Sub\r
+Sub AddToListing(AddedFile As String)\r
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, hFile As Long\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then\r
+ L1 = AddedFile\r
+ fSize = SFileGetFileSize(hFile, 0)\r
+ cSize = SFileGetFileInfo(hFile, 6)\r
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
+ L2 = "<1KB"\r
+ ElseIf fSize = 0 Then\r
+ L2 = "0KB"\r
+ Else\r
+ L2 = CStr(Int(fSize / 1024)) + "KB"\r
+ End If\r
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
+ L4 = "<1KB"\r
+ ElseIf cSize = 0 Then\r
+ L4 = "0KB"\r
+ Else\r
+ L4 = CStr(Int(cSize / 1024)) + "KB"\r
+ End If\r
+ If fSize <> 0 Then\r
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
+ Else\r
+ L3 = "0%"\r
+ End If\r
+ fFlags = SFileGetFileInfo(hFile, 7)\r
+ L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)\r
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
+ On Error Resume Next\r
+ lIndex = List.ListItems.Add(, L1, L1).Index\r
+ On Error GoTo 0\r
+ If lIndex = 0 Then\r
+ lIndex = List.ListItems.Item(L1).Index\r
+ List.ListItems.Item(L1).ListSubItems.Clear\r
+ End If\r
+ List.ListItems.Item(lIndex).Tag = L1\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
+ If fSize <> 0 Then\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
+ Else\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
+ End If\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
+ SFileCloseFile hFile\r
+ End If\r
+ SFileCloseArchive hMPQ\r
+End If\r
+End Sub\r
+Sub FileActionClick(mnuRoot As Menu, mnuItem, Index As Integer)\r
+Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Path = Path + "Temp_extract\"\r
+If ExtractPathNum = -1 Then\r
+ fNum = 0\r
+ Do\r
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
+ fNum = fNum + 1\r
+ Loop\r
+ ExtractPathNum = fNum\r
+End If\r
+Path = Path + CStr(ExtractPathNum) + "\"\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
+ For bNum = 1 To UBound(OpenFiles)\r
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
+ AlreadyInList = True\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ If AlreadyInList = False Then\r
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ End If\r
+ End If\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
+ fName = List.ListItems.Item(fNum).Tag\r
+ ExecuteFile Path + fName, Index, mnuRoot, mnuItem\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
+ End If\r
+Next fNum\r
+SFileCloseArchive hMPQ\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+End Sub\r
+Sub MpqAddToListing(hMPQ As Long, AddedFile As String)\r
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hFile As Long\r
+If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then\r
+ L1 = AddedFile\r
+ fSize = SFileGetFileSize(hFile, 0)\r
+ cSize = SFileGetFileInfo(hFile, 6)\r
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
+ L2 = "<1KB"\r
+ ElseIf fSize = 0 Then\r
+ L2 = "0KB"\r
+ Else\r
+ L2 = CStr(Int(fSize / 1024)) + "KB"\r
+ End If\r
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
+ L4 = "<1KB"\r
+ ElseIf cSize = 0 Then\r
+ L4 = "0KB"\r
+ Else\r
+ L4 = CStr(Int(cSize / 1024)) + "KB"\r
+ End If\r
+ If fSize <> 0 Then\r
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
+ Else\r
+ L3 = "0%"\r
+ End If\r
+ fFlags = SFileGetFileInfo(hFile, 7)\r
+ L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)\r
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
+ On Error Resume Next\r
+ lIndex = List.ListItems.Add(, L1, L1).Index\r
+ On Error GoTo 0\r
+ If lIndex = 0 Then\r
+ lIndex = List.ListItems.Item(L1).Index\r
+ List.ListItems.Item(L1).ListSubItems.Clear\r
+ End If\r
+ List.ListItems.Item(lIndex).Tag = L1\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
+ If fSize <> 0 Then\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
+ Else\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
+ End If\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
+ SFileCloseFile hFile\r
+End If\r
+End Sub\r
+Sub RemoveFromListing(RemovedFile As String)\r
+Dim FileCount As Long\r
+On Error GoTo FileRemoved\r
+Do\r
+List.ListItems.Remove RemovedFile\r
+FileCount = FileCount + 1\r
+Loop\r
+FileRemoved:\r
+If FileCount = 0 Then\r
+ For FileCount = 1 To List.ListItems.Count\r
+ If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then\r
+ List.ListItems.Remove FileCount\r
+ Exit Sub\r
+ End If\r
+ Next FileCount\r
+End If\r
+End Sub\r
+Sub RenameInListing(OldName As String, NewName As String)\r
+Dim lIndex As Long\r
+If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName\r
+On Error GoTo RenameError\r
+lIndex = List.ListItems.Item(OldName).Index\r
+List.ListItems.Item(lIndex).Text = NewName\r
+List.ListItems.Item(lIndex).Tag = NewName\r
+On Error Resume Next\r
+List.ListItems.Item(lIndex).Key = NewName\r
+On Error GoTo 0\r
+Exit Sub\r
+RenameError:\r
+For lIndex = 1 To List.ListItems.Count\r
+ If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then\r
+ List.ListItems.Item(lIndex).Text = NewName\r
+ List.ListItems.Item(lIndex).Tag = NewName\r
+ On Error Resume Next\r
+ List.ListItems.Item(lIndex).Key = NewName\r
+ On Error GoTo 0\r
+ Exit Sub\r
+ End If\r
+Next lIndex\r
+End Sub\r
+Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)\r
+Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO\r
+If Index < mnuRoot.Tag Then\r
+ With sei\r
+ .cbSize = Len(sei)\r
+ .fMask = 0\r
+ .hWnd = hWnd\r
+ .lpVerb = mnuItem(Index).Tag\r
+ .lpFile = FileName\r
+ .lpParameters = vbNullString\r
+ .lpDirectory = vbNullString\r
+ .nShow = 1\r
+ End With\r
+ RetVal = ShellExecuteEx(sei)\r
+Else\r
+ With sei\r
+ .cbSize = Len(sei)\r
+ .fMask = SEE_MASK_CLASSNAME\r
+ .hWnd = hWnd\r
+ .lpVerb = mnuItem(Index).Tag\r
+ .lpFile = FileName\r
+ .lpParameters = vbNullString\r
+ .lpDirectory = vbNullString\r
+ .nShow = 1\r
+ .lpClass = "Unknown"\r
+ End With\r
+ RetVal = ShellExecuteEx(sei)\r
+End If\r
+'If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then\r
+' Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")\r
+' Do\r
+' If InStr(Param, "%1") = 0 Then\r
+' Param = Param + " " + FileName\r
+' Else\r
+' bNum = InStr(Param, "%1")\r
+' Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)\r
+' End If\r
+' Loop While InStr(Param, "%1")\r
+' bNum = 1\r
+' Do While bNum <= Len(Param)\r
+' If InStr(bNum, Param, "%") Then\r
+' bNum = InStr(bNum, Param, "%")\r
+' If InStr(bNum + 1, Param, "%") Then\r
+' bNum2 = InStr(bNum + 1, Param, "%")\r
+' EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)\r
+' If Environ(EnvName) <> "" Then\r
+' Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)\r
+' End If\r
+' End If\r
+' End If\r
+' bNum = bNum + 1\r
+' Loop\r
+' On Error GoTo NoProgram\r
+' Shell Param, 1\r
+' On Error GoTo 0\r
+'End If\r
+'Exit Sub\r
+'NoProgram:\r
+'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"\r
+End Sub\r
+Sub RunMpq2kCommand(CmdLine As String)\r
+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\r
+CurPath = CurDir\r
+If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"\r
+sLine = CmdLine\r
+If Right(sLine, 1) <> " " Then sLine = sLine + " "\r
+If sLine <> "" Then\r
+ ReDim Param(0) As String\r
+ For pNum = 1 To Len(sLine)\r
+ If Mid(sLine, pNum, 1) = Chr(34) Then\r
+ pNum = pNum + 1\r
+ EndParam = InStr(pNum, sLine, Chr(34))\r
+ Else\r
+ EndParam = InStr(pNum, sLine, " ")\r
+ End If\r
+ If EndParam = 0 Then EndParam = Len(sLine) + 1\r
+ If pNum <> EndParam Then\r
+ If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then\r
+ ReDim Preserve Param(UBound(Param) + 1) As String\r
+ Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))\r
+ End If\r
+ End If\r
+ pNum = EndParam\r
+ Next pNum\r
+ If UBound(Param) < 3 Then ReDim Preserve Param(3) As String\r
+ Select Case LCase(Param(1))\r
+ Case "?", "h", "help"\r
+ mnuHReadme_Click\r
+ Case "o", "open"\r
+ OldFileName = CD.FileName\r
+ If Param(2) <> "" Then\r
+ CD.FileName = FullPath(CurPath, Param(2))\r
+ End If\r
+ If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then\r
+ DefaultMaxFiles = Param(3)\r
+ End If\r
+ If FileExists(CD.FileName) Then\r
+ OpenMpq\r
+ If CD.FileName = "" Then\r
+ CD.FileName = OldFileName\r
+ StatBar.SimpleText = "The file does not contain an MPQ archive."\r
+ Else\r
+ StatBar.SimpleText = "Opened " + CD.FileName\r
+ AddRecentFile CD.FileName\r
+ End If\r
+ ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then\r
+ ReDim FileList(0) As String\r
+ List.ListItems.Clear\r
+ ShowSelected\r
+ ShowTotal\r
+ NewFile = True\r
+ ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
+ mnuMpq.Enabled = True\r
+ For Each TItem In mnuTItem\r
+ TItem.Enabled = True\r
+ Next TItem\r
+ Toolbar.Buttons.Item("Add").Enabled = True\r
+ Toolbar.Buttons.Item("Add Folder").Enabled = True\r
+ Toolbar.Buttons.Item("Extract").Enabled = True\r
+ Toolbar.Buttons.Item("Compact").Enabled = True\r
+ Toolbar.Buttons.Item("List").Enabled = True\r
+ If InStr(CD.FileName, "\") > 0 Then\r
+ For bNum = 1 To Len(CD.FileName)\r
+ If InStr(bNum, CD.FileName, "\") > 0 Then\r
+ bNum = InStr(bNum, CD.FileName, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ End If\r
+ Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
+ StatBar.SimpleText = "Created new " + CD.FileName\r
+ AddRecentFile CD.FileName\r
+ ElseIf CD.FileName = "" Then\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Case "n", "new"\r
+ If Param(2) <> "" Then\r
+ CD.FileName = FullPath(CurPath, Param(2))\r
+ If Param(3) <> "" Then\r
+ DefaultMaxFiles = Param(3)\r
+ End If\r
+ If CD.FileName <> "" Then\r
+ ReDim FileList(0) As String\r
+ List.ListItems.Clear\r
+ ShowSelected\r
+ ShowTotal\r
+ NewFile = True\r
+ ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
+ mnuMpq.Enabled = True\r
+ For Each TItem In mnuTItem\r
+ TItem.Enabled = True\r
+ Next TItem\r
+ Toolbar.Buttons.Item("Add").Enabled = True\r
+ Toolbar.Buttons.Item("Add Folder").Enabled = True\r
+ Toolbar.Buttons.Item("Extract").Enabled = True\r
+ Toolbar.Buttons.Item("Compact").Enabled = True\r
+ Toolbar.Buttons.Item("List").Enabled = True\r
+ If InStr(CD.FileName, "\") > 0 Then\r
+ For bNum = 1 To Len(CD.FileName)\r
+ If InStr(bNum, CD.FileName, "\") > 0 Then\r
+ bNum = InStr(bNum, CD.FileName, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ End If\r
+ Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
+ StatBar.SimpleText = "Created new " + CD.FileName\r
+ AddRecentFile CD.FileName\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Case "c", "close"\r
+ StatBar.SimpleText = "Close is for scripts only"\r
+ Case "p", "pause"\r
+ StatBar.SimpleText = "Pause not supported"\r
+ Case "a", "add"\r
+ If CD.FileName <> "" Then\r
+ ReDim FileShortNames(0) As String\r
+ cType = 0\r
+ Rswitch = False\r
+ fCount = 0\r
+ Files = ""\r
+ fEndLine = 0\r
+ fLine = ""\r
+ dwFlags = MAFA_REPLACE_EXISTING\r
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+ For pNum = 3 To UBound(Param)\r
+ If LCase(Param(pNum)) = "/wav" Then\r
+ cType = 2\r
+ dwFlags = dwFlags Or MAFA_COMPRESS\r
+ ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then\r
+ cType = 1\r
+ dwFlags = dwFlags Or MAFA_COMPRESS\r
+ ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then\r
+ cType = -1\r
+ ElseIf LCase(Param(pNum)) = "/r" Then\r
+ Rswitch = True\r
+ End If\r
+ Next pNum\r
+ If Left(Param(3), 1) = "/" Or Param(3) = "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Param(3) = ""\r
+ Else\r
+ Param(3) = Param(2)\r
+ End If\r
+ End If\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ If InStr(Param(2), "\") > 0 Then\r
+ For pNum = 1 To Len(Param(2))\r
+ If InStr(pNum, Param(2), "\") > 0 Then\r
+ pNum = InStr(pNum, Param(2), "\")\r
+ Files = Left(Param(2), pNum)\r
+ End If\r
+ Next pNum\r
+ End If\r
+ MousePointer = 11\r
+ If NewFile = True Then\r
+ If FileExists(CD.FileName) Then Kill CD.FileName\r
+ NewFile = False\r
+ End If\r
+ Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)\r
+ List.Sorted = False\r
+ FileFilter = mFilter\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ = 0 Then\r
+ StatBar.SimpleText = "Can't create archive " + CD.FileName\r
+ Exit Sub\r
+ End If\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ If cType = 0 Then\r
+ StatBar.SimpleText = "Adding " + fLine + "..."\r
+ ElseIf cType = 1 Then\r
+ StatBar.SimpleText = "Adding compressed " + fLine + "..."\r
+ ElseIf cType = 2 Then\r
+ StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."\r
+ ElseIf cType = -1 Then\r
+ StatBar.SimpleText = "Adding " + fLine + " (compression auto-select)..."\r
+ End If\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
+ If cType = 2 Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0\r
+ ElseIf cType = -1 Then\r
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine\r
+ ElseIf cType = 1 Then\r
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0\r
+ End If\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ mFilter.AddItem "*" + GetExtension(Param(3) + fLine)\r
+ For cNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
+ mFilter.RemoveItem cNum\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+ If MatchesFilter(Param(3) + fLine, FileFilter) Then\r
+ ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String\r
+ FileShortNames(UBound(FileShortNames)) = Param(3) + fLine\r
+ End If\r
+ Else\r
+ If cType = 2 Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0\r
+ ElseIf cType = -1 Then\r
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)\r
+ ElseIf cType = 1 Then\r
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0\r
+ End If\r
+ Else\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ mFilter.AddItem "*" + GetExtension(Param(3))\r
+ For cNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
+ mFilter.RemoveItem cNum\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+ If MatchesFilter(Param(3), FileFilter) Then\r
+ ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String\r
+ FileShortNames(UBound(FileShortNames)) = Param(3)\r
+ End If\r
+ End If\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ If UBound(FileShortNames) > 1 Then\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ StatBar.SimpleText = "Adding files to listing... 0% complete"\r
+ For pNum = 1 To UBound(FileShortNames)\r
+ If MatchesFilter(FileShortNames(pNum), FileFilter) Then\r
+ MpqAddToListing hMPQ, FileShortNames(pNum)\r
+ End If\r
+ On Error Resume Next\r
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"\r
+ On Error GoTo 0\r
+ Next pNum\r
+ SFileCloseArchive hMPQ\r
+ End If\r
+ ElseIf UBound(FileShortNames) = 1 Then\r
+ AddToListing FileShortNames(1)\r
+ End If\r
+ MousePointer = 0\r
+ If MatchesFilter("(listfile)", FileFilter) Then\r
+ AddToListing "(listfile)"\r
+ End If\r
+ mFilter = FileFilter\r
+ List.Sorted = True\r
+ RemoveDuplicates\r
+ ShowTotal\r
+ If fCount > 1 Then\r
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "e", "extract"\r
+ If CD.FileName <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Extracting " + Param(2) + "..."\r
+ cType = 0\r
+ For pNum = 3 To UBound(Param)\r
+ If LCase(Param(pNum)) = "/fp" Then\r
+ cType = 1\r
+ Exit For\r
+ End If\r
+ Next pNum\r
+ If Left(Param(3), 1) = "/" Then Param(3) = ""\r
+ If Param(3) = "" Then Param(3) = "."\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ MousePointer = 11\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(CD.FileName, Param(2))\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
+ StatBar.SimpleText = "Can't open archive " + CD.FileName\r
+ Exit Sub\r
+ End If\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ StatBar.SimpleText = "Extracting " + fLine + "..."\r
+ sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ SFileCloseArchive hMPQ\r
+ If fCount > 1 Then\r
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"\r
+ End If\r
+ Else\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
+ StatBar.SimpleText = "Can't open archive " + CD.FileName\r
+ Exit Sub\r
+ End If\r
+ sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType\r
+ SFileCloseArchive hMPQ\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ End If\r
+ MousePointer = 0\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "r", "ren", "rename"\r
+ If CD.FileName <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."\r
+ If Param(2) <> "" And Param(3) <> "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then\r
+ Files = MpqDir(CD.FileName, Param(2))\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
+ StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."\r
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, fLine2\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ Else\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RenameInListing fLine, fLine2\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ End If\r
+ If fCount > 1 Then\r
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "You must use wildcards with new name"\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, Param(3)\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ Else\r
+ MpqRenameFile hMPQ, Param(2), Param(3)\r
+ End If\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RenameInListing Param(2), Param(3)\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "m", "move"\r
+ If CD.FileName <> "" Then\r
+ For pNum = 1 To Len(Param(2))\r
+ If InStr(pNum, Param(2), "\") Then\r
+ pNum = InStr(pNum, Param(2), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next pNum\r
+ fLineTitle = Mid(Param(2), pNum)\r
+ If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
+ Param(3) = Param(3) + fLineTitle\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Moving " + Param(2) + " => " + Param(3) + "..."\r
+ If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(CD.FileName, Param(2))\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
+ StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."\r
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hMPQ, fLine2\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ Else\r
+ MpqRenameFile hMPQ, fLine, fLine2\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RenameInListing fLine, fLine2\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ End If\r
+ If fCount > 1 Then\r
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ MpqDeleteFile hFile, Param(3)\r
+ MpqRenameFile hFile, Param(2), Param(3)\r
+ Else\r
+ MpqRenameFile hFile, Param(2), Param(3)\r
+ End If\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RenameInListing Param(2), Param(3)\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "d", "del", "delete"\r
+ If CD.FileName <> "" Then\r
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Deleting " + Param(2) + "..."\r
+ If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
+ If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
+ Files = MpqDir(CD.FileName, Param(2))\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ For pNum = 1 To Len(Files)\r
+ fEndLine = InStr(pNum, Files, vbCrLf)\r
+ fLine = Mid(Files, pNum, fEndLine - pNum)\r
+ StatBar.SimpleText = "Deleting " + fLine + "..."\r
+ MpqDeleteFile hMPQ, fLine\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RemoveFromListing fLine\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ fCount = fCount + 1\r
+ pNum = fEndLine + 1\r
+ Next pNum\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ End If\r
+ If fCount > 1 Then\r
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"\r
+ End If\r
+ Else\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ MpqDeleteFile hMPQ, Param(2)\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ RemoveFromListing Param(2)\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "f", "flush", "compact"\r
+ If CD.FileName <> "" Then\r
+ MousePointer = 11\r
+ StatBar.SimpleText = "Flushing " + CD.FileName + "..."\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ MpqCompactArchive hMPQ\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ MousePointer = 0\r
+ OpenMpq\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "l", "list"\r
+ If CD.FileName <> "" Then\r
+ If Param(2) <> "" Then\r
+ StatBar.SimpleText = "Creating list..."\r
+ MousePointer = 11\r
+ If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then\r
+ Files = MpqDir(CD.FileName, Param(2))\r
+ Param(2) = Param(3)\r
+ Else\r
+ Files = MpqDir(CD.FileName, "*")\r
+ End If\r
+ fNum = FreeFile\r
+ Open FullPath(CurPath, Param(2)) For Binary As #fNum\r
+ Put #fNum, 1, Files\r
+ Close #fNum\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ MousePointer = 0\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Else\r
+ StatBar.SimpleText = "No archive open"\r
+ End If\r
+ Case "s", "script"\r
+ StatBar.SimpleText = "Running script " + Param(2) + "..."\r
+ If Param(2) <> "" Then\r
+ MousePointer = 11\r
+ RunScript FullPath(CurPath, Param(2))\r
+ MousePointer = 0\r
+ StatBar.SimpleText = StatBar.SimpleText + " Done"\r
+ Else\r
+ StatBar.SimpleText = "Required parameter missing"\r
+ End If\r
+ Case "x", "exit", "quit"\r
+ Unload Me\r
+ Case Else\r
+ If Left(Param(1), 1) <> ";" Then\r
+ If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then\r
+ On Error Resume Next\r
+ ChDir Param(2)\r
+ On Error GoTo 0\r
+ txtCommand_GotFocus\r
+ ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then\r
+ On Error Resume Next\r
+ ChDir Mid(Param(1), 3)\r
+ On Error GoTo 0\r
+ txtCommand_GotFocus\r
+ ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then\r
+ On Error Resume Next\r
+ ChDir Mid(Param(1), 6)\r
+ On Error GoTo 0\r
+ txtCommand_GotFocus\r
+ ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then\r
+ On Error Resume Next\r
+ ChDrive Left(Param(1), 2)\r
+ On Error GoTo 0\r
+ txtCommand_GotFocus\r
+ Else\r
+ Shell "command.com /k " + sLine, 1\r
+ End If\r
+ End If\r
+ End Select\r
+End If\r
+End Sub\r
+Sub BuildRecentFileList()\r
+Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu\r
+For Each RItem In mnuFRecent\r
+ If RItem.Index <> 0 Then Unload RItem\r
+Next RItem\r
+rNum2 = 1\r
+For rNum = 8 To 1 Step -1\r
+ RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))\r
+ If FileExists(RecentFile) Then\r
+ mnuFRecent(0).Visible = True\r
+ On Error Resume Next\r
+ Load mnuFRecent(rNum2)\r
+ On Error GoTo 0\r
+ mnuFRecent(rNum2).Tag = RecentFile\r
+ If TextWidth(RecentFile) > TextWidth("________________________________") Then\r
+ FirstSep = InStr(RecentFile, "\")\r
+ If FirstSep > 0 Then\r
+ For LastSep = FirstSep + 1 To Len(RecentFile)\r
+ If InStr(LastSep, RecentFile, "\") > 0 Then\r
+ LastSep = InStr(LastSep, RecentFile, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next LastSep\r
+ RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)\r
+ End If\r
+ End If\r
+ mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile\r
+ rNum2 = rNum2 + 1\r
+ End If\r
+ If rNum2 > 4 Then Exit For\r
+Next rNum\r
+End Sub\r
+Sub BuildToolsList()\r
+Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu\r
+For Each TItem In mnuTItem\r
+ If TItem.Index <> 0 Then Unload TItem\r
+Next TItem\r
+For Each TItem In mnuPTItem\r
+ If TItem.Index <> 0 Then Unload TItem\r
+Next TItem\r
+mnuTItem(0).Caption = "(Empty)"\r
+mnuPTItem(0).Caption = mnuTItem(0).Caption\r
+mnuTItem(0).Tag = ""\r
+mnuPTItem(0).Tag = ""\r
+Do\r
+ ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))\r
+ ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))\r
+ If ToolName = "" Then ToolName = ToolCommand\r
+ If ToolName <> "" Then\r
+ On Error Resume Next\r
+ Load mnuTItem(tNum)\r
+ Load mnuPTItem(tNum)\r
+ On Error GoTo 0\r
+ mnuTItem(tNum).Tag = ToolCommand\r
+ mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag\r
+ If InStr(ToolName, "&") = 0 And tNum < 9 Then\r
+ mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName\r
+ ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then\r
+ mnuTItem(tNum).Caption = "&0 " + ToolName\r
+ Else\r
+ mnuTItem(tNum).Caption = ToolName\r
+ End If\r
+ mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption\r
+ End If\r
+ tNum = tNum + 1\r
+Loop Until ToolName = ""\r
+End Sub\r
+Sub OpenMpq()\r
+Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long, FileEntries() As FILELISTENTRY\r
+On Error Resume Next\r
+If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then\r
+ ReDim FileList(0) As String\r
+ List.ListItems.Clear\r
+ ShowSelected\r
+ ShowTotal\r
+ NewFile = True\r
+ On Error GoTo 0\r
+ GoTo FileOpened\r
+End If\r
+On Error GoTo 0\r
+\r
+If IsMPQ(CD.FileName) = False Then\r
+ ConvertCwad\r
+End If\r
+\r
+If IsMPQ(CD.FileName) = False Then\r
+ CD.FileName = ""\r
+ MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"\r
+ Exit Sub\r
+End If\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
+ CD.FileName = ""\r
+ MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"\r
+ Exit Sub\r
+End If\r
+StatBar.Style = 1\r
+StatBar.SimpleText = "Loading list..."\r
+MousePointer = 11\r
+Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ReDim FileList(0) As String\r
+#If InternalListing Then\r
+FileList(0) = "(listfile)"\r
+If Mpq.FileExists(CD.FileName, "(listfile)") Then\r
+ FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)\r
+#Else\r
+ sListFiles CD.FileName, hMPQ, ListFile, FileEntries\r
+#End If\r
+ For bNum = 1 To Len(FileCont)\r
+ If InStr(bNum, FileCont, vbCrLf) > 0 Then\r
+ ReDim Preserve FileList(UBound(FileList) + 1) As String\r
+ FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)\r
+ bNum = InStr(bNum, FileCont, vbCrLf) + 1\r
+ Else\r
+ ReDim Preserve FileList(UBound(FileList) + 1) As String\r
+ FileList(UBound(FileList)) = Mid(FileCont, bNum)\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+#If InternalListing Then\r
+End If\r
+nFiles = UBound(FileList)\r
+ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String\r
+For bNum = nFiles + 1 To UBound(FileList)\r
+ FileList(bNum) = GlobalFileList(bNum - nFiles)\r
+Next bNum\r
+#End If\r
+Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long\r
+SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&\r
+List.ListItems.Clear\r
+List.Sorted = False\r
+FileFilter = mFilter\r
+StatBar.SimpleText = "Building list... 0% complete"\r
+mFilter.Clear\r
+For fNum = 0 To UBound(FileEntries)\r
+#If InternalListing Then\r
+ If Mpq.FileExists(CD.FileName, FileList(fNum)) Then\r
+#End If\r
+ If FileEntries(fNum).dwFileExists Then\r
+ MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)\r
+ StripNull MpqFileName\r
+ mFilter.AddItem "*" + GetExtension(MpqFileName)\r
+ For bNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then\r
+ mFilter.RemoveItem bNum\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ If MatchesFilter(MpqFileName, FileFilter) Then\r
+ L1 = MpqFileName\r
+ fSize = FileEntries(fNum).dwFullSize\r
+ cSize = FileEntries(fNum).dwCompressedSize\r
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
+ L2 = "<1KB"\r
+ ElseIf fSize = 0 Then\r
+ L2 = "0KB"\r
+ Else\r
+ L2 = CStr(Int(fSize / 1024)) + "KB"\r
+ End If\r
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
+ L4 = "<1KB"\r
+ ElseIf cSize = 0 Then\r
+ L4 = "0KB"\r
+ Else\r
+ L4 = CStr(Int(cSize / 1024)) + "KB"\r
+ End If\r
+ If fSize <> 0 Then\r
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
+ Else\r
+ L3 = "0%"\r
+ End If\r
+ fFlags = FileEntries(fNum).dwFlags\r
+ L6 = CStr(FileEntries(fNum).lcLocale)\r
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
+ lIndex = 0\r
+ On Error Resume Next\r
+ lIndex = List.ListItems.Add(, , L1).Index\r
+ On Error GoTo 0\r
+ If lIndex = 0 Then\r
+ lIndex = List.ListItems.Item(L1).Index\r
+ List.ListItems.Item(L1).ListSubItems.Clear\r
+ End If\r
+ List.ListItems.Item(lIndex).Tag = L1\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
+ If fSize <> 0 Then\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
+ Else\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
+ End If\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
+ End If\r
+ End If\r
+#If InternalListing Then\r
+ End If\r
+#End If\r
+ On Error Resume Next\r
+ StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"\r
+ On Error GoTo 0\r
+Next fNum\r
+SFileCloseArchive hMPQ\r
+List.Sorted = True\r
+'#If InternalListing Then\r
+RemoveDuplicates\r
+'#End If\r
+On Error Resume Next\r
+List.SelectedItem.Selected = False\r
+On Error GoTo 0\r
+SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&\r
+ShowSelected\r
+ShowTotal\r
+NewFile = False\r
+mFilter = FileFilter\r
+FileOpened:\r
+ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+mnuMpq.Enabled = True\r
+For Each TItem In mnuTItem\r
+ TItem.Enabled = True\r
+Next TItem\r
+Toolbar.Buttons.Item("Add").Enabled = True\r
+Toolbar.Buttons.Item("Add Folder").Enabled = True\r
+Toolbar.Buttons.Item("Extract").Enabled = True\r
+Toolbar.Buttons.Item("Compact").Enabled = True\r
+Toolbar.Buttons.Item("List").Enabled = True\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+If InStr(CD.FileName, "\") > 0 Then\r
+ For bNum = 1 To Len(CD.FileName)\r
+ If InStr(bNum, CD.FileName, "\") > 0 Then\r
+ bNum = InStr(bNum, CD.FileName, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+End If\r
+Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
+AddRecentFile CD.FileName\r
+MousePointer = 0\r
+End Sub\r
+\r
+Sub RemoveDuplicates()\r
+Dim fNum As Long\r
+fNum = 1\r
+Do While fNum <= List.ListItems.Count - 1\r
+ If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) And List.ListItems.Item(fNum).ListSubItems(4).Tag = List.ListItems.Item(fNum + 1).ListSubItems(4).Tag Then\r
+ List.ListItems.Remove (fNum)\r
+ fNum = fNum - 1\r
+ End If\r
+ fNum = fNum + 1\r
+Loop\r
+End Sub\r
+Sub ShowSelected()\r
+Dim fNum As Long, nSelect As Long, sSize As Currency, fSize As Long, L2 As String, hMPQ As Long, hFile As Long\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+On Error Resume Next\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ nSelect = nSelect + 1\r
+ If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then\r
+ sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
+ Else\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then\r
+ fSize = SFileGetFileSize(hFile, 0)\r
+ SFileCloseFile hFile\r
+ End If\r
+ SFileCloseArchive hMPQ\r
+ End If\r
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
+ L2 = "<1KB"\r
+ ElseIf fSize = 0 Then\r
+ L2 = "0KB"\r
+ Else\r
+ L2 = CStr(Int(fSize / 1024)) + "KB"\r
+ End If\r
+ List.ListItems.Item(fNum).ListSubItems(1).Text = L2\r
+ List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize\r
+ sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
+ End If\r
+ End If\r
+Next fNum\r
+If sSize / 1024 > 0 And sSize / 1024 < 1 Then\r
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"\r
+ElseIf sSize = 0 Then\r
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"\r
+Else\r
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"\r
+End If\r
+On Error GoTo 0\r
+Exit Sub\r
+NotSelected:\r
+StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"\r
+End Sub\r
+Sub ShowTotal()\r
+Dim fNum As Long, nFiles As Long, tSize As Currency\r
+On Error Resume Next\r
+For fNum = 1 To List.ListItems.Count\r
+ nFiles = nFiles + 1\r
+ If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then\r
+ tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
+ End If\r
+Next fNum\r
+If tSize / 1024 > 0 And tSize / 1024 < 1 Then\r
+ StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"\r
+Else\r
+ StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"\r
+End If\r
+On Error GoTo 0\r
+End Sub\r
+Private Sub cmdGo_Click()\r
+StatBar.Style = 1\r
+RunMpq2kCommand txtCommand\r
+txtCommand = ""\r
+If StatBar.SimpleText = "" Then txtCommand_GotFocus\r
+End Sub\r
+\r
+Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)\r
+If KeyCode = vbKeyShift Then\r
+ ShiftState = True\r
+ BuildMpqActionList\r
+End If\r
+End Sub\r
+Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)\r
+If KeyCode = vbKeyShift Then\r
+ ShiftState = False\r
+ BuildMpqActionList\r
+End If\r
+End Sub\r
+Private Sub Form_Load()\r
+Dim FileName As String, bNum As Long, CurPath As String, CurPath2 As String, CurPathType As Integer, sLine As String, Param() As String, pNum As Long, EndParam As Long, ParamCutout As String, OldStartPath As String, NewStartPath As String, ErrorText As String\r
+Dim Path\r
+Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+NewKey AppKey\r
+SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ\r
+SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ\r
+FixIcon hWnd, 1\r
+InitFileDialog CD\r
+CD.hwndOwner = hWnd\r
+CD.DefaultExt = "mpq"\r
+CD.MaxFileSize = 5120\r
+InitFolderDialog PathInput\r
+PathInput.hwndOwner = hWnd\r
+PathInput.Flags = BIF_RETURNONLYFSDIRS\r
+ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
+ChDir App.Path\r
+'If Mpq.MpqInitialize = False Then\r
+' ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: "\r
+' Select Case Mpq.LastError\r
+' Case MPQ_ERROR_NO_STAREDIT\r
+' ErrorText = ErrorText + "Can't find StarEdit.exe"\r
+' Case MPQ_ERROR_BAD_STAREDIT\r
+' ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07"\r
+' Case MPQ_ERROR_STAREDIT_RUNNING\r
+' ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this"\r
+' Case Else\r
+' ErrorText = ErrorText + "Unknown"\r
+' End Select\r
+' MsgBox ErrorText\r
+' End\r
+'End If\r
+ExtractPathNum = -1\r
+CopyPathNum = -1\r
+OldStartPath = CurDir\r
+CurPath = GetReg(AppKey + "StartupPath", CurDir)\r
+CurPathType = GetReg(AppKey + "StartupPathType", 0)\r
+If CurPathType < 0 Then CurPathType = 0\r
+If CurPathType > 2 Then CurPathType = 2\r
+If CurPathType = 1 Then\r
+ CurPath = App.Path\r
+End If\r
+CurPath2 = CurPath\r
+If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"\r
+If IsDir(CurPath2) Then\r
+ If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)\r
+ ChDir CurPath\r
+End If\r
+NewStartPath = CurDir\r
+On Error Resume Next\r
+Height = GetReg(AppKey + "Status\WindowHeight", Height)\r
+Left = GetReg(AppKey + "Status\WindowLeft", Left)\r
+Top = GetReg(AppKey + "Status\WindowTop", Top)\r
+Width = GetReg(AppKey + "Status\WindowWidth", Width)\r
+If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0\r
+ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")\r
+DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)\r
+DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)\r
+LocaleID = GetReg(AppKey + "LocaleID", 0)\r
+GlobalEncrypt = False\r
+DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)\r
+Select Case DefaultCompressID\r
+Case -3\r
+DefaultCompress = MAFA_COMPRESS_DEFLATE\r
+Case Else\r
+DefaultCompress = MAFA_COMPRESS_STANDARD\r
+End Select\r
+DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)\r
+BuildRecentFileList\r
+BuildToolsList\r
+On Error GoTo 0\r
+SFileSetLocale LocaleID\r
+ReDim GlobalFileList(0) As String\r
+#If InternalListing Then\r
+If FileExists(ListFile) Then\r
+ Open ListFile For Input As #1\r
+ Do While Not EOF(1)\r
+ ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String\r
+ Line Input #1, GlobalFileList(UBound(GlobalFileList))\r
+ Loop\r
+ Close #1\r
+End If\r
+#End If\r
+FileName = Trim(Command)\r
+If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)\r
+If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)\r
+FileName = Trim(FileName)\r
+If FileExists(FileName) Then\r
+ CD.FileName = FileName\r
+ Show\r
+ OpenMpq\r
+ Exit Sub\r
+End If\r
+ReDim FileList(0) As String\r
+If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"\r
+sLine = Command\r
+If Right(sLine, 1) <> " " Then sLine = sLine + " "\r
+If sLine <> "" Then\r
+ ReDim Param(0) As String\r
+ For pNum = 1 To Len(sLine)\r
+ If Mid(sLine, pNum, 1) = Chr(34) Then\r
+ pNum = pNum + 1\r
+ EndParam = InStr(pNum, sLine, Chr(34))\r
+ If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))\r
+ Else\r
+ EndParam = InStr(pNum, sLine, " ")\r
+ If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)\r
+ End If\r
+ If EndParam = 0 Then EndParam = Len(sLine) + 1\r
+ If pNum <> EndParam Then\r
+ If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then\r
+ ReDim Preserve Param(UBound(Param) + 1) As String\r
+ Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))\r
+ End If\r
+ End If\r
+ pNum = EndParam\r
+ Next pNum\r
+ If UBound(Param) < 3 Then ReDim Preserve Param(3) As String\r
+ Select Case LCase(Param(1))\r
+ Case "o", "open", "n", "new"\r
+ Show\r
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
+ ChDir OldStartPath\r
+ RunMpq2kCommand sLine\r
+ Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"\r
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
+ ChDir OldStartPath\r
+ CD.FileName = FullPath(CurDir, Param(2))\r
+ sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))\r
+ RunMpq2kCommand sLine\r
+ If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)\r
+ ChDir NewStartPath\r
+ Unload Me\r
+ Case "s", "script"\r
+ Show\r
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
+ ChDir OldStartPath\r
+ RunMpq2kCommand sLine\r
+ If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)\r
+ ChDir NewStartPath\r
+ End Select\r
+End If\r
+End Sub\r
+Private Sub Form_Resize()\r
+On Error Resume Next\r
+If WindowState <> 1 Then\r
+ List.Top = Toolbar.Height\r
+ List.Width = ScaleWidth\r
+ List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height\r
+ Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2\r
+ txtCommand.Top = List.Top + List.Height\r
+ txtCommand.Left = Label1.Width\r
+ txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width\r
+ cmdGo.Top = txtCommand.Top\r
+ cmdGo.Left = txtCommand.Left + txtCommand.Width\r
+ mFilter.Left = Toolbar.Buttons.Item("filterspace").Left\r
+ mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width\r
+ Toolbar.Buttons.Item("filterspace").Width = mFilter.Width\r
+End If\r
+End Sub\r
+Private Sub Form_Unload(Cancel As Integer)\r
+Dim Path As String\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+On Error Resume Next\r
+If ExtractPathNum > -1 Then\r
+ KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True\r
+ RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"\r
+End If\r
+If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then\r
+ KillEx Path + "Temp_extract\", "*", 6, True\r
+ RmDir Path + "Temp_extract\"\r
+End If\r
+If CopyPathNum > -1 Then\r
+ KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True\r
+ RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"\r
+End If\r
+If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then\r
+ KillEx Path + "Temp_copy\", "*", 6, True\r
+ RmDir Path + "Temp_copy\"\r
+End If\r
+If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then\r
+ NewKey AppKey\r
+ NewKey AppKey + "Status\"\r
+ If WindowState = 1 Then WindowState = 0\r
+ SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD\r
+ WindowState = 0\r
+ SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD\r
+ SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD\r
+ SetReg AppKey + "Status\WindowTop", Top, REG_DWORD\r
+ SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD\r
+End If\r
+If GetReg(AppKey + "StartupPathType", 0) <= 0 Then\r
+ SetReg AppKey + "StartupPath", CurDir\r
+End If\r
+End\r
+End Sub\r
+Private Sub Label1_Click()\r
+txtCommand.SetFocus\r
+End Sub\r
+Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)\r
+Dim result As Long, hMPQ As Long, hFile As Long\r
+If List.SelectedItem.Text <> NewString Then\r
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
+ result = vbYes\r
+ Else\r
+ result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
+ End If\r
+ If result = vbYes Then\r
+ List.SelectedItem.Tag = NewString\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then\r
+ SFileCloseFile hFile\r
+ SFileSetLocale List.SelectedItem.ListSubItems(4).Tag\r
+ MpqDeleteFile hMPQ, NewString\r
+ MpqRenameFile hMPQ, List.SelectedItem.Text, NewString\r
+ SFileSetLocale LocaleID\r
+ RemoveDuplicates\r
+ Else\r
+ SFileSetLocale List.SelectedItem.ListSubItems(4).Tag\r
+ MpqRenameFile hMPQ, List.SelectedItem.Text, NewString\r
+ SFileSetLocale LocaleID\r
+ End If\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ On Error Resume Next\r
+ List.SelectedItem.Key = NewString\r
+ On Error GoTo 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ End If\r
+ Else\r
+ Cancel = True\r
+ End If\r
+End If\r
+ShowSelected\r
+End Sub\r
+Private Sub List_Click()\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo NotClick\r
+List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
+On Error GoTo 0\r
+ShowSelected\r
+Exit Sub\r
+NotClick:\r
+List.SelectedItem.Selected = False\r
+NotSelected:\r
+ShowSelected\r
+BuildMpqActionList\r
+End Sub\r
+Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)\r
+If List.SortKey = ColumnHeader.Index - 1 Then\r
+ If List.SortOrder = 0 Then\r
+ List.SortOrder = 1\r
+ Else\r
+ List.SortOrder = 0\r
+ End If\r
+Else\r
+ List.SortOrder = 0\r
+ List.SortKey = ColumnHeader.Index - 1\r
+End If\r
+End Sub\r
+Private Sub List_DblClick()\r
+Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo NotClick\r
+List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
+On Error GoTo 0\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Path = Path + "Temp_extract\"\r
+If ExtractPathNum = -1 Then\r
+ fNum = 0\r
+ Do\r
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
+ fNum = fNum + 1\r
+ Loop\r
+ ExtractPathNum = fNum\r
+End If\r
+Path = Path + CStr(ExtractPathNum) + "\"\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
+ For bNum = 1 To UBound(OpenFiles)\r
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
+ AlreadyInList = True\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ If AlreadyInList = False Then\r
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ End If\r
+ End If\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
+ fName = List.ListItems.Item(fNum).Tag\r
+ BuildPopup Path + fName, 0, mnuPopup, mnuPItem\r
+ ExecuteFile Path + fName, 0, mnuPopup, mnuPItem\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
+ End If\r
+Next fNum\r
+SFileCloseArchive hMPQ\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+Exit Sub\r
+NotClick:\r
+List.SelectedItem.Selected = False\r
+NotSelected:\r
+End Sub\r
+Private Sub List_ItemClick(ByVal Item As ListItem)\r
+BuildMpqActionList\r
+End Sub\r
+Private Sub List_KeyPress(KeyAscii As Integer)\r
+If KeyAscii = 13 Then List_DblClick\r
+End Sub\r
+Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)\r
+Dim fNum As Long, fSelect As Long\r
+If KeyCode = vbKeyDelete Then\r
+ mnuMDelete_Click\r
+ElseIf (Shift And vbCtrlMask) And KeyCode = vbKeyA Then\r
+ fSelect = List.SelectedItem.Index\r
+ For fNum = 1 To List.ListItems.Count\r
+ List.ListItems.Item(fNum).Selected = True\r
+ Next fNum\r
+ List.ListItems.Item(fSelect).Selected = True\r
+ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then\r
+ On Error GoTo NotSelected\r
+ List.SelectedItem.Tag = List.SelectedItem.Tag\r
+ On Error GoTo 0\r
+ If List.SelectedItem.Selected = True Then\r
+ BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem\r
+ PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)\r
+ End If\r
+End If\r
+NotSelected:\r
+End Sub\r
+Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+CX = X\r
+CY = Y\r
+If Button And vbRightButton Then\r
+ On Error GoTo NotSelected\r
+ List.SelectedItem.Tag = List.SelectedItem.Tag\r
+ On Error GoTo NotClick\r
+ List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
+ On Error GoTo 0\r
+ BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem\r
+ PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)\r
+End If\r
+NotClick:\r
+NotSelected:\r
+End Sub\r
+Private Sub List_OLECompleteDrag(Effect As Long)\r
+List.Tag = ""\r
+End Sub\r
+Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)\r
+Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, Path2 As String, cNum As Long, FileFilter As String\r
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long\r
+If Data.GetFormat(ccCFFiles) <> True Then Exit Sub\r
+For fNum = 1 To Data.Files.Count\r
+ Path = Data.Files.Item(fNum)\r
+ If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ If IsDir(Path) Then\r
+ Path = Path + "*"\r
+ Data.Files.Remove fNum\r
+ Data.Files.Add Path, fNum\r
+ End If\r
+Next fNum\r
+Path = Data.Files.Item(1)\r
+For bNum = 1 To Len(Path)\r
+ If InStr(bNum, Path, "\") > 0 Then\r
+ For fNum = 1 To Data.Files.Count\r
+ If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound\r
+ Next fNum\r
+ bNum = InStr(bNum, Path, "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+Next bNum\r
+PathFound:\r
+Path = Left(Path, bNum - 1)\r
+ReDim Files(0) As String\r
+Files(0) = Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ReDim Preserve Files(Data.Files.Count) As String\r
+For bNum = 1 To Data.Files.Count\r
+ Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))\r
+ For fNum = 1 To Len(Files(bNum))\r
+ If InStr(fNum, Files(bNum), "\") > 0 Then\r
+ fNum = InStr(fNum, Files(bNum), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next fNum\r
+ FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)\r
+Next bNum\r
+If FolderFiles = "" Then Exit Sub\r
+ReDim Preserve Files(0) As String\r
+For bNum = 1 To Len(FolderFiles)\r
+ ReDim Preserve Files(UBound(Files) + 1) As String\r
+ If InStr(bNum, FolderFiles, vbCrLf) > 0 Then\r
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))\r
+ bNum = InStr(bNum, FolderFiles, vbCrLf) + 1\r
+ Else\r
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))\r
+ Exit For\r
+ End If\r
+Next bNum\r
+FoldName.Show 1\r
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
+If UBound(Files) > 1 Then\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ For bNum = 0 To UBound(Files)\r
+ ShortFiles(bNum) = AddFolderName + Files(bNum)\r
+ Next bNum\r
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
+ For bNum = 1 To UBound(Files)\r
+ Files(bNum) = FullPath(Files(0), Files(bNum))\r
+ Next bNum\r
+Else\r
+ For bNum = 1 To Len(Files(1))\r
+ If InStr(bNum, Files(1), "\") > 0 Then\r
+ bNum = InStr(bNum, Files(1), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
+ Files(1) = FullPath(Files(0), Files(1))\r
+End If\r
+If NewFile = True Then\r
+ If FileExists(CD.FileName) Then Kill CD.FileName\r
+ NewFile = False\r
+End If\r
+List.Sorted = False\r
+FileFilter = mFilter\r
+hMPQ = mOpenMpq(CD.FileName)\r
+If hMPQ = 0 Then\r
+ StatBar.SimpleText = "Can't create archive " + CD.FileName\r
+ Exit Sub\r
+End If\r
+dwFlags = MAFA_REPLACE_EXISTING\r
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+For bNum = 1 To UBound(Files)\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
+ MousePointer = 11\r
+ If mnuMCNone.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
+ ElseIf mnuMCStandard.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+ ElseIf mnuMCDeflate.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+ ElseIf mnuMCBzip2.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+ ElseIf mnuMCAMedium.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
+ ElseIf mnuMCAHighest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
+ ElseIf mnuMCALowest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
+ ElseIf mnuMCAuto.Checked Then\r
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
+ For cNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
+ mFilter.RemoveItem cNum\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+Next bNum\r
+MpqCloseUpdatedArchive hMPQ, 0\r
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ StatBar.SimpleText = "Adding files to listing... 0% complete"\r
+ For bNum = 1 To UBound(Files)\r
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
+ MpqAddToListing hMPQ, ShortFiles(bNum)\r
+ End If\r
+ On Error Resume Next\r
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
+ On Error GoTo 0\r
+ Next bNum\r
+ SFileCloseArchive hMPQ\r
+End If\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+If MatchesFilter("(listfile)", FileFilter) Then\r
+ AddToListing "(listfile)"\r
+End If\r
+mFilter = FileFilter\r
+List.Sorted = True\r
+RemoveDuplicates\r
+ShowTotal\r
+Cancel:\r
+End Sub\r
+Private Sub List_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)\r
+If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then\r
+ Effect = ccOLEDropEffectNone\r
+Else\r
+ Effect = ccOLEDropEffectCopy\r
+End If\r
+End Sub\r
+Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)\r
+Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Path = Path + "Temp_copy\"\r
+If CopyPathNum = -1 Then\r
+ fNum = 0\r
+ Do\r
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
+ fNum = fNum + 1\r
+ Loop\r
+ CopyPathNum = fNum\r
+End If\r
+Path = Path + CStr(CopyPathNum) + "\"\r
+KillEx Path, "*", 6, True\r
+fCount = 0\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then\r
+ Data.Files.Add Path + List.ListItems.Item(fNum).Tag\r
+ End If\r
+ fCount = fCount + 1\r
+ If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag\r
+ End If\r
+Next fNum\r
+SFileCloseArchive hMPQ\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then\r
+ Data.Files.Add Path + "*"\r
+ElseIf fCount = 1 Then\r
+ Data.Files.Add FirstFile\r
+End If\r
+End Sub\r
+Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)\r
+Data.SetData , ccCFFiles\r
+AllowedEffects = ccOLEDropEffectCopy\r
+List.Tag = "WinMPQ"\r
+End Sub\r
+Private Sub mFilter_KeyPress(KeyAscii As Integer)\r
+If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then\r
+ If NewFile = False Then OpenMpq\r
+End If\r
+End Sub\r
+Private Sub mnuFExit_Click()\r
+Unload Me\r
+End Sub\r
+Private Sub mnuFile_Click()\r
+If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False\r
+End Sub\r
+Private Sub mnuFRecent_Click(Index As Integer)\r
+Dim OldFileName As String\r
+OldFileName = CD.FileName\r
+CD.FileName = mnuFRecent(Index).Tag\r
+If FileExists(CD.FileName) = False Then\r
+ CD.FileName = OldFileName\r
+ MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"\r
+ DelRecentFile mnuFRecent(Index).Tag\r
+ Exit Sub\r
+End If\r
+OpenMpq\r
+If CD.FileName = "" Then\r
+ CD.FileName = OldFileName\r
+ DelRecentFile mnuFRecent(Index).Tag\r
+End If\r
+End Sub\r
+Private Sub mnuFReopen_Click()\r
+OpenMpq\r
+End Sub\r
+\r
+Private Sub mnuFScript_Click()\r
+Dim OldFileName As String, OldPath As String\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+CD.Filter = "All Files (*.*)|*.*"\r
+OldFileName = CD.FileName\r
+OldPath = CurDir\r
+CD.hwndOwner = hWnd\r
+If ShowOpen(CD) = False Then GoTo Cancel\r
+StatBar.Style = 1\r
+StatBar.SimpleText = "Running script " + CD.FileName + "..."\r
+MousePointer = 11\r
+RunScript CD.FileName\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+CD.FileName = OldFileName\r
+Cancel:\r
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)\r
+ChDir OldPath\r
+End Sub\r
+Private Sub mnuHAbout_Click()\r
+About.Show 1\r
+End Sub\r
+Private Sub mnuHReadme_Click()\r
+Dim Path As String\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+If FileExists(Path + "WinMPQ.rtf") Then\r
+ ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1\r
+Else\r
+ MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"\r
+End If\r
+End Sub\r
+Private Sub mnuMAdd_Click()\r
+Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String\r
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long\r
+CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2\r
+CD.Filter = "All Files (*.*)|*.*"\r
+OldFileName = CD.FileName\r
+CD.hwndOwner = hWnd\r
+If ShowOpen(CD) = False Then GoTo Cancel\r
+ReDim Files(0) As String\r
+bNum = 1\r
+If InStr(1, CD.FileName, Chr(0)) > 0 Then\r
+ Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)\r
+ bNum = InStr(1, CD.FileName, Chr(0)) + 1\r
+Else\r
+ Files(0) = Mid(CD.FileName, 1)\r
+End If\r
+For bNum = bNum To Len(CD.FileName)\r
+ ReDim Preserve Files(UBound(Files) + 1) As String\r
+ If InStr(bNum, CD.FileName, Chr(0)) > 0 Then\r
+ Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)\r
+ bNum = InStr(bNum, CD.FileName, Chr(0))\r
+ Else\r
+ Files(UBound(Files)) = Mid(CD.FileName, bNum)\r
+ Exit For\r
+ End If\r
+Next bNum\r
+CD.FileName = OldFileName\r
+FoldName.Show 1\r
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
+If UBound(Files) > 1 Then\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ For bNum = 0 To UBound(Files)\r
+ ShortFiles(bNum) = AddFolderName + Files(bNum)\r
+ Next bNum\r
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
+ For bNum = 1 To UBound(Files)\r
+ Files(bNum) = FullPath(Files(0), Files(bNum))\r
+ Next bNum\r
+Else\r
+ For bNum = 1 To Len(Files(1))\r
+ If InStr(bNum, Files(1), "\") > 0 Then\r
+ bNum = InStr(bNum, Files(1), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
+ Files(1) = FullPath(Files(0), Files(1))\r
+End If\r
+If NewFile = True Then\r
+ If FileExists(CD.FileName) Then Kill CD.FileName\r
+ NewFile = False\r
+End If\r
+List.Sorted = False\r
+FileFilter = mFilter\r
+hMPQ = mOpenMpq(CD.FileName)\r
+If hMPQ = 0 Then\r
+ StatBar.SimpleText = "Can't create archive " + CD.FileName\r
+ Exit Sub\r
+End If\r
+dwFlags = MAFA_REPLACE_EXISTING\r
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+For bNum = 1 To UBound(Files)\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
+ MousePointer = 11\r
+ If mnuMCNone.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
+ ElseIf mnuMCStandard.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+ ElseIf mnuMCDeflate.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+ ElseIf mnuMCBzip2.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+ ElseIf mnuMCAMedium.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
+ ElseIf mnuMCAHighest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
+ ElseIf mnuMCALowest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
+ ElseIf mnuMCAuto.Checked Then\r
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
+ For cNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
+ mFilter.RemoveItem cNum\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+Next bNum\r
+MpqCloseUpdatedArchive hMPQ, 0\r
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ StatBar.SimpleText = "Adding files to listing... 0% complete"\r
+ For bNum = 1 To UBound(Files)\r
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
+ MpqAddToListing hMPQ, ShortFiles(bNum)\r
+ End If\r
+ On Error Resume Next\r
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
+ On Error GoTo 0\r
+ Next bNum\r
+ SFileCloseArchive hMPQ\r
+End If\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+If MatchesFilter("(listfile)", FileFilter) Then\r
+ AddToListing "(listfile)"\r
+End If\r
+mFilter = FileFilter\r
+List.Sorted = True\r
+RemoveDuplicates\r
+ShowTotal\r
+Cancel:\r
+End Sub\r
+Private Sub mnuMAddFolder_Click()\r
+Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, cNum As Long, FileFilter As String, hMPQ As Long\r
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, dwFlags As Long\r
+PathInput.hwndOwner = hWnd\r
+Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)\r
+If Path = "" Then GoTo Cancel\r
+FolderFiles = DirEx(Path, "*", 6, True)\r
+If FolderFiles = "" Then Exit Sub\r
+ReDim Files(0) As String\r
+Files(0) = Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+For bNum = 1 To Len(FolderFiles)\r
+ ReDim Preserve Files(UBound(Files) + 1) As String\r
+ If InStr(bNum, FolderFiles, vbCrLf) > 0 Then\r
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))\r
+ bNum = InStr(bNum, FolderFiles, vbCrLf) + 1\r
+ Else\r
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))\r
+ Exit For\r
+ End If\r
+Next bNum\r
+FoldName.Show 1\r
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
+If UBound(Files) > 1 Then\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ For bNum = 0 To UBound(Files)\r
+ ShortFiles(bNum) = AddFolderName + Files(bNum)\r
+ Next bNum\r
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
+ For bNum = 1 To UBound(Files)\r
+ Files(bNum) = FullPath(Files(0), Files(bNum))\r
+ Next bNum\r
+Else\r
+ For bNum = 1 To Len(Files(1))\r
+ If InStr(bNum, Files(1), "\") > 0 Then\r
+ bNum = InStr(bNum, Files(1), "\")\r
+ Else\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ ReDim ShortFiles(UBound(Files)) As String\r
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
+ Files(1) = FullPath(Files(0), Files(1))\r
+End If\r
+If NewFile = True Then\r
+ If FileExists(CD.FileName) Then Kill CD.FileName\r
+ NewFile = False\r
+End If\r
+List.Sorted = False\r
+FileFilter = mFilter\r
+hMPQ = mOpenMpq(CD.FileName)\r
+If hMPQ = 0 Then\r
+ StatBar.SimpleText = "Can't create archive " + CD.FileName\r
+ Exit Sub\r
+End If\r
+dwFlags = MAFA_REPLACE_EXISTING\r
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+For bNum = 1 To UBound(Files)\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
+ MousePointer = 11\r
+ If mnuMCNone.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
+ ElseIf mnuMCStandard.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+ ElseIf mnuMCDeflate.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+ ElseIf mnuMCBzip2.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+ ElseIf mnuMCAMedium.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
+ ElseIf mnuMCAHighest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
+ ElseIf mnuMCALowest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
+ ElseIf mnuMCAuto.Checked Then\r
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
+ For cNum = 1 To mFilter.ListCount - 1\r
+ If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
+ mFilter.RemoveItem cNum\r
+ Exit For\r
+ End If\r
+ Next cNum\r
+Next bNum\r
+MpqCloseUpdatedArchive hMPQ, 0\r
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
+ StatBar.SimpleText = "Adding files to listing... 0% complete"\r
+ For bNum = 1 To UBound(Files)\r
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
+ MpqAddToListing hMPQ, ShortFiles(bNum)\r
+ End If\r
+ On Error Resume Next\r
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
+ On Error GoTo 0\r
+ Next bNum\r
+ SFileCloseArchive hMPQ\r
+End If\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+If MatchesFilter("(listfile)", FileFilter) Then\r
+ AddToListing "(listfile)"\r
+End If\r
+mFilter = FileFilter\r
+List.Sorted = True\r
+RemoveDuplicates\r
+ShowTotal\r
+Cancel:\r
+End Sub\r
+\r
+Private Sub mnuMAddToList_Click()\r
+frmAddToList.Show 1\r
+End Sub\r
+Private Sub mnuMCAHighest_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = True\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+Private Sub mnuMCALowest_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = True\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+\r
+\r
+Private Sub mnuMCAMedium_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = True\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+Private Sub mnuMCAuto_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = True\r
+End Sub\r
+\r
+Private Sub mnuMCBzip2_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = True\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+\r
+Private Sub mnuMCDeflate_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = True\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+\r
+\r
+Private Sub mnuMChLCID_Click()\r
+Dim fNum As Long\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ GoTo FileSelected\r
+ End If\r
+Next fNum\r
+GoTo NotSelected\r
+FileSelected:\r
+ChLCID.Show 1\r
+Exit Sub\r
+NotSelected:\r
+MsgBox "No files are selected.", , "WinMPQ"\r
+End Sub\r
+Private Sub mnuMCNone_Click()\r
+mnuMCNone.Checked = True\r
+mnuMCStandard.Checked = False\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+Private Sub mnuMCompact_Click()\r
+Dim fNum As Long, result As Long, hMPQ As Long\r
+If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
+ result = vbYes\r
+Else\r
+ result = MsgBox("Uncompressed files with an 'X' in the attributes column and are not" + vbCrLf + "listed in (listfile) may be corrupted or deleted by the compacting process." + vbCrLf + "(Note: These files are fairly rare) Continue with compact?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
+End If\r
+If result = vbYes Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Compacting " + CD.FileName + "..."\r
+ MousePointer = 11\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ MpqCompactArchive hMPQ\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ StatBar.Style = 0\r
+ StatBar.SimpleText = ""\r
+ MousePointer = 0\r
+ OpenMpq\r
+End If\r
+End Sub\r
+Private Sub mnuMCStandard_Click()\r
+mnuMCNone.Checked = False\r
+mnuMCStandard.Checked = True\r
+mnuMCDeflate.Checked = False\r
+mnuMCBzip2.Checked = False\r
+mnuMCALowest.Checked = False\r
+mnuMCAMedium.Checked = False\r
+mnuMCAHighest.Checked = False\r
+mnuMCAuto.Checked = False\r
+End Sub\r
+Private Sub mnuMDelete_Click()\r
+Dim fNum As Long, result As Long, hMPQ As Long\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ GoTo FileSelected\r
+ End If\r
+Next fNum\r
+GoTo NotSelected\r
+FileSelected:\r
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
+ result = vbYes\r
+ Else\r
+ result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
+ End If\r
+ If result = vbYes Then\r
+ fNum = 1\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ Do While fNum <= List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag\r
+ SFileSetLocale LocaleID\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ List.ListItems.Remove (fNum)\r
+ fNum = fNum - 1\r
+ End If\r
+ fNum = fNum + 1\r
+ Loop\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ End If\r
+ End If\r
+ StatBar.Style = 0\r
+ StatBar.SimpleText = ""\r
+ MousePointer = 0\r
+ ShowSelected\r
+ ShowTotal\r
+Exit Sub\r
+NotSelected:\r
+MsgBox "No files are selected.", , "WinMPQ"\r
+End Sub\r
+Private Sub mnuMEncrypt_Click()\r
+If mnuMEncrypt.Checked = False Then\r
+ mnuMEncrypt.Checked = True\r
+ GlobalEncrypt = True\r
+Else\r
+ mnuMEncrypt.Checked = False\r
+ GlobalEncrypt = False\r
+End If\r
+End Sub\r
+Private Sub mnuMExtract_Click()\r
+Dim fNum As Long, Path As String, result As Long, hMPQ As Long\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ GoTo FileSelected\r
+ End If\r
+Next fNum\r
+GoTo NotSelected\r
+FileSelected:\r
+PathInput.hwndOwner = hWnd\r
+Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)\r
+If Path = "" Then Exit Sub\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ End If\r
+Next fNum\r
+SFileCloseArchive hMPQ\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+Exit Sub\r
+NotSelected:\r
+If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
+ result = vbYes\r
+Else\r
+ result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
+End If\r
+If result = vbYes Then\r
+ PathInput.hwndOwner = hWnd\r
+ Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)\r
+ If Path = "" Then Exit Sub\r
+ If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+ For fNum = 1 To List.ListItems.Count\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ Next fNum\r
+ SFileCloseArchive hMPQ\r
+ StatBar.Style = 0\r
+ StatBar.SimpleText = ""\r
+ MousePointer = 0\r
+End If\r
+End Sub\r
+Private Sub mnuFNew_Click()\r
+Dim TItem As Menu\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+CD.DefaultExt = "mpq"\r
+CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"\r
+CD.hwndOwner = hWnd\r
+If ShowSave(CD) = False Then GoTo Cancel\r
+ReDim FileList(0) As String\r
+List.ListItems.Clear\r
+ShowSelected\r
+ShowTotal\r
+NewFile = True\r
+ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
+mnuMpq.Enabled = True\r
+For Each TItem In mnuTItem\r
+ TItem.Enabled = True\r
+Next TItem\r
+Toolbar.Buttons.Item("Add").Enabled = True\r
+Toolbar.Buttons.Item("Add Folder").Enabled = True\r
+Toolbar.Buttons.Item("Extract").Enabled = True\r
+Toolbar.Buttons.Item("Compact").Enabled = True\r
+Toolbar.Buttons.Item("List").Enabled = True\r
+Caption = "WinMPQ - " + CD.FileTitle\r
+AddRecentFile CD.FileName\r
+Cancel:\r
+End Sub\r
+Private Sub mnuFOpen_Click()\r
+Dim OldFileName As String\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+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 (*.*)|*.*"\r
+OldFileName = CD.FileName\r
+CD.hwndOwner = hWnd\r
+If ShowOpen(CD) = False Then GoTo Cancel\r
+OpenMpq\r
+If CD.FileName = "" Then CD.FileName = OldFileName\r
+Cancel:\r
+End Sub\r
+Private Sub mnuMItem_Click(Index As Integer)\r
+FileActionClick mnuMpq, mnuMItem, Index\r
+End Sub\r
+Private Sub mnuMRename_Click()\r
+List.StartLabelEdit\r
+End Sub\r
+Private Sub mnuMSaveList_Click()\r
+Dim fNum As Long, fList As String, OldFileName As String\r
+CD.Flags = &H1000 Or &H4 Or &H2\r
+CD.DefaultExt = "txt"\r
+CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"\r
+OldFileName = CD.FileName\r
+CD.FileName = CD.FileName + ".txt"\r
+CD.hwndOwner = hWnd\r
+If ShowSave(CD) = False Then GoTo Cancel\r
+StatBar.Style = 1\r
+StatBar.SimpleText = "Creating list..."\r
+MousePointer = 11\r
+For fNum = 1 To List.ListItems.Count\r
+ fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf\r
+Next fNum\r
+fNum = FreeFile\r
+Open CD.FileName For Binary As #fNum\r
+Put #fNum, 1, fList\r
+Close #fNum\r
+Cancel:\r
+CD.FileName = OldFileName\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+MousePointer = 0\r
+End Sub\r
+Private Sub mnuOptions_Click()\r
+Options.Show 1\r
+End Sub\r
+\r
+Private Sub mnuPChLCID_Click()\r
+mnuMChLCID_Click\r
+End Sub\r
+Private Sub mnuPDelete_Click()\r
+mnuMDelete_Click\r
+End Sub\r
+Private Sub mnuPExtract_Click()\r
+mnuMExtract_Click\r
+End Sub\r
+Private Sub mnuPItem_Click(Index As Integer)\r
+FileActionClick mnuPopup, mnuPItem, Index\r
+End Sub\r
+Private Sub mnuPRename_Click()\r
+mnuMRename_Click\r
+End Sub\r
+Private Sub mnuPTItem_Click(Index As Integer)\r
+mnuTItem_Click Index\r
+End Sub\r
+Private Sub mnuTAdd_Click()\r
+ToolList.Show 1\r
+BuildToolsList\r
+End Sub\r
+Private Sub mnuTItem_Click(Index As Integer)\r
+Dim Param As String, bNum As Long, FileName As String, Path As String, fNum As Long, AlreadyInList As Boolean, UseFile As Boolean, NewParam As String, FileNameList As String, hMPQ As Long\r
+Param = mnuTItem(Index).Tag\r
+On Error GoTo NoProgram\r
+If Param = "" Then Err.Raise 53\r
+On Error GoTo 0\r
+Do\r
+ If InStr(1, Param, "%mpq", 1) Then\r
+ bNum = InStr(1, Param, "%mpq", 1)\r
+ Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)\r
+ End If\r
+Loop While InStr(1, Param, "%mpq", 1)\r
+NewParam = Param\r
+On Error GoTo NotSelected\r
+List.SelectedItem.Tag = List.SelectedItem.Tag\r
+On Error GoTo 0\r
+If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag\r
+NotSelected:\r
+If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then\r
+ Path = App.Path\r
+ If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+ Path = Path + "Temp_extract\"\r
+ If ExtractPathNum = -1 Then\r
+ fNum = 0\r
+ Do\r
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
+ fNum = fNum + 1\r
+ Loop\r
+ ExtractPathNum = fNum\r
+ End If\r
+ Path = Path + CStr(ExtractPathNum) + "\"\r
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
+ For fNum = 1 To List.ListItems.Count\r
+ If List.ListItems.Item(fNum).Selected Then\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
+ MousePointer = 11\r
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
+ SFileSetLocale LocaleID\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
+ For bNum = 1 To UBound(OpenFiles)\r
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
+ AlreadyInList = True\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ Exit For\r
+ End If\r
+ Next bNum\r
+ If AlreadyInList = False Then\r
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
+ End If\r
+ End If\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
+ FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)\r
+ UseFile = True\r
+ Param = NewParam\r
+ Do\r
+ If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then\r
+ If FileName <> "" Then\r
+ Param = Param + " " + FileName\r
+ End If\r
+ ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then\r
+ bNum = InStr(Param, Chr(34) + "%1" + Chr(34))\r
+ If FileName <> "" Then\r
+ Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)\r
+ Else\r
+ Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)\r
+ End If\r
+ ElseIf InStr(Param, "%1") Then\r
+ bNum = InStr(Param, "%1")\r
+ If FileName <> "" Then\r
+ Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)\r
+ Else\r
+ Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)\r
+ End If\r
+ End If\r
+ Loop While InStr(Param, "%1")\r
+ On Error GoTo NoProgram\r
+ Shell Param, 1\r
+ On Error GoTo 0\r
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
+ End If\r
+ Next fNum\r
+ SFileCloseArchive hMPQ\r
+ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ On Error GoTo NoProgram\r
+ Shell Param, 1\r
+ On Error GoTo 0\r
+ Timer1.Enabled = True\r
+Else\r
+ MsgBox "No files are selected.", , "WinMPQ"\r
+End If\r
+If FileName <> "" Then\r
+ StatBar.Style = 0\r
+ StatBar.SimpleText = ""\r
+ MousePointer = 0\r
+End If\r
+Exit Sub\r
+NoProgram:\r
+If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"\r
+End Sub\r
+\r
+Private Sub mnuTMpqEmbed_Click()\r
+frmMpq.Show\r
+End Sub\r
+Private Sub Timer1_Timer()\r
+Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long\r
+If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub\r
+Path = App.Path\r
+If Right(Path, 1) <> "\" Then Path = Path + "\"\r
+Path = Path + "Temp_extract\"\r
+Path = Path + CStr(ExtractPathNum) + "\"\r
+For fNum = 1 To UBound(OpenFiles)\r
+ If FileExists(FullPath(Path, OpenFiles(fNum))) Then\r
+ If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then\r
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
+ result = vbYes\r
+ Else\r
+ result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")\r
+ End If\r
+ If FileExists(FullPath(Path, OpenFiles(fNum))) Then\r
+ OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))\r
+ If result = vbYes Then\r
+ List.Sorted = False\r
+ StatBar.Style = 1\r
+ StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."\r
+ MousePointer = 11\r
+ dwFlags = MAFA_REPLACE_EXISTING\r
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
+ hMPQ = mOpenMpq(CD.FileName)\r
+ If hMPQ Then\r
+ If mnuMCNone.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0\r
+ ElseIf mnuMCStandard.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
+ ElseIf mnuMCDeflate.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
+ ElseIf mnuMCBzip2.Checked Then\r
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
+ ElseIf mnuMCAMedium.Checked Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0\r
+ ElseIf mnuMCAHighest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1\r
+ ElseIf mnuMCALowest.Checked Then\r
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2\r
+ ElseIf mnuMCAuto.Checked Then\r
+ mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)\r
+ End If\r
+ End If\r
+ MpqAddToListing hMPQ, OpenFiles(fNum)\r
+ MpqCloseUpdatedArchive hMPQ, 0\r
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
+ StatBar.Style = 0\r
+ StatBar.SimpleText = ""\r
+ MousePointer = 0\r
+ List.Sorted = True\r
+ RemoveDuplicates\r
+ ShowTotal\r
+ End If\r
+ End If\r
+ End If\r
+ Else\r
+ For bNum = fNum To UBound(OpenFiles) - 1\r
+ OpenFiles(bNum) = OpenFiles(bNum + 1)\r
+ OpenFileDates(bNum) = OpenFileDates(bNum + 1)\r
+ Next bNum\r
+ ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date\r
+ fNum = fNum - 1\r
+ If UBound(OpenFiles) = 0 Then Timer1.Enabled = False\r
+ End If\r
+ If fNum >= UBound(OpenFiles) Then Exit For\r
+Next fNum\r
+If FileExists(CD.FileName) Then\r
+ If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq\r
+Else\r
+ OpenMpq\r
+End If\r
+End Sub\r
+Private Sub Toolbar_ButtonClick(ByVal Button As Button)\r
+Select Case Button.Key\r
+Case "New"\r
+ mnuFNew_Click\r
+Case "Open"\r
+ mnuFOpen_Click\r
+Case "Add"\r
+ mnuMAdd_Click\r
+Case "Add Folder"\r
+ mnuMAddFolder_Click\r
+Case "Extract"\r
+ mnuMExtract_Click\r
+Case "Compact"\r
+ mnuMCompact_Click\r
+Case "List"\r
+ If NewFile = False Then OpenMpq\r
+End Select\r
+End Sub\r
+Private Sub txtCommand_GotFocus()\r
+cmdGo.Default = True\r
+txtCommandHasFocus = True\r
+StatBar.Style = 1\r
+StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)\r
+End Sub\r
+Private Sub txtCommand_LostFocus()\r
+cmdGo.Default = False\r
+txtCommandHasFocus = False\r
+StatBar.Style = 0\r
+StatBar.SimpleText = ""\r
+End Sub\r