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 DelRecentFile(rFileName As String)
 685 Dim bNum As Long, fNum As Long
 686 For bNum = 1 To 8
 687     If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
 688         For fNum = bNum To 7
 689             SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
 690         Next fNum
 691         DelReg AppKey + "Recent\File" + CStr(8)
 692         Exit For
 693     End If
 694 Next bNum
 695 BuildRecentFileList
 696 End Sub
 697 Sub AddToListing(AddedFile As String)
 698 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
 699 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
 700     If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
 701         L1 = AddedFile
 702         fSize = SFileGetFileSize(hFile, 0)
 703         cSize = SFileGetFileInfo(hFile, 6)
 704         If fSize / 1024 > 0 And fSize / 1024 < 1 Then
 705             L2 = "<1KB"
 706         ElseIf fSize = 0 Then
 707             L2 = "0KB"
 708         Else
 709             L2 = CStr(Int(fSize / 1024)) + "KB"
 710         End If
 711         If cSize / 1024 > 0 And cSize / 1024 < 1 Then
 712             L4 = "<1KB"
 713         ElseIf cSize = 0 Then
 714             L4 = "0KB"
 715         Else
 716             L4 = CStr(Int(cSize / 1024)) + "KB"
 717         End If
 718         If fSize <> 0 Then
 719             L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
 720         Else
 721             L3 = "0%"
 722         End If
 723         fFlags = SFileGetFileInfo(hFile, 7)
 724         L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
 725         If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
 726         If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
 727         If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
 728         On Error Resume Next
 729         lIndex = List.ListItems.Add(, L1, L1).Index
 730         On Error GoTo 0
 731         If lIndex = 0 Then
 732             lIndex = List.ListItems.Item(L1).Index
 733             List.ListItems.Item(L1).ListSubItems.Clear
 734         End If
 735         List.ListItems.Item(lIndex).Tag = L1
 736         List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
 737         If fSize <> 0 Then
 738             List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
 739         Else
 740             List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
 741         End If
 742         List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
 743         List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
 744         List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
 745         SFileCloseFile hFile
 746     End If
 747     SFileCloseArchive hMPQ
 748 End If
 749 End Sub
 750 Sub FileActionClick(mnuRoot As Menu, mnuItem, Index As Integer)
 751 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
 752 Path = App.Path
 753 If Right(Path, 1) <> "\" Then Path = Path + "\"
 754 Path = Path + "Temp_extract\"
 755 If ExtractPathNum = -1 Then
 756     fNum = 0
 757     Do
 758     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
 759     fNum = fNum + 1
 760     Loop
 761     ExtractPathNum = fNum
 762 End If
 763 Path = Path + CStr(ExtractPathNum) + "\"
 764 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
 765 For fNum = 1 To List.ListItems.Count
 766     If List.ListItems.Item(fNum).Selected Then
 767         StatBar.Style = 1
 768         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
 769         MousePointer = 11
 770         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
 771         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
 772         SFileSetLocale LocaleID
 773         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
 774             For bNum = 1 To UBound(OpenFiles)
 775                 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
 776                     AlreadyInList = True
 777                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
 778                     Exit For
 779                 End If
 780             Next bNum
 781             If AlreadyInList = False Then
 782                 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
 783                 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
 784                 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
 785             End If
 786         End If
 787         StatBar.Style = 1
 788         StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
 789         fName = List.ListItems.Item(fNum).Tag
 790         ExecuteFile Path + fName, Index, mnuRoot, mnuItem
 791         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
 792     End If
 793 Next fNum
 794 SFileCloseArchive hMPQ
 795 StatBar.Style = 0
 796 StatBar.SimpleText = ""
 797 MousePointer = 0
 798 End Sub
 799 Sub MpqAddToListing(hMPQ As Long, AddedFile As String)
 800 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
 801 If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
 802     L1 = AddedFile
 803     fSize = SFileGetFileSize(hFile, 0)
 804     cSize = SFileGetFileInfo(hFile, 6)
 805     If fSize / 1024 > 0 And fSize / 1024 < 1 Then
 806         L2 = "<1KB"
 807     ElseIf fSize = 0 Then
 808         L2 = "0KB"
 809     Else
 810         L2 = CStr(Int(fSize / 1024)) + "KB"
 811     End If
 812     If cSize / 1024 > 0 And cSize / 1024 < 1 Then
 813         L4 = "<1KB"
 814     ElseIf cSize = 0 Then
 815         L4 = "0KB"
 816     Else
 817         L4 = CStr(Int(cSize / 1024)) + "KB"
 818     End If
 819     If fSize <> 0 Then
 820         L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
 821     Else
 822         L3 = "0%"
 823     End If
 824     fFlags = SFileGetFileInfo(hFile, 7)
 825     L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
 826     If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
 827     If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
 828     If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
 829     On Error Resume Next
 830     lIndex = List.ListItems.Add(, L1, L1).Index
 831     On Error GoTo 0
 832     If lIndex = 0 Then
 833         lIndex = List.ListItems.Item(L1).Index
 834         List.ListItems.Item(L1).ListSubItems.Clear
 835     End If
 836     List.ListItems.Item(lIndex).Tag = L1
 837     List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
 838     If fSize <> 0 Then
 839         List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
 840     Else
 841         List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
 842     End If
 843     List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
 844     List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
 845     List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
 846     SFileCloseFile hFile
 847 End If
 848 End Sub
 849 Sub RemoveFromListing(RemovedFile As String)
 850 Dim FileCount As Long
 851 On Error GoTo FileRemoved
 852 Do
 853 List.ListItems.Remove RemovedFile
 854 FileCount = FileCount + 1
 855 Loop
 856 FileRemoved:
 857 If FileCount = 0 Then
 858     For FileCount = 1 To List.ListItems.Count
 859         If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then
 860             List.ListItems.Remove FileCount
 861             Exit Sub
 862         End If
 863     Next FileCount
 864 End If
 865 End Sub
 866 Sub RenameInListing(OldName As String, NewName As String)
 867 Dim lIndex As Long
 868 If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName
 869 On Error GoTo RenameError
 870 lIndex = List.ListItems.Item(OldName).Index
 871 List.ListItems.Item(lIndex).Text = NewName
 872 List.ListItems.Item(lIndex).Tag = NewName
 873 On Error Resume Next
 874 List.ListItems.Item(lIndex).Key = NewName
 875 On Error GoTo 0
 876 Exit Sub
 877 RenameError:
 878 For lIndex = 1 To List.ListItems.Count
 879     If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then
 880         List.ListItems.Item(lIndex).Text = NewName
 881         List.ListItems.Item(lIndex).Tag = NewName
 882         On Error Resume Next
 883         List.ListItems.Item(lIndex).Key = NewName
 884         On Error GoTo 0
 885         Exit Sub
 886     End If
 887 Next lIndex
 888 End Sub
 889 Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)
 890 Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO
 891 If Index < mnuRoot.Tag Then
 892     With sei
 893         .cbSize = Len(sei)
 894         .fMask = 0
 895         .hWnd = hWnd
 896         .lpVerb = mnuItem(Index).Tag
 897         .lpFile = FileName
 898         .lpParameters = vbNullString
 899         .lpDirectory = vbNullString
 900         .nShow = 1
 901     End With
 902     RetVal = ShellExecuteEx(sei)
 903 Else
 904     With sei
 905         .cbSize = Len(sei)
 906         .fMask = SEE_MASK_CLASSNAME
 907         .hWnd = hWnd
 908         .lpVerb = mnuItem(Index).Tag
 909         .lpFile = FileName
 910         .lpParameters = vbNullString
 911         .lpDirectory = vbNullString
 912         .nShow = 1
 913         .lpClass = "Unknown"
 914     End With
 915     RetVal = ShellExecuteEx(sei)
 916 End If
 917 'If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then
 918 '    Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")
 919 '    Do
 920 '        If InStr(Param, "%1") = 0 Then
 921 '            Param = Param + " " + FileName
 922 '        Else
 923 '            bNum = InStr(Param, "%1")
 924 '            Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
 925 '        End If
 926 '    Loop While InStr(Param, "%1")
 927 '    bNum = 1
 928 '    Do While bNum <= Len(Param)
 929 '        If InStr(bNum, Param, "%") Then
 930 '            bNum = InStr(bNum, Param, "%")
 931 '            If InStr(bNum + 1, Param, "%") Then
 932 '                bNum2 = InStr(bNum + 1, Param, "%")
 933 '                EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)
 934 '                If Environ(EnvName) <> "" Then
 935 '                    Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)
 936 '                End If
 937 '            End If
 938 '        End If
 939 '        bNum = bNum + 1
 940 '    Loop
 941 '    On Error GoTo NoProgram
 942 '    Shell Param, 1
 943 '    On Error GoTo 0
 944 'End If
 945 'Exit Sub
 946 'NoProgram:
 947 'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
 948 End Sub
 949 Sub RunMpq2kCommand(CmdLine As String)
 950 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
 951 CurPath = CurDir
 952 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
 953 sLine = CmdLine
 954 If Right(sLine, 1) <> " " Then sLine = sLine + " "
 955 If sLine <> "" Then
 956     ReDim Param(0) As String
 957     For pNum = 1 To Len(sLine)
 958         If Mid(sLine, pNum, 1) = Chr(34) Then
 959             pNum = pNum + 1
 960             EndParam = InStr(pNum, sLine, Chr(34))
 961         Else
 962             EndParam = InStr(pNum, sLine, " ")
 963         End If
 964         If EndParam = 0 Then EndParam = Len(sLine) + 1
 965         If pNum <> EndParam Then
 966             If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
 967                 ReDim Preserve Param(UBound(Param) + 1) As String
 968                 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
 969             End If
 970         End If
 971         pNum = EndParam
 972     Next pNum
 973     If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
 974     Select Case LCase(Param(1))
 975     Case "?", "h", "help"
 976         mnuHReadme_Click
 977     Case "o", "open"
 978         OldFileName = CD.FileName
 979         If Param(2) <> "" Then
 980             CD.FileName = FullPath(CurPath, Param(2))
 981         End If
 982         If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then
 983             DefaultMaxFiles = Param(3)
 984         End If
 985         If FileExists(CD.FileName) Then
 986             OpenMpq
 987             If CD.FileName = "" Then
 988                 CD.FileName = OldFileName
 989                 StatBar.SimpleText = "The file does not contain an MPQ archive."
 990             Else
 991                 StatBar.SimpleText = "Opened " + CD.FileName
 992                 AddRecentFile CD.FileName
 993             End If
 994         ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then
 995             ReDim FileList(0) As String
 996             List.ListItems.Clear
 997             ShowSelected
 998             ShowTotal
 999             NewFile = True
1000             ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1001             mnuMpq.Enabled = True
1002             For Each TItem In mnuTItem
1003                 TItem.Enabled = True
1004             Next TItem
1005             Toolbar.Buttons.Item("Add").Enabled = True
1006             Toolbar.Buttons.Item("Add Folder").Enabled = True
1007             Toolbar.Buttons.Item("Extract").Enabled = True
1008             Toolbar.Buttons.Item("Compact").Enabled = True
1009             Toolbar.Buttons.Item("List").Enabled = True
1010             If InStr(CD.FileName, "\") > 0 Then
1011                 For bNum = 1 To Len(CD.FileName)
1012                     If InStr(bNum, CD.FileName, "\") > 0 Then
1013                         bNum = InStr(bNum, CD.FileName, "\")
1014                     Else
1015                         Exit For
1016                     End If
1017                 Next bNum
1018             End If
1019             Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1020             StatBar.SimpleText = "Created new " + CD.FileName
1021             AddRecentFile CD.FileName
1022         ElseIf CD.FileName = "" Then
1023             StatBar.SimpleText = "Required parameter missing"
1024         End If
1025     Case "n", "new"
1026         If Param(2) <> "" Then
1027             CD.FileName = FullPath(CurPath, Param(2))
1028             If Param(3) <> "" Then
1029                 DefaultMaxFiles = Param(3)
1030             End If
1031             If CD.FileName <> "" Then
1032                 ReDim FileList(0) As String
1033                 List.ListItems.Clear
1034                 ShowSelected
1035                 ShowTotal
1036                 NewFile = True
1037                 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1038                 mnuMpq.Enabled = True
1039                 For Each TItem In mnuTItem
1040                     TItem.Enabled = True
1041                 Next TItem
1042                 Toolbar.Buttons.Item("Add").Enabled = True
1043                 Toolbar.Buttons.Item("Add Folder").Enabled = True
1044                 Toolbar.Buttons.Item("Extract").Enabled = True
1045                 Toolbar.Buttons.Item("Compact").Enabled = True
1046                 Toolbar.Buttons.Item("List").Enabled = True
1047                 If InStr(CD.FileName, "\") > 0 Then
1048                     For bNum = 1 To Len(CD.FileName)
1049                         If InStr(bNum, CD.FileName, "\") > 0 Then
1050                             bNum = InStr(bNum, CD.FileName, "\")
1051                         Else
1052                             Exit For
1053                         End If
1054                     Next bNum
1055                 End If
1056                 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1057                 StatBar.SimpleText = "Created new " + CD.FileName
1058                 AddRecentFile CD.FileName
1059             End If
1060         Else
1061             StatBar.SimpleText = "Required parameter missing"
1062         End If
1063     Case "c", "close"
1064         StatBar.SimpleText = "Close is for scripts only"
1065     Case "p", "pause"
1066         StatBar.SimpleText = "Pause not supported"
1067     Case "a", "add"
1068         If CD.FileName <> "" Then
1069             ReDim FileShortNames(0) As String
1070             cType = 0
1071             Rswitch = False
1072             fCount = 0
1073             Files = ""
1074             fEndLine = 0
1075             fLine = ""
1076             dwFlags = MAFA_REPLACE_EXISTING
1077             If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
1078             For pNum = 3 To UBound(Param)
1079                 If LCase(Param(pNum)) = "/wav" Then
1080                     cType = 2
1081                     dwFlags = dwFlags Or MAFA_COMPRESS
1082                 ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
1083                     cType = 1
1084                     dwFlags = dwFlags Or MAFA_COMPRESS
1085                 ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
1086                     cType = -1
1087                 ElseIf LCase(Param(pNum)) = "/r" Then
1088                     Rswitch = True
1089                 End If
1090             Next pNum
1091             If Left(Param(3), 1) = "/" Or Param(3) = "" Then
1092                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1093                     Param(3) = ""
1094                 Else
1095                     Param(3) = Param(2)
1096                 End If
1097             End If
1098             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1099                 If InStr(Param(2), "\") > 0 Then
1100                     For pNum = 1 To Len(Param(2))
1101                         If InStr(pNum, Param(2), "\") > 0 Then
1102                             pNum = InStr(pNum, Param(2), "\")
1103                             Files = Left(Param(2), pNum)
1104                         End If
1105                     Next pNum
1106                 End If
1107                 MousePointer = 11
1108                 If NewFile = True Then
1109                     If FileExists(CD.FileName) Then Kill CD.FileName
1110                     NewFile = False
1111                 End If
1112                 Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
1113                 List.Sorted = False
1114                 FileFilter = mFilter
1115                 hMPQ = mOpenMpq(CD.FileName)
1116                 If hMPQ = 0 Then
1117                     StatBar.SimpleText = "Can't create archive " + CD.FileName
1118                     Exit Sub
1119                 End If
1120                 For pNum = 1 To Len(Files)
1121                     fEndLine = InStr(pNum, Files, vbCrLf)
1122                     fLine = Mid(Files, pNum, fEndLine - pNum)
1123                     If cType = 0 Then
1124                         StatBar.SimpleText = "Adding " + fLine + "..."
1125                     ElseIf cType = 1 Then
1126                         StatBar.SimpleText = "Adding compressed " + fLine + "..."
1127                     ElseIf cType = 2 Then
1128                         StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."
1129                     ElseIf cType = -1 Then
1130                         StatBar.SimpleText = "Adding " + fLine + " (compression auto-select)..."
1131                     End If
1132                     If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1133                         If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
1134                         If cType = 2 Then
1135                             MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
1136                         ElseIf cType = -1 Then
1137                             mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
1138                         ElseIf cType = 1 Then
1139                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
1140                         Else
1141                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
1142                         End If
1143                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1144                         mFilter.AddItem "*" + GetExtension(Param(3) + fLine)
1145                         For cNum = 1 To mFilter.ListCount - 1
1146                             If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
1147                                 mFilter.RemoveItem cNum
1148                                 Exit For
1149                             End If
1150                         Next cNum
1151                         If MatchesFilter(Param(3) + fLine, FileFilter) Then
1152                             ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
1153                             FileShortNames(UBound(FileShortNames)) = Param(3) + fLine
1154                         End If
1155                     Else
1156                         If cType = 2 Then
1157                             MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
1158                         ElseIf cType = -1 Then
1159                             mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
1160                         ElseIf cType = 1 Then
1161                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
1162                         Else
1163                             MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
1164                         End If
1165                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1166                         mFilter.AddItem "*" + GetExtension(Param(3))
1167                         For cNum = 1 To mFilter.ListCount - 1
1168                             If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
1169                                 mFilter.RemoveItem cNum
1170                                 Exit For
1171                             End If
1172                         Next cNum
1173                         If MatchesFilter(Param(3), FileFilter) Then
1174                             ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
1175                             FileShortNames(UBound(FileShortNames)) = Param(3)
1176                         End If
1177                     End If
1178                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1179                     fCount = fCount + 1
1180                     pNum = fEndLine + 1
1181                 Next pNum
1182                 MpqCloseUpdatedArchive hMPQ, 0
1183                 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1184                 If UBound(FileShortNames) > 1 Then
1185                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1186                         StatBar.SimpleText = "Adding files to listing... 0% complete"
1187                         For pNum = 1 To UBound(FileShortNames)
1188                             If MatchesFilter(FileShortNames(pNum), FileFilter) Then
1189                                 MpqAddToListing hMPQ, FileShortNames(pNum)
1190                             End If
1191                             On Error Resume Next
1192                             StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"
1193                             On Error GoTo 0
1194                         Next pNum
1195                         SFileCloseArchive hMPQ
1196                     End If
1197                 ElseIf UBound(FileShortNames) = 1 Then
1198                     AddToListing FileShortNames(1)
1199                 End If
1200                 MousePointer = 0
1201                 If MatchesFilter("(listfile)", FileFilter) Then
1202                     AddToListing "(listfile)"
1203                 End If
1204                 mFilter = FileFilter
1205                 List.Sorted = True
1206                 RemoveDuplicates
1207                 ShowTotal
1208                 If fCount > 1 Then
1209                     StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"
1210                 End If
1211             Else
1212                 StatBar.SimpleText = "Required parameter missing"
1213             End If
1214         Else
1215             StatBar.SimpleText = "No archive open"
1216         End If
1217     Case "e", "extract"
1218         If CD.FileName <> "" Then
1219             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Extracting " + Param(2) + "..."
1220             cType = 0
1221             For pNum = 3 To UBound(Param)
1222                 If LCase(Param(pNum)) = "/fp" Then
1223                     cType = 1
1224                     Exit For
1225                 End If
1226             Next pNum
1227             If Left(Param(3), 1) = "/" Then Param(3) = ""
1228             If Param(3) = "" Then Param(3) = "."
1229             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1230                 MousePointer = 11
1231                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1232                     Files = MpqDir(CD.FileName, Param(2))
1233                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1234                         StatBar.SimpleText = "Can't open archive " + CD.FileName
1235                         Exit Sub
1236                     End If
1237                     For pNum = 1 To Len(Files)
1238                         fEndLine = InStr(pNum, Files, vbCrLf)
1239                         fLine = Mid(Files, pNum, fEndLine - pNum)
1240                         StatBar.SimpleText = "Extracting " + fLine + "..."
1241                         sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
1242                         StatBar.SimpleText = StatBar.SimpleText + " Done"
1243                         fCount = fCount + 1
1244                         pNum = fEndLine + 1
1245                     Next pNum
1246                     SFileCloseArchive hMPQ
1247                     If fCount > 1 Then
1248                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"
1249                     End If
1250                 Else
1251                     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1252                         StatBar.SimpleText = "Can't open archive " + CD.FileName
1253                         Exit Sub
1254                     End If
1255                     sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
1256                     SFileCloseArchive hMPQ
1257                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1258                 End If
1259                 MousePointer = 0
1260             Else
1261                 StatBar.SimpleText = "Required parameter missing"
1262             End If
1263         Else
1264             StatBar.SimpleText = "No archive open"
1265         End If
1266     Case "r", "ren", "rename"
1267         If CD.FileName <> "" Then
1268             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."
1269             If Param(2) <> "" And Param(3) <> "" Then
1270                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1271                     If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then
1272                         Files = MpqDir(CD.FileName, Param(2))
1273                         hMPQ = mOpenMpq(CD.FileName)
1274                         If hMPQ Then
1275                             For pNum = 1 To Len(Files)
1276                                 fEndLine = InStr(pNum, Files, vbCrLf)
1277                                 fLine = Mid(Files, pNum, fEndLine - pNum)
1278                                 fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
1279                                 StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."
1280                                 If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
1281                                     SFileCloseFile hFile
1282                                     MpqDeleteFile hMPQ, fLine2
1283                                     MpqRenameFile hMPQ, fLine, fLine2
1284                                 Else
1285                                     MpqRenameFile hMPQ, fLine, fLine2
1286                                 End If
1287                                 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1288                                 RenameInListing fLine, fLine2
1289                                 StatBar.SimpleText = StatBar.SimpleText + " Done"
1290                                 fCount = fCount + 1
1291                                 pNum = fEndLine + 1
1292                             Next pNum
1293                             MpqCloseUpdatedArchive hMPQ, 0
1294                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1295                         End If
1296                         If fCount > 1 Then
1297                             StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"
1298                         End If
1299                     Else
1300                     StatBar.SimpleText = "You must use wildcards with new name"
1301                     End If
1302                 Else
1303                     hMPQ = mOpenMpq(CD.FileName)
1304                     If hMPQ Then
1305                         If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
1306                             SFileCloseFile hFile
1307                             MpqDeleteFile hMPQ, Param(3)
1308                             MpqRenameFile hMPQ, Param(2), Param(3)
1309                         Else
1310                             MpqRenameFile hMPQ, Param(2), Param(3)
1311                         End If
1312                         MpqCloseUpdatedArchive hMPQ, 0
1313                     End If
1314                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1315                     RenameInListing Param(2), Param(3)
1316                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1317                 End If
1318             Else
1319                 StatBar.SimpleText = "Required parameter missing"
1320             End If
1321         Else
1322             StatBar.SimpleText = "No archive open"
1323         End If
1324     Case "m", "move"
1325         If CD.FileName <> "" Then
1326             For pNum = 1 To Len(Param(2))
1327                 If InStr(pNum, Param(2), "\") Then
1328                     pNum = InStr(pNum, Param(2), "\")
1329                 Else
1330                     Exit For
1331                 End If
1332             Next pNum
1333             fLineTitle = Mid(Param(2), pNum)
1334             If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
1335             Param(3) = Param(3) + fLineTitle
1336             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Moving " + Param(2) + " => " + Param(3) + "..."
1337             If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then
1338                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1339                     Files = MpqDir(CD.FileName, Param(2))
1340                     hMPQ = mOpenMpq(CD.FileName)
1341                     If hMPQ Then
1342                         For pNum = 1 To Len(Files)
1343                             fEndLine = InStr(pNum, Files, vbCrLf)
1344                             fLine = Mid(Files, pNum, fEndLine - pNum)
1345                             fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
1346                             StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."
1347                             If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
1348                                 SFileCloseFile hFile
1349                                 MpqDeleteFile hMPQ, fLine2
1350                                 MpqRenameFile hMPQ, fLine, fLine2
1351                             Else
1352                                 MpqRenameFile hMPQ, fLine, fLine2
1353                             End If
1354                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1355                             RenameInListing fLine, fLine2
1356                             StatBar.SimpleText = StatBar.SimpleText + " Done"
1357                             fCount = fCount + 1
1358                             pNum = fEndLine + 1
1359                         Next pNum
1360                         MpqCloseUpdatedArchive hMPQ, 0
1361                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1362                     End If
1363                     If fCount > 1 Then
1364                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"
1365                     End If
1366                 Else
1367                     hMPQ = mOpenMpq(CD.FileName)
1368                     If hMPQ Then
1369                         If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
1370                             SFileCloseFile hFile
1371                             MpqDeleteFile hFile, Param(3)
1372                             MpqRenameFile hFile, Param(2), Param(3)
1373                         Else
1374                             MpqRenameFile hFile, Param(2), Param(3)
1375                         End If
1376                         MpqCloseUpdatedArchive hMPQ, 0
1377                     End If
1378                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1379                     RenameInListing Param(2), Param(3)
1380                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1381                 End If
1382             Else
1383                 StatBar.SimpleText = "Required parameter missing"
1384             End If
1385         Else
1386             StatBar.SimpleText = "No archive open"
1387         End If
1388     Case "d", "del", "delete"
1389         If CD.FileName <> "" Then
1390             If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Deleting " + Param(2) + "..."
1391             If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
1392                 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
1393                     Files = MpqDir(CD.FileName, Param(2))
1394                     hMPQ = mOpenMpq(CD.FileName)
1395                     If hMPQ Then
1396                         For pNum = 1 To Len(Files)
1397                             fEndLine = InStr(pNum, Files, vbCrLf)
1398                             fLine = Mid(Files, pNum, fEndLine - pNum)
1399                             StatBar.SimpleText = "Deleting " + fLine + "..."
1400                             MpqDeleteFile hMPQ, fLine
1401                             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1402                             RemoveFromListing fLine
1403                             StatBar.SimpleText = StatBar.SimpleText + " Done"
1404                             fCount = fCount + 1
1405                             pNum = fEndLine + 1
1406                         Next pNum
1407                         MpqCloseUpdatedArchive hMPQ, 0
1408                         If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1409                     End If
1410                     If fCount > 1 Then
1411                         StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
1412                     End If
1413                 Else
1414                     hMPQ = mOpenMpq(CD.FileName)
1415                     If hMPQ Then
1416                         MpqDeleteFile hMPQ, Param(2)
1417                         MpqCloseUpdatedArchive hMPQ, 0
1418                     End If
1419                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1420                     RemoveFromListing Param(2)
1421                     StatBar.SimpleText = StatBar.SimpleText + " Done"
1422                 End If
1423             Else
1424                 StatBar.SimpleText = "Required parameter missing"
1425             End If
1426         Else
1427             StatBar.SimpleText = "No archive open"
1428         End If
1429     Case "f", "flush", "compact"
1430         If CD.FileName <> "" Then
1431             MousePointer = 11
1432             StatBar.SimpleText = "Flushing " + CD.FileName + "..."
1433             hMPQ = mOpenMpq(CD.FileName)
1434             If hMPQ Then
1435                 MpqCompactArchive hMPQ
1436                 MpqCloseUpdatedArchive hMPQ, 0
1437             End If
1438             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1439             StatBar.SimpleText = StatBar.SimpleText + " Done"
1440             MousePointer = 0
1441             OpenMpq
1442         Else
1443             StatBar.SimpleText = "No archive open"
1444         End If
1445     Case "l", "list"
1446         If CD.FileName <> "" Then
1447             If Param(2) <> "" Then
1448                 StatBar.SimpleText = "Creating list..."
1449                 MousePointer = 11
1450                 If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
1451                     Files = MpqDir(CD.FileName, Param(2))
1452                     Param(2) = Param(3)
1453                 Else
1454                     Files = MpqDir(CD.FileName, "*")
1455                 End If
1456                 fNum = FreeFile
1457                 Open FullPath(CurPath, Param(2)) For Binary As #fNum
1458                 Put #fNum, 1, Files
1459                 Close #fNum
1460                 StatBar.SimpleText = StatBar.SimpleText + " Done"
1461                 MousePointer = 0
1462             Else
1463                 StatBar.SimpleText = "Required parameter missing"
1464             End If
1465         Else
1466             StatBar.SimpleText = "No archive open"
1467         End If
1468     Case "s", "script"
1469         StatBar.SimpleText = "Running script " + Param(2) + "..."
1470         If Param(2) <> "" Then
1471             MousePointer = 11
1472             RunScript FullPath(CurPath, Param(2))
1473             MousePointer = 0
1474             StatBar.SimpleText = StatBar.SimpleText + " Done"
1475         Else
1476             StatBar.SimpleText = "Required parameter missing"
1477         End If
1478     Case "x", "exit", "quit"
1479         Unload Me
1480     Case Else
1481         If Left(Param(1), 1) <> ";" Then
1482             If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then
1483                 On Error Resume Next
1484                 ChDir Param(2)
1485                 On Error GoTo 0
1486                 txtCommand_GotFocus
1487             ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then
1488                 On Error Resume Next
1489                 ChDir Mid(Param(1), 3)
1490                 On Error GoTo 0
1491                 txtCommand_GotFocus
1492             ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then
1493                 On Error Resume Next
1494                 ChDir Mid(Param(1), 6)
1495                 On Error GoTo 0
1496                 txtCommand_GotFocus
1497             ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then
1498                 On Error Resume Next
1499                 ChDrive Left(Param(1), 2)
1500                 On Error GoTo 0
1501                 txtCommand_GotFocus
1502             Else
1503                 Shell "command.com /k " + sLine, 1
1504             End If
1505         End If
1506     End Select
1507 End If
1508 End Sub
1509 Sub BuildRecentFileList()
1510 Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu
1511 For Each RItem In mnuFRecent
1512     If RItem.Index <> 0 Then Unload RItem
1513 Next RItem
1514 rNum2 = 1
1515 For rNum = 8 To 1 Step -1
1516     RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))
1517     If FileExists(RecentFile) Then
1518         mnuFRecent(0).Visible = True
1519         On Error Resume Next
1520         Load mnuFRecent(rNum2)
1521         On Error GoTo 0
1522         mnuFRecent(rNum2).Tag = RecentFile
1523         If TextWidth(RecentFile) > TextWidth("________________________________") Then
1524             FirstSep = InStr(RecentFile, "\")
1525             If FirstSep > 0 Then
1526                 For LastSep = FirstSep + 1 To Len(RecentFile)
1527                     If InStr(LastSep, RecentFile, "\") > 0 Then
1528                         LastSep = InStr(LastSep, RecentFile, "\")
1529                     Else
1530                         Exit For
1531                     End If
1532                 Next LastSep
1533                 RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)
1534             End If
1535         End If
1536         mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile
1537         rNum2 = rNum2 + 1
1538     End If
1539     If rNum2 > 4 Then Exit For
1540 Next rNum
1541 End Sub
1542 Sub BuildToolsList()
1543 Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu
1544 For Each TItem In mnuTItem
1545     If TItem.Index <> 0 Then Unload TItem
1546 Next TItem
1547 For Each TItem In mnuPTItem
1548     If TItem.Index <> 0 Then Unload TItem
1549 Next TItem
1550 mnuTItem(0).Caption = "(Empty)"
1551 mnuPTItem(0).Caption = mnuTItem(0).Caption
1552 mnuTItem(0).Tag = ""
1553 mnuPTItem(0).Tag = ""
1554 Do
1555     ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
1556     ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
1557     If ToolName = "" Then ToolName = ToolCommand
1558     If ToolName <> "" Then
1559         On Error Resume Next
1560         Load mnuTItem(tNum)
1561         Load mnuPTItem(tNum)
1562         On Error GoTo 0
1563         mnuTItem(tNum).Tag = ToolCommand
1564         mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag
1565         If InStr(ToolName, "&") = 0 And tNum < 9 Then
1566             mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName
1567         ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then
1568             mnuTItem(tNum).Caption = "&0 " + ToolName
1569         Else
1570             mnuTItem(tNum).Caption = ToolName
1571         End If
1572         mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption
1573     End If
1574     tNum = tNum + 1
1575 Loop Until ToolName = ""
1576 End Sub
1577 Sub OpenMpq()
1578 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
1579 On Error Resume Next
1580 If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
1581     ReDim FileList(0) As String
1582     List.ListItems.Clear
1583     ShowSelected
1584     ShowTotal
1585     NewFile = True
1586     On Error GoTo 0
1587     GoTo FileOpened
1588 End If
1589 On Error GoTo 0
1590 If IsMPQ(CD.FileName) = False Then
1591     CD.FileName = ""
1592     MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"
1593     Exit Sub
1594 End If
1595 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
1596     CD.FileName = ""
1597     MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"
1598     Exit Sub
1599 End If
1600 StatBar.Style = 1
1601 StatBar.SimpleText = "Loading list..."
1602 MousePointer = 11
1603 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1604 ReDim FileList(0) As String
1605 #If InternalListing Then
1606 FileList(0) = "(listfile)"
1607 If Mpq.FileExists(CD.FileName, "(listfile)") Then
1608     FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)
1609 #Else
1610     sListFiles CD.FileName, hMPQ, ListFile, FileEntries
1611 #End If
1612     For bNum = 1 To Len(FileCont)
1613         If InStr(bNum, FileCont, vbCrLf) > 0 Then
1614             ReDim Preserve FileList(UBound(FileList) + 1) As String
1615             FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)
1616             bNum = InStr(bNum, FileCont, vbCrLf) + 1
1617         Else
1618             ReDim Preserve FileList(UBound(FileList) + 1) As String
1619             FileList(UBound(FileList)) = Mid(FileCont, bNum)
1620             Exit For
1621         End If
1622     Next bNum
1623 #If InternalListing Then
1624 End If
1625 nFiles = UBound(FileList)
1626 ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String
1627 For bNum = nFiles + 1 To UBound(FileList)
1628     FileList(bNum) = GlobalFileList(bNum - nFiles)
1629 Next bNum
1630 #End If
1631 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
1632 SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&
1633 List.ListItems.Clear
1634 List.Sorted = False
1635 FileFilter = mFilter
1636 StatBar.SimpleText = "Building list... 0% complete"
1637 For fNum = 0 To UBound(FileEntries)
1638 #If InternalListing Then
1639     If Mpq.FileExists(CD.FileName, FileList(fNum)) Then
1640 #End If
1641     If FileEntries(fNum).dwFileExists Then
1642     MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)
1643     StripNull MpqFileName
1644     mFilter.AddItem "*" + GetExtension(MpqFileName)
1645     For bNum = 1 To mFilter.ListCount - 1
1646         If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then
1647             mFilter.RemoveItem bNum
1648             Exit For
1649         End If
1650     Next bNum
1651     If MatchesFilter(MpqFileName, FileFilter) Then
1652         L1 = MpqFileName
1653                 fSize = FileEntries(fNum).dwFullSize
1654                 cSize = FileEntries(fNum).dwCompressedSize
1655                 If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1656                     L2 = "<1KB"
1657                 ElseIf fSize = 0 Then
1658                     L2 = "0KB"
1659                 Else
1660                     L2 = CStr(Int(fSize / 1024)) + "KB"
1661                 End If
1662                 If cSize / 1024 > 0 And cSize / 1024 < 1 Then
1663                     L4 = "<1KB"
1664                 ElseIf cSize = 0 Then
1665                     L4 = "0KB"
1666                 Else
1667                     L4 = CStr(Int(cSize / 1024)) + "KB"
1668                 End If
1669                 If fSize <> 0 Then
1670                     L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
1671                 Else
1672                     L3 = "0%"
1673                 End If
1674                 fFlags = FileEntries(fNum).dwFlags
1675                 L6 = CStr(FileEntries(fNum).lcLocale)
1676                 If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
1677                 If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
1678                 If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
1679         lIndex = 0
1680         On Error Resume Next
1681         lIndex = List.ListItems.Add(, , L1).Index
1682         On Error GoTo 0
1683         If lIndex = 0 Then
1684             lIndex = List.ListItems.Item(L1).Index
1685             List.ListItems.Item(L1).ListSubItems.Clear
1686         End If
1687         List.ListItems.Item(lIndex).Tag = L1
1688         List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
1689             If fSize <> 0 Then
1690                 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
1691             Else
1692                 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
1693             End If
1694             List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
1695             List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6
1696             List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
1697     End If
1698     End If
1699 #If InternalListing Then
1700     End If
1701 #End If
1702     On Error Resume Next
1703     StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"
1704     On Error GoTo 0
1705 Next fNum
1706 SFileCloseArchive hMPQ
1707 List.Sorted = True
1708 '#If InternalListing Then
1709 RemoveDuplicates
1710 '#End If
1711 On Error Resume Next
1712 List.SelectedItem.Selected = False
1713 On Error GoTo 0
1714 SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&
1715 ShowSelected
1716 ShowTotal
1717 NewFile = False
1718 mFilter = FileFilter
1719 FileOpened:
1720 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1721 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
1722 mnuMpq.Enabled = True
1723 For Each TItem In mnuTItem
1724     TItem.Enabled = True
1725 Next TItem
1726 Toolbar.Buttons.Item("Add").Enabled = True
1727 Toolbar.Buttons.Item("Add Folder").Enabled = True
1728 Toolbar.Buttons.Item("Extract").Enabled = True
1729 Toolbar.Buttons.Item("Compact").Enabled = True
1730 Toolbar.Buttons.Item("List").Enabled = True
1731 StatBar.Style = 0
1732 StatBar.SimpleText = ""
1733 If InStr(CD.FileName, "\") > 0 Then
1734     For bNum = 1 To Len(CD.FileName)
1735         If InStr(bNum, CD.FileName, "\") > 0 Then
1736             bNum = InStr(bNum, CD.FileName, "\")
1737         Else
1738             Exit For
1739         End If
1740     Next bNum
1741 End If
1742 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
1743 AddRecentFile CD.FileName
1744 MousePointer = 0
1745 End Sub
1746 Sub RemoveDuplicates()
1747 Dim fNum As Long
1748 fNum = 1
1749 Do While fNum <= List.ListItems.Count - 1
1750     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
1751         List.ListItems.Remove (fNum)
1752         fNum = fNum - 1
1753     End If
1754     fNum = fNum + 1
1755 Loop
1756 End Sub
1757 Sub ShowSelected()
1758 Dim fNum As Long, nSelect As Long, sSize As Long, fSize As Long, L2 As String, hMPQ As Long, hFile As Long
1759 On Error GoTo NotSelected
1760 List.SelectedItem.Tag = List.SelectedItem.Tag
1761 On Error GoTo 0
1762 For fNum = 1 To List.ListItems.Count
1763     If List.ListItems.Item(fNum).Selected Then
1764         nSelect = nSelect + 1
1765         If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1766             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1767         Else
1768             If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1769                 If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
1770                     fSize = SFileGetFileSize(hFile, 0)
1771                     SFileCloseFile hFile
1772                 End If
1773                 SFileCloseArchive hMPQ
1774             End If
1775             If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1776                 L2 = "<1KB"
1777             ElseIf fSize = 0 Then
1778                 L2 = "0KB"
1779             Else
1780                 L2 = CStr(Int(fSize / 1024)) + "KB"
1781             End If
1782             List.ListItems.Item(fNum).ListSubItems(1).Text = L2
1783             List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
1784             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1785         End If
1786     End If
1787 Next fNum
1788 If sSize / 1024 > 0 And sSize / 1024 < 1 Then
1789     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
1790 ElseIf sSize = 0 Then
1791     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
1792 Else
1793     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
1794 End If
1795 Exit Sub
1796 NotSelected:
1797 StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
1798 End Sub
1799 Sub ShowTotal()
1800 Dim fNum As Long, nFiles As Long, tSize As Long
1801 For fNum = 1 To List.ListItems.Count
1802     nFiles = nFiles + 1
1803     If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1804         tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1805     End If
1806 Next fNum
1807 If tSize / 1024 > 0 And tSize / 1024 < 1 Then
1808     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
1809 Else
1810     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
1811 End If
1812 End Sub
1813 Private Sub cmdGo_Click()
1814 StatBar.Style = 1
1815 RunMpq2kCommand txtCommand
1816 txtCommand = ""
1817 If StatBar.SimpleText = "" Then txtCommand_GotFocus
1818 End Sub
1819
1820 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1821 If KeyCode = vbKeyShift Then
1822     ShiftState = True
1823     BuildMpqActionList
1824 End If
1825 End Sub
1826 Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
1827 If KeyCode = vbKeyShift Then
1828     ShiftState = False
1829     BuildMpqActionList
1830 End If
1831 End Sub
1832 Private Sub Form_Load()
1833 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
1834 Dim Path
1835 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1836 NewKey AppKey
1837 SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
1838 SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
1839 FixIcon hWnd, 1
1840 InitFileDialog CD
1841 CD.hwndOwner = hWnd
1842 CD.DefaultExt = "mpq"
1843 CD.MaxFileSize = 5120
1844 InitFolderDialog PathInput
1845 PathInput.hwndOwner = hWnd
1846 PathInput.Flags = BIF_RETURNONLYFSDIRS
1847 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1848 ChDir App.Path
1849 'If Mpq.MpqInitialize = False Then
1850 '    ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason:  "
1851 '    Select Case Mpq.LastError
1852 '    Case MPQ_ERROR_NO_STAREDIT
1853 '        ErrorText = ErrorText + "Can't find StarEdit.exe"
1854 '    Case MPQ_ERROR_BAD_STAREDIT
1855 '        ErrorText = ErrorText + "Wrong version of StarEdit.exe.  Need SC/BW 1.07"
1856 '    Case MPQ_ERROR_STAREDIT_RUNNING
1857 '        ErrorText = ErrorText + "StarEdit.exe is running.  It must be closed before running this"
1858 '    Case Else
1859 '        ErrorText = ErrorText + "Unknown"
1860 '    End Select
1861 '    MsgBox ErrorText
1862 '    End
1863 'End If
1864 ExtractPathNum = -1
1865 CopyPathNum = -1
1866 OldStartPath = CurDir
1867 CurPath = GetReg(AppKey + "StartupPath", CurDir)
1868 CurPathType = GetReg(AppKey + "StartupPathType", 0)
1869 If CurPathType < 0 Then CurPathType = 0
1870 If CurPathType > 2 Then CurPathType = 2
1871 If CurPathType = 1 Then
1872     CurPath = App.Path
1873 End If
1874 CurPath2 = CurPath
1875 If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
1876 If IsDir(CurPath2) Then
1877     If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
1878     ChDir CurPath
1879 End If
1880 NewStartPath = CurDir
1881 On Error Resume Next
1882 Height = GetReg(AppKey + "Status\WindowHeight", Height)
1883 Left = GetReg(AppKey + "Status\WindowLeft", Left)
1884 Top = GetReg(AppKey + "Status\WindowTop", Top)
1885 Width = GetReg(AppKey + "Status\WindowWidth", Width)
1886 If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
1887 ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
1888 DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
1889 DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)
1890 LocaleID = GetReg(AppKey + "LocaleID", 0)
1891 GlobalEncrypt = False
1892 DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
1893 Select Case DefaultCompressID
1894 Case -3
1895 DefaultCompress = MAFA_COMPRESS_DEFLATE
1896 Case Else
1897 DefaultCompress = MAFA_COMPRESS_STANDARD
1898 End Select
1899 DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
1900 BuildRecentFileList
1901 BuildToolsList
1902 On Error GoTo 0
1903 SFileSetLocale LocaleID
1904 ReDim GlobalFileList(0) As String
1905 #If InternalListing Then
1906 If FileExists(ListFile) Then
1907     Open ListFile For Input As #1
1908     Do While Not EOF(1)
1909         ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
1910         Line Input #1, GlobalFileList(UBound(GlobalFileList))
1911     Loop
1912     Close #1
1913 End If
1914 #End If
1915 FileName = Trim(Command)
1916 If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
1917 If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
1918 FileName = Trim(FileName)
1919 If FileExists(FileName) Then
1920     CD.FileName = FileName
1921     Show
1922     OpenMpq
1923     Exit Sub
1924 End If
1925 ReDim FileList(0) As String
1926 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
1927 sLine = Command
1928 If Right(sLine, 1) <> " " Then sLine = sLine + " "
1929 If sLine <> "" Then
1930     ReDim Param(0) As String
1931     For pNum = 1 To Len(sLine)
1932         If Mid(sLine, pNum, 1) = Chr(34) Then
1933             pNum = pNum + 1
1934             EndParam = InStr(pNum, sLine, Chr(34))
1935             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
1936         Else
1937             EndParam = InStr(pNum, sLine, " ")
1938             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
1939         End If
1940         If EndParam = 0 Then EndParam = Len(sLine) + 1
1941         If pNum <> EndParam Then
1942             If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
1943                 ReDim Preserve Param(UBound(Param) + 1) As String
1944                 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
1945             End If
1946         End If
1947         pNum = EndParam
1948     Next pNum
1949     If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
1950     Select Case LCase(Param(1))
1951     Case "o", "open", "n", "new"
1952         Show
1953         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1954         ChDir OldStartPath
1955         RunMpq2kCommand sLine
1956     Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
1957         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1958         ChDir OldStartPath
1959         CD.FileName = FullPath(CurDir, Param(2))
1960         sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
1961         RunMpq2kCommand sLine
1962         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1963         ChDir NewStartPath
1964         Unload Me
1965     Case "s", "script"
1966         Show
1967         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1968         ChDir OldStartPath
1969         RunMpq2kCommand sLine
1970         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1971         ChDir NewStartPath
1972     End Select
1973 End If
1974 End Sub
1975 Private Sub Form_Resize()
1976 On Error Resume Next
1977 If WindowState <> 1 Then
1978     List.Top = Toolbar.Height
1979     List.Width = ScaleWidth
1980     List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
1981     Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
1982     txtCommand.Top = List.Top + List.Height
1983     txtCommand.Left = Label1.Width
1984     txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
1985     cmdGo.Top = txtCommand.Top
1986     cmdGo.Left = txtCommand.Left + txtCommand.Width
1987     mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
1988     Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
1989 End If
1990 End Sub
1991 Private Sub Form_Unload(Cancel As Integer)
1992 Dim Path As String
1993 Path = App.Path
1994 If Right(Path, 1) <> "\" Then Path = Path + "\"
1995 On Error Resume Next
1996 If ExtractPathNum > -1 Then
1997     KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
1998     RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
1999 End If
2000 If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
2001     KillEx Path + "Temp_extract\", "*", 6, True
2002     RmDir Path + "Temp_extract\"
2003 End If
2004 If CopyPathNum > -1 Then
2005     KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
2006     RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
2007 End If
2008 If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
2009     KillEx Path + "Temp_copy\", "*", 6, True
2010     RmDir Path + "Temp_copy\"
2011 End If
2012 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
2013     NewKey AppKey
2014     NewKey AppKey + "Status\"
2015     If WindowState = 1 Then WindowState = 0
2016     SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
2017     WindowState = 0
2018     SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
2019     SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
2020     SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
2021     SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
2022 End If
2023 If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
2024     SetReg AppKey + "StartupPath", CurDir
2025 End If
2026 End
2027 End Sub
2028 Private Sub Label1_Click()
2029 txtCommand.SetFocus
2030 End Sub
2031 Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
2032 Dim result As Long, hMPQ As Long, hFile As Long
2033 If List.SelectedItem.Text <> NewString Then
2034     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2035         result = vbYes
2036     Else
2037         result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2038     End If
2039     If result = vbYes Then
2040         List.SelectedItem.Tag = NewString
2041         hMPQ = mOpenMpq(CD.FileName)
2042         If hMPQ Then
2043             If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
2044                 SFileCloseFile hFile
2045                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2046                 MpqDeleteFile hMPQ, NewString
2047                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2048                 SFileSetLocale LocaleID
2049                 RemoveDuplicates
2050             Else
2051                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2052                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2053                 SFileSetLocale LocaleID
2054             End If
2055             MpqCloseUpdatedArchive hMPQ, 0
2056             On Error Resume Next
2057             List.SelectedItem.Key = NewString
2058             On Error GoTo 0
2059             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2060         End If
2061     Else
2062         Cancel = True
2063     End If
2064 End If
2065 ShowSelected
2066 End Sub
2067 Private Sub List_Click()
2068 On Error GoTo NotSelected
2069 List.SelectedItem.Tag = List.SelectedItem.Tag
2070 On Error GoTo NotClick
2071 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2072 On Error GoTo 0
2073 ShowSelected
2074 Exit Sub
2075 NotClick:
2076 List.SelectedItem.Selected = False
2077 NotSelected:
2078 ShowSelected
2079 BuildMpqActionList
2080 End Sub
2081 Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
2082 If List.SortKey = ColumnHeader.Index - 1 Then
2083     If List.SortOrder = 0 Then
2084         List.SortOrder = 1
2085     Else
2086         List.SortOrder = 0
2087     End If
2088 Else
2089     List.SortOrder = 0
2090     List.SortKey = ColumnHeader.Index - 1
2091 End If
2092 End Sub
2093 Private Sub List_DblClick()
2094 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
2095 On Error GoTo NotSelected
2096 List.SelectedItem.Tag = List.SelectedItem.Tag
2097 On Error GoTo NotClick
2098 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2099 On Error GoTo 0
2100 Path = App.Path
2101 If Right(Path, 1) <> "\" Then Path = Path + "\"
2102 Path = Path + "Temp_extract\"
2103 If ExtractPathNum = -1 Then
2104     fNum = 0
2105     Do
2106     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2107     fNum = fNum + 1
2108     Loop
2109     ExtractPathNum = fNum
2110 End If
2111 Path = Path + CStr(ExtractPathNum) + "\"
2112 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2113 For fNum = 1 To List.ListItems.Count
2114     If List.ListItems.Item(fNum).Selected Then
2115         StatBar.Style = 1
2116         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2117         MousePointer = 11
2118         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2119         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2120         SFileSetLocale LocaleID
2121         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
2122             For bNum = 1 To UBound(OpenFiles)
2123                 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
2124                     AlreadyInList = True
2125                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2126                     Exit For
2127                 End If
2128             Next bNum
2129             If AlreadyInList = False Then
2130                 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
2131                 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
2132                 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2133             End If
2134         End If
2135         StatBar.Style = 1
2136         StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
2137         fName = List.ListItems.Item(fNum).Tag
2138         BuildPopup Path + fName, 0, mnuPopup, mnuPItem
2139         ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
2140         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
2141     End If
2142 Next fNum
2143 SFileCloseArchive hMPQ
2144 StatBar.Style = 0
2145 StatBar.SimpleText = ""
2146 MousePointer = 0
2147 Exit Sub
2148 NotClick:
2149 List.SelectedItem.Selected = False
2150 NotSelected:
2151 End Sub
2152 Private Sub List_ItemClick(ByVal Item As ListItem)
2153 BuildMpqActionList
2154 End Sub
2155 Private Sub List_KeyPress(KeyAscii As Integer)
2156 If KeyAscii = 13 Then List_DblClick
2157 End Sub
2158 Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
2159 If KeyCode = vbKeyDelete Then
2160     mnuMDelete_Click
2161 ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
2162     On Error GoTo NotSelected
2163     List.SelectedItem.Tag = List.SelectedItem.Tag
2164     On Error GoTo 0
2165     If List.SelectedItem.Selected = True Then
2166         BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2167         PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
2168     End If
2169 End If
2170 NotSelected:
2171 End Sub
2172 Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
2173 CX = X
2174 CY = Y
2175 If Button And vbRightButton Then
2176     On Error GoTo NotSelected
2177     List.SelectedItem.Tag = List.SelectedItem.Tag
2178     On Error GoTo NotClick
2179     List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2180     On Error GoTo 0
2181     BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2182     PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
2183 End If
2184 NotClick:
2185 NotSelected:
2186 End Sub
2187 Private Sub List_OLECompleteDrag(Effect As Long)
2188 List.Tag = ""
2189 End Sub
2190 Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
2191 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
2192 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
2193 If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
2194 For fNum = 1 To Data.Files.Count
2195     Path = Data.Files.Item(fNum)
2196     If Right(Path, 1) <> "\" Then Path = Path + "\"
2197     If IsDir(Path) Then
2198         Path = Path + "*"
2199         Data.Files.Remove fNum
2200         Data.Files.Add Path, fNum
2201     End If
2202 Next fNum
2203 Path = Data.Files.Item(1)
2204 For bNum = 1 To Len(Path)
2205     If InStr(bNum, Path, "\") > 0 Then
2206         For fNum = 1 To Data.Files.Count
2207             If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
2208         Next fNum
2209         bNum = InStr(bNum, Path, "\")
2210     Else
2211         Exit For
2212     End If
2213 Next bNum
2214 PathFound:
2215 Path = Left(Path, bNum - 1)
2216 ReDim Files(0) As String
2217 Files(0) = Path
2218 If Right(Path, 1) <> "\" Then Path = Path + "\"
2219 ReDim Preserve Files(Data.Files.Count) As String
2220 For bNum = 1 To Data.Files.Count
2221     Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
2222     For fNum = 1 To Len(Files(bNum))
2223         If InStr(fNum, Files(bNum), "\") > 0 Then
2224             fNum = InStr(fNum, Files(bNum), "\")
2225         Else
2226             Exit For
2227         End If
2228     Next fNum
2229     FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
2230 Next bNum
2231 If FolderFiles = "" Then Exit Sub
2232 ReDim Preserve Files(0) As String
2233 For bNum = 1 To Len(FolderFiles)
2234     ReDim Preserve Files(UBound(Files) + 1) As String
2235     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2236         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2237         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2238     Else
2239         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2240         Exit For
2241     End If
2242 Next bNum
2243 FoldName.Show 1
2244 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2245 If UBound(Files) > 1 Then
2246     ReDim ShortFiles(UBound(Files)) As String
2247     For bNum = 0 To UBound(Files)
2248         ShortFiles(bNum) = AddFolderName + Files(bNum)
2249     Next bNum
2250     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2251     For bNum = 1 To UBound(Files)
2252         Files(bNum) = FullPath(Files(0), Files(bNum))
2253     Next bNum
2254 Else
2255     For bNum = 1 To Len(Files(1))
2256         If InStr(bNum, Files(1), "\") > 0 Then
2257             bNum = InStr(bNum, Files(1), "\")
2258         Else
2259             Exit For
2260         End If
2261     Next bNum
2262     ReDim ShortFiles(UBound(Files)) As String
2263     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2264     Files(1) = FullPath(Files(0), Files(1))
2265 End If
2266 If NewFile = True Then
2267     If FileExists(CD.FileName) Then Kill CD.FileName
2268     NewFile = False
2269 End If
2270 List.Sorted = False
2271 FileFilter = mFilter
2272 hMPQ = mOpenMpq(CD.FileName)
2273 If hMPQ = 0 Then
2274     StatBar.SimpleText = "Can't create archive " + CD.FileName
2275     Exit Sub
2276 End If
2277 dwFlags = MAFA_REPLACE_EXISTING
2278 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2279 For bNum = 1 To UBound(Files)
2280     StatBar.Style = 1
2281     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2282     MousePointer = 11
2283     If mnuMCNone.Checked Then
2284         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2285     ElseIf mnuMCStandard.Checked Then
2286         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2287     ElseIf mnuMCDeflate.Checked Then
2288         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2289     ElseIf mnuMCAMedium.Checked Then
2290         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2291     ElseIf mnuMCAHighest.Checked Then
2292         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2293     ElseIf mnuMCALowest.Checked Then
2294         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2295     ElseIf mnuMCAuto.Checked Then
2296         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2297     End If
2298     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2299     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2300     For cNum = 1 To mFilter.ListCount - 1
2301         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2302             mFilter.RemoveItem cNum
2303             Exit For
2304         End If
2305     Next cNum
2306 Next bNum
2307 MpqCloseUpdatedArchive hMPQ, 0
2308 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2309 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2310     StatBar.SimpleText = "Adding files to listing... 0% complete"
2311     For bNum = 1 To UBound(Files)
2312         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2313             MpqAddToListing hMPQ, ShortFiles(bNum)
2314         End If
2315         On Error Resume Next
2316         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2317         On Error GoTo 0
2318     Next bNum
2319     SFileCloseArchive hMPQ
2320 End If
2321 StatBar.Style = 0
2322 StatBar.SimpleText = ""
2323 MousePointer = 0
2324 If MatchesFilter("(listfile)", FileFilter) Then
2325     AddToListing "(listfile)"
2326 End If
2327 mFilter = FileFilter
2328 List.Sorted = True
2329 RemoveDuplicates
2330 ShowTotal
2331 Cancel:
2332 End Sub
2333 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)
2334 If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
2335     Effect = ccOLEDropEffectNone
2336 Else
2337     Effect = ccOLEDropEffectCopy
2338 End If
2339 End Sub
2340 Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
2341 Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
2342 Path = App.Path
2343 If Right(Path, 1) <> "\" Then Path = Path + "\"
2344 Path = Path + "Temp_copy\"
2345 If CopyPathNum = -1 Then
2346     fNum = 0
2347     Do
2348     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2349     fNum = fNum + 1
2350     Loop
2351     CopyPathNum = fNum
2352 End If
2353 Path = Path + CStr(CopyPathNum) + "\"
2354 KillEx Path, "*", 6, True
2355 fCount = 0
2356 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2357 For fNum = 1 To List.ListItems.Count
2358     If List.ListItems.Item(fNum).Selected Then
2359         StatBar.Style = 1
2360         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2361         MousePointer = 11
2362         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2363         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2364         SFileSetLocale LocaleID
2365         If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
2366             Data.Files.Add Path + List.ListItems.Item(fNum).Tag
2367         End If
2368         fCount = fCount + 1
2369         If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
2370     End If
2371 Next fNum
2372 SFileCloseArchive hMPQ
2373 StatBar.Style = 0
2374 StatBar.SimpleText = ""
2375 MousePointer = 0
2376 If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
2377     Data.Files.Add Path + "*"
2378 ElseIf fCount = 1 Then
2379     Data.Files.Add FirstFile
2380 End If
2381 End Sub
2382 Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
2383 Data.SetData , ccCFFiles
2384 AllowedEffects = ccOLEDropEffectCopy
2385 List.Tag = "WinMPQ"
2386 End Sub
2387 Private Sub mFilter_KeyPress(KeyAscii As Integer)
2388 If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
2389     If NewFile = False Then OpenMpq
2390 End If
2391 End Sub
2392 Private Sub mnuFExit_Click()
2393 Unload Me
2394 End Sub
2395 Private Sub mnuFile_Click()
2396 If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
2397 End Sub
2398 Private Sub mnuFRecent_Click(Index As Integer)
2399 Dim OldFileName As String
2400 OldFileName = CD.FileName
2401 CD.FileName = mnuFRecent(Index).Tag
2402 If FileExists(CD.FileName) = False Then
2403     CD.FileName = OldFileName
2404     MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
2405     DelRecentFile mnuFRecent(Index).Tag
2406     Exit Sub
2407 End If
2408 OpenMpq
2409 If CD.FileName = "" Then
2410     CD.FileName = OldFileName
2411     DelRecentFile mnuFRecent(Index).Tag
2412 End If
2413 End Sub
2414 Private Sub mnuFReopen_Click()
2415 OpenMpq
2416 End Sub
2417
2418 Private Sub mnuFScript_Click()
2419 Dim OldFileName As String, OldPath As String
2420 CD.Flags = &H1000 Or &H4 Or &H2
2421 CD.Filter = "All Files (*.*)|*.*"
2422 OldFileName = CD.FileName
2423 OldPath = CurDir
2424 CD.hwndOwner = hWnd
2425 If ShowOpen(CD) = False Then GoTo Cancel
2426 StatBar.Style = 1
2427 StatBar.SimpleText = "Running script " + CD.FileName + "..."
2428 MousePointer = 11
2429 RunScript CD.FileName
2430 StatBar.Style = 0
2431 StatBar.SimpleText = ""
2432 MousePointer = 0
2433 CD.FileName = OldFileName
2434 Cancel:
2435 If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
2436 ChDir OldPath
2437 End Sub
2438 Private Sub mnuHAbout_Click()
2439 About.Show 1
2440 End Sub
2441 Private Sub mnuHReadme_Click()
2442 Dim Path As String
2443 Path = App.Path
2444 If Right(Path, 1) <> "\" Then Path = Path + "\"
2445 If FileExists(Path + "WinMPQ.rtf") Then
2446     ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
2447 Else
2448     MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
2449 End If
2450 End Sub
2451 Private Sub mnuMAdd_Click()
2452 Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
2453 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
2454 CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
2455 CD.Filter = "All Files (*.*)|*.*"
2456 OldFileName = CD.FileName
2457 CD.hwndOwner = hWnd
2458 If ShowOpen(CD) = False Then GoTo Cancel
2459 ReDim Files(0) As String
2460 bNum = 1
2461 If InStr(1, CD.FileName, Chr(0)) > 0 Then
2462     Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
2463     bNum = InStr(1, CD.FileName, Chr(0)) + 1
2464 Else
2465     Files(0) = Mid(CD.FileName, 1)
2466 End If
2467 For bNum = bNum To Len(CD.FileName)
2468     ReDim Preserve Files(UBound(Files) + 1) As String
2469     If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
2470         Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
2471         bNum = InStr(bNum, CD.FileName, Chr(0))
2472     Else
2473         Files(UBound(Files)) = Mid(CD.FileName, bNum)
2474         Exit For
2475     End If
2476 Next bNum
2477 CD.FileName = OldFileName
2478 FoldName.Show 1
2479 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2480 If UBound(Files) > 1 Then
2481     ReDim ShortFiles(UBound(Files)) As String
2482     For bNum = 0 To UBound(Files)
2483         ShortFiles(bNum) = AddFolderName + Files(bNum)
2484     Next bNum
2485     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2486     For bNum = 1 To UBound(Files)
2487         Files(bNum) = FullPath(Files(0), Files(bNum))
2488     Next bNum
2489 Else
2490     For bNum = 1 To Len(Files(1))
2491         If InStr(bNum, Files(1), "\") > 0 Then
2492             bNum = InStr(bNum, Files(1), "\")
2493         Else
2494             Exit For
2495         End If
2496     Next bNum
2497     ReDim ShortFiles(UBound(Files)) As String
2498     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2499     Files(1) = FullPath(Files(0), Files(1))
2500 End If
2501 If NewFile = True Then
2502     If FileExists(CD.FileName) Then Kill CD.FileName
2503     NewFile = False
2504 End If
2505 List.Sorted = False
2506 FileFilter = mFilter
2507 hMPQ = mOpenMpq(CD.FileName)
2508 If hMPQ = 0 Then
2509     StatBar.SimpleText = "Can't create archive " + CD.FileName
2510     Exit Sub
2511 End If
2512 dwFlags = MAFA_REPLACE_EXISTING
2513 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2514 For bNum = 1 To UBound(Files)
2515     StatBar.Style = 1
2516     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2517     MousePointer = 11
2518     If mnuMCNone.Checked Then
2519         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2520     ElseIf mnuMCStandard.Checked Then
2521         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2522     ElseIf mnuMCDeflate.Checked Then
2523         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2524     ElseIf mnuMCAMedium.Checked Then
2525         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2526     ElseIf mnuMCAHighest.Checked Then
2527         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2528     ElseIf mnuMCALowest.Checked Then
2529         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2530     ElseIf mnuMCAuto.Checked Then
2531         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2532     End If
2533     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2534     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2535     For cNum = 1 To mFilter.ListCount - 1
2536         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2537             mFilter.RemoveItem cNum
2538             Exit For
2539         End If
2540     Next cNum
2541 Next bNum
2542 MpqCloseUpdatedArchive hMPQ, 0
2543 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2544 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2545     StatBar.SimpleText = "Adding files to listing... 0% complete"
2546     For bNum = 1 To UBound(Files)
2547         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2548             MpqAddToListing hMPQ, ShortFiles(bNum)
2549         End If
2550         On Error Resume Next
2551         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2552         On Error GoTo 0
2553     Next bNum
2554     SFileCloseArchive hMPQ
2555 End If
2556 StatBar.Style = 0
2557 StatBar.SimpleText = ""
2558 MousePointer = 0
2559 If MatchesFilter("(listfile)", FileFilter) Then
2560     AddToListing "(listfile)"
2561 End If
2562 mFilter = FileFilter
2563 List.Sorted = True
2564 RemoveDuplicates
2565 ShowTotal
2566 Cancel:
2567 End Sub
2568 Private Sub mnuMAddFolder_Click()
2569 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
2570 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
2571 PathInput.hwndOwner = hWnd
2572 Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
2573 If Path = "" Then GoTo Cancel
2574 FolderFiles = DirEx(Path, "*", 6, True)
2575 If FolderFiles = "" Then Exit Sub
2576 ReDim Files(0) As String
2577 Files(0) = Path
2578 If Right(Path, 1) <> "\" Then Path = Path + "\"
2579 For bNum = 1 To Len(FolderFiles)
2580     ReDim Preserve Files(UBound(Files) + 1) As String
2581     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2582         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2583         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2584     Else
2585         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2586         Exit For
2587     End If
2588 Next bNum
2589 FoldName.Show 1
2590 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2591 If UBound(Files) > 1 Then
2592     ReDim ShortFiles(UBound(Files)) As String
2593     For bNum = 0 To UBound(Files)
2594         ShortFiles(bNum) = AddFolderName + Files(bNum)
2595     Next bNum
2596     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2597     For bNum = 1 To UBound(Files)
2598         Files(bNum) = FullPath(Files(0), Files(bNum))
2599     Next bNum
2600 Else
2601     For bNum = 1 To Len(Files(1))
2602         If InStr(bNum, Files(1), "\") > 0 Then
2603             bNum = InStr(bNum, Files(1), "\")
2604         Else
2605             Exit For
2606         End If
2607     Next bNum
2608     ReDim ShortFiles(UBound(Files)) As String
2609     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2610     Files(1) = FullPath(Files(0), Files(1))
2611 End If
2612 If NewFile = True Then
2613     If FileExists(CD.FileName) Then Kill CD.FileName
2614     NewFile = False
2615 End If
2616 List.Sorted = False
2617 FileFilter = mFilter
2618 hMPQ = mOpenMpq(CD.FileName)
2619 If hMPQ = 0 Then
2620     StatBar.SimpleText = "Can't create archive " + CD.FileName
2621     Exit Sub
2622 End If
2623 dwFlags = MAFA_REPLACE_EXISTING
2624 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2625 For bNum = 1 To UBound(Files)
2626     StatBar.Style = 1
2627     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2628     MousePointer = 11
2629     If mnuMCNone.Checked Then
2630         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2631     ElseIf mnuMCStandard.Checked Then
2632         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2633     ElseIf mnuMCDeflate.Checked Then
2634         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2635     ElseIf mnuMCAMedium.Checked Then
2636         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2637     ElseIf mnuMCAHighest.Checked Then
2638         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2639     ElseIf mnuMCALowest.Checked Then
2640         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2641     ElseIf mnuMCAuto.Checked Then
2642         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2643     End If
2644     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2645     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2646     For cNum = 1 To mFilter.ListCount - 1
2647         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2648             mFilter.RemoveItem cNum
2649             Exit For
2650         End If
2651     Next cNum
2652 Next bNum
2653 MpqCloseUpdatedArchive hMPQ, 0
2654 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2655 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2656     StatBar.SimpleText = "Adding files to listing... 0% complete"
2657     For bNum = 1 To UBound(Files)
2658         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2659             MpqAddToListing hMPQ, ShortFiles(bNum)
2660         End If
2661         On Error Resume Next
2662         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2663         On Error GoTo 0
2664     Next bNum
2665     SFileCloseArchive hMPQ
2666 End If
2667 StatBar.Style = 0
2668 StatBar.SimpleText = ""
2669 MousePointer = 0
2670 If MatchesFilter("(listfile)", FileFilter) Then
2671     AddToListing "(listfile)"
2672 End If
2673 mFilter = FileFilter
2674 List.Sorted = True
2675 RemoveDuplicates
2676 ShowTotal
2677 Cancel:
2678 End Sub
2679
2680 Private Sub mnuMAddToList_Click()
2681 frmAddToList.Show 1
2682 End Sub
2683 Private Sub mnuMCAHighest_Click()
2684 mnuMCNone.Checked = False
2685 mnuMCStandard.Checked = False
2686 mnuMCDeflate.Checked = False
2687 mnuMCALowest.Checked = False
2688 mnuMCAMedium.Checked = False
2689 mnuMCAHighest.Checked = True
2690 mnuMCAuto.Checked = False
2691 End Sub
2692 Private Sub mnuMCALowest_Click()
2693 mnuMCNone.Checked = False
2694 mnuMCStandard.Checked = False
2695 mnuMCDeflate.Checked = False
2696 mnuMCALowest.Checked = True
2697 mnuMCAMedium.Checked = False
2698 mnuMCAHighest.Checked = False
2699 mnuMCAuto.Checked = False
2700 End Sub
2701
2702
2703 Private Sub mnuMCAMedium_Click()
2704 mnuMCNone.Checked = False
2705 mnuMCStandard.Checked = False
2706 mnuMCDeflate.Checked = False
2707 mnuMCALowest.Checked = False
2708 mnuMCAMedium.Checked = True
2709 mnuMCAHighest.Checked = False
2710 mnuMCAuto.Checked = False
2711 End Sub
2712 Private Sub mnuMCAuto_Click()
2713 mnuMCNone.Checked = False
2714 mnuMCStandard.Checked = False
2715 mnuMCDeflate.Checked = False
2716 mnuMCALowest.Checked = False
2717 mnuMCAMedium.Checked = False
2718 mnuMCAHighest.Checked = False
2719 mnuMCAuto.Checked = True
2720 End Sub
2721
2722 Private Sub mnuMCDeflate_Click()
2723 mnuMCNone.Checked = False
2724 mnuMCStandard.Checked = False
2725 mnuMCDeflate.Checked = True
2726 mnuMCALowest.Checked = False
2727 mnuMCAMedium.Checked = False
2728 mnuMCAHighest.Checked = False
2729 mnuMCAuto.Checked = False
2730 End Sub
2731
2732
2733 Private Sub mnuMChLCID_Click()
2734 Dim fNum As Long
2735 On Error GoTo NotSelected
2736 List.SelectedItem.Tag = List.SelectedItem.Tag
2737 On Error GoTo 0
2738 For fNum = 1 To List.ListItems.Count
2739     If List.ListItems.Item(fNum).Selected Then
2740         GoTo FileSelected
2741     End If
2742 Next fNum
2743 GoTo NotSelected
2744 FileSelected:
2745 ChLCID.Show 1
2746 Exit Sub
2747 NotSelected:
2748 MsgBox "No files are selected.", , "WinMPQ"
2749 End Sub
2750 Private Sub mnuMCNone_Click()
2751 mnuMCNone.Checked = True
2752 mnuMCStandard.Checked = False
2753 mnuMCDeflate.Checked = False
2754 mnuMCALowest.Checked = False
2755 mnuMCAMedium.Checked = False
2756 mnuMCAHighest.Checked = False
2757 mnuMCAuto.Checked = False
2758 End Sub
2759 Private Sub mnuMCompact_Click()
2760 Dim fNum As Long, result As Long, hMPQ As Long
2761 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2762     result = vbYes
2763 Else
2764     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")
2765 End If
2766 If result = vbYes Then
2767     StatBar.Style = 1
2768     StatBar.SimpleText = "Compacting " + CD.FileName + "..."
2769     MousePointer = 11
2770     hMPQ = mOpenMpq(CD.FileName)
2771     If hMPQ Then
2772         MpqCompactArchive hMPQ
2773         MpqCloseUpdatedArchive hMPQ, 0
2774     End If
2775     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2776     StatBar.Style = 0
2777     StatBar.SimpleText = ""
2778     MousePointer = 0
2779     OpenMpq
2780 End If
2781 End Sub
2782 Private Sub mnuMCStandard_Click()
2783 mnuMCNone.Checked = False
2784 mnuMCStandard.Checked = True
2785 mnuMCDeflate.Checked = False
2786 mnuMCALowest.Checked = False
2787 mnuMCAMedium.Checked = False
2788 mnuMCAHighest.Checked = False
2789 mnuMCAuto.Checked = False
2790 End Sub
2791 Private Sub mnuMDelete_Click()
2792 Dim fNum As Long, result As Long, hMPQ As Long
2793 On Error GoTo NotSelected
2794 List.SelectedItem.Tag = List.SelectedItem.Tag
2795 On Error GoTo 0
2796 For fNum = 1 To List.ListItems.Count
2797     If List.ListItems.Item(fNum).Selected Then
2798         GoTo FileSelected
2799     End If
2800 Next fNum
2801 GoTo NotSelected
2802 FileSelected:
2803     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2804         result = vbYes
2805     Else
2806         result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2807     End If
2808     If result = vbYes Then
2809         fNum = 1
2810         hMPQ = mOpenMpq(CD.FileName)
2811         If hMPQ Then
2812             Do While fNum <= List.ListItems.Count
2813                 If List.ListItems.Item(fNum).Selected Then
2814                     StatBar.Style = 1
2815                     StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
2816                     MousePointer = 11
2817                     SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2818                     MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
2819                     SFileSetLocale LocaleID
2820                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2821                     List.ListItems.Remove (fNum)
2822                     fNum = fNum - 1
2823                 End If
2824                 fNum = fNum + 1
2825             Loop
2826             MpqCloseUpdatedArchive hMPQ, 0
2827         End If
2828     End If
2829     StatBar.Style = 0
2830     StatBar.SimpleText = ""
2831     MousePointer = 0
2832     ShowSelected
2833     ShowTotal
2834 Exit Sub
2835 NotSelected:
2836 MsgBox "No files are selected.", , "WinMPQ"
2837 End Sub
2838 Private Sub mnuMEncrypt_Click()
2839 If mnuMEncrypt.Checked = False Then
2840     mnuMEncrypt.Checked = True
2841     GlobalEncrypt = True
2842 Else
2843     mnuMEncrypt.Checked = False
2844     GlobalEncrypt = False
2845 End If
2846 End Sub
2847 Private Sub mnuMExtract_Click()
2848 Dim fNum As Long, Path As String, result As Long, hMPQ As Long
2849 On Error GoTo NotSelected
2850 List.SelectedItem.Tag = List.SelectedItem.Tag
2851 On Error GoTo 0
2852 For fNum = 1 To List.ListItems.Count
2853     If List.ListItems.Item(fNum).Selected Then
2854         GoTo FileSelected
2855     End If
2856 Next fNum
2857 GoTo NotSelected
2858 FileSelected:
2859 PathInput.hwndOwner = hWnd
2860 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2861 If Path = "" Then Exit Sub
2862 If Right(Path, 1) <> "\" Then Path = Path + "\"
2863 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2864 For fNum = 1 To List.ListItems.Count
2865     If List.ListItems.Item(fNum).Selected Then
2866         StatBar.Style = 1
2867         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2868         MousePointer = 11
2869         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2870         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2871         SFileSetLocale LocaleID
2872     End If
2873 Next fNum
2874 SFileCloseArchive hMPQ
2875 StatBar.Style = 0
2876 StatBar.SimpleText = ""
2877 MousePointer = 0
2878 Exit Sub
2879 NotSelected:
2880 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2881     result = vbYes
2882 Else
2883     result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2884 End If
2885 If result = vbYes Then
2886     PathInput.hwndOwner = hWnd
2887     Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2888     If Path = "" Then Exit Sub
2889     If Right(Path, 1) <> "\" Then Path = Path + "\"
2890     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2891     For fNum = 1 To List.ListItems.Count
2892         StatBar.Style = 1
2893         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2894         MousePointer = 11
2895         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2896         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2897         SFileSetLocale LocaleID
2898     Next fNum
2899     SFileCloseArchive hMPQ
2900     StatBar.Style = 0
2901     StatBar.SimpleText = ""
2902     MousePointer = 0
2903 End If
2904 End Sub
2905 Private Sub mnuFNew_Click()
2906 Dim TItem As Menu
2907 CD.Flags = &H1000 Or &H4 Or &H2
2908 CD.DefaultExt = "mpq"
2909 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
2910 CD.hwndOwner = hWnd
2911 If ShowSave(CD) = False Then GoTo Cancel
2912 ReDim FileList(0) As String
2913 List.ListItems.Clear
2914 ShowSelected
2915 ShowTotal
2916 NewFile = True
2917 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
2918 mnuMpq.Enabled = True
2919 For Each TItem In mnuTItem
2920     TItem.Enabled = True
2921 Next TItem
2922 Toolbar.Buttons.Item("Add").Enabled = True
2923 Toolbar.Buttons.Item("Add Folder").Enabled = True
2924 Toolbar.Buttons.Item("Extract").Enabled = True
2925 Toolbar.Buttons.Item("Compact").Enabled = True
2926 Toolbar.Buttons.Item("List").Enabled = True
2927 Caption = "WinMPQ - " + CD.FileTitle
2928 AddRecentFile CD.FileName
2929 Cancel:
2930 End Sub
2931 Private Sub mnuFOpen_Click()
2932 Dim OldFileName As String
2933 CD.Flags = &H1000 Or &H4 Or &H2
2934 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
2935 OldFileName = CD.FileName
2936 CD.hwndOwner = hWnd
2937 If ShowOpen(CD) = False Then GoTo Cancel
2938 OpenMpq
2939 If CD.FileName = "" Then CD.FileName = OldFileName
2940 Cancel:
2941 End Sub
2942 Private Sub mnuMItem_Click(Index As Integer)
2943 FileActionClick mnuMpq, mnuMItem, Index
2944 End Sub
2945 Private Sub mnuMRename_Click()
2946 List.StartLabelEdit
2947 End Sub
2948 Private Sub mnuMSaveList_Click()
2949 Dim fNum As Long, fList As String, OldFileName As String
2950 CD.Flags = &H1000 Or &H4 Or &H2
2951 CD.DefaultExt = "txt"
2952 CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
2953 OldFileName = CD.FileName
2954 CD.FileName = CD.FileName + ".txt"
2955 CD.hwndOwner = hWnd
2956 If ShowSave(CD) = False Then GoTo Cancel
2957 StatBar.Style = 1
2958 StatBar.SimpleText = "Creating list..."
2959 MousePointer = 11
2960 For fNum = 1 To List.ListItems.Count
2961     fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
2962 Next fNum
2963 fNum = FreeFile
2964 Open CD.FileName For Binary As #fNum
2965 Put #fNum, 1, fList
2966 Close #fNum
2967 Cancel:
2968 CD.FileName = OldFileName
2969 StatBar.Style = 0
2970 StatBar.SimpleText = ""
2971 MousePointer = 0
2972 End Sub
2973 Private Sub mnuOptions_Click()
2974 Options.Show 1
2975 End Sub
2976
2977 Private Sub mnuPChLCID_Click()
2978 mnuMChLCID_Click
2979 End Sub
2980 Private Sub mnuPDelete_Click()
2981 mnuMDelete_Click
2982 End Sub
2983 Private Sub mnuPExtract_Click()
2984 mnuMExtract_Click
2985 End Sub
2986 Private Sub mnuPItem_Click(Index As Integer)
2987 FileActionClick mnuPopup, mnuPItem, Index
2988 End Sub
2989 Private Sub mnuPRename_Click()
2990 mnuMRename_Click
2991 End Sub
2992 Private Sub mnuPTItem_Click(Index As Integer)
2993 mnuTItem_Click Index
2994 End Sub
2995 Private Sub mnuTAdd_Click()
2996 ToolList.Show 1
2997 BuildToolsList
2998 End Sub
2999 Private Sub mnuTItem_Click(Index As Integer)
3000 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
3001 Param = mnuTItem(Index).Tag
3002 On Error GoTo NoProgram
3003 If Param = "" Then Err.Raise 53
3004 On Error GoTo 0
3005 Do
3006     If InStr(1, Param, "%mpq", 1) Then
3007         bNum = InStr(1, Param, "%mpq", 1)
3008         Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
3009     End If
3010 Loop While InStr(1, Param, "%mpq", 1)
3011 NewParam = Param
3012 On Error GoTo NotSelected
3013 List.SelectedItem.Tag = List.SelectedItem.Tag
3014 On Error GoTo 0
3015 If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
3016 NotSelected:
3017 If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
3018     Path = App.Path
3019     If Right(Path, 1) <> "\" Then Path = Path + "\"
3020     Path = Path + "Temp_extract\"
3021     If ExtractPathNum = -1 Then
3022         fNum = 0
3023         Do
3024         If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
3025         fNum = fNum + 1
3026         Loop
3027         ExtractPathNum = fNum
3028     End If
3029     Path = Path + CStr(ExtractPathNum) + "\"
3030     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
3031     For fNum = 1 To List.ListItems.Count
3032         If List.ListItems.Item(fNum).Selected Then
3033             StatBar.Style = 1
3034             StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
3035             MousePointer = 11
3036             SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
3037             sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
3038             SFileSetLocale LocaleID
3039             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
3040                 For bNum = 1 To UBound(OpenFiles)
3041                     If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
3042                         AlreadyInList = True
3043                         If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3044                         Exit For
3045                     End If
3046                 Next bNum
3047                 If AlreadyInList = False Then
3048                     ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
3049                     OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
3050                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3051                 End If
3052             End If
3053             StatBar.Style = 1
3054             StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
3055             FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
3056             UseFile = True
3057             Param = NewParam
3058             Do
3059                 If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
3060                     If FileName <> "" Then
3061                         Param = Param + " " + FileName
3062                     End If
3063                 ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
3064                     bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
3065                     If FileName <> "" Then
3066                         Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
3067                     Else
3068                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
3069                     End If
3070                 ElseIf InStr(Param, "%1") Then
3071                     bNum = InStr(Param, "%1")
3072                     If FileName <> "" Then
3073                         Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
3074                     Else
3075                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
3076                     End If
3077                 End If
3078             Loop While InStr(Param, "%1")
3079             On Error GoTo NoProgram
3080             Shell Param, 1
3081             On Error GoTo 0
3082             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
3083         End If
3084     Next fNum
3085     SFileCloseArchive hMPQ
3086 ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
3087     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3088     On Error GoTo NoProgram
3089     Shell Param, 1
3090     On Error GoTo 0
3091     Timer1.Enabled = True
3092 Else
3093     MsgBox "No files are selected.", , "WinMPQ"
3094 End If
3095 If FileName <> "" Then
3096     StatBar.Style = 0
3097     StatBar.SimpleText = ""
3098     MousePointer = 0
3099 End If
3100 Exit Sub
3101 NoProgram:
3102 If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
3103 End Sub
3104
3105 Private Sub mnuTMpqEmbed_Click()
3106 frmMpq.Show
3107 End Sub
3108 Private Sub Timer1_Timer()
3109 Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
3110 If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
3111 Path = App.Path
3112 If Right(Path, 1) <> "\" Then Path = Path + "\"
3113 Path = Path + "Temp_extract\"
3114 Path = Path + CStr(ExtractPathNum) + "\"
3115 For fNum = 1 To UBound(OpenFiles)
3116     If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3117         If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
3118             If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
3119                 result = vbYes
3120             Else
3121             result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
3122             End If
3123             If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3124                 OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
3125                 If result = vbYes Then
3126                     List.Sorted = False
3127                     StatBar.Style = 1
3128                     StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
3129                     MousePointer = 11
3130                     dwFlags = MAFA_REPLACE_EXISTING
3131                     If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
3132                     hMPQ = mOpenMpq(CD.FileName)
3133                     If hMPQ Then
3134                         If mnuMCNone.Checked Then
3135                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
3136                         ElseIf mnuMCStandard.Checked Then
3137                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
3138                         ElseIf mnuMCDeflate.Checked Then
3139                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
3140                         ElseIf mnuMCAMedium.Checked Then
3141                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
3142                         ElseIf mnuMCAHighest.Checked Then
3143                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
3144                         ElseIf mnuMCALowest.Checked Then
3145                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
3146                         ElseIf mnuMCAuto.Checked Then
3147                             mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
3148                         End If
3149                     End If
3150                     MpqAddToListing hMPQ, OpenFiles(fNum)
3151                     MpqCloseUpdatedArchive hMPQ, 0
3152                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3153                     StatBar.Style = 0
3154                     StatBar.SimpleText = ""
3155                     MousePointer = 0
3156                     List.Sorted = True
3157                     RemoveDuplicates
3158                     ShowTotal
3159                 End If
3160             End If
3161         End If
3162     Else
3163         For bNum = fNum To UBound(OpenFiles) - 1
3164             OpenFiles(bNum) = OpenFiles(bNum + 1)
3165             OpenFileDates(bNum) = OpenFileDates(bNum + 1)
3166         Next bNum
3167         ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
3168         fNum = fNum - 1
3169         If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
3170     End If
3171     If fNum >= UBound(OpenFiles) Then Exit For
3172 Next fNum
3173 If FileExists(CD.FileName) Then
3174     If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
3175 Else
3176     OpenMpq
3177 End If
3178 End Sub
3179 Private Sub Toolbar_ButtonClick(ByVal Button As Button)
3180 Select Case Button.Key
3181 Case "New"
3182     mnuFNew_Click
3183 Case "Open"
3184     mnuFOpen_Click
3185 Case "Add"
3186     mnuMAdd_Click
3187 Case "Add Folder"
3188     mnuMAddFolder_Click
3189 Case "Extract"
3190     mnuMExtract_Click
3191 Case "Compact"
3192     mnuMCompact_Click
3193 Case "List"
3194     If NewFile = False Then OpenMpq
3195 End Select
3196 End Sub
3197 Private Sub txtCommand_GotFocus()
3198 cmdGo.Default = True
3199 txtCommandHasFocus = True
3200 StatBar.Style = 1
3201 StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
3202 End Sub
3203 Private Sub txtCommand_LostFocus()
3204 cmdGo.Default = False
3205 txtCommandHasFocus = False
3206 StatBar.Style = 0
3207 StatBar.SimpleText = ""
3208 End Sub