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