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