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 Currency, 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 On Error Resume Next
1763 For fNum = 1 To List.ListItems.Count
1764     If List.ListItems.Item(fNum).Selected Then
1765         nSelect = nSelect + 1
1766         If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1767             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1768         Else
1769             If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1770                 If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
1771                     fSize = SFileGetFileSize(hFile, 0)
1772                     SFileCloseFile hFile
1773                 End If
1774                 SFileCloseArchive hMPQ
1775             End If
1776             If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1777                 L2 = "<1KB"
1778             ElseIf fSize = 0 Then
1779                 L2 = "0KB"
1780             Else
1781                 L2 = CStr(Int(fSize / 1024)) + "KB"
1782             End If
1783             List.ListItems.Item(fNum).ListSubItems(1).Text = L2
1784             List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
1785             sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1786         End If
1787     End If
1788 Next fNum
1789 If sSize / 1024 > 0 And sSize / 1024 < 1 Then
1790     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
1791 ElseIf sSize = 0 Then
1792     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
1793 Else
1794     StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
1795 End If
1796 On Error GoTo 0
1797 Exit Sub
1798 NotSelected:
1799 StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
1800 End Sub
1801 Sub ShowTotal()
1802 Dim fNum As Long, nFiles As Long, tSize As Currency
1803 On Error Resume Next
1804 For fNum = 1 To List.ListItems.Count
1805     nFiles = nFiles + 1
1806     If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1807         tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1808     End If
1809 Next fNum
1810 If tSize / 1024 > 0 And tSize / 1024 < 1 Then
1811     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
1812 Else
1813     StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
1814 End If
1815 On Error GoTo 0
1816 End Sub
1817 Private Sub cmdGo_Click()
1818 StatBar.Style = 1
1819 RunMpq2kCommand txtCommand
1820 txtCommand = ""
1821 If StatBar.SimpleText = "" Then txtCommand_GotFocus
1822 End Sub
1823
1824 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1825 If KeyCode = vbKeyShift Then
1826     ShiftState = True
1827     BuildMpqActionList
1828 End If
1829 End Sub
1830 Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
1831 If KeyCode = vbKeyShift Then
1832     ShiftState = False
1833     BuildMpqActionList
1834 End If
1835 End Sub
1836 Private Sub Form_Load()
1837 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
1838 Dim Path
1839 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1840 NewKey AppKey
1841 SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
1842 SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
1843 FixIcon hWnd, 1
1844 InitFileDialog CD
1845 CD.hwndOwner = hWnd
1846 CD.DefaultExt = "mpq"
1847 CD.MaxFileSize = 5120
1848 InitFolderDialog PathInput
1849 PathInput.hwndOwner = hWnd
1850 PathInput.Flags = BIF_RETURNONLYFSDIRS
1851 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
1852 ChDir App.Path
1853 'If Mpq.MpqInitialize = False Then
1854 '    ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason:  "
1855 '    Select Case Mpq.LastError
1856 '    Case MPQ_ERROR_NO_STAREDIT
1857 '        ErrorText = ErrorText + "Can't find StarEdit.exe"
1858 '    Case MPQ_ERROR_BAD_STAREDIT
1859 '        ErrorText = ErrorText + "Wrong version of StarEdit.exe.  Need SC/BW 1.07"
1860 '    Case MPQ_ERROR_STAREDIT_RUNNING
1861 '        ErrorText = ErrorText + "StarEdit.exe is running.  It must be closed before running this"
1862 '    Case Else
1863 '        ErrorText = ErrorText + "Unknown"
1864 '    End Select
1865 '    MsgBox ErrorText
1866 '    End
1867 'End If
1868 ExtractPathNum = -1
1869 CopyPathNum = -1
1870 OldStartPath = CurDir
1871 CurPath = GetReg(AppKey + "StartupPath", CurDir)
1872 CurPathType = GetReg(AppKey + "StartupPathType", 0)
1873 If CurPathType < 0 Then CurPathType = 0
1874 If CurPathType > 2 Then CurPathType = 2
1875 If CurPathType = 1 Then
1876     CurPath = App.Path
1877 End If
1878 CurPath2 = CurPath
1879 If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
1880 If IsDir(CurPath2) Then
1881     If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
1882     ChDir CurPath
1883 End If
1884 NewStartPath = CurDir
1885 On Error Resume Next
1886 Height = GetReg(AppKey + "Status\WindowHeight", Height)
1887 Left = GetReg(AppKey + "Status\WindowLeft", Left)
1888 Top = GetReg(AppKey + "Status\WindowTop", Top)
1889 Width = GetReg(AppKey + "Status\WindowWidth", Width)
1890 If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
1891 ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
1892 DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
1893 DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)
1894 LocaleID = GetReg(AppKey + "LocaleID", 0)
1895 GlobalEncrypt = False
1896 DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
1897 Select Case DefaultCompressID
1898 Case -3
1899 DefaultCompress = MAFA_COMPRESS_DEFLATE
1900 Case Else
1901 DefaultCompress = MAFA_COMPRESS_STANDARD
1902 End Select
1903 DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
1904 BuildRecentFileList
1905 BuildToolsList
1906 On Error GoTo 0
1907 SFileSetLocale LocaleID
1908 ReDim GlobalFileList(0) As String
1909 #If InternalListing Then
1910 If FileExists(ListFile) Then
1911     Open ListFile For Input As #1
1912     Do While Not EOF(1)
1913         ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
1914         Line Input #1, GlobalFileList(UBound(GlobalFileList))
1915     Loop
1916     Close #1
1917 End If
1918 #End If
1919 FileName = Trim(Command)
1920 If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
1921 If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
1922 FileName = Trim(FileName)
1923 If FileExists(FileName) Then
1924     CD.FileName = FileName
1925     Show
1926     OpenMpq
1927     Exit Sub
1928 End If
1929 ReDim FileList(0) As String
1930 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
1931 sLine = Command
1932 If Right(sLine, 1) <> " " Then sLine = sLine + " "
1933 If sLine <> "" Then
1934     ReDim Param(0) As String
1935     For pNum = 1 To Len(sLine)
1936         If Mid(sLine, pNum, 1) = Chr(34) Then
1937             pNum = pNum + 1
1938             EndParam = InStr(pNum, sLine, Chr(34))
1939             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
1940         Else
1941             EndParam = InStr(pNum, sLine, " ")
1942             If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
1943         End If
1944         If EndParam = 0 Then EndParam = Len(sLine) + 1
1945         If pNum <> EndParam Then
1946             If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
1947                 ReDim Preserve Param(UBound(Param) + 1) As String
1948                 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
1949             End If
1950         End If
1951         pNum = EndParam
1952     Next pNum
1953     If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
1954     Select Case LCase(Param(1))
1955     Case "o", "open", "n", "new"
1956         Show
1957         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1958         ChDir OldStartPath
1959         RunMpq2kCommand sLine
1960     Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
1961         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1962         ChDir OldStartPath
1963         CD.FileName = FullPath(CurDir, Param(2))
1964         sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
1965         RunMpq2kCommand sLine
1966         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1967         ChDir NewStartPath
1968         Unload Me
1969     Case "s", "script"
1970         Show
1971         If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1972         ChDir OldStartPath
1973         RunMpq2kCommand sLine
1974         If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1975         ChDir NewStartPath
1976     End Select
1977 End If
1978 End Sub
1979 Private Sub Form_Resize()
1980 On Error Resume Next
1981 If WindowState <> 1 Then
1982     List.Top = Toolbar.Height
1983     List.Width = ScaleWidth
1984     List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
1985     Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
1986     txtCommand.Top = List.Top + List.Height
1987     txtCommand.Left = Label1.Width
1988     txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
1989     cmdGo.Top = txtCommand.Top
1990     cmdGo.Left = txtCommand.Left + txtCommand.Width
1991     mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
1992     Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
1993 End If
1994 End Sub
1995 Private Sub Form_Unload(Cancel As Integer)
1996 Dim Path As String
1997 Path = App.Path
1998 If Right(Path, 1) <> "\" Then Path = Path + "\"
1999 On Error Resume Next
2000 If ExtractPathNum > -1 Then
2001     KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
2002     RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
2003 End If
2004 If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
2005     KillEx Path + "Temp_extract\", "*", 6, True
2006     RmDir Path + "Temp_extract\"
2007 End If
2008 If CopyPathNum > -1 Then
2009     KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
2010     RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
2011 End If
2012 If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
2013     KillEx Path + "Temp_copy\", "*", 6, True
2014     RmDir Path + "Temp_copy\"
2015 End If
2016 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
2017     NewKey AppKey
2018     NewKey AppKey + "Status\"
2019     If WindowState = 1 Then WindowState = 0
2020     SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
2021     WindowState = 0
2022     SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
2023     SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
2024     SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
2025     SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
2026 End If
2027 If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
2028     SetReg AppKey + "StartupPath", CurDir
2029 End If
2030 End
2031 End Sub
2032 Private Sub Label1_Click()
2033 txtCommand.SetFocus
2034 End Sub
2035 Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
2036 Dim result As Long, hMPQ As Long, hFile As Long
2037 If List.SelectedItem.Text <> NewString Then
2038     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2039         result = vbYes
2040     Else
2041         result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2042     End If
2043     If result = vbYes Then
2044         List.SelectedItem.Tag = NewString
2045         hMPQ = mOpenMpq(CD.FileName)
2046         If hMPQ Then
2047             If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
2048                 SFileCloseFile hFile
2049                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2050                 MpqDeleteFile hMPQ, NewString
2051                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2052                 SFileSetLocale LocaleID
2053                 RemoveDuplicates
2054             Else
2055                 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2056                 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2057                 SFileSetLocale LocaleID
2058             End If
2059             MpqCloseUpdatedArchive hMPQ, 0
2060             On Error Resume Next
2061             List.SelectedItem.Key = NewString
2062             On Error GoTo 0
2063             If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2064         End If
2065     Else
2066         Cancel = True
2067     End If
2068 End If
2069 ShowSelected
2070 End Sub
2071 Private Sub List_Click()
2072 On Error GoTo NotSelected
2073 List.SelectedItem.Tag = List.SelectedItem.Tag
2074 On Error GoTo NotClick
2075 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2076 On Error GoTo 0
2077 ShowSelected
2078 Exit Sub
2079 NotClick:
2080 List.SelectedItem.Selected = False
2081 NotSelected:
2082 ShowSelected
2083 BuildMpqActionList
2084 End Sub
2085 Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
2086 If List.SortKey = ColumnHeader.Index - 1 Then
2087     If List.SortOrder = 0 Then
2088         List.SortOrder = 1
2089     Else
2090         List.SortOrder = 0
2091     End If
2092 Else
2093     List.SortOrder = 0
2094     List.SortKey = ColumnHeader.Index - 1
2095 End If
2096 End Sub
2097 Private Sub List_DblClick()
2098 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
2099 On Error GoTo NotSelected
2100 List.SelectedItem.Tag = List.SelectedItem.Tag
2101 On Error GoTo NotClick
2102 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2103 On Error GoTo 0
2104 Path = App.Path
2105 If Right(Path, 1) <> "\" Then Path = Path + "\"
2106 Path = Path + "Temp_extract\"
2107 If ExtractPathNum = -1 Then
2108     fNum = 0
2109     Do
2110     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2111     fNum = fNum + 1
2112     Loop
2113     ExtractPathNum = fNum
2114 End If
2115 Path = Path + CStr(ExtractPathNum) + "\"
2116 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2117 For fNum = 1 To List.ListItems.Count
2118     If List.ListItems.Item(fNum).Selected Then
2119         StatBar.Style = 1
2120         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2121         MousePointer = 11
2122         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2123         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2124         SFileSetLocale LocaleID
2125         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
2126             For bNum = 1 To UBound(OpenFiles)
2127                 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
2128                     AlreadyInList = True
2129                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2130                     Exit For
2131                 End If
2132             Next bNum
2133             If AlreadyInList = False Then
2134                 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
2135                 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
2136                 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2137             End If
2138         End If
2139         StatBar.Style = 1
2140         StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
2141         fName = List.ListItems.Item(fNum).Tag
2142         BuildPopup Path + fName, 0, mnuPopup, mnuPItem
2143         ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
2144         If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
2145     End If
2146 Next fNum
2147 SFileCloseArchive hMPQ
2148 StatBar.Style = 0
2149 StatBar.SimpleText = ""
2150 MousePointer = 0
2151 Exit Sub
2152 NotClick:
2153 List.SelectedItem.Selected = False
2154 NotSelected:
2155 End Sub
2156 Private Sub List_ItemClick(ByVal Item As ListItem)
2157 BuildMpqActionList
2158 End Sub
2159 Private Sub List_KeyPress(KeyAscii As Integer)
2160 If KeyAscii = 13 Then List_DblClick
2161 End Sub
2162 Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
2163 If KeyCode = vbKeyDelete Then
2164     mnuMDelete_Click
2165 ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
2166     On Error GoTo NotSelected
2167     List.SelectedItem.Tag = List.SelectedItem.Tag
2168     On Error GoTo 0
2169     If List.SelectedItem.Selected = True Then
2170         BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2171         PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
2172     End If
2173 End If
2174 NotSelected:
2175 End Sub
2176 Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
2177 CX = X
2178 CY = Y
2179 If Button And vbRightButton Then
2180     On Error GoTo NotSelected
2181     List.SelectedItem.Tag = List.SelectedItem.Tag
2182     On Error GoTo NotClick
2183     List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2184     On Error GoTo 0
2185     BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
2186     PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
2187 End If
2188 NotClick:
2189 NotSelected:
2190 End Sub
2191 Private Sub List_OLECompleteDrag(Effect As Long)
2192 List.Tag = ""
2193 End Sub
2194 Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
2195 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
2196 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
2197 If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
2198 For fNum = 1 To Data.Files.Count
2199     Path = Data.Files.Item(fNum)
2200     If Right(Path, 1) <> "\" Then Path = Path + "\"
2201     If IsDir(Path) Then
2202         Path = Path + "*"
2203         Data.Files.Remove fNum
2204         Data.Files.Add Path, fNum
2205     End If
2206 Next fNum
2207 Path = Data.Files.Item(1)
2208 For bNum = 1 To Len(Path)
2209     If InStr(bNum, Path, "\") > 0 Then
2210         For fNum = 1 To Data.Files.Count
2211             If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
2212         Next fNum
2213         bNum = InStr(bNum, Path, "\")
2214     Else
2215         Exit For
2216     End If
2217 Next bNum
2218 PathFound:
2219 Path = Left(Path, bNum - 1)
2220 ReDim Files(0) As String
2221 Files(0) = Path
2222 If Right(Path, 1) <> "\" Then Path = Path + "\"
2223 ReDim Preserve Files(Data.Files.Count) As String
2224 For bNum = 1 To Data.Files.Count
2225     Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
2226     For fNum = 1 To Len(Files(bNum))
2227         If InStr(fNum, Files(bNum), "\") > 0 Then
2228             fNum = InStr(fNum, Files(bNum), "\")
2229         Else
2230             Exit For
2231         End If
2232     Next fNum
2233     FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
2234 Next bNum
2235 If FolderFiles = "" Then Exit Sub
2236 ReDim Preserve Files(0) As String
2237 For bNum = 1 To Len(FolderFiles)
2238     ReDim Preserve Files(UBound(Files) + 1) As String
2239     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2240         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2241         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2242     Else
2243         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2244         Exit For
2245     End If
2246 Next bNum
2247 FoldName.Show 1
2248 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2249 If UBound(Files) > 1 Then
2250     ReDim ShortFiles(UBound(Files)) As String
2251     For bNum = 0 To UBound(Files)
2252         ShortFiles(bNum) = AddFolderName + Files(bNum)
2253     Next bNum
2254     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2255     For bNum = 1 To UBound(Files)
2256         Files(bNum) = FullPath(Files(0), Files(bNum))
2257     Next bNum
2258 Else
2259     For bNum = 1 To Len(Files(1))
2260         If InStr(bNum, Files(1), "\") > 0 Then
2261             bNum = InStr(bNum, Files(1), "\")
2262         Else
2263             Exit For
2264         End If
2265     Next bNum
2266     ReDim ShortFiles(UBound(Files)) As String
2267     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2268     Files(1) = FullPath(Files(0), Files(1))
2269 End If
2270 If NewFile = True Then
2271     If FileExists(CD.FileName) Then Kill CD.FileName
2272     NewFile = False
2273 End If
2274 List.Sorted = False
2275 FileFilter = mFilter
2276 hMPQ = mOpenMpq(CD.FileName)
2277 If hMPQ = 0 Then
2278     StatBar.SimpleText = "Can't create archive " + CD.FileName
2279     Exit Sub
2280 End If
2281 dwFlags = MAFA_REPLACE_EXISTING
2282 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2283 For bNum = 1 To UBound(Files)
2284     StatBar.Style = 1
2285     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2286     MousePointer = 11
2287     If mnuMCNone.Checked Then
2288         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2289     ElseIf mnuMCStandard.Checked Then
2290         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2291     ElseIf mnuMCDeflate.Checked Then
2292         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2293     ElseIf mnuMCAMedium.Checked Then
2294         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2295     ElseIf mnuMCAHighest.Checked Then
2296         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2297     ElseIf mnuMCALowest.Checked Then
2298         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2299     ElseIf mnuMCAuto.Checked Then
2300         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2301     End If
2302     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2303     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2304     For cNum = 1 To mFilter.ListCount - 1
2305         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2306             mFilter.RemoveItem cNum
2307             Exit For
2308         End If
2309     Next cNum
2310 Next bNum
2311 MpqCloseUpdatedArchive hMPQ, 0
2312 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2313 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2314     StatBar.SimpleText = "Adding files to listing... 0% complete"
2315     For bNum = 1 To UBound(Files)
2316         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2317             MpqAddToListing hMPQ, ShortFiles(bNum)
2318         End If
2319         On Error Resume Next
2320         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2321         On Error GoTo 0
2322     Next bNum
2323     SFileCloseArchive hMPQ
2324 End If
2325 StatBar.Style = 0
2326 StatBar.SimpleText = ""
2327 MousePointer = 0
2328 If MatchesFilter("(listfile)", FileFilter) Then
2329     AddToListing "(listfile)"
2330 End If
2331 mFilter = FileFilter
2332 List.Sorted = True
2333 RemoveDuplicates
2334 ShowTotal
2335 Cancel:
2336 End Sub
2337 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)
2338 If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
2339     Effect = ccOLEDropEffectNone
2340 Else
2341     Effect = ccOLEDropEffectCopy
2342 End If
2343 End Sub
2344 Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
2345 Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
2346 Path = App.Path
2347 If Right(Path, 1) <> "\" Then Path = Path + "\"
2348 Path = Path + "Temp_copy\"
2349 If CopyPathNum = -1 Then
2350     fNum = 0
2351     Do
2352     If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2353     fNum = fNum + 1
2354     Loop
2355     CopyPathNum = fNum
2356 End If
2357 Path = Path + CStr(CopyPathNum) + "\"
2358 KillEx Path, "*", 6, True
2359 fCount = 0
2360 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2361 For fNum = 1 To List.ListItems.Count
2362     If List.ListItems.Item(fNum).Selected Then
2363         StatBar.Style = 1
2364         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2365         MousePointer = 11
2366         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2367         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2368         SFileSetLocale LocaleID
2369         If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
2370             Data.Files.Add Path + List.ListItems.Item(fNum).Tag
2371         End If
2372         fCount = fCount + 1
2373         If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
2374     End If
2375 Next fNum
2376 SFileCloseArchive hMPQ
2377 StatBar.Style = 0
2378 StatBar.SimpleText = ""
2379 MousePointer = 0
2380 If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
2381     Data.Files.Add Path + "*"
2382 ElseIf fCount = 1 Then
2383     Data.Files.Add FirstFile
2384 End If
2385 End Sub
2386 Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
2387 Data.SetData , ccCFFiles
2388 AllowedEffects = ccOLEDropEffectCopy
2389 List.Tag = "WinMPQ"
2390 End Sub
2391 Private Sub mFilter_KeyPress(KeyAscii As Integer)
2392 If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
2393     If NewFile = False Then OpenMpq
2394 End If
2395 End Sub
2396 Private Sub mnuFExit_Click()
2397 Unload Me
2398 End Sub
2399 Private Sub mnuFile_Click()
2400 If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
2401 End Sub
2402 Private Sub mnuFRecent_Click(Index As Integer)
2403 Dim OldFileName As String
2404 OldFileName = CD.FileName
2405 CD.FileName = mnuFRecent(Index).Tag
2406 If FileExists(CD.FileName) = False Then
2407     CD.FileName = OldFileName
2408     MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
2409     DelRecentFile mnuFRecent(Index).Tag
2410     Exit Sub
2411 End If
2412 OpenMpq
2413 If CD.FileName = "" Then
2414     CD.FileName = OldFileName
2415     DelRecentFile mnuFRecent(Index).Tag
2416 End If
2417 End Sub
2418 Private Sub mnuFReopen_Click()
2419 OpenMpq
2420 End Sub
2421
2422 Private Sub mnuFScript_Click()
2423 Dim OldFileName As String, OldPath As String
2424 CD.Flags = &H1000 Or &H4 Or &H2
2425 CD.Filter = "All Files (*.*)|*.*"
2426 OldFileName = CD.FileName
2427 OldPath = CurDir
2428 CD.hwndOwner = hWnd
2429 If ShowOpen(CD) = False Then GoTo Cancel
2430 StatBar.Style = 1
2431 StatBar.SimpleText = "Running script " + CD.FileName + "..."
2432 MousePointer = 11
2433 RunScript CD.FileName
2434 StatBar.Style = 0
2435 StatBar.SimpleText = ""
2436 MousePointer = 0
2437 CD.FileName = OldFileName
2438 Cancel:
2439 If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
2440 ChDir OldPath
2441 End Sub
2442 Private Sub mnuHAbout_Click()
2443 About.Show 1
2444 End Sub
2445 Private Sub mnuHReadme_Click()
2446 Dim Path As String
2447 Path = App.Path
2448 If Right(Path, 1) <> "\" Then Path = Path + "\"
2449 If FileExists(Path + "WinMPQ.rtf") Then
2450     ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
2451 Else
2452     MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
2453 End If
2454 End Sub
2455 Private Sub mnuMAdd_Click()
2456 Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
2457 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
2458 CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
2459 CD.Filter = "All Files (*.*)|*.*"
2460 OldFileName = CD.FileName
2461 CD.hwndOwner = hWnd
2462 If ShowOpen(CD) = False Then GoTo Cancel
2463 ReDim Files(0) As String
2464 bNum = 1
2465 If InStr(1, CD.FileName, Chr(0)) > 0 Then
2466     Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
2467     bNum = InStr(1, CD.FileName, Chr(0)) + 1
2468 Else
2469     Files(0) = Mid(CD.FileName, 1)
2470 End If
2471 For bNum = bNum To Len(CD.FileName)
2472     ReDim Preserve Files(UBound(Files) + 1) As String
2473     If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
2474         Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
2475         bNum = InStr(bNum, CD.FileName, Chr(0))
2476     Else
2477         Files(UBound(Files)) = Mid(CD.FileName, bNum)
2478         Exit For
2479     End If
2480 Next bNum
2481 CD.FileName = OldFileName
2482 FoldName.Show 1
2483 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2484 If UBound(Files) > 1 Then
2485     ReDim ShortFiles(UBound(Files)) As String
2486     For bNum = 0 To UBound(Files)
2487         ShortFiles(bNum) = AddFolderName + Files(bNum)
2488     Next bNum
2489     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2490     For bNum = 1 To UBound(Files)
2491         Files(bNum) = FullPath(Files(0), Files(bNum))
2492     Next bNum
2493 Else
2494     For bNum = 1 To Len(Files(1))
2495         If InStr(bNum, Files(1), "\") > 0 Then
2496             bNum = InStr(bNum, Files(1), "\")
2497         Else
2498             Exit For
2499         End If
2500     Next bNum
2501     ReDim ShortFiles(UBound(Files)) As String
2502     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2503     Files(1) = FullPath(Files(0), Files(1))
2504 End If
2505 If NewFile = True Then
2506     If FileExists(CD.FileName) Then Kill CD.FileName
2507     NewFile = False
2508 End If
2509 List.Sorted = False
2510 FileFilter = mFilter
2511 hMPQ = mOpenMpq(CD.FileName)
2512 If hMPQ = 0 Then
2513     StatBar.SimpleText = "Can't create archive " + CD.FileName
2514     Exit Sub
2515 End If
2516 dwFlags = MAFA_REPLACE_EXISTING
2517 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2518 For bNum = 1 To UBound(Files)
2519     StatBar.Style = 1
2520     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2521     MousePointer = 11
2522     If mnuMCNone.Checked Then
2523         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2524     ElseIf mnuMCStandard.Checked Then
2525         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2526     ElseIf mnuMCDeflate.Checked Then
2527         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2528     ElseIf mnuMCAMedium.Checked Then
2529         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2530     ElseIf mnuMCAHighest.Checked Then
2531         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2532     ElseIf mnuMCALowest.Checked Then
2533         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2534     ElseIf mnuMCAuto.Checked Then
2535         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2536     End If
2537     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2538     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2539     For cNum = 1 To mFilter.ListCount - 1
2540         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2541             mFilter.RemoveItem cNum
2542             Exit For
2543         End If
2544     Next cNum
2545 Next bNum
2546 MpqCloseUpdatedArchive hMPQ, 0
2547 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2548 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2549     StatBar.SimpleText = "Adding files to listing... 0% complete"
2550     For bNum = 1 To UBound(Files)
2551         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2552             MpqAddToListing hMPQ, ShortFiles(bNum)
2553         End If
2554         On Error Resume Next
2555         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2556         On Error GoTo 0
2557     Next bNum
2558     SFileCloseArchive hMPQ
2559 End If
2560 StatBar.Style = 0
2561 StatBar.SimpleText = ""
2562 MousePointer = 0
2563 If MatchesFilter("(listfile)", FileFilter) Then
2564     AddToListing "(listfile)"
2565 End If
2566 mFilter = FileFilter
2567 List.Sorted = True
2568 RemoveDuplicates
2569 ShowTotal
2570 Cancel:
2571 End Sub
2572 Private Sub mnuMAddFolder_Click()
2573 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
2574 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
2575 PathInput.hwndOwner = hWnd
2576 Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
2577 If Path = "" Then GoTo Cancel
2578 FolderFiles = DirEx(Path, "*", 6, True)
2579 If FolderFiles = "" Then Exit Sub
2580 ReDim Files(0) As String
2581 Files(0) = Path
2582 If Right(Path, 1) <> "\" Then Path = Path + "\"
2583 For bNum = 1 To Len(FolderFiles)
2584     ReDim Preserve Files(UBound(Files) + 1) As String
2585     If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2586         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2587         bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2588     Else
2589         Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2590         Exit For
2591     End If
2592 Next bNum
2593 FoldName.Show 1
2594 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
2595 If UBound(Files) > 1 Then
2596     ReDim ShortFiles(UBound(Files)) As String
2597     For bNum = 0 To UBound(Files)
2598         ShortFiles(bNum) = AddFolderName + Files(bNum)
2599     Next bNum
2600     If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2601     For bNum = 1 To UBound(Files)
2602         Files(bNum) = FullPath(Files(0), Files(bNum))
2603     Next bNum
2604 Else
2605     For bNum = 1 To Len(Files(1))
2606         If InStr(bNum, Files(1), "\") > 0 Then
2607             bNum = InStr(bNum, Files(1), "\")
2608         Else
2609             Exit For
2610         End If
2611     Next bNum
2612     ReDim ShortFiles(UBound(Files)) As String
2613     ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2614     Files(1) = FullPath(Files(0), Files(1))
2615 End If
2616 If NewFile = True Then
2617     If FileExists(CD.FileName) Then Kill CD.FileName
2618     NewFile = False
2619 End If
2620 List.Sorted = False
2621 FileFilter = mFilter
2622 hMPQ = mOpenMpq(CD.FileName)
2623 If hMPQ = 0 Then
2624     StatBar.SimpleText = "Can't create archive " + CD.FileName
2625     Exit Sub
2626 End If
2627 dwFlags = MAFA_REPLACE_EXISTING
2628 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
2629 For bNum = 1 To UBound(Files)
2630     StatBar.Style = 1
2631     StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2632     MousePointer = 11
2633     If mnuMCNone.Checked Then
2634         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
2635     ElseIf mnuMCStandard.Checked Then
2636         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2637     ElseIf mnuMCDeflate.Checked Then
2638         MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
2639     ElseIf mnuMCAMedium.Checked Then
2640         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
2641     ElseIf mnuMCAHighest.Checked Then
2642         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
2643     ElseIf mnuMCALowest.Checked Then
2644         MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
2645     ElseIf mnuMCAuto.Checked Then
2646         mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2647     End If
2648     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2649     mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2650     For cNum = 1 To mFilter.ListCount - 1
2651         If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2652             mFilter.RemoveItem cNum
2653             Exit For
2654         End If
2655     Next cNum
2656 Next bNum
2657 MpqCloseUpdatedArchive hMPQ, 0
2658 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2659 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
2660     StatBar.SimpleText = "Adding files to listing... 0% complete"
2661     For bNum = 1 To UBound(Files)
2662         If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2663             MpqAddToListing hMPQ, ShortFiles(bNum)
2664         End If
2665         On Error Resume Next
2666         StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2667         On Error GoTo 0
2668     Next bNum
2669     SFileCloseArchive hMPQ
2670 End If
2671 StatBar.Style = 0
2672 StatBar.SimpleText = ""
2673 MousePointer = 0
2674 If MatchesFilter("(listfile)", FileFilter) Then
2675     AddToListing "(listfile)"
2676 End If
2677 mFilter = FileFilter
2678 List.Sorted = True
2679 RemoveDuplicates
2680 ShowTotal
2681 Cancel:
2682 End Sub
2683
2684 Private Sub mnuMAddToList_Click()
2685 frmAddToList.Show 1
2686 End Sub
2687 Private Sub mnuMCAHighest_Click()
2688 mnuMCNone.Checked = False
2689 mnuMCStandard.Checked = False
2690 mnuMCDeflate.Checked = False
2691 mnuMCALowest.Checked = False
2692 mnuMCAMedium.Checked = False
2693 mnuMCAHighest.Checked = True
2694 mnuMCAuto.Checked = False
2695 End Sub
2696 Private Sub mnuMCALowest_Click()
2697 mnuMCNone.Checked = False
2698 mnuMCStandard.Checked = False
2699 mnuMCDeflate.Checked = False
2700 mnuMCALowest.Checked = True
2701 mnuMCAMedium.Checked = False
2702 mnuMCAHighest.Checked = False
2703 mnuMCAuto.Checked = False
2704 End Sub
2705
2706
2707 Private Sub mnuMCAMedium_Click()
2708 mnuMCNone.Checked = False
2709 mnuMCStandard.Checked = False
2710 mnuMCDeflate.Checked = False
2711 mnuMCALowest.Checked = False
2712 mnuMCAMedium.Checked = True
2713 mnuMCAHighest.Checked = False
2714 mnuMCAuto.Checked = False
2715 End Sub
2716 Private Sub mnuMCAuto_Click()
2717 mnuMCNone.Checked = False
2718 mnuMCStandard.Checked = False
2719 mnuMCDeflate.Checked = False
2720 mnuMCALowest.Checked = False
2721 mnuMCAMedium.Checked = False
2722 mnuMCAHighest.Checked = False
2723 mnuMCAuto.Checked = True
2724 End Sub
2725
2726 Private Sub mnuMCDeflate_Click()
2727 mnuMCNone.Checked = False
2728 mnuMCStandard.Checked = False
2729 mnuMCDeflate.Checked = True
2730 mnuMCALowest.Checked = False
2731 mnuMCAMedium.Checked = False
2732 mnuMCAHighest.Checked = False
2733 mnuMCAuto.Checked = False
2734 End Sub
2735
2736
2737 Private Sub mnuMChLCID_Click()
2738 Dim fNum As Long
2739 On Error GoTo NotSelected
2740 List.SelectedItem.Tag = List.SelectedItem.Tag
2741 On Error GoTo 0
2742 For fNum = 1 To List.ListItems.Count
2743     If List.ListItems.Item(fNum).Selected Then
2744         GoTo FileSelected
2745     End If
2746 Next fNum
2747 GoTo NotSelected
2748 FileSelected:
2749 ChLCID.Show 1
2750 Exit Sub
2751 NotSelected:
2752 MsgBox "No files are selected.", , "WinMPQ"
2753 End Sub
2754 Private Sub mnuMCNone_Click()
2755 mnuMCNone.Checked = True
2756 mnuMCStandard.Checked = False
2757 mnuMCDeflate.Checked = False
2758 mnuMCALowest.Checked = False
2759 mnuMCAMedium.Checked = False
2760 mnuMCAHighest.Checked = False
2761 mnuMCAuto.Checked = False
2762 End Sub
2763 Private Sub mnuMCompact_Click()
2764 Dim fNum As Long, result As Long, hMPQ As Long
2765 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2766     result = vbYes
2767 Else
2768     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")
2769 End If
2770 If result = vbYes Then
2771     StatBar.Style = 1
2772     StatBar.SimpleText = "Compacting " + CD.FileName + "..."
2773     MousePointer = 11
2774     hMPQ = mOpenMpq(CD.FileName)
2775     If hMPQ Then
2776         MpqCompactArchive hMPQ
2777         MpqCloseUpdatedArchive hMPQ, 0
2778     End If
2779     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2780     StatBar.Style = 0
2781     StatBar.SimpleText = ""
2782     MousePointer = 0
2783     OpenMpq
2784 End If
2785 End Sub
2786 Private Sub mnuMCStandard_Click()
2787 mnuMCNone.Checked = False
2788 mnuMCStandard.Checked = True
2789 mnuMCDeflate.Checked = False
2790 mnuMCALowest.Checked = False
2791 mnuMCAMedium.Checked = False
2792 mnuMCAHighest.Checked = False
2793 mnuMCAuto.Checked = False
2794 End Sub
2795 Private Sub mnuMDelete_Click()
2796 Dim fNum As Long, result As Long, hMPQ As Long
2797 On Error GoTo NotSelected
2798 List.SelectedItem.Tag = List.SelectedItem.Tag
2799 On Error GoTo 0
2800 For fNum = 1 To List.ListItems.Count
2801     If List.ListItems.Item(fNum).Selected Then
2802         GoTo FileSelected
2803     End If
2804 Next fNum
2805 GoTo NotSelected
2806 FileSelected:
2807     If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2808         result = vbYes
2809     Else
2810         result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2811     End If
2812     If result = vbYes Then
2813         fNum = 1
2814         hMPQ = mOpenMpq(CD.FileName)
2815         If hMPQ Then
2816             Do While fNum <= List.ListItems.Count
2817                 If List.ListItems.Item(fNum).Selected Then
2818                     StatBar.Style = 1
2819                     StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
2820                     MousePointer = 11
2821                     SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2822                     MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
2823                     SFileSetLocale LocaleID
2824                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2825                     List.ListItems.Remove (fNum)
2826                     fNum = fNum - 1
2827                 End If
2828                 fNum = fNum + 1
2829             Loop
2830             MpqCloseUpdatedArchive hMPQ, 0
2831         End If
2832     End If
2833     StatBar.Style = 0
2834     StatBar.SimpleText = ""
2835     MousePointer = 0
2836     ShowSelected
2837     ShowTotal
2838 Exit Sub
2839 NotSelected:
2840 MsgBox "No files are selected.", , "WinMPQ"
2841 End Sub
2842 Private Sub mnuMEncrypt_Click()
2843 If mnuMEncrypt.Checked = False Then
2844     mnuMEncrypt.Checked = True
2845     GlobalEncrypt = True
2846 Else
2847     mnuMEncrypt.Checked = False
2848     GlobalEncrypt = False
2849 End If
2850 End Sub
2851 Private Sub mnuMExtract_Click()
2852 Dim fNum As Long, Path As String, result As Long, hMPQ As Long
2853 On Error GoTo NotSelected
2854 List.SelectedItem.Tag = List.SelectedItem.Tag
2855 On Error GoTo 0
2856 For fNum = 1 To List.ListItems.Count
2857     If List.ListItems.Item(fNum).Selected Then
2858         GoTo FileSelected
2859     End If
2860 Next fNum
2861 GoTo NotSelected
2862 FileSelected:
2863 PathInput.hwndOwner = hWnd
2864 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2865 If Path = "" Then Exit Sub
2866 If Right(Path, 1) <> "\" Then Path = Path + "\"
2867 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2868 For fNum = 1 To List.ListItems.Count
2869     If List.ListItems.Item(fNum).Selected Then
2870         StatBar.Style = 1
2871         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2872         MousePointer = 11
2873         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2874         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2875         SFileSetLocale LocaleID
2876     End If
2877 Next fNum
2878 SFileCloseArchive hMPQ
2879 StatBar.Style = 0
2880 StatBar.SimpleText = ""
2881 MousePointer = 0
2882 Exit Sub
2883 NotSelected:
2884 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
2885     result = vbYes
2886 Else
2887     result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
2888 End If
2889 If result = vbYes Then
2890     PathInput.hwndOwner = hWnd
2891     Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2892     If Path = "" Then Exit Sub
2893     If Right(Path, 1) <> "\" Then Path = Path + "\"
2894     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
2895     For fNum = 1 To List.ListItems.Count
2896         StatBar.Style = 1
2897         StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2898         MousePointer = 11
2899         SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2900         sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2901         SFileSetLocale LocaleID
2902     Next fNum
2903     SFileCloseArchive hMPQ
2904     StatBar.Style = 0
2905     StatBar.SimpleText = ""
2906     MousePointer = 0
2907 End If
2908 End Sub
2909 Private Sub mnuFNew_Click()
2910 Dim TItem As Menu
2911 CD.Flags = &H1000 Or &H4 Or &H2
2912 CD.DefaultExt = "mpq"
2913 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
2914 CD.hwndOwner = hWnd
2915 If ShowSave(CD) = False Then GoTo Cancel
2916 ReDim FileList(0) As String
2917 List.ListItems.Clear
2918 ShowSelected
2919 ShowTotal
2920 NewFile = True
2921 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
2922 mnuMpq.Enabled = True
2923 For Each TItem In mnuTItem
2924     TItem.Enabled = True
2925 Next TItem
2926 Toolbar.Buttons.Item("Add").Enabled = True
2927 Toolbar.Buttons.Item("Add Folder").Enabled = True
2928 Toolbar.Buttons.Item("Extract").Enabled = True
2929 Toolbar.Buttons.Item("Compact").Enabled = True
2930 Toolbar.Buttons.Item("List").Enabled = True
2931 Caption = "WinMPQ - " + CD.FileTitle
2932 AddRecentFile CD.FileName
2933 Cancel:
2934 End Sub
2935 Private Sub mnuFOpen_Click()
2936 Dim OldFileName As String
2937 CD.Flags = &H1000 Or &H4 Or &H2
2938 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
2939 OldFileName = CD.FileName
2940 CD.hwndOwner = hWnd
2941 If ShowOpen(CD) = False Then GoTo Cancel
2942 OpenMpq
2943 If CD.FileName = "" Then CD.FileName = OldFileName
2944 Cancel:
2945 End Sub
2946 Private Sub mnuMItem_Click(Index As Integer)
2947 FileActionClick mnuMpq, mnuMItem, Index
2948 End Sub
2949 Private Sub mnuMRename_Click()
2950 List.StartLabelEdit
2951 End Sub
2952 Private Sub mnuMSaveList_Click()
2953 Dim fNum As Long, fList As String, OldFileName As String
2954 CD.Flags = &H1000 Or &H4 Or &H2
2955 CD.DefaultExt = "txt"
2956 CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
2957 OldFileName = CD.FileName
2958 CD.FileName = CD.FileName + ".txt"
2959 CD.hwndOwner = hWnd
2960 If ShowSave(CD) = False Then GoTo Cancel
2961 StatBar.Style = 1
2962 StatBar.SimpleText = "Creating list..."
2963 MousePointer = 11
2964 For fNum = 1 To List.ListItems.Count
2965     fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
2966 Next fNum
2967 fNum = FreeFile
2968 Open CD.FileName For Binary As #fNum
2969 Put #fNum, 1, fList
2970 Close #fNum
2971 Cancel:
2972 CD.FileName = OldFileName
2973 StatBar.Style = 0
2974 StatBar.SimpleText = ""
2975 MousePointer = 0
2976 End Sub
2977 Private Sub mnuOptions_Click()
2978 Options.Show 1
2979 End Sub
2980
2981 Private Sub mnuPChLCID_Click()
2982 mnuMChLCID_Click
2983 End Sub
2984 Private Sub mnuPDelete_Click()
2985 mnuMDelete_Click
2986 End Sub
2987 Private Sub mnuPExtract_Click()
2988 mnuMExtract_Click
2989 End Sub
2990 Private Sub mnuPItem_Click(Index As Integer)
2991 FileActionClick mnuPopup, mnuPItem, Index
2992 End Sub
2993 Private Sub mnuPRename_Click()
2994 mnuMRename_Click
2995 End Sub
2996 Private Sub mnuPTItem_Click(Index As Integer)
2997 mnuTItem_Click Index
2998 End Sub
2999 Private Sub mnuTAdd_Click()
3000 ToolList.Show 1
3001 BuildToolsList
3002 End Sub
3003 Private Sub mnuTItem_Click(Index As Integer)
3004 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
3005 Param = mnuTItem(Index).Tag
3006 On Error GoTo NoProgram
3007 If Param = "" Then Err.Raise 53
3008 On Error GoTo 0
3009 Do
3010     If InStr(1, Param, "%mpq", 1) Then
3011         bNum = InStr(1, Param, "%mpq", 1)
3012         Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
3013     End If
3014 Loop While InStr(1, Param, "%mpq", 1)
3015 NewParam = Param
3016 On Error GoTo NotSelected
3017 List.SelectedItem.Tag = List.SelectedItem.Tag
3018 On Error GoTo 0
3019 If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
3020 NotSelected:
3021 If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
3022     Path = App.Path
3023     If Right(Path, 1) <> "\" Then Path = Path + "\"
3024     Path = Path + "Temp_extract\"
3025     If ExtractPathNum = -1 Then
3026         fNum = 0
3027         Do
3028         If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
3029         fNum = fNum + 1
3030         Loop
3031         ExtractPathNum = fNum
3032     End If
3033     Path = Path + CStr(ExtractPathNum) + "\"
3034     If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
3035     For fNum = 1 To List.ListItems.Count
3036         If List.ListItems.Item(fNum).Selected Then
3037             StatBar.Style = 1
3038             StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
3039             MousePointer = 11
3040             SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
3041             sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
3042             SFileSetLocale LocaleID
3043             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
3044                 For bNum = 1 To UBound(OpenFiles)
3045                     If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
3046                         AlreadyInList = True
3047                         If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3048                         Exit For
3049                     End If
3050                 Next bNum
3051                 If AlreadyInList = False Then
3052                     ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
3053                     OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
3054                     If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3055                 End If
3056             End If
3057             StatBar.Style = 1
3058             StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
3059             FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
3060             UseFile = True
3061             Param = NewParam
3062             Do
3063                 If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
3064                     If FileName <> "" Then
3065                         Param = Param + " " + FileName
3066                     End If
3067                 ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
3068                     bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
3069                     If FileName <> "" Then
3070                         Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
3071                     Else
3072                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
3073                     End If
3074                 ElseIf InStr(Param, "%1") Then
3075                     bNum = InStr(Param, "%1")
3076                     If FileName <> "" Then
3077                         Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
3078                     Else
3079                         Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
3080                     End If
3081                 End If
3082             Loop While InStr(Param, "%1")
3083             On Error GoTo NoProgram
3084             Shell Param, 1
3085             On Error GoTo 0
3086             If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
3087         End If
3088     Next fNum
3089     SFileCloseArchive hMPQ
3090 ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
3091     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3092     On Error GoTo NoProgram
3093     Shell Param, 1
3094     On Error GoTo 0
3095     Timer1.Enabled = True
3096 Else
3097     MsgBox "No files are selected.", , "WinMPQ"
3098 End If
3099 If FileName <> "" Then
3100     StatBar.Style = 0
3101     StatBar.SimpleText = ""
3102     MousePointer = 0
3103 End If
3104 Exit Sub
3105 NoProgram:
3106 If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
3107 End Sub
3108
3109 Private Sub mnuTMpqEmbed_Click()
3110 frmMpq.Show
3111 End Sub
3112 Private Sub Timer1_Timer()
3113 Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
3114 If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
3115 Path = App.Path
3116 If Right(Path, 1) <> "\" Then Path = Path + "\"
3117 Path = Path + "Temp_extract\"
3118 Path = Path + CStr(ExtractPathNum) + "\"
3119 For fNum = 1 To UBound(OpenFiles)
3120     If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3121         If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
3122             If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
3123                 result = vbYes
3124             Else
3125             result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
3126             End If
3127             If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3128                 OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
3129                 If result = vbYes Then
3130                     List.Sorted = False
3131                     StatBar.Style = 1
3132                     StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
3133                     MousePointer = 11
3134                     dwFlags = MAFA_REPLACE_EXISTING
3135                     If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
3136                     hMPQ = mOpenMpq(CD.FileName)
3137                     If hMPQ Then
3138                         If mnuMCNone.Checked Then
3139                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
3140                         ElseIf mnuMCStandard.Checked Then
3141                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
3142                         ElseIf mnuMCDeflate.Checked Then
3143                             MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
3144                         ElseIf mnuMCAMedium.Checked Then
3145                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
3146                         ElseIf mnuMCAHighest.Checked Then
3147                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
3148                         ElseIf mnuMCALowest.Checked Then
3149                             MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
3150                         ElseIf mnuMCAuto.Checked Then
3151                             mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
3152                         End If
3153                     End If
3154                     MpqAddToListing hMPQ, OpenFiles(fNum)
3155                     MpqCloseUpdatedArchive hMPQ, 0
3156                     If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3157                     StatBar.Style = 0
3158                     StatBar.SimpleText = ""
3159                     MousePointer = 0
3160                     List.Sorted = True
3161                     RemoveDuplicates
3162                     ShowTotal
3163                 End If
3164             End If
3165         End If
3166     Else
3167         For bNum = fNum To UBound(OpenFiles) - 1
3168             OpenFiles(bNum) = OpenFiles(bNum + 1)
3169             OpenFileDates(bNum) = OpenFileDates(bNum + 1)
3170         Next bNum
3171         ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
3172         fNum = fNum - 1
3173         If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
3174     End If
3175     If fNum >= UBound(OpenFiles) Then Exit For
3176 Next fNum
3177 If FileExists(CD.FileName) Then
3178     If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
3179 Else
3180     OpenMpq
3181 End If
3182 End Sub
3183 Private Sub Toolbar_ButtonClick(ByVal Button As Button)
3184 Select Case Button.Key
3185 Case "New"
3186     mnuFNew_Click
3187 Case "Open"
3188     mnuFOpen_Click
3189 Case "Add"
3190     mnuMAdd_Click
3191 Case "Add Folder"
3192     mnuMAddFolder_Click
3193 Case "Extract"
3194     mnuMExtract_Click
3195 Case "Compact"
3196     mnuMCompact_Click
3197 Case "List"
3198     If NewFile = False Then OpenMpq
3199 End Select
3200 End Sub
3201 Private Sub txtCommand_GotFocus()
3202 cmdGo.Default = True
3203 txtCommandHasFocus = True
3204 StatBar.Style = 1
3205 StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
3206 End Sub
3207 Private Sub txtCommand_LostFocus()
3208 cmdGo.Default = False
3209 txtCommandHasFocus = False
3210 StatBar.Style = 0
3211 StatBar.SimpleText = ""
3212 End Sub