-
Notifications
You must be signed in to change notification settings - Fork 3
/
frmMpq.frm
308 lines (306 loc) · 10.3 KB
/
frmMpq.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
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