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