Current News
Archived News
Search News
Discussion Forum


Old Forum
Install Programs More Downloads...
Troubleshooting
Source Code
Format Specs.
Misc. Information
Non-SF Stuff
Links




ae3ba78ccb67ac1d9a80a2b1277f2b79d77050f7
1 VERSION 4.00
2 Begin VB.Form frmMpq 
3    BorderStyle     =   1  'Fixed Single
4    Caption         =   "MPQ Embedder"
5    ClientHeight    =   1695
6    ClientLeft      =   3045
7    ClientTop       =   2730
8    ClientWidth     =   2775
9    Height          =   2385
10    Icon            =   "frmMpq.frx":0000
11    Left            =   2985
12    LinkTopic       =   "Form1"
13    MaxButton       =   0   'False
14    ScaleHeight     =   1695
15    ScaleWidth      =   2775
16    Top             =   2100
17    Width           =   2895
18    Begin VB.CommandButton cmdSaveEXE 
19       Caption         =   "Save &EXE"
20       Enabled         =   0   'False
21       Height          =   375
22       Left            =   1440
23       TabIndex        =   3
24       Top             =   1200
25       Width           =   1215
26    End
27    Begin VB.CommandButton cmdRemove 
28       Caption         =   "&Remove"
29       Enabled         =   0   'False
30       Height          =   375
31       Left            =   120
32       TabIndex        =   2
33       Top             =   1200
34       Width           =   1215
35    End
36    Begin VB.CommandButton cmdSaveMPQ 
37       Caption         =   "Save &MPQ"
38       Enabled         =   0   'False
39       Height          =   375
40       Left            =   1440
41       TabIndex        =   1
42       Top             =   720
43       Width           =   1215
44    End
45    Begin VB.CommandButton cmdAdd 
46       Caption         =   "&Add"
47       Enabled         =   0   'False
48       Height          =   375
49       Left            =   120
50       TabIndex        =   0
51       Top             =   720
52       Width           =   1215
53    End
54    Begin VB.Label Label1 
55       Height          =   615
56       Left            =   120
57       TabIndex        =   4
58       Top             =   120
59       Width           =   2565
60       WordWrap        =   -1  'True
61    End
62    Begin VB.Menu mnuFile 
63       Caption         =   "&File"
64       Begin VB.Menu mnuFOpen 
65          Caption         =   "&Open..."
66       End
67       Begin VB.Menu mnuFSep 
68          Caption         =   "-"
69       End
70       Begin VB.Menu mnuFExit 
71          Caption         =   "E&xit"
72       End
73    End
74    Begin VB.Menu mnuRun 
75       Caption         =   "&Run EXE"
76       Enabled         =   0   'False
77    End
78    Begin VB.Menu mnuHelp 
79       Caption         =   "&Help"
80       Begin VB.Menu mnuHReadme 
81          Caption         =   "View &Readme..."
82       End
83       Begin VB.Menu mnuHSep 
84          Caption         =   "-"
85       End
86       Begin VB.Menu mnuHAbout 
87          Caption         =   "&About..."
88       End
89    End
90 End
91 Attribute VB_Name = "frmMpq"
92 Attribute VB_Creatable = False
93 Attribute VB_Exposed = False
94 Option Explicit
96 Dim MpqHeader As Long, IsEXE As Boolean, FileDialog As OPENFILENAME
97 Private Sub cmdAdd_Click()
98 Dim OldFileName As String, NewMpqHeader As Long, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
99 FileDialog.Flags = &H1000 Or &H4 Or &H2
100 FileDialog.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"
101 OldFileName = FileDialog.FileName
102 FileDialog.hwndOwner = hWnd
103 If ShowOpen(FileDialog) = False Then GoTo Cancel
104 NewMpqHeader = FindMpqHeader(FileDialog.FileName)
105 If NewMpqHeader = -1 Then
106     MsgBox "This file does not contain an MPQ archive.", , "MPQ Embedder"
107     GoTo Cancel
108 End If
109 fNum = FreeFile
110 Open FileDialog.FileName For Binary As #fNum
111 fNum2 = FreeFile
112 Open OldFileName For Binary As #fNum2
113 If MpqHeader / 512 <> Int(MpqHeader / 512) Then
114     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")
115     If bNum = vbYes Then
116         Text = String(512 - (MpqHeader - Int(MpqHeader / 512) * 512), Chr(0))
117         Put #fNum2, MpqHeader + 1, Text
118         MpqHeader = MpqHeader + Len(Text)
119     End If
120 End If
121 For bNum = NewMpqHeader + 1 To LOF(fNum) Step 2 ^ 20
122     Text = String(2 ^ 20, Chr(0))
123     If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
124         Get #fNum, bNum, Text
125         Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
126     Else
127         Text = String(LOF(fNum) - bNum + 1, Chr(0))
128         Get #fNum, bNum, Text
129         Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
130     End If
131 Next bNum
132 Close #fNum2
133 Close #fNum
134 cmdAdd.Enabled = False
135 cmdRemove.Enabled = True
136 cmdSaveMPQ.Enabled = True
137 cmdSaveEXE.Enabled = True
138 If MpqHeader / 512 = Int(MpqHeader / 512) Then
139     Label1.Caption = "This file contains an MPQ archive."
140 Else
141     Label1.Caption = "This file contains an MPQ archive, but other programs may not be able to read it."
142 End If
143 Cancel:
144 FileDialog.FileName = OldFileName
145 End Sub
146 Private Sub cmdRemove_Click()
147 Dim fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
148 bNum = MsgBox("Are you sure you want to permanently" + vbCrLf + "remove the MPQ archive from this file?", vbQuestion Or vbYesNo Or vbDefaultButton2, "MPQ Embedder")
149 If bNum = vbNo Then Exit Sub
150 fNum = FreeFile
151 Open FileDialog.FileName For Binary As #fNum
152 fNum2 = FreeFile
153 If Dir(FileDialog.FileName + ".remove") <> "" Then Kill FileDialog.FileName + ".remove"
154 Open FileDialog.FileName + ".remove" For Binary As #fNum2
155 For bNum = 1 To MpqHeader Step 2 ^ 20
156     Text = String(2 ^ 20, Chr(0))
157     If MpqHeader - bNum + 1 >= 2 ^ 20 Then
158         Get #fNum, bNum, Text
159         Put #fNum2, bNum, Text
160     Else
161         Text = String(MpqHeader - bNum + 1, Chr(0))
162         Get #fNum, bNum, Text
163         Put #fNum2, bNum, Text
164     End If
165 Next bNum
166 Close #fNum2
167 Close #fNum
168 Kill FileDialog.FileName
169 Name FileDialog.FileName + ".remove" As FileDialog.FileName
170 cmdAdd.Enabled = True
171 cmdRemove.Enabled = False
172 cmdSaveMPQ.Enabled = False
173 cmdSaveEXE.Enabled = True
174 Label1.Caption = "This file does not contain an MPQ archive."
175 End Sub
176 Private Sub cmdSaveEXE_Click()
177 Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
178 FileDialog.Flags = &H1000 Or &H4 Or &H2
179 FileDialog.Filter = "File (*.*)|*.*"
180 FileDialog.DefaultExt = ""
181 OldFileName = FileDialog.FileName
182 FileDialog.FileName = FileDialog.FileName
183 FileDialog.hwndOwner = hWnd
184 If ShowSave(FileDialog) = False Then GoTo Cancel
185 fNum = FreeFile
186 Open OldFileName For Binary As #fNum
187 fNum2 = FreeFile
188 If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
189 Open FileDialog.FileName For Binary As #fNum2
190 For bNum = 1 To MpqHeader Step 2 ^ 20
191     Text = String(2 ^ 20, Chr(0))
192     If MpqHeader - bNum + 1 >= 2 ^ 20 Then
193         Get #fNum, bNum, Text
194         Put #fNum2, bNum, Text
195     Else
196         Text = String(MpqHeader - bNum + 1, Chr(0))
197         Get #fNum, bNum, Text
198         Put #fNum2, bNum, Text
199     End If
200 Next bNum
201 Close #fNum2
202 Close #fNum
203 Cancel:
204 FileDialog.FileName = OldFileName
205 End Sub
206 Private Sub cmdSaveMPQ_Click()
207 Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
208 FileDialog.Flags = &H1000 Or &H4 Or &H2
209 FileDialog.Filter = "MPQ Archive (*.mpq)|*.mpq"
210 FileDialog.DefaultExt = "mpq"
211 OldFileName = FileDialog.FileName
212 FileDialog.FileName = FileDialog.FileName + ".mpq"
213 FileDialog.hwndOwner = hWnd
214 If ShowSave(FileDialog) = False Then GoTo Cancel
215 fNum = FreeFile
216 Open OldFileName For Binary As #fNum
217 fNum2 = FreeFile
218 If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
219 Open FileDialog.FileName For Binary As #fNum2
220 For bNum = MpqHeader + 1 To LOF(fNum) Step 2 ^ 20
221     Text = String(2 ^ 20, Chr(0))
222     If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
223         Get #fNum, bNum, Text
224         Put #fNum2, bNum - MpqHeader, Text
225     Else
226         Text = String(LOF(fNum) - bNum + 1, Chr(0))
227         Get #fNum, bNum, Text
228         Put #fNum2, bNum - MpqHeader, Text
229     End If
230 Next bNum
231 Close #fNum2
232 Close #fNum
233 Cancel:
234 FileDialog.FileName = OldFileName
235 End Sub
237 Private Sub Form_Load()
238 FileDialog = CD
239 End Sub
240 Private Sub mnuFExit_Click()
241 Unload Me
242 End Sub
243 Private Sub mnuFOpen_Click()
244 Dim OldFileName As String, OldMpqHeader As Long, fNum As Long, Text As String
245 FileDialog.Flags = &H1000 Or &H4 Or &H2
246 FileDialog.Filter = "All Files (*.*)|*.*"
247 OldFileName = FileDialog.FileName
248 OldMpqHeader = MpqHeader
249 FileDialog.hwndOwner = hWnd
250 If ShowOpen(FileDialog) = False Then GoTo Cancel
251 If FileLen(FileDialog.FileName) = 0 Then
252     MsgBox "This is an empty file.", vbExclamation, "MPQ Embedder"
253     GoTo Cancel
254 End If
255 fNum = FreeFile
256 Open FileDialog.FileName For Binary As #fNum
257 Text = String(2, Chr(0))
258 If LOF(fNum) >= 2 Then Get #fNum, 1, Text
259 Close #fNum
260 If Text = "MZ" Then IsEXE = True Else IsEXE = False
261 If IsEXE Then mnuRun.Enabled = True Else mnuRun.Enabled = False
262 MpqHeader = FindMpqHeader(FileDialog.FileName)
263 If MpqHeader <= -1 Then
264     cmdAdd.Enabled = True
265     cmdRemove.Enabled = False
266     cmdSaveMPQ.Enabled = False
267     cmdSaveEXE.Enabled = True
268     MpqHeader = FileLen(FileDialog.FileName)
269     Label1.Caption = "This file does not contain an MPQ archive."
270 ElseIf MpqHeader = 0 Then
271     cmdAdd.Enabled = False
272     cmdRemove.Enabled = False
273     cmdSaveMPQ.Enabled = True
274     cmdSaveEXE.Enabled = False
275     Label1.Caption = "This file is an MPQ archive."
276 ElseIf MpqHeader > 0 Then
277     cmdAdd.Enabled = False
278     cmdRemove.Enabled = True
279     cmdSaveMPQ.Enabled = True
280     cmdSaveEXE.Enabled = True
281     If MpqHeader / 512 = Int(MpqHeader / 512) Then
282         Label1.Caption = "This file contains an MPQ archive."
283     Else
284         Label1.Caption = "This file contains an MPQ archive, but other programs may be unable to read it."
285     End If
286 End If
287 Exit Sub
288 Cancel:
289 FileDialog.FileName = OldFileName
290 MpqHeader = OldMpqHeader
291 End Sub
292 Private Sub mnuHAbout_Click()
293 About.Show 1
294 End Sub
295 Private Sub mnuHReadme_Click()
296 Dim Path As String
297 Path = App.Path
298 If Right(Path, 1) <> "\" Then Path = Path + "\"
299 If Dir(Path + "WMpqEmbed.rtf") = "" Then MsgBox "Could not find WMpqEmbed.rtf!", vbCritical, "MPQ Embedder"
300 ShellExecute hWnd, vbNullString, Path + "WMpqEmbed.rtf", vbNullString, vbNullString, 1
301 End Sub
302 Private Sub mnuRun_Click()
303 On Error GoTo NotExecutable
304 Shell FileDialog.FileName, 1
305 Exit Sub
306 NotExecutable:
307 MsgBox "This file is not a .exe file.", vbInformation, "MPQ Embedder"
308 End Sub