listing.frm

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