listing.frm

   1 VERSION 4.00
   2 Begin VB.Form MpqEx
   3    Caption         =   "WinMPQ"
   4    ClientHeight    =   3510
   5    ClientLeft      =   1245
   6    ClientTop       =   1785
   7    ClientWidth     =   6690
   8    Height          =   4200
   9    Icon            =   "listing.frx":0000
  10    KeyPreview      =   -1  'True
  11    Left            =   1185
  12    LinkTopic       =   "Form1"
  13    ScaleHeight     =   3510
  14    ScaleWidth      =   6690
  15    Top             =   1155
  16    Width           =   6810
  17    Begin VB.Timer Timer1
  18       Enabled         =   0   'False
  19       Interval        =   2500
  20       Left            =   6120
  21       Top             =   2160
  22    End
  23    Begin VB.TextBox txtCommand
  24       BackColor       =   &H8000000F&
  25       Height          =   285
  26       Left            =   1440
  27       TabIndex        =   1
  28       Top             =   2880
  29       Width           =   4695
  30    End
  31    Begin VB.CommandButton cmdGo
  32       Caption         =   "Go"
  33       Height          =   285
  34       Left            =   6120
  35       TabIndex        =   2
  36       Top             =   2880
  37       Width           =   495
  38    End
  39    Begin VB.ComboBox mFilter
  40       Height          =   315
  41       ItemData        =   "listing.frx":27A2
  42       Left            =   5220
  43       List            =   "listing.frx":27A9
  44       Sorted          =   -1  'True
  45       TabIndex        =   3
  46       Text            =   "*"
  47       Top             =   30
  48       Width           =   675
  49    End
  50    Begin MSComctlLib.Toolbar Toolbar
  51       Align           =   1  'Align Top
  52       Height          =   345
  53       Left            =   0
  54       TabIndex        =   5
  55       Top             =   0
  56       Width           =   6690
  57       _ExtentX        =   11800
  58       _ExtentY        =   609
  59       ButtonWidth     =   1535
  60       ButtonHeight    =   556
  61       Wrappable       =   0   'False
  62       Appearance      =   1
  63       Style           =   1
  64       ImageList       =   "ImageList1"
  65       _Version        =   393216
  66       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
  67          NumButtons      =   8
  68          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
  69             Caption         =   "New"
  70             Key             =   "New"
  71             Description     =   "Create a new archive"
  72             ToolTipText     =   "Create a new archive"
  73             ImageIndex      =   1
  74          EndProperty
  75          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
  76             Caption         =   "Open"
  77             Key             =   "Open"
  78             Description     =   "Open an existing archive"
  79             ToolTipText     =   "Open an existing archive"
  80          EndProperty
  81          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
  82             Enabled         =   0   'False
  83             Caption         =   "Add"
  84             Key             =   "Add"
  85             Description     =   "Add files to the archive"
  86             ToolTipText     =   "Add files to the archive"
  87          EndProperty
  88          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
  89             Enabled         =   0   'False
  90             Caption         =   "Add Folder"
  91             Key             =   "Add Folder"
  92             Description     =   "Add files from a folder and its subfolders"
  93             ToolTipText     =   "Add files from a folder and its subfolders"
  94          EndProperty
  95          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
  96             Enabled         =   0   'False
  97             Caption         =   "Extract"
  98             Key             =   "Extract"
  99             Description     =   "Extract files from the archive"
 100             ToolTipText     =   "Extract files from the archive"
 101          EndProperty
 102          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
 103             Enabled         =   0   'False
 104             Caption         =   "Compact"
 105             Key             =   "Compact"
 106             Description     =   "Clear deleted files from the archive"
 107             ToolTipText     =   "Clear deleted files from the archive"
 108          EndProperty
 109          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
 110             Enabled         =   0   'False
 111             Key             =   "filterspace"
 112             Style           =   4
 113             Object.Width           =   675
 114          EndProperty
 115          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
 116             Enabled         =   0   'False
 117             Caption         =   "List"
 118             Key             =   "List"
 119          EndProperty
 120       EndProperty
 121    End
 122    Begin VB.Label Label1
 123       AutoSize        =   -1  'True
 124       Caption         =   " MPQ2k &Command  "
 125       Height          =   195
 126       Left            =   0
 127       TabIndex        =   6
 128       Top             =   2880
 129       Width           =   1425
 130    End
 131    Begin MSComctlLib.ImageList ImageList1
 132       Left            =   6120
 133       Top             =   1560
 134       _ExtentX        =   1005
 135       _ExtentY        =   1005
 136       BackColor       =   -2147483643
 137       ImageWidth      =   1
 138       ImageHeight     =   1
 139       MaskColor       =   12632256
 140       _Version        =   393216
 141       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
 142          NumListImages   =   1
 143          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
 144             Picture         =   "listing.frx":27B0
 145             Key             =   ""
 146          EndProperty
 147       EndProperty
 148    End
 149    Begin MSComctlLib.StatusBar StatBar
 150       Align           =   2  'Align Bottom
 151       Height          =   300
 152       Left            =   0
 153       TabIndex        =   4
 154       Top             =   3210
 155       Width           =   6690
 156       _ExtentX        =   11800
 157       _ExtentY        =   529
 158       _Version        =   393216
 159       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
 160          NumPanels       =   2
 161          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
 162             AutoSize        =   1
 163             Object.Width           =   5664
 164             MinWidth        =   2
 165             Key             =   "FileInfo"
 166          EndProperty
 167          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
 168             AutoSize        =   1
 169             Object.Width           =   5664
 170             MinWidth        =   2
 171             Key             =   "MpqInfo"
 172          EndProperty
 173       EndProperty
 174    End
 175    Begin MSComctlLib.ListView List
 176       Height          =   2295
 177       Left            =   0
 178       TabIndex        =   0
 179       Top             =   360
 180       Width           =   6015
 181       _ExtentX        =   10610
 182       _ExtentY        =   4048
 183       View            =   3
 184       Arrange         =   2
 185       Sorted          =   -1  'True
 186       MultiSelect     =   -1  'True
 187       LabelWrap       =   -1  'True
 188       HideSelection   =   -1  'True
 189       OLEDragMode     =   1
 190       OLEDropMode     =   1
 191       AllowReorder    =   -1  'True
 192       _Version        =   393217
 193       ForeColor       =   -2147483640
 194       BackColor       =   -2147483643
 195       BorderStyle     =   1
 196       Appearance      =   1
 197       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 198          Name            =   "MS Sans Serif"
 199          Size            =   8.25
 200          Charset         =   0
 201          Weight          =   400
 202          Underline       =   0   'False
 203          Italic          =   0   'False
 204          Strikethrough   =   0   'False
 205       EndProperty
 206       OLEDragMode     =   1
 207       OLEDropMode     =   1
 208       NumItems        =   6
 209       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 210          Key             =   "N"
 211          Text            =   "Name"
 212          Object.Width           =   5080
 213       EndProperty
 214       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 215          Alignment       =   1
 216          SubItemIndex    =   1
 217          Key             =   "S"
 218          Text            =   "Size"
 219          Object.Width           =   1905
 220       EndProperty
 221       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 222          Alignment       =   1
 223          SubItemIndex    =   2
 224          Key             =   "R"
 225          Text            =   "Ratio"
 226          Object.Width           =   1129
 227       EndProperty
 228       BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 229          Alignment       =   1
 230          SubItemIndex    =   3
 231          Key             =   "PK"
 232          Text            =   "Packed"
 233          Object.Width           =   1905
 234       EndProperty
 235       BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 236          SubItemIndex    =   4
 237          Key             =   "LCID"
 238          Text            =   "Locale ID"
 239          Object.Width           =   1129
 240       EndProperty
 241       BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
 242          SubItemIndex    =   5
 243          Key             =   "A"
 244          Text            =   "Attributes"
 245          Object.Width           =   1129
 246       EndProperty
 247    End
 248    Begin VB.Menu mnuFile
 249       Caption         =   "&File"
 250       Begin VB.Menu mnuFNew
 251          Caption         =   "&New..."
 252          Shortcut        =   ^N
 253       End
 254       Begin VB.Menu mnuFOpen
 255          Caption         =   "&Open..."
 256          Shortcut        =   ^O
 257       End
 258       Begin VB.Menu mnuFReopen
 259          Caption         =   "&Reopen Mpq"
 260          Shortcut        =   {F5}
 261       End
 262       Begin VB.Menu mnuFScript
 263          Caption         =   "Run Mo'PaQ 2000 &Script..."
 264          Shortcut        =   ^S
 265       End
 266       Begin VB.Menu mnuFSep
 267          Caption         =   "-"
 268       End
 269       Begin VB.Menu mnuFExit
 270          Caption         =   "E&xit"
 271       End
 272       Begin VB.Menu mnuFRecent
 273          Caption         =   "-"
 274          Index           =   0
 275          Visible         =   0   'False
 276       End
 277    End
 278    Begin VB.Menu mnuMpq
 279       Caption         =   "&Mpq"
 280       Enabled         =   0   'False
 281       Begin VB.Menu mnuMItem
 282          Caption         =   "&Open"
 283          Index           =   0
 284          Visible         =   0   'False
 285       End
 286       Begin VB.Menu mnuMSep1
 287          Caption         =   "-"
 288          Visible         =   0   'False
 289       End
 290       Begin VB.Menu mnuMExtract
 291          Caption         =   "&Extract"
 292          Shortcut        =   ^E
 293       End
 294       Begin VB.Menu mnuMDelete
 295          Caption         =   "&Delete         Del or"
 296          Shortcut        =   ^D
 297       End
 298       Begin VB.Menu mnuMRename
 299          Caption         =   "Rena&me"
 300          Shortcut        =   ^R
 301       End
 302       Begin VB.Menu mnuMChLCID
 303          Caption         =   "Change Locale &ID..."
 304          Shortcut        =   ^I
 305       End
 306       Begin VB.Menu mnuMSep2
 307          Caption         =   "-"
 308       End
 309       Begin VB.Menu mnuMAdd
 310          Caption         =   "&Add..."
 311          Shortcut        =   ^A
 312       End
 313       Begin VB.Menu mnuMAddFolder
 314          Caption         =   "Add &Folder..."
 315          Shortcut        =   ^F
 316       End
 317       Begin VB.Menu mnuMCompression
 318          Caption         =   "&Compression"
 319          Begin VB.Menu mnuMCAuto
 320             Caption         =   "Auto-Select"
 321             Checked         =   -1  'True
 322             Shortcut        =   {F4}
 323          End
 324          Begin VB.Menu mnuMCSep
 325             Caption         =   "-"
 326          End
 327          Begin VB.Menu mnuMCNone
 328             Caption         =   "&None"
 329             Shortcut        =   {F2}
 330          End
 331          Begin VB.Menu mnuMCStandard
 332             Caption         =   "&Standard"
 333             Shortcut        =   {F3}
 334          End
 335          Begin VB.Menu mnuMCDeflate
 336             Caption         =   "&Deflate"
 337             Shortcut        =   {F9}
 338          End
 339          Begin VB.Menu mnuMCAudio
 340             Caption         =   "&Audio"
 341             Begin VB.Menu mnuMCALowest
 342                Caption         =   "&Lowest (Best quality)"
 343                Shortcut        =   {F6}
 344             End
 345             Begin VB.Menu mnuMCAMedium
 346                Caption         =   "&Medium"
 347                Shortcut        =   {F7}
 348             End
 349             Begin VB.Menu mnuMCAHighest
 350                Caption         =   "&Highest (Least space)"
 351                Shortcut        =   {F8}
 352             End
 353          End
 354       End
 355       Begin VB.Menu mnuMEncrypt
 356          Caption         =   "Encr&ypt Files"
 357       End
 358       Begin VB.Menu mnuMCompact
 359          Caption         =   "Com&pact"
 360          Shortcut        =   ^P
 361       End
 362       Begin VB.Menu mnuMAddToList
 363          Caption         =   "Add File to Li&sting..."
 364          Shortcut        =   ^K
 365       End
 366       Begin VB.Menu mnuMSaveList
 367          Caption         =   "Save File &List..."
 368          Shortcut        =   ^L
 369       End
 370    End
 371    Begin VB.Menu mnuTools
 372       Caption         =   "&Tools"
 373       Begin VB.Menu mnuTItem
 374          Caption         =   "(Empty)"
 375          Enabled         =   0   'False
 376          Index           =   0
 377       End
 378       Begin VB.Menu mnuTSep
 379          Caption         =   "-"
 380       End
 381       Begin VB.Menu mnuTMpqEmbed
 382          Caption         =   "MPQ Embedder"
 383       End
 384       Begin VB.Menu mnuTSep2
 385          Caption         =   "-"
 386       End
 387       Begin VB.Menu mnuTAdd
 388          Caption         =   "&Add/Remove..."
 389       End
 390    End
 391    Begin VB.Menu mnuOptions
 392       Caption         =   "&Options..."
 393    End
 394    Begin VB.Menu mnuHelp
 395       Caption         =   "&Help"
 396       Begin VB.Menu mnuHReadme
 397          Caption         =   "View &Readme..."
 398          Shortcut        =   {F1}
 399       End
 400       Begin VB.Menu mnuHSep
 401          Caption         =   "-"
 402       End
 403       Begin VB.Menu mnuHAbout
 404          Caption         =   "&About..."
 405       End
 406    End
 407    Begin VB.Menu mnuPopup
 408       Caption         =   "Popup Menu"
 409       Visible         =   0   'False
 410       Begin VB.Menu mnuPItem
 411          Caption         =   "&Open"
 412          Index           =   0
 413       End
 414       Begin VB.Menu mnuPSep1
 415          Caption         =   "-"
 416       End
 417       Begin VB.Menu mnuPTools
 418          Caption         =   "&Tools"
 419          Begin VB.Menu mnuPTItem
 420             Caption         =   "(Empty)"
 421             Index           =   0
 422          End
 423       End
 424       Begin VB.Menu mnuPSep2
 425          Caption         =   "-"
 426       End
 427       Begin VB.Menu mnuPExtract
 428          Caption         =   "&Extract"
 429       End
 430       Begin VB.Menu mnuPDelete
 431          Caption         =   "&Delete"
 432       End
 433       Begin VB.Menu mnuPRename
 434          Caption         =   "Rena&me"
 435       End
 436       Begin VB.Menu mnuPChLCID
 437          Caption         =   "Change Locale &ID..."
 438       End
 439    End
 440 End
 441 Attribute VB_Name = "MpqEx"
 442 Attribute VB_Creatable = False
 443 Attribute VB_Exposed = False
 444 Option Explicit
 445
 446 Dim txtCommandHasFocus As Boolean, ShiftState As Boolean
 447 Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date
 448 Sub AddRecentFile(rFileName As String)
 449 Dim bNum As Long, fNum As Long
 450 NewKey AppKey + "Recent\"
 451 For bNum = 1 To 8
 452     If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
 453         For fNum = bNum To 7
 454             If Not IsEmpty(GetReg(AppKey + "Recent\File" + CStr(fNum + 1))) Then
 455                 SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
 456             Else
 457                 Exit For
 458             End If
 459         Next fNum
 460         SetReg AppKey + "Recent\File" + CStr(fNum), rFileName
 461         Exit For
 462     End If
 463 Next bNum
 464 If fNum = 0 Then
 465     For bNum = 1 To 8
 466         If IsEmpty(GetReg(AppKey + "Recent\File" + CStr(bNum))) Then
 467             SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
 468             Exit For
 469         ElseIf bNum = 8 Then
 470             For fNum = 1 To 7
 471                 SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
 472             Next fNum
 473             SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
 474         End If
 475     Next bNum
 476 End If
 477 BuildRecentFileList
 478 End Sub
 479 Sub BuildMpqActionList()
 480 Dim Shift As Integer
 481 On Error GoTo NotSelected
 482 List.SelectedItem.Tag = List.SelectedItem.Tag
 483 On Error GoTo 0
 484 If List.SelectedItem.Selected = True Then
 485     Shift = 0
 486     If ShiftState = True Then Shift = vbShiftMask
 487     mnuMItem(0).Visible = True
 488     mnuMSep1.Visible = True
 489     BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem
 490 Else
 491     GoTo NotSelected
 492 End If
 493 Exit Sub
 494 NotSelected:
 495 Dim PItem As Menu
 496 For Each PItem In mnuMItem
 497     If PItem.Index <> 0 Then Unload PItem
 498 Next PItem
 499 mnuMItem(0).Visible = False
 500 mnuMSep1.Visible = False
 501 End Sub
 502 Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)
 503 Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String
 504 mnuRoot.Tag = 0
 505 For Each PItem In mnuItem
 506     If PItem.Index <> 0 Then Unload PItem
 507 Next PItem
 508 If InStr(FileName, ".") = 0 Then
 509     GoSub AddGlobal
 510 Else
 511     For bNum = 1 To Len(FileName)
 512         If InStr(bNum, FileName, ".") > 0 Then
 513             bNum = InStr(bNum, FileName, ".")
 514         Else
 515             Exit For
 516         End If
 517     Next bNum
 518     aName = Mid(FileName, bNum - 1)
 519     aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")
 520     If aName = "" Then
 521         GoSub AddGlobal
 522         Exit Sub
 523     End If
 524     dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
 525     dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
 526     If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\command\")) Then
 527         If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\")) Then
 528             mnuItem(0).Caption = "Op&en with..."
 529         Else
 530             mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
 531         End If
 532         mnuItem(0).Tag = dItem
 533         mnuRoot.Tag = 1
 534         aNum = 0
 535         bNum = 1
 536     Else
 537         aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)
 538         If aItem = "" Then
 539             GoSub AddGlobal
 540             Exit Sub
 541         End If
 542         If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
 543             If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
 544                 mnuItem(0).Caption = "Op&en with..."
 545             Else
 546                 mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
 547             End If
 548             mnuItem(0).Tag = aItem
 549             mnuRoot.Tag = 1
 550             aNum = 1
 551             bNum = 1
 552         Else
 553             aNum = 1
 554             bNum = 0
 555         End If
 556     End If
 557     Do
 558         aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
 559         If aItem <> "" Then
 560             If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
 561                 On Error Resume Next
 562                 Load mnuItem(bNum)
 563                 On Error GoTo 0
 564                 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
 565                     mnuItem(bNum).Caption = "Op&en with..."
 566                 Else
 567                     mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
 568                 End If
 569                 mnuItem(bNum).Tag = aItem
 570                 mnuRoot.Tag = mnuRoot.Tag + 1
 571                 bNum = bNum + 1
 572             End If
 573             aNum = aNum + 1
 574         End If
 575     Loop Until aItem = ""
 576     GoSub AddGlobal
 577     If Shift And vbShiftMask Then GoSub AddUnknown
 578 End If
 579 Exit Sub
 580 AddGlobal:
 581     aNum = 0
 582     bNum = mnuRoot.Tag
 583     dItem = ""
 584     If bNum = 0 Then
 585         dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open")
 586         dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem)
 587         If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then
 588             If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then
 589                 mnuItem(bNum).Caption = "Op&en with..."
 590             Else
 591                 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
 592             End If
 593             mnuItem(bNum).Tag = dItem
 594             mnuRoot.Tag = mnuRoot.Tag + 1
 595             bNum = bNum + 1
 596         End If
 597     End If
 598     Do
 599         aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum)
 600         If aItem <> "" Then
 601             If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then
 602                 On Error Resume Next
 603                 Load mnuItem(bNum)
 604                 On Error GoTo 0
 605                 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then
 606                     mnuItem(bNum).Caption = "Op&en with..."
 607                 Else
 608                     mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
 609                 End If
 610                 mnuItem(bNum).Tag = aItem
 611                 mnuRoot.Tag = mnuRoot.Tag + 1
 612                 bNum = bNum + 1
 613             End If
 614             aNum = aNum + 1
 615         End If
 616     Loop Until aItem = ""
 617     If bNum = 0 Then
 618         GoSub AddUnknown
 619         Exit Sub
 620     End If
 621 Return
 622 AddUnknown:
 623     aNum = 0
 624     bNum = mnuRoot.Tag
 625     dItem = ""
 626     If bNum = 0 Then
 627         dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")
 628         dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)
 629         If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then
 630             If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then
 631                 mnuItem(bNum).Caption = "Op&en with..."
 632             Else
 633                 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
 634             End If
 635             mnuItem(bNum).Tag = dItem
 636             bNum = bNum + 1
 637         End If
 638     End If
 639     Do
 640         aItem = EnumKey("HKEY_CLASSES_ROOT\Unknown\shell\", aNum)
 641         If aItem <> "" Then
 642             If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\command\")) Then
 643                 On Error Resume Next
 644                 Load mnuItem(bNum)
 645                 On Error GoTo 0
 646                 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\")) Then
 647                     mnuItem(bNum).Caption = "Op&en with..."
 648                 Else
 649                     mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
 650                 End If
 651                 mnuItem(bNum).Tag = aItem
 652                 bNum = bNum + 1
 653             End If
 654             aNum = aNum + 1
 655         End If
 656     Loop Until aItem = ""
 657 Return
 658 End Sub
 659 Sub ChangeLCID(NewLCID As Long)
 660 Dim fNum As Long, hMPQ As Long
 661 fNum = 1
 662 hMPQ = mOpenMpq(CD.FileName)
 663 If hMPQ Then
 664     Do While fNum <= List.ListItems.Count
 665         If List.ListItems.Item(fNum).Selected Then
 666             StatBar.Style = 1
 667             StatBar.SimpleText = "Changing locale ID of " + List.ListItems.Item(fNum).Tag + " to " + CStr(NewLCID) + "..."
 668             MousePointer = 11
 669             MpqSetFileLocale hMPQ, List.ListItems.Item(fNum).Tag, List.ListItems.Item(fNum).ListSubItems(4).Tag, NewLCID
 670             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
 671             List.ListItems.Item(fNum).ListSubItems(4).Tag = NewLCID
 672             List.ListItems.Item(fNum).ListSubItems(4).Text = NewLCID
 673         End If
 674         fNum = fNum + 1
 675     Loop
 676     MpqCloseUpdatedArchive hMPQ, 0
 677 End If
 678 StatBar.Style = 0
 679 StatBar.SimpleText = ""
 680 MousePointer = 0
 681 ShowSelected
 682 ShowTotal
 683 End Sub
 684 Sub ConvertCwad()
 685     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
 686
 687     If CWadOpenArchive(CD.FileName, 0, hCwad) Then
 688         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"
 689         CwadName = CD.FileName
 690         CD.Flags = &H1000 Or &H4 Or &H2
 691         CD.DefaultExt = "mpq"
 692         CD.Filter = "Mpq Archive (*.mpq)|*.mpq"
 693         CD.hwndOwner = hWnd
 694         CD.FileName = CwadName + ".mpq"
 695         If ShowSave(CD) Then
 696             If CD.FileName = CwadName Then
 697                 MsgBox "Cannot overwrite source archive.", vbExclamation, "WinMPQ"
 698                 CWadCloseArchive hCwad
 699                 Exit Sub
 700             End If
 701
 702             BufSize = CWadListFiles(hCwad, ListBuffer, 0)
 703             If BufSize > 0 Then ListBuffer = String$(BufSize - 1, Chr$(0))
 704             CWadListFiles hCwad, ListBuffer, BufSize
 705             MultiStringToArray ListBuffer, Files
 706
 707             If FileExists(CD.FileName) Then Kill CD.FileName
 708             hMPQ = mOpenMpq(CD.FileName)
 709             If hMPQ = 0 Then
 710                 StatBar.SimpleText = "Can't create archive " + CD.FileName
 711             Else
 712                 dwFlags = MAFA_REPLACE_EXISTING
 713                 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
 714
 715                 For nFile = 1 To UBound(Files)
 716                     If CWadOpenFile(hCwad, Files(nFile), 0, hFile) Then
 717                         fLen = CWadGetFileSize(hFile)
 718
 719                         If fLen > 0 Then
 720                             ReDim buffer(fLen - 1)
 721                         Else
 722                             ReDim buffer(0)
 723                         End If
 724
 725                         CWadSetFilePointer hFile, 0, FILE_BEGIN
 726                         CWadReadFile hFile, buffer(0), fLen, fLen
 727                         CWadCloseFile hFile
 728
 729                         StatBar.SimpleText = "Adding " + Files(nFile) + "..."
 730                         MousePointer = 11
 731                         If mnuMCNone.Checked Then
 732                             MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags, 0, 0
 733                         ElseIf mnuMCStandard.Checked Then
 734                             MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
 735                         ElseIf mnuMCDeflate.Checked Then
 736                             MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
 737                         ElseIf mnuMCAMedium.Checked Then
 738                             MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 0
 739                         ElseIf mnuMCAHighest.Checked Then
 740                             MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 1
 741                         ElseIf mnuMCALowest.Checked Then
 742                             MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 2
 743                         ElseIf mnuMCAuto.Checked Then
 744                             mAddAutoFromBuffer hMPQ, buffer(0), fLen, Files(nFile)
 745                         End If
 746                     End If
 747                 Next nFile
 748
 749                 MpqCloseUpdatedArchive hMPQ, 0
 750             End If
 751         Else
 752             CD.FileName = CwadName
 753         End If
 754
 755         CWadCloseArchive hCwad
 756     End If
 757 End Sub
 758
 759 Sub DelRecentFile(rFileName As String)
 760 Dim bNum As Long, fNum As Long
 761 For bNum = 1 To 8
 762     If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
 763         For fNum = bNum To 7
 764             SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
 765         Next fNum
 766         DelReg AppKey + "Recent\File" + CStr(8)
 767         Exit For
 768     End If
 769 Next bNum
 770 BuildRecentFileList
 771 End Sub
 772 Sub AddToListing(AddedFile As String)
 773 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
 774 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
 775     If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
 776         L1 = AddedFile
 777         fSize = SFileGetFileSize(hFile, 0)
 778         cSize = SFileGetFileInfo(hFile, 6)
 779         If fSize / 1024 > 0 And fSize / 1024 < 1 Then
 780             L2 = "<1KB"
 781         ElseIf fSize = 0 Then
 782             L2 = "0KB"
 783         Else
 784             L2 = CStr(Int(fSize / 1024)) + "KB"
 785         End If
 786         If cSize / 1024 > 0 And cSize / 1024 < 1 Then
 787             L4 = "<1KB"
 788         ElseIf cSize = 0 Then
 789             L4 = "0KB"
 790         Else
 791             L4 = CStr(Int(cSize / 1024)) + "KB"
 792         End If
 793         If fSize <> 0 Then
 794             L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
 795         Else
 796             L3 = "0%"
 797         End If
 798         fFlags = SFileGetFileInfo(hFile, 7)
 799         L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
 800         If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
 801         If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
 802         If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
 803         On Error Resume Next
 804         lIndex = List.ListItems.Add(, L1, L1).Index
 805         On Error GoTo 0
 806         If lIndex = 0 Then
 807             lIndex = List.ListItems.Item(L1).Index
 808             List.ListItems.Item(L1).ListSubItems.Clear
 809         End If
 810         List.ListItems.Item(lIndex).Tag = L1
 811         List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
 812         If fSize <> 0 Then
 813             List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
 814         Else
 815             List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
 816         End If
 817         List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
 818         List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
 819         List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
 820         SFileCloseFile hFile
 821     End If
 822     SFileCloseArchive hMPQ
 823 End If
 824 End Sub
 825 Sub FileActionClick(mnuRoot As Menu, mnuItem, Index As Integer)
 826 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
 827 Path = App.Path
 828 If Right(Path, 1) <> "\" Then Path = Path + "\"
 829 Path = Path + "Temp_extract\"
 830 If ExtractPathNum = -1 Then
 831     fNum = 0
 832     Do
 833     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
 834     fNum = fNum + 1
 835     Loop
 836     ExtractPathNum = fNum
 837 End If
 838 Path = Path + CStr(ExtractPathNum) + "\"
 839 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
 840 For fNum = 1 To List.ListItems.Count
 841     If List.ListItems.Item(fNum).Selected Then
 842         StatBar.Style = 1
 843         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
 844         MousePointer = 11
 845         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
 846         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
 847         SFileSetLocale LocaleID
 848         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
 849             For bNum = 1 To UBound(OpenFiles)
 850                 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
 851                     AlreadyInList = True
 852                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
 853                     Exit For
 854                 End If
 855             Next bNum
 856             If AlreadyInList = False Then
 857                 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
 858                 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
 859                 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
 860             End If
 861         End If
 862         StatBar.Style = 1
 863         StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
 864         fName = List.ListItems.Item(fNum).Tag
 865         ExecuteFile Path + fName, Index, mnuRoot, mnuItem
 866         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
 867     End If
 868 Next fNum
 869 SFileCloseArchive hMPQ
 870 StatBar.Style = 0
 871 StatBar.SimpleText = ""
 872 MousePointer = 0
 873 End Sub
 874 Sub MpqAddToListing(hMPQ As Long, AddedFile As String)
 875 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
 876 If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
 877     L1 = AddedFile
 878     fSize = SFileGetFileSize(hFile, 0)
 879     cSize = SFileGetFileInfo(hFile, 6)
 880     If fSize / 1024 > 0 And fSize / 1024 < 1 Then
 881         L2 = "<1KB"
 882     ElseIf fSize = 0 Then
 883         L2 = "0KB"
 884     Else
 885         L2 = CStr(Int(fSize / 1024)) + "KB"
 886     End If
 887     If cSize / 1024 > 0 And cSize / 1024 < 1 Then
 888         L4 = "<1KB"
 889     ElseIf cSize = 0 Then
 890         L4 = "0KB"
 891     Else
 892         L4 = CStr(Int(cSize / 1024)) + "KB"
 893     End If
 894     If fSize <> 0 Then
 895         L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
 896     Else
 897         L3 = "0%"
 898     End If
 899     fFlags = SFileGetFileInfo(hFile, 7)
 900     L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
 901     If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
 902     If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
 903     If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
 904     On Error Resume Next
 905     lIndex = List.ListItems.Add(, L1, L1).Index
 906     On Error GoTo 0
 907     If lIndex = 0 Then
 908         lIndex = List.ListItems.Item(L1).Index
 909         List.ListItems.Item(L1).ListSubItems.Clear
 910     End If
 911     List.ListItems.Item(lIndex).Tag = L1
 912     List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
 913     If fSize <> 0 Then
 914         List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
 915     Else
 916         List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
 917     End If
 918     List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
 919     List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
 920     List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
 921     SFileCloseFile hFile
 922 End If
 923 End Sub
 924 Sub RemoveFromListing(RemovedFile As String)
 925 Dim FileCount As Long
 926 On Error GoTo FileRemoved
 927 Do
 928 List.ListItems.Remove RemovedFile
 929 FileCount = FileCount + 1
 930 Loop
 931 FileRemoved:
 932 If FileCount = 0 Then
 933     For FileCount = 1 To List.ListItems.Count
 934         If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then
 935             List.ListItems.Remove FileCount
 936             Exit Sub
 937         End If
 938     Next FileCount
 939 End If
 940 End Sub
 941 Sub RenameInListing(OldName As String, NewName As String)
 942 Dim lIndex As Long
 943 If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName
 944 On Error GoTo RenameError
 945 lIndex = List.ListItems.Item(OldName).Index
 946 List.ListItems.Item(lIndex).Text = NewName
 947 List.ListItems.Item(lIndex).Tag = NewName
 948 On Error Resume Next
 949 List.ListItems.Item(lIndex).Key = NewName
 950 On Error GoTo 0
 951 Exit Sub
 952 RenameError:
 953 For lIndex = 1 To List.ListItems.Count
 954     If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then
 955         List.ListItems.Item(lIndex).Text = NewName
 956         List.ListItems.Item(lIndex).Tag = NewName
 957         On Error Resume Next
 958         List.ListItems.Item(lIndex).Key = NewName
 959         On Error GoTo 0
 960         Exit Sub
 961     End If
 962 Next lIndex
 963 End Sub
 964 Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)
 965 Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO
 966 If Index < mnuRoot.Tag Then
 967     With sei
 968         .cbSize = Len(sei)
 969         .fMask = 0
 970         .hWnd = hWnd
 971         .lpVerb = mnuItem(Index).Tag
 972         .lpFile = FileName
 973         .lpParameters = vbNullString
 974         .lpDirectory = vbNullString
 975         .nShow = 1
 976     End With
 977     RetVal = ShellExecuteEx(sei)
 978 Else
 979     With sei
 980         .cbSize = Len(sei)
 981         .fMask = SEE_MASK_CLASSNAME
 982         .hWnd = hWnd
 983         .lpVerb = mnuItem(Index).Tag
 984         .lpFile = FileName
 985         .lpParameters = vbNullString
 986         .lpDirectory = vbNullString
 987         .nShow = 1
 988         .lpClass = "Unknown"
 989     End With
 990     RetVal = ShellExecuteEx(sei)
 991 End If
 992 'If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then
 993 '    Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")
 994 '    Do
 995 '        If InStr(Param, "%1") = 0 Then
 996 '            Param = Param + " " + FileName
 997 '        Else
 998 '            bNum = InStr(Param, "%1")
 999 '            Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
1000 '        End If
1001 '    Loop While InStr(Param, "%1")
1002 '    bNum = 1
1003 '    Do While bNum <= Len(Param)
1004 '        If InStr(bNum, Param, "%") Then
1005 '            bNum = InStr(bNum, Param, "%")
1006 '            If InStr(bNum + 1, Param, "%") Then
1007 '                bNum2 = InStr(bNum + 1, Param, "%")
1008 '                EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)
1009 '                If Environ(EnvName) <> "" Then
1010 '                    Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)
1011 '                End If
1012 '            End If
1013 '        End If
1014 '        bNum = bNum + 1
1015 '    Loop
1016 '    On Error GoTo NoProgram
1017 '    Shell Param, 1
1018 '    On Error GoTo 0
1019 'End If
1020 'Exit Sub
1021 'NoProgram:
1022 'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
1023 End Sub
1024 Sub RunMpq2kCommand(CmdLine As String)
1025 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
1026 CurPath = CurDir
1027 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
1028 sLine = CmdLine
1029 If Right(sLine, 1) <> " " Then sLine = sLine + " "
1030 If sLine <> "" Then
1031     ReDim Param(0) As String
1032     For pNum = 1 To Len(sLine)
1033         If Mid(sLine, pNum, 1) = Chr(34) Then
1034             pNum = pNum + 1
1035             EndParam = InStr(pNum, sLine, Chr(34))
1036         Else
1037             EndParam = InStr(pNum, sLine, " ")
1038         End If
1039         If EndParam = 0 Then EndParam = Len(sLine) + 1
1040         If pNum <> EndParam Then
1041             If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
1042                 ReDim Preserve Param(UBound(Param) + 1) As String
1043                 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
1044             End If
1045         End If
1046         pNum = EndParam
1047     Next pNum
1048     If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
1049     Select Case LCase(Param(1))
1050     Case "?", "h", "help"
1051         mnuHReadme_Click
1052     Case "o", "open"
1053         OldFileName = CD.FileName
1054         If Param(2) <> "" Then
1055             CD.FileName = FullPath(CurPath, Param(2))
1056         End If
1057         If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then
1058             DefaultMaxFiles = Param(3)
1059         End If
1060         If FileExists(CD.FileName) Then
1061             OpenMpq
1062             If CD.FileName = "" Then
1063                 CD.FileName = OldFileName
1064                 StatBar.SimpleText = "The file does not contain an MPQ archive."
1065             Else
1066                 StatBar.SimpleText = "Opened " + CD.FileName
1067                 AddRecentFile CD.FileName
1068             End If
1069         ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then
1070             ReDim FileList(0) As String
1071             List.ListItems.Clear
1072             ShowSelected
1073             ShowTotal
1074             NewFile = True
1075             ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1076             mnuMpq.Enabled = True
1077             For Each TItem In mnuTItem
1078                 TItem.Enabled = True
1079             Next TItem
1080             Toolbar.Buttons.Item("Add").Enabled = True
1081             Toolbar.Buttons.Item("Add Folder").Enabled = True
1082             Toolbar.Buttons.Item("Extract").Enabled = True
1083             Toolbar.Buttons.Item("Compact").Enabled = True
1084             Toolbar.Buttons.Item("List").Enabled = True
1085             If InStr(CD.FileName, "\") > 0 Then
1086                 For bNum = 1 To Len(CD.FileName)
1087                     If InStr(bNum, CD.FileName, "\") > 0 Then
1088                         bNum = InStr(bNum, CD.FileName, "\")
1089                     Else
1090                         Exit For
1091                     End If
1092                 Next bNum
1093             End If
1094             Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1095             StatBar.SimpleText = "Created new " + CD.FileName
1096             AddRecentFile CD.FileName
1097         ElseIf CD.FileName = "" Then
1098             StatBar.SimpleText = "Required parameter missing"
1099         End If
1100     Case "n", "new"
1101         If Param(2) <> "" Then
1102             CD.FileName = FullPath(CurPath, Param(2))
1103             If Param(3) <> "" Then
1104                 DefaultMaxFiles = Param(3)
1105             End If
1106             If CD.FileName <> "" Then
1107                 ReDim FileList(0) As String
1108                 List.ListItems.Clear
1109                 ShowSelected
1110                 ShowTotal
1111                 NewFile = True
1112                 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1113                 mnuMpq.Enabled = True
1114                 For Each TItem In mnuTItem
1115                     TItem.Enabled = True
1116                 Next TItem
1117                 Toolbar.Buttons.Item("Add").Enabled = True
1118                 Toolbar.Buttons.Item("Add Folder").Enabled = True
1119                 Toolbar.Buttons.Item("Extract").Enabled = True
1120                 Toolbar.Buttons.Item("Compact").Enabled = True
1121                 Toolbar.Buttons.Item("List").Enabled = True
1122                 If InStr(CD.FileName, "\") > 0 Then
1123                     For bNum = 1 To Len(CD.FileName)
1124                         If InStr(bNum, CD.FileName, "\") > 0 Then
1125                             bNum = InStr(bNum, CD.FileName, "\")
1126                         Else
1127                             Exit For
1128                         End If
1129                     Next bNum
1130                 End If
1131                 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1132                 StatBar.SimpleText = "Created new " + CD.FileName
1133                 AddRecentFile CD.FileName
1134             End If
1135         Else
1136             StatBar.SimpleText = "Required parameter missing"
1137         End If
1138     Case "c", "close"
1139         StatBar.SimpleText = "Close is for scripts only"
1140     Case "p", "pause"
1141         StatBar.SimpleText = "Pause not supported"
1142     Case "a", "add"
1143         If CD.FileName <> "" Then
1144             ReDim FileShortNames(0) As String
1145             cType = 0
1146             Rswitch = False
1147             fCount = 0
1148             Files = ""
1149             fEndLine = 0
1150             fLine = ""
1151             dwFlags = MAFA_REPLACE_EXISTING
1152             If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
1153             For pNum = 3 To UBound(Param)
1154                 If LCase(Param(pNum)) = "/wav" Then
1155                     cType = 2
1156                     dwFlags = dwFlags Or MAFA_COMPRESS
1157                 ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
1158                     cType = 1
1159                     dwFlags = dwFlags Or MAFA_COMPRESS
1160                 ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
1161                     cType = -1
1162                 ElseIf LCase(Param(pNum)) = "/r" Then
1163                     Rswitch = True
1164                 End If
1165             Next pNum
1166             If Left(Param(3), 1) = "/" Or Param(3) = "" Then
1167                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1168                     Param(3) = ""
1169                 Else
1170                     Param(3) = Param(2)
1171                 End If
1172             End If
1173             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1174                 If InStr(Param(2), "\") > 0 Then
1175                     For pNum = 1 To Len(Param(2))
1176                         If InStr(pNum, Param(2), "\") > 0 Then
1177                             pNum = InStr(pNum, Param(2), "\")
1178                             Files = Left(Param(2), pNum)
1179                         End If
1180                     Next pNum
1181                 End If
1182                 MousePointer = 11
1183                 If NewFile = True Then
1184                     If FileExists(CD.FileName) Then Kill CD.FileName
1185                     NewFile = False
1186                 End If
1187                 Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
1188                 List.Sorted = False
1189                 FileFilter = mFilter
1190                 hMPQ = mOpenMpq(CD.FileName)
1191                 If hMPQ = 0 Then
1192                     StatBar.SimpleText = "Can't create archive " + CD.FileName
1193                     Exit Sub
1194                 End If
1195                 For pNum = 1 To Len(Files)
1196                     fEndLine = InStr(pNum, Files, vbCrLf)
1197                     fLine = Mid(Files, pNum, fEndLine - pNum)
1198                     If cType = 0 Then
1199                         StatBar.SimpleText = "Adding " + fLine + "..."
1200                     ElseIf cType = 1 Then
1201                         StatBar.SimpleText = "Adding compressed " + fLine + "..."
1202                     ElseIf cType = 2 Then
1203                         StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."
1204                     ElseIf cType = -1 Then
1205                         StatBar.SimpleText = "Adding " + fLine + " (compression auto-select)..."
1206                     End If
1207                     If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1208                         If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
1209                         If cType = 2 Then
1210                             MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
1211                         ElseIf cType = -1 Then
1212                             mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
1213                         ElseIf cType = 1 Then
1214                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
1215                         Else
1216                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
1217                         End If
1218                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1219                         mFilter.AddItem "*" + GetExtension(Param(3) + fLine)
1220                         For cNum = 1 To mFilter.ListCount - 1
1221                             If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
1222                                 mFilter.RemoveItem cNum
1223                                 Exit For
1224                             End If
1225                         Next cNum
1226                         If MatchesFilter(Param(3) + fLine, FileFilter) Then
1227                             ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
1228                             FileShortNames(UBound(FileShortNames)) = Param(3) + fLine
1229                         End If
1230                     Else
1231                         If cType = 2 Then
1232                             MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
1233                         ElseIf cType = -1 Then
1234                             mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
1235                         ElseIf cType = 1 Then
1236                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
1237                         Else
1238                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
1239                         End If
1240                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1241                         mFilter.AddItem "*" + GetExtension(Param(3))
1242                         For cNum = 1 To mFilter.ListCount - 1
1243                             If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
1244                                 mFilter.RemoveItem cNum
1245                                 Exit For
1246                             End If
1247                         Next cNum
1248                         If MatchesFilter(Param(3), FileFilter) Then
1249                             ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
1250                             FileShortNames(UBound(FileShortNames)) = Param(3)
1251                         End If
1252                     End If
1253                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1254                     fCount = fCount + 1
1255                     pNum = fEndLine + 1
1256                 Next pNum
1257                 MpqCloseUpdatedArchive hMPQ, 0
1258                 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1259                 If UBound(FileShortNames) > 1 Then
1260                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1261                         StatBar.SimpleText = "Adding files to listing... 0% complete"
1262                         For pNum = 1 To UBound(FileShortNames)
1263                             If MatchesFilter(FileShortNames(pNum), FileFilter) Then
1264                                 MpqAddToListing hMPQ, FileShortNames(pNum)
1265                             End If
1266                             On Error Resume Next
1267                             StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"
1268                             On Error GoTo 0
1269                         Next pNum
1270                         SFileCloseArchive hMPQ
1271                     End If
1272                 ElseIf UBound(FileShortNames) = 1 Then
1273                     AddToListing FileShortNames(1)
1274                 End If
1275                 MousePointer = 0
1276                 If MatchesFilter("(listfile)", FileFilter) Then
1277                     AddToListing "(listfile)"
1278                 End If
1279                 mFilter = FileFilter
1280                 List.Sorted = True
1281                 RemoveDuplicates
1282                 ShowTotal
1283                 If fCount > 1 Then
1284                     StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"
1285                 End If
1286             Else
1287                 StatBar.SimpleText = "Required parameter missing"
1288             End If
1289         Else
1290             StatBar.SimpleText = "No archive open"
1291         End If
1292     Case "e", "extract"
1293         If CD.FileName <> "" Then
1294             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Extracting " + Param(2) + "..."
1295             cType = 0
1296             For pNum = 3 To UBound(Param)
1297                 If LCase(Param(pNum)) = "/fp" Then
1298                     cType = 1
1299                     Exit For
1300                 End If
1301             Next pNum
1302             If Left(Param(3), 1) = "/" Then Param(3) = ""
1303             If Param(3) = "" Then Param(3) = "."
1304             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1305                 MousePointer = 11
1306                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1307                     Files = MpqDir(CD.FileName, Param(2))
1308                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1309                         StatBar.SimpleText = "Can't open archive " + CD.FileName
1310                         Exit Sub
1311                     End If
1312                     For pNum = 1 To Len(Files)
1313                         fEndLine = InStr(pNum, Files, vbCrLf)
1314                         fLine = Mid(Files, pNum, fEndLine - pNum)
1315                         StatBar.SimpleText = "Extracting " + fLine + "..."
1316                         sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
1317                         StatBar.SimpleText = StatBar.SimpleText + " Done"
1318                         fCount = fCount + 1
1319                         pNum = fEndLine + 1
1320                     Next pNum
1321                     SFileCloseArchive hMPQ
1322                     If fCount > 1 Then
1323                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"
1324                     End If
1325                 Else
1326                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1327                         StatBar.SimpleText = "Can't open archive " + CD.FileName
1328                         Exit Sub
1329                     End If
1330                     sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
1331                     SFileCloseArchive hMPQ
1332                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1333                 End If
1334                 MousePointer = 0
1335             Else
1336                 StatBar.SimpleText = "Required parameter missing"
1337             End If
1338         Else
1339             StatBar.SimpleText = "No archive open"
1340         End If
1341     Case "r", "ren", "rename"
1342         If CD.FileName <> "" Then
1343             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."
1344             If Param(2) <> "" And Param(3) <> "" Then
1345                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1346                     If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then
1347                         Files = MpqDir(CD.FileName, Param(2))
1348                         hMPQ = mOpenMpq(CD.FileName)
1349                         If hMPQ Then
1350                             For pNum = 1 To Len(Files)
1351                                 fEndLine = InStr(pNum, Files, vbCrLf)
1352                                 fLine = Mid(Files, pNum, fEndLine - pNum)
1353                                 fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
1354                                 StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."
1355                                 If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
1356                                     SFileCloseFile hFile
1357                                     MpqDeleteFile hMPQ, fLine2
1358                                     MpqRenameFile hMPQ, fLine, fLine2
1359                                 Else
1360                                     MpqRenameFile hMPQ, fLine, fLine2
1361                                 End If
1362                                 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1363                                 RenameInListing fLine, fLine2
1364                                 StatBar.SimpleText = StatBar.SimpleText + " Done"
1365                                 fCount = fCount + 1
1366                                 pNum = fEndLine + 1
1367                             Next pNum
1368                             MpqCloseUpdatedArchive hMPQ, 0
1369                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1370                         End If
1371                         If fCount > 1 Then
1372                             StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"
1373                         End If
1374                     Else
1375                     StatBar.SimpleText = "You must use wildcards with new name"
1376                     End If
1377                 Else
1378                     hMPQ = mOpenMpq(CD.FileName)
1379                     If hMPQ Then
1380                         If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
1381                             SFileCloseFile hFile
1382                             MpqDeleteFile hMPQ, Param(3)
1383                             MpqRenameFile hMPQ, Param(2), Param(3)
1384                         Else
1385                             MpqRenameFile hMPQ, Param(2), Param(3)
1386                         End If
1387                         MpqCloseUpdatedArchive hMPQ, 0
1388                     End If
1389                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1390                     RenameInListing Param(2), Param(3)
1391                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1392                 End If
1393             Else
1394                 StatBar.SimpleText = "Required parameter missing"
1395             End If
1396         Else
1397             StatBar.SimpleText = "No archive open"
1398         End If
1399     Case "m", "move"
1400         If CD.FileName <> "" Then
1401             For pNum = 1 To Len(Param(2))
1402                 If InStr(pNum, Param(2), "\") Then
1403                     pNum = InStr(pNum, Param(2), "\")
1404                 Else
1405                     Exit For
1406                 End If
1407             Next pNum
1408             fLineTitle = Mid(Param(2), pNum)
1409             If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
1410             Param(3) = Param(3) + fLineTitle
1411             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Moving " + Param(2) + " => " + Param(3) + "..."
1412             If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then
1413                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1414                     Files = MpqDir(CD.FileName, Param(2))
1415                     hMPQ = mOpenMpq(CD.FileName)
1416                     If hMPQ Then
1417                         For pNum = 1 To Len(Files)
1418                             fEndLine = InStr(pNum, Files, vbCrLf)
1419                             fLine = Mid(Files, pNum, fEndLine - pNum)
1420                             fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
1421                             StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."
1422                             If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
1423                                 SFileCloseFile hFile
1424                                 MpqDeleteFile hMPQ, fLine2
1425                                 MpqRenameFile hMPQ, fLine, fLine2
1426                             Else
1427                                 MpqRenameFile hMPQ, fLine, fLine2
1428                             End If
1429                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1430                             RenameInListing fLine, fLine2
1431                             StatBar.SimpleText = StatBar.SimpleText + " Done"
1432                             fCount = fCount + 1
1433                             pNum = fEndLine + 1
1434                         Next pNum
1435                         MpqCloseUpdatedArchive hMPQ, 0
1436                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1437                     End If
1438                     If fCount > 1 Then
1439                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"
1440                     End If
1441                 Else
1442                     hMPQ = mOpenMpq(CD.FileName)
1443                     If hMPQ Then
1444                         If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
1445                             SFileCloseFile hFile
1446                             MpqDeleteFile hFile, Param(3)
1447                             MpqRenameFile hFile, Param(2), Param(3)
1448                         Else
1449                             MpqRenameFile hFile, Param(2), Param(3)
1450                         End If
1451                         MpqCloseUpdatedArchive hMPQ, 0
1452                     End If
1453                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1454                     RenameInListing Param(2), Param(3)
1455                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1456                 End If
1457             Else
1458                 StatBar.SimpleText = "Required parameter missing"
1459             End If
1460         Else
1461             StatBar.SimpleText = "No archive open"
1462         End If
1463     Case "d", "del", "delete"
1464         If CD.FileName <> "" Then
1465             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Deleting " + Param(2) + "..."
1466             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1467                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1468                     Files = MpqDir(CD.FileName, Param(2))
1469                     hMPQ = mOpenMpq(CD.FileName)
1470                     If hMPQ Then
1471                         For pNum = 1 To Len(Files)
1472                             fEndLine = InStr(pNum, Files, vbCrLf)
1473                             fLine = Mid(Files, pNum, fEndLine - pNum)
1474                             StatBar.SimpleText = "Deleting " + fLine + "..."
1475                             MpqDeleteFile hMPQ, fLine
1476                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1477                             RemoveFromListing fLine
1478                             StatBar.SimpleText = StatBar.SimpleText + " Done"
1479                             fCount = fCount + 1
1480                             pNum = fEndLine + 1
1481                         Next pNum
1482                         MpqCloseUpdatedArchive hMPQ, 0
1483                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1484                     End If
1485                     If fCount > 1 Then
1486                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
1487                     End If
1488                 Else
1489                     hMPQ = mOpenMpq(CD.FileName)
1490                     If hMPQ Then
1491                         MpqDeleteFile hMPQ, Param(2)
1492                         MpqCloseUpdatedArchive hMPQ, 0
1493                     End If
1494                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1495                     RemoveFromListing Param(2)
1496                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1497                 End If
1498             Else
1499                 StatBar.SimpleText = "Required parameter missing"
1500             End If
1501         Else
1502             StatBar.SimpleText = "No archive open"
1503         End If
1504     Case "f", "flush", "compact"
1505         If CD.FileName <> "" Then
1506             MousePointer = 11
1507             StatBar.SimpleText = "Flushing " + CD.FileName + "..."
1508             hMPQ = mOpenMpq(CD.FileName)
1509             If hMPQ Then
1510                 MpqCompactArchive hMPQ
1511                 MpqCloseUpdatedArchive hMPQ, 0
1512             End If
1513             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1514             StatBar.SimpleText = StatBar.SimpleText + " Done"
1515             MousePointer = 0
1516             OpenMpq
1517         Else
1518             StatBar.SimpleText = "No archive open"
1519         End If
1520     Case "l", "list"
1521         If CD.FileName <> "" Then
1522             If Param(2) <> "" Then
1523                 StatBar.SimpleText = "Creating list..."
1524                 MousePointer = 11
1525                 If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
1526                     Files = MpqDir(CD.FileName, Param(2))
1527                     Param(2) = Param(3)
1528                 Else
1529                     Files = MpqDir(CD.FileName, "*")
1530                 End If
1531                 fNum = FreeFile
1532                 Open FullPath(CurPath, Param(2)) For Binary As #fNum
1533                 Put #fNum, 1, Files
1534                 Close #fNum
1535                 StatBar.SimpleText = StatBar.SimpleText + " Done"
1536                 MousePointer = 0
1537             Else
1538                 StatBar.SimpleText = "Required parameter missing"
1539             End If
1540         Else
1541             StatBar.SimpleText = "No archive open"
1542         End If
1543     Case "s", "script"
1544         StatBar.SimpleText = "Running script " + Param(2) + "..."
1545         If Param(2) <> "" Then
1546             MousePointer = 11
1547             RunScript FullPath(CurPath, Param(2))
1548             MousePointer = 0
1549             StatBar.SimpleText = StatBar.SimpleText + " Done"
1550         Else
1551             StatBar.SimpleText = "Required parameter missing"
1552         End If
1553     Case "x", "exit", "quit"
1554         Unload Me
1555     Case Else
1556         If Left(Param(1), 1) <> ";" Then
1557             If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then
1558                 On Error Resume Next
1559                 ChDir Param(2)
1560                 On Error GoTo 0
1561                 txtCommand_GotFocus
1562             ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then
1563                 On Error Resume Next
1564                 ChDir Mid(Param(1), 3)
1565                 On Error GoTo 0
1566                 txtCommand_GotFocus
1567             ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then
1568                 On Error Resume Next
1569                 ChDir Mid(Param(1), 6)
1570                 On Error GoTo 0
1571                 txtCommand_GotFocus
1572             ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then
1573                 On Error Resume Next
1574                 ChDrive Left(Param(1), 2)
1575                 On Error GoTo 0
1576                 txtCommand_GotFocus
1577             Else
1578                 Shell "command.com /k " + sLine, 1
1579             End If
1580         End If
1581     End Select
1582 End If
1583 End Sub
1584 Sub BuildRecentFileList()
1585 Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu
1586 For Each RItem In mnuFRecent
1587     If RItem.Index <> 0 Then Unload RItem
1588 Next RItem
1589 rNum2 = 1
1590 For rNum = 8 To 1 Step -1
1591     RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))
1592     If FileExists(RecentFile) Then
1593         mnuFRecent(0).Visible = True
1594         On Error Resume Next
1595         Load mnuFRecent(rNum2)
1596         On Error GoTo 0
1597         mnuFRecent(rNum2).Tag = RecentFile
1598         If TextWidth(RecentFile) > TextWidth("________________________________") Then
1599             FirstSep = InStr(RecentFile, "\")
1600             If FirstSep > 0 Then
1601                 For LastSep = FirstSep + 1 To Len(RecentFile)
1602                     If InStr(LastSep, RecentFile, "\") > 0 Then
1603                         LastSep = InStr(LastSep, RecentFile, "\")
1604                     Else
1605                         Exit For
1606                     End If
1607                 Next LastSep
1608                 RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)
1609             End If
1610         End If
1611         mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile
1612         rNum2 = rNum2 + 1
1613     End If
1614     If rNum2 > 4 Then Exit For
1615 Next rNum
1616 End Sub
1617 Sub BuildToolsList()
1618 Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu
1619 For Each TItem In mnuTItem
1620     If TItem.Index <> 0 Then Unload TItem
1621 Next TItem
1622 For Each TItem In mnuPTItem
1623     If TItem.Index <> 0 Then Unload TItem
1624 Next TItem
1625 mnuTItem(0).Caption = "(Empty)"
1626 mnuPTItem(0).Caption = mnuTItem(0).Caption
1627 mnuTItem(0).Tag = ""
1628 mnuPTItem(0).Tag = ""
1629 Do
1630     ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
1631     ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
1632     If ToolName = "" Then ToolName = ToolCommand
1633     If ToolName <> "" Then
1634         On Error Resume Next
1635         Load mnuTItem(tNum)
1636         Load mnuPTItem(tNum)
1637         On Error GoTo 0
1638         mnuTItem(tNum).Tag = ToolCommand
1639         mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag
1640         If InStr(ToolName, "&") = 0 And tNum < 9 Then
1641             mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName
1642         ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then
1643             mnuTItem(tNum).Caption = "&0 " + ToolName
1644         Else
1645             mnuTItem(tNum).Caption = ToolName
1646         End If
1647         mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption
1648     End If
1649     tNum = tNum + 1
1650 Loop Until ToolName = ""
1651 End Sub
1652 Sub OpenMpq()
1653 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
1654 On Error Resume Next
1655 If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
1656     ReDim FileList(0) As String
1657     List.ListItems.Clear
1658     ShowSelected
1659     ShowTotal
1660     NewFile = True
1661     On Error GoTo 0
1662     GoTo FileOpened
1663 End If
1664 On Error GoTo 0
1665
1666 If IsMPQ(CD.FileName) = False Then
1667     ConvertCwad
1668 End If
1669
1670 If IsMPQ(CD.FileName) = False Then
1671     CD.FileName = ""
1672     MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"
1673     Exit Sub
1674 End If
1675 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1676     CD.FileName = ""
1677     MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"
1678     Exit Sub
1679 End If
1680 StatBar.Style = 1
1681 StatBar.SimpleText = "Loading list..."
1682 MousePointer = 11
1683 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1684 ReDim FileList(0) As String
1685 #If InternalListing Then
1686 FileList(0) = "(listfile)"
1687 If Mpq.FileExists(CD.FileName, "(listfile)") Then
1688     FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)
1689 #Else
1690     sListFiles CD.FileName, hMPQ, ListFile, FileEntries
1691 #End If
1692     For bNum = 1 To Len(FileCont)
1693         If InStr(bNum, FileCont, vbCrLf) > 0 Then
1694             ReDim Preserve FileList(UBound(FileList) + 1) As String
1695             FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)
1696             bNum = InStr(bNum, FileCont, vbCrLf) + 1
1697         Else
1698             ReDim Preserve FileList(UBound(FileList) + 1) As String
1699             FileList(UBound(FileList)) = Mid(FileCont, bNum)
1700             Exit For
1701         End If
1702     Next bNum
1703 #If InternalListing Then
1704 End If
1705 nFiles = UBound(FileList)
1706 ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String
1707 For bNum = nFiles + 1 To UBound(FileList)
1708     FileList(bNum) = GlobalFileList(bNum - nFiles)
1709 Next bNum
1710 #End If
1711 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
1712 SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&
1713 List.ListItems.Clear
1714 List.Sorted = False
1715 FileFilter = mFilter
1716 StatBar.SimpleText = "Building list... 0% complete"
1717 mFilter.Clear
1718 For fNum = 0 To UBound(FileEntries)
1719 #If InternalListing Then
1720     If Mpq.FileExists(CD.FileName, FileList(fNum)) Then
1721 #End If
1722     If FileEntries(fNum).dwFileExists Then
1723     MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)
1724     StripNull MpqFileName
1725     mFilter.AddItem "*" + GetExtension(MpqFileName)
1726     For bNum = 1 To mFilter.ListCount - 1
1727         If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then
1728             mFilter.RemoveItem bNum
1729             Exit For
1730         End If
1731     Next bNum
1732     If MatchesFilter(MpqFileName, FileFilter) Then
1733         L1 = MpqFileName
1734                 fSize = FileEntries(fNum).dwFullSize
1735                 cSize = FileEntries(fNum).dwCompressedSize
1736                 If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1737                     L2 = "<1KB"
1738                 ElseIf fSize = 0 Then
1739                     L2 = "0KB"
1740                 Else
1741                     L2 = CStr(Int(fSize / 1024)) + "KB"
1742                 End If
1743                 If cSize / 1024 > 0 And cSize / 1024 < 1 Then
1744                     L4 = "<1KB"
1745                 ElseIf cSize = 0 Then
1746                     L4 = "0KB"
1747                 Else
1748                     L4 = CStr(Int(cSize / 1024)) + "KB"
1749                 End If
1750                 If fSize <> 0 Then
1751                     L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
1752                 Else
1753                     L3 = "0%"
1754                 End If
1755                 fFlags = FileEntries(fNum).dwFlags
1756                 L6 = CStr(FileEntries(fNum).lcLocale)
1757                 If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
1758                 If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
1759                 If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
1760         lIndex = 0
1761         On Error Resume Next
1762         lIndex = List.ListItems.Add(, , L1).Index
1763         On Error GoTo 0
1764         If lIndex = 0 Then
1765             lIndex = List.ListItems.Item(L1).Index
1766             List.ListItems.Item(L1).ListSubItems.Clear
1767         End If
1768         List.ListItems.Item(lIndex).Tag = L1
1769         List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
1770             If fSize <> 0 Then
1771                 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
1772             Else
1773                 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
1774             End If
1775             List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
1776             List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
1777             List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
1778     End If
1779     End If
1780 #If InternalListing Then
1781     End If
1782 #End If
1783     On Error Resume Next
1784     StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"
1785     On Error GoTo 0
1786 Next fNum
1787 SFileCloseArchive hMPQ
1788 List.Sorted = True
1789 '#If InternalListing Then
1790 RemoveDuplicates
1791 '#End If
1792 On Error Resume Next
1793 List.SelectedItem.Selected = False
1794 On Error GoTo 0
1795 SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&
1796 ShowSelected
1797 ShowTotal
1798 NewFile = False
1799 mFilter = FileFilter
1800 FileOpened:
1801 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1802 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1803 mnuMpq.Enabled = True
1804 For Each TItem In mnuTItem
1805     TItem.Enabled = True
1806 Next TItem
1807 Toolbar.Buttons.Item("Add").Enabled = True
1808 Toolbar.Buttons.Item("Add Folder").Enabled = True
1809 Toolbar.Buttons.Item("Extract").Enabled = True
1810 Toolbar.Buttons.Item("Compact").Enabled = True
1811 Toolbar.Buttons.Item("List").Enabled = True
1812 StatBar.Style = 0
1813 StatBar.SimpleText = ""
1814 If InStr(CD.FileName, "\") > 0 Then
1815     For bNum = 1 To Len(CD.FileName)
1816         If InStr(bNum, CD.FileName, "\") > 0 Then
1817             bNum = InStr(bNum, CD.FileName, "\")
1818         Else
1819             Exit For
1820         End If
1821     Next bNum
1822 End If
1823 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1824 AddRecentFile CD.FileName
1825 MousePointer = 0
1826 End Sub
1827
1828 Sub RemoveDuplicates()
1829 Dim fNum As Long
1830 fNum = 1
1831 Do While fNum <= List.ListItems.Count - 1
1832     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
1833         List.ListItems.Remove (fNum)
1834         fNum = fNum - 1
1835     End If
1836     fNum = fNum + 1
1837 Loop
1838 End Sub
1839 Sub ShowSelected()
1840 Dim fNum As Long, nSelect As Long, sSize As Currency, fSize As Long, L2 As String, hMPQ As Long, hFile As Long
1841 On Error GoTo NotSelected
1842 List.SelectedItem.Tag = List.SelectedItem.Tag
1843 On Error GoTo 0
1844 On Error Resume Next
1845 For fNum = 1 To List.ListItems.Count
1846     If List.ListItems.Item(fNum).Selected Then
1847         nSelect = nSelect + 1
1848         If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1849             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1850         Else
1851             If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1852                 If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
1853                     fSize = SFileGetFileSize(hFile, 0)
1854                     SFileCloseFile hFile
1855                 End If
1856                 SFileCloseArchive hMPQ
1857             End If
1858             If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1859                 L2 = "<1KB"
1860             ElseIf fSize = 0 Then
1861                 L2 = "0KB"
1862             Else
1863                 L2 = CStr(Int(fSize / 1024)) + "KB"
1864             End If
1865             List.ListItems.Item(fNum).ListSubItems(1).Text = L2
1866             List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
1867             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1868         End If
1869     End If
1870 Next fNum
1871 If sSize / 1024 > 0 And sSize / 1024 < 1 Then
1872     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
1873 ElseIf sSize = 0 Then
1874     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
1875 Else
1876     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
1877 End If
1878 On Error GoTo 0
1879 Exit Sub
1880 NotSelected:
1881 StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
1882 End Sub
1883 Sub ShowTotal()
1884 Dim fNum As Long, nFiles As Long, tSize As Currency
1885 On Error Resume Next
1886 For fNum = 1 To List.ListItems.Count
1887     nFiles = nFiles + 1
1888     If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1889         tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1890     End If
1891 Next fNum
1892 If tSize / 1024 > 0 And tSize / 1024 < 1 Then
1893     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
1894 Else
1895     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
1896 End If
1897 On Error GoTo 0
1898 End Sub
1899 Private Sub cmdGo_Click()
1900 StatBar.Style = 1
1901 RunMpq2kCommand txtCommand
1902 txtCommand = ""
1903 If StatBar.SimpleText = "" Then txtCommand_GotFocus
1904 End Sub
1905
1906 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1907 If KeyCode = vbKeyShift Then
1908     ShiftState = True
1909     BuildMpqActionList
1910 End If
1911 End Sub
1912 Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
1913 If KeyCode = vbKeyShift Then
1914     ShiftState = False
1915     BuildMpqActionList
1916 End If
1917 End Sub
1918 Private Sub Form_Load()
1919 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
1920 Dim Path
1921 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1922 NewKey AppKey
1923 SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
1924 SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
1925 FixIcon hWnd, 1
1926 InitFileDialog CD
1927 CD.hwndOwner = hWnd
1928 CD.DefaultExt = "mpq"
1929 CD.MaxFileSize = 5120
1930 InitFolderDialog PathInput
1931 PathInput.hwndOwner = hWnd
1932 PathInput.Flags = BIF_RETURNONLYFSDIRS
1933 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1934 ChDir App.Path
1935 'If Mpq.MpqInitialize = False Then
1936 '    ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason:  "
1937 '    Select Case Mpq.LastError
1938 '    Case MPQ_ERROR_NO_STAREDIT
1939 '        ErrorText = ErrorText + "Can't find StarEdit.exe"
1940 '    Case MPQ_ERROR_BAD_STAREDIT
1941 '        ErrorText = ErrorText + "Wrong version of StarEdit.exe.  Need SC/BW 1.07"
1942 '    Case MPQ_ERROR_STAREDIT_RUNNING
1943 '        ErrorText = ErrorText + "StarEdit.exe is running.  It must be closed before running this"
1944 '    Case Else
1945 '        ErrorText = ErrorText + "Unknown"
1946 '    End Select
1947 '    MsgBox ErrorText
1948 '    End
1949 'End If
1950 ExtractPathNum = -1
1951 CopyPathNum = -1
1952 OldStartPath = CurDir
1953 CurPath = GetReg(AppKey + "StartupPath", CurDir)
1954 CurPathType = GetReg(AppKey + "StartupPathType", 0)
1955 If CurPathType < 0 Then CurPathType = 0
1956 If CurPathType > 2 Then CurPathType = 2
1957 If CurPathType = 1 Then
1958     CurPath = App.Path
1959 End If
1960 CurPath2 = CurPath
1961 If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
1962 If IsDir(CurPath2) Then
1963     If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
1964     ChDir CurPath
1965 End If
1966 NewStartPath = CurDir
1967 On Error Resume Next
1968 Height = GetReg(AppKey + "Status\WindowHeight", Height)
1969 Left = GetReg(AppKey + "Status\WindowLeft", Left)
1970 Top = GetReg(AppKey + "Status\WindowTop", Top)
1971 Width = GetReg(AppKey + "Status\WindowWidth", Width)
1972 If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
1973 ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
1974 DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
1975 DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)
1976 LocaleID = GetReg(AppKey + "LocaleID", 0)
1977 GlobalEncrypt = False
1978 DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
1979 Select Case DefaultCompressID
1980 Case -3
1981 DefaultCompress = MAFA_COMPRESS_DEFLATE
1982 Case Else
1983 DefaultCompress = MAFA_COMPRESS_STANDARD
1984 End Select
1985 DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
1986 BuildRecentFileList
1987 BuildToolsList
1988 On Error GoTo 0
1989 SFileSetLocale LocaleID
1990 ReDim GlobalFileList(0) As String
1991 #If InternalListing Then
1992 If FileExists(ListFile) Then
1993     Open ListFile For Input As #1
1994     Do While Not EOF(1)
1995         ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
1996         Line Input #1, GlobalFileList(UBound(GlobalFileList))
1997     Loop
1998     Close #1
1999 End If
2000 #End If
2001 FileName = Trim(Command)
2002 If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
2003 If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
2004 FileName = Trim(FileName)
2005 If FileExists(FileName) Then
2006     CD.FileName = FileName
2007     Show
2008     OpenMpq
2009     Exit Sub
2010 End If
2011 ReDim FileList(0) As String
2012 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
2013 sLine = Command
2014 If Right(sLine, 1) <> " " Then sLine = sLine + " "
2015 If sLine <> "" Then
2016     ReDim Param(0) As String
2017     For pNum = 1 To Len(sLine)
2018         If Mid(sLine, pNum, 1) = Chr(34) Then
2019             pNum = pNum + 1
2020             EndParam = InStr(pNum, sLine, Chr(34))
2021             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
2022         Else
2023             EndParam = InStr(pNum, sLine, " ")
2024             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
2025         End If
2026         If EndParam = 0 Then EndParam = Len(sLine) + 1
2027         If pNum <> EndParam Then
2028             If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
2029                 ReDim Preserve Param(UBound(Param) + 1) As String
2030                 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
2031             End If
2032         End If
2033         pNum = EndParam
2034     Next pNum
2035     If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
2036     Select Case LCase(Param(1))
2037     Case "o", "open", "n", "new"
2038         Show
2039         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
2040         ChDir OldStartPath
2041         RunMpq2kCommand sLine
2042     Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
2043         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
2044         ChDir OldStartPath
2045         CD.FileName = FullPath(CurDir, Param(2))
2046         sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
2047         RunMpq2kCommand sLine
2048         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
2049         ChDir NewStartPath
2050         Unload Me
2051     Case "s", "script"
2052         Show
2053         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
2054         ChDir OldStartPath
2055         RunMpq2kCommand sLine
2056         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
2057         ChDir NewStartPath
2058     End Select
2059 End If
2060 End Sub
2061 Private Sub Form_Resize()
2062 On Error Resume Next
2063 If WindowState <> 1 Then
2064     List.Top = Toolbar.Height
2065     List.Width = ScaleWidth
2066     List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
2067     Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
2068     txtCommand.Top = List.Top + List.Height
2069     txtCommand.Left = Label1.Width
2070     txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
2071     cmdGo.Top = txtCommand.Top
2072     cmdGo.Left = txtCommand.Left + txtCommand.Width
2073     mFilter.Left = Toolbar.Buttons.Item("filterspace").Left
2074     mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
2075     Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
2076 End If
2077 End Sub
2078 Private Sub Form_Unload(Cancel As Integer)
2079 Dim Path As String
2080 Path = App.Path
2081 If Right(Path, 1) <> "\" Then Path = Path + "\"
2082 On Error Resume Next
2083 If ExtractPathNum > -1 Then
2084     KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
2085     RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
2086 End If
2087 If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
2088     KillEx Path + "Temp_extract\", "*", 6, True
2089     RmDir Path + "Temp_extract\"
2090 End If
2091 If CopyPathNum > -1 Then
2092     KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
2093     RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
2094 End If
2095 If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
2096     KillEx Path + "Temp_copy\", "*", 6, True
2097     RmDir Path + "Temp_copy\"
2098 End If
2099 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
2100     NewKey AppKey
2101     NewKey AppKey + "Status\"
2102     If WindowState = 1 Then WindowState = 0
2103     SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
2104     WindowState = 0
2105     SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
2106     SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
2107     SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
2108     SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
2109 End If
2110 If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
2111     SetReg AppKey + "StartupPath", CurDir
2112 End If
2113 End
2114 End Sub
2115 Private Sub Label1_Click()
2116 txtCommand.SetFocus
2117 End Sub
2118 Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
2119 Dim result As Long, hMPQ As Long, hFile As Long
2120 If List.SelectedItem.Text <> NewString Then
2121     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2122         result = vbYes
2123     Else
2124         result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2125     End If
2126     If result = vbYes Then
2127         List.SelectedItem.Tag = NewString
2128         hMPQ = mOpenMpq(CD.FileName)
2129         If hMPQ Then
2130             If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
2131                 SFileCloseFile hFile
2132                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2133                 MpqDeleteFile hMPQ, NewString
2134                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2135                 SFileSetLocale LocaleID
2136                 RemoveDuplicates
2137             Else
2138                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2139                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2140                 SFileSetLocale LocaleID
2141             End If
2142             MpqCloseUpdatedArchive hMPQ, 0
2143             On Error Resume Next
2144             List.SelectedItem.Key = NewString
2145             On Error GoTo 0
2146             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2147         End If
2148     Else
2149         Cancel = True
2150     End If
2151 End If
2152 ShowSelected
2153 End Sub
2154 Private Sub List_Click()
2155 On Error GoTo NotSelected
2156 List.SelectedItem.Tag = List.SelectedItem.Tag
2157 On Error GoTo NotClick
2158 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2159 On Error GoTo 0
2160 ShowSelected
2161 Exit Sub
2162 NotClick:
2163 List.SelectedItem.Selected = False
2164 NotSelected:
2165 ShowSelected
2166 BuildMpqActionList
2167 End Sub
2168 Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
2169 If List.SortKey = ColumnHeader.Index - 1 Then
2170     If List.SortOrder = 0 Then
2171         List.SortOrder = 1
2172     Else
2173         List.SortOrder = 0
2174     End If
2175 Else
2176     List.SortOrder = 0
2177     List.SortKey = ColumnHeader.Index - 1
2178 End If
2179 End Sub
2180 Private Sub List_DblClick()
2181 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
2182 On Error GoTo NotSelected
2183 List.SelectedItem.Tag = List.SelectedItem.Tag
2184 On Error GoTo NotClick
2185 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2186 On Error GoTo 0
2187 Path = App.Path
2188 If Right(Path, 1) <> "\" Then Path = Path + "\"
2189 Path = Path + "Temp_extract\"
2190 If ExtractPathNum = -1 Then
2191     fNum = 0
2192     Do
2193     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2194     fNum = fNum + 1
2195     Loop
2196     ExtractPathNum = fNum
2197 End If
2198 Path = Path + CStr(ExtractPathNum) + "\"
2199 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2200 For fNum = 1 To List.ListItems.Count
2201     If List.ListItems.Item(fNum).Selected Then
2202         StatBar.Style = 1
2203         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2204         MousePointer = 11
2205         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2206         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2207         SFileSetLocale LocaleID
2208         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
2209             For bNum = 1 To UBound(OpenFiles)
2210                 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
2211                     AlreadyInList = True
2212                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2213                     Exit For
2214                 End If
2215             Next bNum
2216             If AlreadyInList = False Then
2217                 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
2218                 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
2219                 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2220             End If
2221         End If
2222         StatBar.Style = 1
2223         StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
2224         fName = List.ListItems.Item(fNum).Tag
2225         BuildPopup Path + fName, 0, mnuPopup, mnuPItem
2226         ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
2227         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
2228     End If
2229 Next fNum
2230 SFileCloseArchive hMPQ
2231 StatBar.Style = 0
2232 StatBar.SimpleText = ""
2233 MousePointer = 0
2234 Exit Sub
2235 NotClick:
2236 List.SelectedItem.Selected = False
2237 NotSelected:
2238 End Sub
2239 Private Sub List_ItemClick(ByVal Item As ListItem)
2240 BuildMpqActionList
2241 End Sub
2242 Private Sub List_KeyPress(KeyAscii As Integer)
2243 If KeyAscii = 13 Then List_DblClick
2244 End Sub
2245 Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
2246 If KeyCode = vbKeyDelete Then
2247     mnuMDelete_Click
2248 ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
2249     On Error GoTo NotSelected
2250     List.SelectedItem.Tag = List.SelectedItem.Tag
2251     On Error GoTo 0
2252     If List.SelectedItem.Selected = True Then
2253         BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2254         PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
2255     End If
2256 End If
2257 NotSelected:
2258 End Sub
2259 Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
2260 CX = X
2261 CY = Y
2262 If Button And vbRightButton Then
2263     On Error GoTo NotSelected
2264     List.SelectedItem.Tag = List.SelectedItem.Tag
2265     On Error GoTo NotClick
2266     List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2267     On Error GoTo 0
2268     BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2269     PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
2270 End If
2271 NotClick:
2272 NotSelected:
2273 End Sub
2274 Private Sub List_OLECompleteDrag(Effect As Long)
2275 List.Tag = ""
2276 End Sub
2277 Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
2278 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
2279 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
2280 If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
2281 For fNum = 1 To Data.Files.Count
2282     Path = Data.Files.Item(fNum)
2283     If Right(Path, 1) <> "\" Then Path = Path + "\"
2284     If IsDir(Path) Then
2285         Path = Path + "*"
2286         Data.Files.Remove fNum
2287         Data.Files.Add Path, fNum
2288     End If
2289 Next fNum
2290 Path = Data.Files.Item(1)
2291 For bNum = 1 To Len(Path)
2292     If InStr(bNum, Path, "\") > 0 Then
2293         For fNum = 1 To Data.Files.Count
2294             If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
2295         Next fNum
2296         bNum = InStr(bNum, Path, "\")
2297     Else
2298         Exit For
2299     End If
2300 Next bNum
2301 PathFound:
2302 Path = Left(Path, bNum - 1)
2303 ReDim Files(0) As String
2304 Files(0) = Path
2305 If Right(Path, 1) <> "\" Then Path = Path + "\"
2306 ReDim Preserve Files(Data.Files.Count) As String
2307 For bNum = 1 To Data.Files.Count
2308     Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
2309     For fNum = 1 To Len(Files(bNum))
2310         If InStr(fNum, Files(bNum), "\") > 0 Then
2311             fNum = InStr(fNum, Files(bNum), "\")
2312         Else
2313             Exit For
2314         End If
2315     Next fNum
2316     FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
2317 Next bNum
2318 If FolderFiles = "" Then Exit Sub
2319 ReDim Preserve Files(0) As String
2320 For bNum = 1 To Len(FolderFiles)
2321     ReDim Preserve Files(UBound(Files) + 1) As String
2322     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2323         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2324         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2325     Else
2326         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2327         Exit For
2328     End If
2329 Next bNum
2330 FoldName.Show 1
2331 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2332 If UBound(Files) > 1 Then
2333     ReDim ShortFiles(UBound(Files)) As String
2334     For bNum = 0 To UBound(Files)
2335         ShortFiles(bNum) = AddFolderName + Files(bNum)
2336     Next bNum
2337     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2338     For bNum = 1 To UBound(Files)
2339         Files(bNum) = FullPath(Files(0), Files(bNum))
2340     Next bNum
2341 Else
2342     For bNum = 1 To Len(Files(1))
2343         If InStr(bNum, Files(1), "\") > 0 Then
2344             bNum = InStr(bNum, Files(1), "\")
2345         Else
2346             Exit For
2347         End If
2348     Next bNum
2349     ReDim ShortFiles(UBound(Files)) As String
2350     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2351     Files(1) = FullPath(Files(0), Files(1))
2352 End If
2353 If NewFile = True Then
2354     If FileExists(CD.FileName) Then Kill CD.FileName
2355     NewFile = False
2356 End If
2357 List.Sorted = False
2358 FileFilter = mFilter
2359 hMPQ = mOpenMpq(CD.FileName)
2360 If hMPQ = 0 Then
2361     StatBar.SimpleText = "Can't create archive " + CD.FileName
2362     Exit Sub
2363 End If
2364 dwFlags = MAFA_REPLACE_EXISTING
2365 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2366 For bNum = 1 To UBound(Files)
2367     StatBar.Style = 1
2368     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2369     MousePointer = 11
2370     If mnuMCNone.Checked Then
2371         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2372     ElseIf mnuMCStandard.Checked Then
2373         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2374     ElseIf mnuMCDeflate.Checked Then
2375         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2376     ElseIf mnuMCAMedium.Checked Then
2377         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2378     ElseIf mnuMCAHighest.Checked Then
2379         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2380     ElseIf mnuMCALowest.Checked Then
2381         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2382     ElseIf mnuMCAuto.Checked Then
2383         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2384     End If
2385     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2386     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2387     For cNum = 1 To mFilter.ListCount - 1
2388         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2389             mFilter.RemoveItem cNum
2390             Exit For
2391         End If
2392     Next cNum
2393 Next bNum
2394 MpqCloseUpdatedArchive hMPQ, 0
2395 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2396 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2397     StatBar.SimpleText = "Adding files to listing... 0% complete"
2398     For bNum = 1 To UBound(Files)
2399         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2400             MpqAddToListing hMPQ, ShortFiles(bNum)
2401         End If
2402         On Error Resume Next
2403         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2404         On Error GoTo 0
2405     Next bNum
2406     SFileCloseArchive hMPQ
2407 End If
2408 StatBar.Style = 0
2409 StatBar.SimpleText = ""
2410 MousePointer = 0
2411 If MatchesFilter("(listfile)", FileFilter) Then
2412     AddToListing "(listfile)"
2413 End If
2414 mFilter = FileFilter
2415 List.Sorted = True
2416 RemoveDuplicates
2417 ShowTotal
2418 Cancel:
2419 End Sub
2420 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)
2421 If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
2422     Effect = ccOLEDropEffectNone
2423 Else
2424     Effect = ccOLEDropEffectCopy
2425 End If
2426 End Sub
2427 Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
2428 Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
2429 Path = App.Path
2430 If Right(Path, 1) <> "\" Then Path = Path + "\"
2431 Path = Path + "Temp_copy\"
2432 If CopyPathNum = -1 Then
2433     fNum = 0
2434     Do
2435     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2436     fNum = fNum + 1
2437     Loop
2438     CopyPathNum = fNum
2439 End If
2440 Path = Path + CStr(CopyPathNum) + "\"
2441 KillEx Path, "*", 6, True
2442 fCount = 0
2443 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2444 For fNum = 1 To List.ListItems.Count
2445     If List.ListItems.Item(fNum).Selected Then
2446         StatBar.Style = 1
2447         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2448         MousePointer = 11
2449         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2450         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2451         SFileSetLocale LocaleID
2452         If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
2453             Data.Files.Add Path + List.ListItems.Item(fNum).Tag
2454         End If
2455         fCount = fCount + 1
2456         If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
2457     End If
2458 Next fNum
2459 SFileCloseArchive hMPQ
2460 StatBar.Style = 0
2461 StatBar.SimpleText = ""
2462 MousePointer = 0
2463 If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
2464     Data.Files.Add Path + "*"
2465 ElseIf fCount = 1 Then
2466     Data.Files.Add FirstFile
2467 End If
2468 End Sub
2469 Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
2470 Data.SetData , ccCFFiles
2471 AllowedEffects = ccOLEDropEffectCopy
2472 List.Tag = "WinMPQ"
2473 End Sub
2474 Private Sub mFilter_KeyPress(KeyAscii As Integer)
2475 If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
2476     If NewFile = False Then OpenMpq
2477 End If
2478 End Sub
2479 Private Sub mnuFExit_Click()
2480 Unload Me
2481 End Sub
2482 Private Sub mnuFile_Click()
2483 If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
2484 End Sub
2485 Private Sub mnuFRecent_Click(Index As Integer)
2486 Dim OldFileName As String
2487 OldFileName = CD.FileName
2488 CD.FileName = mnuFRecent(Index).Tag
2489 If FileExists(CD.FileName) = False Then
2490     CD.FileName = OldFileName
2491     MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
2492     DelRecentFile mnuFRecent(Index).Tag
2493     Exit Sub
2494 End If
2495 OpenMpq
2496 If CD.FileName = "" Then
2497     CD.FileName = OldFileName
2498     DelRecentFile mnuFRecent(Index).Tag
2499 End If
2500 End Sub
2501 Private Sub mnuFReopen_Click()
2502 OpenMpq
2503 End Sub
2504
2505 Private Sub mnuFScript_Click()
2506 Dim OldFileName As String, OldPath As String
2507 CD.Flags = &H1000 Or &H4 Or &H2
2508 CD.Filter = "All Files (*.*)|*.*"
2509 OldFileName = CD.FileName
2510 OldPath = CurDir
2511 CD.hwndOwner = hWnd
2512 If ShowOpen(CD) = False Then GoTo Cancel
2513 StatBar.Style = 1
2514 StatBar.SimpleText = "Running script " + CD.FileName + "..."
2515 MousePointer = 11
2516 RunScript CD.FileName
2517 StatBar.Style = 0
2518 StatBar.SimpleText = ""
2519 MousePointer = 0
2520 CD.FileName = OldFileName
2521 Cancel:
2522 If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
2523 ChDir OldPath
2524 End Sub
2525 Private Sub mnuHAbout_Click()
2526 About.Show 1
2527 End Sub
2528 Private Sub mnuHReadme_Click()
2529 Dim Path As String
2530 Path = App.Path
2531 If Right(Path, 1) <> "\" Then Path = Path + "\"
2532 If FileExists(Path + "WinMPQ.rtf") Then
2533     ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
2534 Else
2535     MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
2536 End If
2537 End Sub
2538 Private Sub mnuMAdd_Click()
2539 Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
2540 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
2541 CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
2542 CD.Filter = "All Files (*.*)|*.*"
2543 OldFileName = CD.FileName
2544 CD.hwndOwner = hWnd
2545 If ShowOpen(CD) = False Then GoTo Cancel
2546 ReDim Files(0) As String
2547 bNum = 1
2548 If InStr(1, CD.FileName, Chr(0)) > 0 Then
2549     Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
2550     bNum = InStr(1, CD.FileName, Chr(0)) + 1
2551 Else
2552     Files(0) = Mid(CD.FileName, 1)
2553 End If
2554 For bNum = bNum To Len(CD.FileName)
2555     ReDim Preserve Files(UBound(Files) + 1) As String
2556     If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
2557         Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
2558         bNum = InStr(bNum, CD.FileName, Chr(0))
2559     Else
2560         Files(UBound(Files)) = Mid(CD.FileName, bNum)
2561         Exit For
2562     End If
2563 Next bNum
2564 CD.FileName = OldFileName
2565 FoldName.Show 1
2566 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2567 If UBound(Files) > 1 Then
2568     ReDim ShortFiles(UBound(Files)) As String
2569     For bNum = 0 To UBound(Files)
2570         ShortFiles(bNum) = AddFolderName + Files(bNum)
2571     Next bNum
2572     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2573     For bNum = 1 To UBound(Files)
2574         Files(bNum) = FullPath(Files(0), Files(bNum))
2575     Next bNum
2576 Else
2577     For bNum = 1 To Len(Files(1))
2578         If InStr(bNum, Files(1), "\") > 0 Then
2579             bNum = InStr(bNum, Files(1), "\")
2580         Else
2581             Exit For
2582         End If
2583     Next bNum
2584     ReDim ShortFiles(UBound(Files)) As String
2585     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2586     Files(1) = FullPath(Files(0), Files(1))
2587 End If
2588 If NewFile = True Then
2589     If FileExists(CD.FileName) Then Kill CD.FileName
2590     NewFile = False
2591 End If
2592 List.Sorted = False
2593 FileFilter = mFilter
2594 hMPQ = mOpenMpq(CD.FileName)
2595 If hMPQ = 0 Then
2596     StatBar.SimpleText = "Can't create archive " + CD.FileName
2597     Exit Sub
2598 End If
2599 dwFlags = MAFA_REPLACE_EXISTING
2600 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2601 For bNum = 1 To UBound(Files)
2602     StatBar.Style = 1
2603     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2604     MousePointer = 11
2605     If mnuMCNone.Checked Then
2606         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2607     ElseIf mnuMCStandard.Checked Then
2608         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2609     ElseIf mnuMCDeflate.Checked Then
2610         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2611     ElseIf mnuMCAMedium.Checked Then
2612         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2613     ElseIf mnuMCAHighest.Checked Then
2614         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2615     ElseIf mnuMCALowest.Checked Then
2616         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2617     ElseIf mnuMCAuto.Checked Then
2618         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2619     End If
2620     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2621     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2622     For cNum = 1 To mFilter.ListCount - 1
2623         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2624             mFilter.RemoveItem cNum
2625             Exit For
2626         End If
2627     Next cNum
2628 Next bNum
2629 MpqCloseUpdatedArchive hMPQ, 0
2630 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2631 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2632     StatBar.SimpleText = "Adding files to listing... 0% complete"
2633     For bNum = 1 To UBound(Files)
2634         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2635             MpqAddToListing hMPQ, ShortFiles(bNum)
2636         End If
2637         On Error Resume Next
2638         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2639         On Error GoTo 0
2640     Next bNum
2641     SFileCloseArchive hMPQ
2642 End If
2643 StatBar.Style = 0
2644 StatBar.SimpleText = ""
2645 MousePointer = 0
2646 If MatchesFilter("(listfile)", FileFilter) Then
2647     AddToListing "(listfile)"
2648 End If
2649 mFilter = FileFilter
2650 List.Sorted = True
2651 RemoveDuplicates
2652 ShowTotal
2653 Cancel:
2654 End Sub
2655 Private Sub mnuMAddFolder_Click()
2656 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
2657 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
2658 PathInput.hwndOwner = hWnd
2659 Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
2660 If Path = "" Then GoTo Cancel
2661 FolderFiles = DirEx(Path, "*", 6, True)
2662 If FolderFiles = "" Then Exit Sub
2663 ReDim Files(0) As String
2664 Files(0) = Path
2665 If Right(Path, 1) <> "\" Then Path = Path + "\"
2666 For bNum = 1 To Len(FolderFiles)
2667     ReDim Preserve Files(UBound(Files) + 1) As String
2668     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2669         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2670         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2671     Else
2672         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2673         Exit For
2674     End If
2675 Next bNum
2676 FoldName.Show 1
2677 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2678 If UBound(Files) > 1 Then
2679     ReDim ShortFiles(UBound(Files)) As String
2680     For bNum = 0 To UBound(Files)
2681         ShortFiles(bNum) = AddFolderName + Files(bNum)
2682     Next bNum
2683     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2684     For bNum = 1 To UBound(Files)
2685         Files(bNum) = FullPath(Files(0), Files(bNum))
2686     Next bNum
2687 Else
2688     For bNum = 1 To Len(Files(1))
2689         If InStr(bNum, Files(1), "\") > 0 Then
2690             bNum = InStr(bNum, Files(1), "\")
2691         Else
2692             Exit For
2693         End If
2694     Next bNum
2695     ReDim ShortFiles(UBound(Files)) As String
2696     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2697     Files(1) = FullPath(Files(0), Files(1))
2698 End If
2699 If NewFile = True Then
2700     If FileExists(CD.FileName) Then Kill CD.FileName
2701     NewFile = False
2702 End If
2703 List.Sorted = False
2704 FileFilter = mFilter
2705 hMPQ = mOpenMpq(CD.FileName)
2706 If hMPQ = 0 Then
2707     StatBar.SimpleText = "Can't create archive " + CD.FileName
2708     Exit Sub
2709 End If
2710 dwFlags = MAFA_REPLACE_EXISTING
2711 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2712 For bNum = 1 To UBound(Files)
2713     StatBar.Style = 1
2714     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2715     MousePointer = 11
2716     If mnuMCNone.Checked Then
2717         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2718     ElseIf mnuMCStandard.Checked Then
2719         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2720     ElseIf mnuMCDeflate.Checked Then
2721         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2722     ElseIf mnuMCAMedium.Checked Then
2723         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2724     ElseIf mnuMCAHighest.Checked Then
2725         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2726     ElseIf mnuMCALowest.Checked Then
2727         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2728     ElseIf mnuMCAuto.Checked Then
2729         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2730     End If
2731     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2732     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2733     For cNum = 1 To mFilter.ListCount - 1
2734         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2735             mFilter.RemoveItem cNum
2736             Exit For
2737         End If
2738     Next cNum
2739 Next bNum
2740 MpqCloseUpdatedArchive hMPQ, 0
2741 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2742 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2743     StatBar.SimpleText = "Adding files to listing... 0% complete"
2744     For bNum = 1 To UBound(Files)
2745         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2746             MpqAddToListing hMPQ, ShortFiles(bNum)
2747         End If
2748         On Error Resume Next
2749         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2750         On Error GoTo 0
2751     Next bNum
2752     SFileCloseArchive hMPQ
2753 End If
2754 StatBar.Style = 0
2755 StatBar.SimpleText = ""
2756 MousePointer = 0
2757 If MatchesFilter("(listfile)", FileFilter) Then
2758     AddToListing "(listfile)"
2759 End If
2760 mFilter = FileFilter
2761 List.Sorted = True
2762 RemoveDuplicates
2763 ShowTotal
2764 Cancel:
2765 End Sub
2766
2767 Private Sub mnuMAddToList_Click()
2768 frmAddToList.Show 1
2769 End Sub
2770 Private Sub mnuMCAHighest_Click()
2771 mnuMCNone.Checked = False
2772 mnuMCStandard.Checked = False
2773 mnuMCDeflate.Checked = False
2774 mnuMCALowest.Checked = False
2775 mnuMCAMedium.Checked = False
2776 mnuMCAHighest.Checked = True
2777 mnuMCAuto.Checked = False
2778 End Sub
2779 Private Sub mnuMCALowest_Click()
2780 mnuMCNone.Checked = False
2781 mnuMCStandard.Checked = False
2782 mnuMCDeflate.Checked = False
2783 mnuMCALowest.Checked = True
2784 mnuMCAMedium.Checked = False
2785 mnuMCAHighest.Checked = False
2786 mnuMCAuto.Checked = False
2787 End Sub
2788
2789
2790 Private Sub mnuMCAMedium_Click()
2791 mnuMCNone.Checked = False
2792 mnuMCStandard.Checked = False
2793 mnuMCDeflate.Checked = False
2794 mnuMCALowest.Checked = False
2795 mnuMCAMedium.Checked = True
2796 mnuMCAHighest.Checked = False
2797 mnuMCAuto.Checked = False
2798 End Sub
2799 Private Sub mnuMCAuto_Click()
2800 mnuMCNone.Checked = False
2801 mnuMCStandard.Checked = False
2802 mnuMCDeflate.Checked = False
2803 mnuMCALowest.Checked = False
2804 mnuMCAMedium.Checked = False
2805 mnuMCAHighest.Checked = False
2806 mnuMCAuto.Checked = True
2807 End Sub
2808
2809 Private Sub mnuMCDeflate_Click()
2810 mnuMCNone.Checked = False
2811 mnuMCStandard.Checked = False
2812 mnuMCDeflate.Checked = True
2813 mnuMCALowest.Checked = False
2814 mnuMCAMedium.Checked = False
2815 mnuMCAHighest.Checked = False
2816 mnuMCAuto.Checked = False
2817 End Sub
2818
2819
2820 Private Sub mnuMChLCID_Click()
2821 Dim fNum As Long
2822 On Error GoTo NotSelected
2823 List.SelectedItem.Tag = List.SelectedItem.Tag
2824 On Error GoTo 0
2825 For fNum = 1 To List.ListItems.Count
2826     If List.ListItems.Item(fNum).Selected Then
2827         GoTo FileSelected
2828     End If
2829 Next fNum
2830 GoTo NotSelected
2831 FileSelected:
2832 ChLCID.Show 1
2833 Exit Sub
2834 NotSelected:
2835 MsgBox "No files are selected.", , "WinMPQ"
2836 End Sub
2837 Private Sub mnuMCNone_Click()
2838 mnuMCNone.Checked = True
2839 mnuMCStandard.Checked = False
2840 mnuMCDeflate.Checked = False
2841 mnuMCALowest.Checked = False
2842 mnuMCAMedium.Checked = False
2843 mnuMCAHighest.Checked = False
2844 mnuMCAuto.Checked = False
2845 End Sub
2846 Private Sub mnuMCompact_Click()
2847 Dim fNum As Long, result As Long, hMPQ As Long
2848 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2849     result = vbYes
2850 Else
2851     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")
2852 End If
2853 If result = vbYes Then
2854     StatBar.Style = 1
2855     StatBar.SimpleText = "Compacting " + CD.FileName + "..."
2856     MousePointer = 11
2857     hMPQ = mOpenMpq(CD.FileName)
2858     If hMPQ Then
2859         MpqCompactArchive hMPQ
2860         MpqCloseUpdatedArchive hMPQ, 0
2861     End If
2862     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2863     StatBar.Style = 0
2864     StatBar.SimpleText = ""
2865     MousePointer = 0
2866     OpenMpq
2867 End If
2868 End Sub
2869 Private Sub mnuMCStandard_Click()
2870 mnuMCNone.Checked = False
2871 mnuMCStandard.Checked = True
2872 mnuMCDeflate.Checked = False
2873 mnuMCALowest.Checked = False
2874 mnuMCAMedium.Checked = False
2875 mnuMCAHighest.Checked = False
2876 mnuMCAuto.Checked = False
2877 End Sub
2878 Private Sub mnuMDelete_Click()
2879 Dim fNum As Long, result As Long, hMPQ As Long
2880 On Error GoTo NotSelected
2881 List.SelectedItem.Tag = List.SelectedItem.Tag
2882 On Error GoTo 0
2883 For fNum = 1 To List.ListItems.Count
2884     If List.ListItems.Item(fNum).Selected Then
2885         GoTo FileSelected
2886     End If
2887 Next fNum
2888 GoTo NotSelected
2889 FileSelected:
2890     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2891         result = vbYes
2892     Else
2893         result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2894     End If
2895     If result = vbYes Then
2896         fNum = 1
2897         hMPQ = mOpenMpq(CD.FileName)
2898         If hMPQ Then
2899             Do While fNum <= List.ListItems.Count
2900                 If List.ListItems.Item(fNum).Selected Then
2901                     StatBar.Style = 1
2902                     StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
2903                     MousePointer = 11
2904                     SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2905                     MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
2906                     SFileSetLocale LocaleID
2907                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2908                     List.ListItems.Remove (fNum)
2909                     fNum = fNum - 1
2910                 End If
2911                 fNum = fNum + 1
2912             Loop
2913             MpqCloseUpdatedArchive hMPQ, 0
2914         End If
2915     End If
2916     StatBar.Style = 0
2917     StatBar.SimpleText = ""
2918     MousePointer = 0
2919     ShowSelected
2920     ShowTotal
2921 Exit Sub
2922 NotSelected:
2923 MsgBox "No files are selected.", , "WinMPQ"
2924 End Sub
2925 Private Sub mnuMEncrypt_Click()
2926 If mnuMEncrypt.Checked = False Then
2927     mnuMEncrypt.Checked = True
2928     GlobalEncrypt = True
2929 Else
2930     mnuMEncrypt.Checked = False
2931     GlobalEncrypt = False
2932 End If
2933 End Sub
2934 Private Sub mnuMExtract_Click()
2935 Dim fNum As Long, Path As String, result As Long, hMPQ As Long
2936 On Error GoTo NotSelected
2937 List.SelectedItem.Tag = List.SelectedItem.Tag
2938 On Error GoTo 0
2939 For fNum = 1 To List.ListItems.Count
2940     If List.ListItems.Item(fNum).Selected Then
2941         GoTo FileSelected
2942     End If
2943 Next fNum
2944 GoTo NotSelected
2945 FileSelected:
2946 PathInput.hwndOwner = hWnd
2947 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2948 If Path = "" Then Exit Sub
2949 If Right(Path, 1) <> "\" Then Path = Path + "\"
2950 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2951 For fNum = 1 To List.ListItems.Count
2952     If List.ListItems.Item(fNum).Selected Then
2953         StatBar.Style = 1
2954         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2955         MousePointer = 11
2956         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2957         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2958         SFileSetLocale LocaleID
2959     End If
2960 Next fNum
2961 SFileCloseArchive hMPQ
2962 StatBar.Style = 0
2963 StatBar.SimpleText = ""
2964 MousePointer = 0
2965 Exit Sub
2966 NotSelected:
2967 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2968     result = vbYes
2969 Else
2970     result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2971 End If
2972 If result = vbYes Then
2973     PathInput.hwndOwner = hWnd
2974     Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2975     If Path = "" Then Exit Sub
2976     If Right(Path, 1) <> "\" Then Path = Path + "\"
2977     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2978     For fNum = 1 To List.ListItems.Count
2979         StatBar.Style = 1
2980         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2981         MousePointer = 11
2982         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2983         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2984         SFileSetLocale LocaleID
2985     Next fNum
2986     SFileCloseArchive hMPQ
2987     StatBar.Style = 0
2988     StatBar.SimpleText = ""
2989     MousePointer = 0
2990 End If
2991 End Sub
2992 Private Sub mnuFNew_Click()
2993 Dim TItem As Menu
2994 CD.Flags = &H1000 Or &H4 Or &H2
2995 CD.DefaultExt = "mpq"
2996 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"
2997 CD.hwndOwner = hWnd
2998 If ShowSave(CD) = False Then GoTo Cancel
2999 ReDim FileList(0) As String
3000 List.ListItems.Clear
3001 ShowSelected
3002 ShowTotal
3003 NewFile = True
3004 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
3005 mnuMpq.Enabled = True
3006 For Each TItem In mnuTItem
3007     TItem.Enabled = True
3008 Next TItem
3009 Toolbar.Buttons.Item("Add").Enabled = True
3010 Toolbar.Buttons.Item("Add Folder").Enabled = True
3011 Toolbar.Buttons.Item("Extract").Enabled = True
3012 Toolbar.Buttons.Item("Compact").Enabled = True
3013 Toolbar.Buttons.Item("List").Enabled = True
3014 Caption = "WinMPQ - " + CD.FileTitle
3015 AddRecentFile CD.FileName
3016 Cancel:
3017 End Sub
3018 Private Sub mnuFOpen_Click()
3019 Dim OldFileName As String
3020 CD.Flags = &H1000 Or &H4 Or &H2
3021 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 (*.*)|*.*"
3022 OldFileName = CD.FileName
3023 CD.hwndOwner = hWnd
3024 If ShowOpen(CD) = False Then GoTo Cancel
3025 OpenMpq
3026 If CD.FileName = "" Then CD.FileName = OldFileName
3027 Cancel:
3028 End Sub
3029 Private Sub mnuMItem_Click(Index As Integer)
3030 FileActionClick mnuMpq, mnuMItem, Index
3031 End Sub
3032 Private Sub mnuMRename_Click()
3033 List.StartLabelEdit
3034 End Sub
3035 Private Sub mnuMSaveList_Click()
3036 Dim fNum As Long, fList As String, OldFileName As String
3037 CD.Flags = &H1000 Or &H4 Or &H2
3038 CD.DefaultExt = "txt"
3039 CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
3040 OldFileName = CD.FileName
3041 CD.FileName = CD.FileName + ".txt"
3042 CD.hwndOwner = hWnd
3043 If ShowSave(CD) = False Then GoTo Cancel
3044 StatBar.Style = 1
3045 StatBar.SimpleText = "Creating list..."
3046 MousePointer = 11
3047 For fNum = 1 To List.ListItems.Count
3048     fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
3049 Next fNum
3050 fNum = FreeFile
3051 Open CD.FileName For Binary As #fNum
3052 Put #fNum, 1, fList
3053 Close #fNum
3054 Cancel:
3055 CD.FileName = OldFileName
3056 StatBar.Style = 0
3057 StatBar.SimpleText = ""
3058 MousePointer = 0
3059 End Sub
3060 Private Sub mnuOptions_Click()
3061 Options.Show 1
3062 End Sub
3063
3064 Private Sub mnuPChLCID_Click()
3065 mnuMChLCID_Click
3066 End Sub
3067 Private Sub mnuPDelete_Click()
3068 mnuMDelete_Click
3069 End Sub
3070 Private Sub mnuPExtract_Click()
3071 mnuMExtract_Click
3072 End Sub
3073 Private Sub mnuPItem_Click(Index As Integer)
3074 FileActionClick mnuPopup, mnuPItem, Index
3075 End Sub
3076 Private Sub mnuPRename_Click()
3077 mnuMRename_Click
3078 End Sub
3079 Private Sub mnuPTItem_Click(Index As Integer)
3080 mnuTItem_Click Index
3081 End Sub
3082 Private Sub mnuTAdd_Click()
3083 ToolList.Show 1
3084 BuildToolsList
3085 End Sub
3086 Private Sub mnuTItem_Click(Index As Integer)
3087 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
3088 Param = mnuTItem(Index).Tag
3089 On Error GoTo NoProgram
3090 If Param = "" Then Err.Raise 53
3091 On Error GoTo 0
3092 Do
3093     If InStr(1, Param, "%mpq", 1) Then
3094         bNum = InStr(1, Param, "%mpq", 1)
3095         Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
3096     End If
3097 Loop While InStr(1, Param, "%mpq", 1)
3098 NewParam = Param
3099 On Error GoTo NotSelected
3100 List.SelectedItem.Tag = List.SelectedItem.Tag
3101 On Error GoTo 0
3102 If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
3103 NotSelected:
3104 If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
3105     Path = App.Path
3106     If Right(Path, 1) <> "\" Then Path = Path + "\"
3107     Path = Path + "Temp_extract\"
3108     If ExtractPathNum = -1 Then
3109         fNum = 0
3110         Do
3111         If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
3112         fNum = fNum + 1
3113         Loop
3114         ExtractPathNum = fNum
3115     End If
3116     Path = Path + CStr(ExtractPathNum) + "\"
3117     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
3118     For fNum = 1 To List.ListItems.Count
3119         If List.ListItems.Item(fNum).Selected Then
3120             StatBar.Style = 1
3121             StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
3122             MousePointer = 11
3123             SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
3124             sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
3125             SFileSetLocale LocaleID
3126             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
3127                 For bNum = 1 To UBound(OpenFiles)
3128                     If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
3129                         AlreadyInList = True
3130                         If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3131                         Exit For
3132                     End If
3133                 Next bNum
3134                 If AlreadyInList = False Then
3135                     ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
3136                     OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
3137                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3138                 End If
3139             End If
3140             StatBar.Style = 1
3141             StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
3142             FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
3143             UseFile = True
3144             Param = NewParam
3145             Do
3146                 If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
3147                     If FileName <> "" Then
3148                         Param = Param + " " + FileName
3149                     End If
3150                 ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
3151                     bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
3152                     If FileName <> "" Then
3153                         Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
3154                     Else
3155                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
3156                     End If
3157                 ElseIf InStr(Param, "%1") Then
3158                     bNum = InStr(Param, "%1")
3159                     If FileName <> "" Then
3160                         Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
3161                     Else
3162                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
3163                     End If
3164                 End If
3165             Loop While InStr(Param, "%1")
3166             On Error GoTo NoProgram
3167             Shell Param, 1
3168             On Error GoTo 0
3169             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
3170         End If
3171     Next fNum
3172     SFileCloseArchive hMPQ
3173 ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
3174     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3175     On Error GoTo NoProgram
3176     Shell Param, 1
3177     On Error GoTo 0
3178     Timer1.Enabled = True
3179 Else
3180     MsgBox "No files are selected.", , "WinMPQ"
3181 End If
3182 If FileName <> "" Then
3183     StatBar.Style = 0
3184     StatBar.SimpleText = ""
3185     MousePointer = 0
3186 End If
3187 Exit Sub
3188 NoProgram:
3189 If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
3190 End Sub
3191
3192 Private Sub mnuTMpqEmbed_Click()
3193 frmMpq.Show
3194 End Sub
3195 Private Sub Timer1_Timer()
3196 Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
3197 If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
3198 Path = App.Path
3199 If Right(Path, 1) <> "\" Then Path = Path + "\"
3200 Path = Path + "Temp_extract\"
3201 Path = Path + CStr(ExtractPathNum) + "\"
3202 For fNum = 1 To UBound(OpenFiles)
3203     If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3204         If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
3205             If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
3206                 result = vbYes
3207             Else
3208             result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
3209             End If
3210             If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3211                 OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
3212                 If result = vbYes Then
3213                     List.Sorted = False
3214                     StatBar.Style = 1
3215                     StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
3216                     MousePointer = 11
3217                     dwFlags = MAFA_REPLACE_EXISTING
3218                     If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
3219                     hMPQ = mOpenMpq(CD.FileName)
3220                     If hMPQ Then
3221                         If mnuMCNone.Checked Then
3222                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
3223                         ElseIf mnuMCStandard.Checked Then
3224                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
3225                         ElseIf mnuMCDeflate.Checked Then
3226                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
3227                         ElseIf mnuMCAMedium.Checked Then
3228                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
3229                         ElseIf mnuMCAHighest.Checked Then
3230                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
3231                         ElseIf mnuMCALowest.Checked Then
3232                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
3233                         ElseIf mnuMCAuto.Checked Then
3234                             mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
3235                         End If
3236                     End If
3237                     MpqAddToListing hMPQ, OpenFiles(fNum)
3238                     MpqCloseUpdatedArchive hMPQ, 0
3239                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3240                     StatBar.Style = 0
3241                     StatBar.SimpleText = ""
3242                     MousePointer = 0
3243                     List.Sorted = True
3244                     RemoveDuplicates
3245                     ShowTotal
3246                 End If
3247             End If
3248         End If
3249     Else
3250         For bNum = fNum To UBound(OpenFiles) - 1
3251             OpenFiles(bNum) = OpenFiles(bNum + 1)
3252             OpenFileDates(bNum) = OpenFileDates(bNum + 1)
3253         Next bNum
3254         ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
3255         fNum = fNum - 1
3256         If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
3257     End If
3258     If fNum >= UBound(OpenFiles) Then Exit For
3259 Next fNum
3260 If FileExists(CD.FileName) Then
3261     If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
3262 Else
3263     OpenMpq
3264 End If
3265 End Sub
3266 Private Sub Toolbar_ButtonClick(ByVal Button As Button)
3267 Select Case Button.Key
3268 Case "New"
3269     mnuFNew_Click
3270 Case "Open"
3271     mnuFOpen_Click
3272 Case "Add"
3273     mnuMAdd_Click
3274 Case "Add Folder"
3275     mnuMAddFolder_Click
3276 Case "Extract"
3277     mnuMExtract_Click
3278 Case "Compact"
3279     mnuMCompact_Click
3280 Case "List"
3281     If NewFile = False Then OpenMpq
3282 End Select
3283 End Sub
3284 Private Sub txtCommand_GotFocus()
3285 cmdGo.Default = True
3286 txtCommandHasFocus = True
3287 StatBar.Style = 1
3288 StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
3289 End Sub
3290 Private Sub txtCommand_LostFocus()
3291 cmdGo.Default = False
3292 txtCommandHasFocus = False
3293 StatBar.Style = 0
3294 StatBar.SimpleText = ""
3295 End Sub