frmMpq.frm

   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
  95
  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
 236
 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