Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 4121 lines (3911 sloc) 180 KB
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form frmRead
Caption = "FFXI Parser 3.6.0"
ClientHeight = 5760
ClientLeft = 60
ClientTop = 450
ClientWidth = 7350
Icon = "frmReadnew.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5760
ScaleWidth = 7350
StartUpPosition = 3 'Windows Default
Begin RichTextLib.RichTextBox RTB_Fish
Height = 4650
Left = 90
TabIndex = 36
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 405
Visible = 0 'False
Width = 7170
_ExtentX = 12647
_ExtentY = 8202
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":1E72
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame frameChat
BorderStyle = 0 'None
Height = 4650
Left = 90
TabIndex = 28
Top = 405
Visible = 0 'False
Width = 7215
Begin VB.OptionButton optionChat
Caption = "All"
Height = 240
Index = 5
Left = 3825
TabIndex = 35
Top = 45
Width = 1005
End
Begin VB.OptionButton optionChat
Caption = "LinkShell"
Height = 240
Index = 4
Left = 2835
TabIndex = 34
Top = 45
Width = 1005
End
Begin VB.OptionButton optionChat
Caption = "Party"
Height = 240
Index = 3
Left = 2115
TabIndex = 33
Top = 45
Width = 690
End
Begin VB.OptionButton optionChat
Caption = "Tell"
Height = 240
Index = 2
Left = 1440
TabIndex = 32
Top = 45
Width = 690
End
Begin VB.OptionButton optionChat
Caption = "Shout"
Height = 240
Index = 1
Left = 630
TabIndex = 31
Top = 45
Width = 825
End
Begin VB.OptionButton optionChat
Caption = "Say"
Height = 240
Index = 0
Left = 0
TabIndex = 30
Top = 45
Width = 690
End
Begin RichTextLib.RichTextBox RTB_Chat
Height = 4290
Left = 0
TabIndex = 29
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 315
Width = 7170
_ExtentX = 12647
_ExtentY = 7567
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":1EE9
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin VB.ComboBox comboUser
Height = 315
ItemData = "frmReadnew.frx":1F69
Left = 1800
List = "frmReadnew.frx":1F7F
Style = 2 'Dropdown List
TabIndex = 15
Top = 5085
Width = 1095
End
Begin VB.OptionButton optionResults
Height = 195
Index = 0
Left = 90
TabIndex = 12
ToolTipText = "Double click / Right click"
Top = 5130
Value = -1 'True
Width = 240
End
Begin VB.ComboBox comboDisplay
Height = 315
ItemData = "frmReadnew.frx":1FBF
Left = 360
List = "frmReadnew.frx":1FD8
Style = 2 'Dropdown List
TabIndex = 10
Top = 5085
Width = 1095
End
Begin VB.OptionButton optionResults
Height = 195
Index = 1
Left = 1530
TabIndex = 9
Top = 5145
Width = 240
End
Begin MSComDlg.CommonDialog CD_Save
Left = 45
Top = 135
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComDlg.CommonDialog CD1
Left = 4455
Top = 405
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Timer timerRead
Enabled = 0 'False
Interval = 5000
Left = 4995
Top = 450
End
Begin VB.CommandButton cmdOpen
Caption = "Start"
Height = 330
Left = 90
TabIndex = 0
Top = 45
Width = 1005
End
Begin VB.FileListBox fileList
Height = 1455
Left = 90
Pattern = "*.log"
TabIndex = 3
Top = 2385
Visible = 0 'False
Width = 1275
End
Begin VB.ListBox fileListBox
Height = 2595
Left = 90
Sorted = -1 'True
TabIndex = 2
Top = 5760
Visible = 0 'False
Width = 7170
End
Begin VB.DirListBox dirList
Height = 1890
Left = 90
TabIndex = 1
Top = 405
Visible = 0 'False
Width = 2805
End
Begin VB.CommandButton cmdOptions
Caption = "Options"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6390
TabIndex = 6
Top = 5085
Width = 870
End
Begin InetCtlsObjects.Inet inet
Left = 6615
Top = 720
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
Protocol = 4
URL = "http://"
End
Begin RichTextLib.RichTextBox RTB_Details
Height = 4650
Left = 90
TabIndex = 14
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 405
Visible = 0 'False
Width = 7170
_ExtentX = 12647
_ExtentY = 8202
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":2012
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin RichTextLib.RichTextBox RTB_Averages
Height = 4650
Left = 90
TabIndex = 11
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 405
Visible = 0 'False
Width = 7170
_ExtentX = 12647
_ExtentY = 8202
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":2089
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin RichTextLib.RichTextBox RTB_User
Height = 4650
Left = 90
TabIndex = 8
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 405
Visible = 0 'False
Width = 7170
_ExtentX = 12647
_ExtentY = 8202
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":2100
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin RichTextLib.RichTextBox RTB
Height = 2400
Left = 405
TabIndex = 7
Top = 2025
Visible = 0 'False
Width = 6315
_ExtentX = 11139
_ExtentY = 4233
_Version = 393217
Enabled = -1 'True
TextRTF = $"frmReadnew.frx":2180
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame frameEdit
Height = 4650
Left = 90
TabIndex = 17
Top = 405
Width = 7215
Begin VB.CommandButton cmdExport
Caption = "Export/Recalc"
Enabled = 0 'False
Height = 330
Left = 5130
TabIndex = 27
Top = 540
Width = 1995
End
Begin VB.CommandButton cmdCustom
Caption = "Select"
Height = 330
Left = 5130
TabIndex = 24
Top = 2160
Width = 1995
End
Begin VB.ComboBox comboMOB
Height = 315
ItemData = "frmReadnew.frx":21F7
Left = 5130
List = "frmReadnew.frx":21F9
TabIndex = 23
Text = "Type or select monster"
Top = 1800
Width = 1995
End
Begin VB.CommandButton cmdSelect
Caption = "Select All"
Height = 330
Left = 5130
TabIndex = 21
Top = 1260
Width = 1995
End
Begin VB.CommandButton cmdUnselect
Caption = "Unselect All"
Height = 330
Left = 5130
TabIndex = 20
Top = 900
Width = 1995
End
Begin VB.CommandButton cmdRecalc
Caption = "Recalculate"
Enabled = 0 'False
Height = 330
Left = 5130
TabIndex = 19
Top = 180
Width = 1995
End
Begin VB.ListBox listResults
Height = 3960
Left = 45
MultiSelect = 2 'Extended
TabIndex = 18
Top = 135
Width = 5010
End
Begin VB.Label lblInfo
Alignment = 2 'Center
Caption = "Example: Type ""goblin"" without quotes for all goblins."
ForeColor = &H00C00000&
Height = 600
Index = 1
Left = 5175
TabIndex = 25
Top = 2520
Width = 1905
End
Begin VB.Label lblInfo
Alignment = 2 'Center
Caption = "All log information except battles will be lost if you recalculate."
ForeColor = &H000000C0&
Height = 600
Index = 0
Left = 5175
TabIndex = 22
Top = 3510
Width = 1905
End
End
Begin RichTextLib.RichTextBox RTB_Report
Height = 4560
Left = 90
TabIndex = 37
TabStop = 0 'False
ToolTipText = "Double Click to Save"
Top = 405
Width = 7170
_ExtentX = 12647
_ExtentY = 8043
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ReadOnly = -1 'True
ScrollBars = 3
RightMargin = 1.00000e5
TextRTF = $"frmReadnew.frx":21FB
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label lblAbout
Alignment = 1 'Right Justify
Caption = "About"
BeginProperty Font
Name = "Arial"
Size = 6.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 195
Left = 5805
MouseIcon = "frmReadnew.frx":2272
MousePointer = 99 'Custom
TabIndex = 26
Top = 5145
Width = 510
End
Begin VB.Label lblChange
Caption = "Change"
BeginProperty Font
Name = "Arial"
Size = 6.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 195
Left = 2925
MouseIcon = "frmReadnew.frx":23C4
MousePointer = 99 'Custom
TabIndex = 16
Top = 5145
Width = 510
End
Begin VB.Label lblUpdate
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = " No update available."
BeginProperty Font
Name = "Arial"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Left = 90
TabIndex = 13
Top = 5490
Visible = 0 'False
Width = 7170
End
Begin VB.Label lblStatus
Alignment = 1 'Right Justify
Caption = "Waiting."
Height = 195
Left = 1755
TabIndex = 5
Top = 105
Width = 5460
End
Begin VB.Label Label1
Caption = "Status:"
Height = 195
Left = 1170
TabIndex = 4
Top = 100
Width = 690
End
Begin VB.Shape Shape1
Height = 330
Left = 1125
Top = 45
Width = 6180
End
Begin VB.Menu mnuOptions
Caption = "mnuOptions"
Visible = 0 'False
Begin VB.Menu mnuPlayer
Caption = "Player Damage Only"
Visible = 0 'False
End
Begin VB.Menu mnuMonster
Caption = "Monster Damage Only"
Visible = 0 'False
End
Begin VB.Menu mnuSpacer1
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu mnuReport
Caption = "Report Fields"
End
Begin VB.Menu mnuUser
Caption = "Change User"
End
Begin VB.Menu mnuClear
Caption = "Clear"
End
Begin VB.Menu mnuSpacer2
Caption = "-"
End
Begin VB.Menu mnuUpdate
Caption = "Auto Update Check"
End
Begin VB.Menu mnuTray
Caption = "Show as Tray Icon"
End
End
Begin VB.Menu mnuIcon
Caption = "mnuIcon"
Visible = 0 'False
Begin VB.Menu mnuRestore
Caption = "Restore"
Visible = 0 'False
End
Begin VB.Menu mnuExit
Caption = "Exit"
End
End
End
Attribute VB_Name = "frmRead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DPS(17, 2) As String, Stats(50, 30) As String, Players(50, 4) As String, P1Uses As String, HasErrors As Boolean, FishFound() As String, LootFound() As String, PlayerLoot() As String, CurrentFight As String
Dim SingleUser As String, SingleAcc As Long, SingleLines As Long, SingleHit As Long, SingleMiss As Long, SingleDmg As String, SingleCrit As String, LastLoc As Long, PrevTotalDMG As Long, PrevSwings As Long, PrevTotalTaken As Long, PrevTakenSwings As Long, TotalSwingTaken As Long
Dim SingleUserB As String, SingleAccB As Long, SingleLinesB As Long, SingleHitB As Long, SingleMissB As Long, SingleDmgB As String, SingleCritB As String, LastLocB As Long
Dim ChatText() As String, EffList As String
Dim ReadDPS_Start As Boolean, ReadEXP_Start As Boolean, StopEXP As Boolean, BeginDPS As Boolean
Dim ReadDPS_Stop As Boolean, ReadEXP_Stop As Boolean, StopDPS As Boolean
Dim Read_Start As Boolean, Read_Stop As Boolean
Dim ReadFISH_Start As Boolean, FishHeader As String, FishComment As String
Dim GrandPList(17, 28) As String, MB As Boolean
Dim PList(17, 28) As String, TotalExp As Long, TotalDPS As Long, StartTime As Date, StopTime As Date, StartTimeDPS As Date, StopTimeDPS As Date, FightStartTime As Date, FightStopTime As Date
Dim Prev0 As String, Prev1 As String, Prev2 As String, Prev3 As String, Prev4 As String, Prev5 As String, Prev6 As String, Prev7 As String, Prev8 As String
Dim FoundP1 As Boolean, SkipIt As Boolean
Dim dHigh As Long, dLow As Long, SelStart As Long, ErrorCount As Long, UniqueMOB As Long
Dim ff As Integer, i As Integer, X As Integer, p As Integer, pl As Integer, u As Integer, f As Integer
Dim MyPos As Integer, MyPos2 As Integer, MyPos3 As Integer
Dim CurrentLine As String, NextLine As String, P1Special As String, P1 As String, P1Opp As String, P1Stat As String, P1Takes As String, PartA As String, FightComment As String, SaveFileName As String, NewPlayer As String, MonsterCheck As String
Dim PrevlineA As String, PrevlineB As String, PrevlineC As String, PrevlineD As String, PrevlineE As String, PrevlineF As String
Dim HTMLCode As String, SummaryCode As String
Dim Critical As Boolean, Casts As Boolean
Dim LastItem As String, Updates As String
Private WithEvents tIcon As TrayIcon
Attribute tIcon.VB_VarHelpID = -1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Const SW_SHOWNORMAL = 1
Option Explicit
Private Function ColumnText() As String
ColumnText = ResizePart("Player", 1000)
ColumnText = ColumnText & vbTab & ResizePart("Total", 525)
If ReportOptions(18, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("DMG %", 525)
End If
If ReportOptions(0, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Basic", 525)
End If
If ReportOptions(1, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Skill", 525)
End If
If ReportOptions(2, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Spell", 525)
End If
If ReportOptions(3, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Hi/Lo", 525)
End If
If ReportOptions(4, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Avg", 525)
End If
If ReportOptions(5, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Crit %", 525)
End If
If ReportOptions(6, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Crit #", 525)
End If
If ReportOptions(21, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Effect", 525)
End If
If ReportOptions(22, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("WS #", 525)
End If
If ReportOptions(7, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Hit %", 525)
End If
If ReportOptions(8, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Hit/Miss", 525)
End If
If ReportOptions(9, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Avd %", 525)
End If
If ReportOptions(10, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Tk/Av", 525)
End If
If ReportOptions(11, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Evade", 525)
End If
If ReportOptions(12, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Parry", 525)
End If
If ReportOptions(13, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Block", 525)
End If
If ReportOptions(14, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Absorb", 525)
End If
If ReportOptions(15, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Avoid", 525)
End If
If ReportOptions(20, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Anti", 525)
End If
If ReportOptions(23, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Cnter", 525)
End If
If ReportOptions(16, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Taken", 525)
End If
If ReportOptions(17, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Rcver", 525)
End If
If ReportOptions(19, 0) = 1 Then
ColumnText = ColumnText & vbTab & ResizePart("Heal", 525)
End If
ColumnText = ColumnText & vbTab
End Function
Private Sub FishRPT()
Dim lf, MyPos, AddLoot As String
If FishFound(0) <> "" Then
If FishHeader = "" Then FishHeader = "Unknown Time"
RTB_Fish.SelBold = True
RTB_Fish.SelText = FishHeader & vbNewLine
RTB_Fish.SelBold = False
For lf = 0 To UBound(FishFound)
RTB_Fish.SelBold = False
If FishFound(lf) <> "" Then
' If InStr(1, LCase(FishFound(lf)), " - catches lost") = 0 And InStr(1, LCase(FishFound(lf)), " - didn't catch") = 0 Then
' AddLoot = Replace(Replace(FishFound(lf), "a ", ""), "an ", "") & "s"
' MyPos = InStr(1, AddLoot, " - ")
' AddLoot = Left$(AddLoot, MyPos - 1) & " - " & UCase(Mid$(AddLoot, MyPos + 3, 1)) & Mid$(AddLoot, MyPos + 4)
' RTB_Fish.SelBold = False
' RTB_Fish.SelColor = vbBlack
' RTB_Fish.SelText = vbTab & AddLoot & vbNewLine
' Else
AddLoot = FishFound(lf)
MyPos = InStr(1, AddLoot, " - ")
AddLoot = Left$(AddLoot, MyPos - 1) & " - " & UCase(Mid$(AddLoot, MyPos + 3, 1)) & Mid$(AddLoot, MyPos + 4)
RTB_Fish.SelBold = False
RTB_Fish.SelColor = vbBlack
RTB_Fish.SelText = vbTab & AddLoot & vbNewLine
' End If
End If
Next
If FishComment <> "" Then
RTB_Fish.SelBold = False
RTB_Fish.SelColor = vbBlack
RTB_Fish.SelText = vbTab & "Comment: " & FishComment
FishComment = ""
End If
RTB_Fish.SelText = vbNewLine & vbNewLine
End If
End Sub
Private Function HTMLCodeHeader() As String
HTMLCodeHeader = ""
HTMLCodeHeader = HTMLCodeHeader & "<TR style=""FONT-WEIGHT:bold;BACKGROUND-COLOR:#b8ced9"">"
HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=75></TD>"
If ExportOptions(0, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Basic</TD>"
If ExportOptions(1, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Skill</TD>"
If ExportOptions(2, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Spell</TD>"
If ExportOptions(21, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Effects</TD>"
If ExportOptions(22, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>WS #</TD>"
If ExportOptions(3, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>High/Low</TD>"
If ExportOptions(4, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Average</TD>"
If ExportOptions(5, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Crit %</TD>"
If ExportOptions(6, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Crits</TD>"
If ExportOptions(7, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Hit %</TD>"
If ExportOptions(8, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Hit/Miss</TD>"
If ExportOptions(9, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Avoid %</TD>"
If ExportOptions(10, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Take/Avoid</TD>"
If ExportOptions(11, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Evades</TD>"
If ExportOptions(12, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Parries</TD>"
If ExportOptions(13, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Blocks</TD>"
If ExportOptions(23, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Counters</TD>"
If ExportOptions(20, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Anticipates</TD>"
If ExportOptions(14, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Absorbs</TD>"
If ExportOptions(15, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=50>Avoids</TD>"
If ExportOptions(16, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=75>DMG Taken</TD>"
If ExportOptions(17, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=75>HP Rec'd</TD>"
If ExportOptions(19, 0) = 1 Then HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=75>HP Healed</TD>"
HTMLCodeHeader = HTMLCodeHeader & "<TD WIDTH=75>TTL DMG</TD></TR>" & vbNewLine
End Function
Private Sub NewStatsArray(Location As Integer, Amt As Long)
Dim i
For i = 0 To Amt
If i <> 10 And i <> 11 And i <> 12 And i <> 13 Then
Stats(Location, i) = "0"
End If
Next
End Sub
Public Sub ParseLog(FullFile() As String, CustomMode As Boolean, GenerateHTML As Boolean)
On Error GoTo err_handler
Dim ExpLine As Long, ExpGain As String, LineType As String, ExpChecks As Long, AvgAcc As String, CustomAdd As Boolean, PrevLoot As Boolean, PrevFish As Boolean, StatClear As Integer, TotalSeconds As String
Dim AddMOB As Boolean, lf, LootItem As String, FishItem As String, GilAmt As Long, TotalBase As Long, TotalSkill As Long, TotalSpell As Long, TotalTaken As Long, TotalHP As Long, TotalHPH As Long, TotalDMG As Long, TotalHit As Long, TotalSwing As Long, PrevUseType As String, PreP1 As String, TotalEffect As Long, HTMLCodeNew As String, LootPlayer As String, dp, EstDPS As String
Dim Part(25) As String, Parts As Integer, CurrentSel As String, LastPlayer As Boolean
If CustomMode = False Then
Dim EditFile
EditFile = FreeFile
Open App.Path & "\EditFile.log" For Append As #EditFile
End If
For ff = 0 To UBound(FullFile)
If Len(CurrentLine) > 10 Then
PrevlineF = PrevlineE
PrevlineE = PrevlineD
PrevlineD = PrevlineC
PrevlineC = PrevlineB
PrevlineB = PrevlineA
PrevlineA = CurrentLine
End If
CurrentLine = FullFile(ff)
If ff + 1 <= UBound(FullFile) Then
NextLine = FullFile(ff + 1)
Else
NextLine = ""
End If
LineType = Trim(Right(CurrentLine, 3))
If Left$(NextLine, 2) <> "" And IsNumeric(Left$(NextLine, 1)) = False And Len(NextLine) <> 2 And Trim(NextLine) <> "" Then
CurrentLine = CurrentLine & ", " & NextLine
If ff + 1 <= UBound(FullFile) Then
ff = ff + 1
End If
End If
'MISS/BLOCK/PARRY/ABSORB/EVADE/ANTI
If (InStr(1, CurrentLine, " anticipates the attack.") <> 0 Or InStr(1, CurrentLine, " evades.") <> 0 Or InStr(1, CurrentLine, " absorbs the damage and ") <> 0 Or InStr(1, CurrentLine, " blocks ") <> 0 Or InStr(1, CurrentLine, " parries ") <> 0 Or InStr(1, CurrentLine, " misses ") <> 0 Or InStr(1, CurrentLine, " miss ") <> 0 Or InStr(1, CurrentLine, " misses.") <> 0) And InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06,0f", LineType) = 0 Then
P1Special = ""
FoundP1 = False
MyPos = InStr(1, CurrentLine, " misses ")
If InStr(1, CurrentLine, " misses ") Then
MyPos = InStr(1, CurrentLine, " misses ")
ElseIf InStr(1, CurrentLine, " parries ") Then
MyPos = InStr(1, CurrentLine, " parries ")
ElseIf InStr(1, CurrentLine, " blocks ") Then
MyPos = InStr(1, CurrentLine, " blocks ")
ElseIf InStr(1, CurrentLine, " absorbs ") Then
MyPos = InStr(1, CurrentLine, " shadow absorbs ")
ElseIf InStr(1, CurrentLine, " anticipates ") Then
MyPos = InStr(1, CurrentLine, " anticipates ")
ElseIf InStr(1, CurrentLine, " ranged attack misses.") Then
MyPos = InStr(1, CurrentLine, " ranged attack misses.")
ElseIf InStr(1, CurrentLine, " evades.") Then
MyPos = InStr(1, CurrentLine, " evades.")
ElseIf MyPos = 0 Then
MyPos = InStr(1, CurrentLine, " miss ")
End If
If InStr(1, CurrentLine, " uses ") Then
MyPos = InStr(1, CurrentLine, " uses ")
End If
P1 = Mid$(CurrentLine, 3, MyPos - 3)
If InStr(1, CurrentLine, " uses ") Then P1Uses = P1
If InStr(1, CurrentLine, " misses ") Then
MyPos = MyPos + 8
ElseIf InStr(1, CurrentLine, " miss ") Then
MyPos = MyPos + 6
ElseIf InStr(1, CurrentLine, " parries ") Then
MyPos = MyPos + 9
ElseIf InStr(1, CurrentLine, " blocks ") Then
MyPos = MyPos + 8
ElseIf InStr(1, CurrentLine, " shadow absorbs ") Then
MyPos = MyPos + 16
ElseIf InStr(1, CurrentLine, " anticipates ") Then
MyPos = MyPos + 13
ElseIf InStr(1, CurrentLine, " ranged attack misses.") Then
MyPos = MyPos + 22
ElseIf InStr(1, CurrentLine, " evades.") Then
MyPos = MyPos + 9
End If
P1 = Replace(P1, "'s", "")
If InStr(1, CurrentLine, " misses.") = 0 And InStr(1, CurrentLine, ", but") = 0 And InStr(1, CurrentLine, " parries ") = 0 And InStr(1, CurrentLine, " blocks ") = 0 And InStr(1, CurrentLine, " absorbs the damage and ") = 0 And InStr(1, CurrentLine, " evades.") = 0 And InStr(1, CurrentLine, " anticipates the attack.") = 0 Then
MyPos2 = InStr(1, CurrentLine, ".")
P1Opp = Mid$(CurrentLine, MyPos, MyPos2 - MyPos)
ElseIf InStr(1, CurrentLine, " misses.") = 0 And InStr(1, CurrentLine, " parries ") = 0 And InStr(1, CurrentLine, " blocks ") = 0 And InStr(1, CurrentLine, " absorbs the damage and ") = 0 And InStr(1, CurrentLine, " evades.") = 0 And InStr(1, CurrentLine, " anticipates the attack.") = 0 Then
MyPos = InStr(1, CurrentLine, ", but misses ")
MyPos2 = InStr(1, CurrentLine, ".")
P1Opp = Replace(Mid$(CurrentLine, MyPos + 13, MyPos2 - (MyPos + 13)), "the ", "The ")
ElseIf InStr(1, CurrentLine, " parries ") Or InStr(1, CurrentLine, " blocks ") Then
MyPos2 = InStr(1, CurrentLine, "attack ")
P1Opp = Mid$(CurrentLine, MyPos, MyPos2 - MyPos)
ElseIf Mid$(CurrentLine, 3, 4) <> "The " Then
P1Opp = CurrentFight
Else
P1Opp = ""
End If
P1Opp = Replace(P1Opp, "the ", "The ")
If InStr(1, P1, "'s") Then P1 = Trim(Replace(P1, "'s", ""))
If InStr(1, P1Opp, "'s") Then P1Opp = Trim(Replace(P1Opp, "'s", ""))
If InStr(1, CurrentLine, " absorbs the damage and ") Or InStr(1, CurrentLine, " evades.") Or InStr(1, CurrentLine, " blocks ") Or InStr(1, CurrentLine, " parries ") Or InStr(1, CurrentLine, " anticipates the attack.") Then
PreP1 = P1
P1 = P1Opp
P1Opp = PreP1
End If
If P1Opp <> "" And P1 <> "" Then
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1) And LCase(Stats(i, 1)) = LCase(P1Opp) Then
If Stats(i, 3) = "" Then Stats(i, 3) = "0"
Stats(i, 3) = CDbl(Stats(i, 3)) + 1
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1
Stats(i, 1) = P1Opp
Stats(i, 3) = CDbl(Stats(i, 3)) + 1
Exit For
End If
Next
End If
CurrentLine = CurrentLine
FoundP1 = False
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1Opp) And LCase(Stats(i, 1)) = LCase(P1) Then
Stats(i, 15) = CDbl(Stats(i, 15)) + 1
If InStr(1, CurrentLine, " evades.") Then
Stats(i, 21) = CDbl(Stats(i, 21)) + 1
ElseIf InStr(1, CurrentLine, " parries ") Then
Stats(i, 22) = CDbl(Stats(i, 22)) + 1
ElseIf InStr(1, CurrentLine, " blocks ") Then
Stats(i, 23) = CDbl(Stats(i, 23)) + 1
ElseIf InStr(1, CurrentLine, " absorbs the damage and ") Then
Stats(i, 24) = CDbl(Stats(i, 24)) + 1
ElseIf InStr(1, CurrentLine, " miss") Then
Stats(i, 25) = CDbl(Stats(i, 25)) + 1
ElseIf InStr(1, CurrentLine, " anticipates the attack.") Then
Stats(i, 27) = CDbl(Stats(i, 27)) + 1
End If
FoundP1 = True
Exit For
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1Opp
Stats(i, 1) = P1
Stats(i, 15) = CDbl(Stats(i, 15)) + 1
If InStr(1, CurrentLine, " evades.") Then
Stats(i, 21) = CDbl(Stats(i, 21)) + 1
ElseIf InStr(1, CurrentLine, " parries ") Then
Stats(i, 22) = CDbl(Stats(i, 22)) + 1
ElseIf InStr(1, CurrentLine, " blocks ") Then
Stats(i, 23) = CDbl(Stats(i, 23)) + 1
ElseIf InStr(1, CurrentLine, " absorbs the damage and ") Then
Stats(i, 24) = CDbl(Stats(i, 24)) + 1
ElseIf InStr(1, CurrentLine, " miss") Then
Stats(i, 25) = CDbl(Stats(i, 25)) + 1
ElseIf InStr(1, CurrentLine, " anticipates the attack.") Then
Stats(i, 27) = CDbl(Stats(i, 27)) + 1
End If
Exit For
End If
Next
End If
FoundP1 = False
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
End If
'BASIC/ADDITIONAL/COUTNER
ElseIf (InStr(1, CurrentLine, " counter") <> 0 Or InStr(1, CurrentLine, "Additional effect: ") <> 0 Or InStr(1, CurrentLine, " hits ") <> 0 Or InStr(1, CurrentLine, " hit ") <> 0) And InStr(1, LCase(CurrentLine), " drained ") = 0 And InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06,0f", LineType) = 0 Then
P1Special = ""
FoundP1 = False
MyPos = InStr(1, CurrentLine, " hits ")
If MyPos = 0 Then MyPos = InStr(1, CurrentLine, " hit ")
If InStr(1, LCase(CurrentLine), "ranged attack") Then MyPos = MyPos - 16
If InStr(1, LCase(CurrentLine), "counter") Then MyPos = InStr(1, CurrentLine, "'s attack")
If InStr(1, CurrentLine, "Additional effect: ") = 0 Then P1 = Mid$(CurrentLine, 3, MyPos - 3)
If InStr(1, LCase(CurrentLine), "ranged attack") Then MyPos = MyPos + 16
P1 = Replace(P1, "Cover! ", "")
If InStr(1, CurrentLine, " hit ") Then MyPos = MyPos - 1
MyPos2 = InStr(MyPos + 7, CurrentLine, " for ")
PrevlineA = PrevlineA
If InStr(1, CurrentLine, "Additional effect: ") Then
MyPos = InStr(1, CurrentLine, "Additional effect: ") + 19
MyPos2 = InStr(MyPos, CurrentLine, " takes ")
If MyPos2 = 0 Then
P1Opp = CurrentFight
Else
P1Opp = Mid$(CurrentLine, MyPos, MyPos2 - (MyPos))
End If
MyPos3 = InStr(1, CurrentLine, " additional points of ")
If MyPos3 = 0 Then MyPos3 = InStr(1, CurrentLine, " additional point of ")
If MyPos2 <> 0 Then
P1Stat = Mid$(CurrentLine, MyPos2 + 6, MyPos3 - (MyPos2 + 6))
Else
MyPos2 = InStr(MyPos + 1, CurrentLine, " ")
P1Stat = Mid$(CurrentLine, MyPos, MyPos2 - (MyPos))
End If
ElseIf InStr(1, LCase(CurrentLine), "counter") Then
P1Opp = P1
MyPos = InStr(1, CurrentLine, " by ")
MyPos2 = InStr(MyPos, CurrentLine, ".")
P1 = Mid$(CurrentLine, MyPos + 4, MyPos2 - (MyPos + 4))
MyPos2 = InStr(1, CurrentLine, " takes ")
MyPos3 = InStr(1, CurrentLine, " points of ")
P1Stat = Mid$(CurrentLine, MyPos2 + 7, MyPos3 - (MyPos2 + 7))
Else
P1Opp = Mid$(CurrentLine, MyPos + 6, MyPos2 - (MyPos + 6))
MyPos3 = InStr(1, CurrentLine, " points of ")
If MyPos3 = 0 Then MyPos3 = InStr(1, CurrentLine, " point of ")
P1Stat = Mid$(CurrentLine, MyPos2 + 5, MyPos3 - (MyPos2 + 5))
End If
If InStr(1, P1, "'s") Then P1 = Replace(P1, "'s", "")
P1Opp = Replace(P1Opp, "the ", "The ")
If InStr(1, "14,19", Trim(Right$(CurrentLine, 3))) Then
CurrentFight = P1Opp
ElseIf InStr(1, "1c,20", Trim(Right$(CurrentLine, 3))) Then
CurrentFight = P1
End If
If IsNumeric(Trim(P1Stat)) Then
If StopDPS = False And BeginDPS = True Then
If LineType <> "20" And LineType <> "1c" Then
For i = 0 To UBound(DPS)
If LCase(DPS(i, 0)) = LCase(P1) Then
DPS(i, 1) = CDbl(DPS(i, 1)) + CDbl(P1Stat)
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(DPS)
If DPS(i, 0) = "" Then
DPS(i, 0) = P1
DPS(i, 1) = CDbl(P1Stat)
Exit For
End If
Next
End If
FoundP1 = False
End If
End If
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1) And LCase(Stats(i, 1)) = LCase(P1Opp) Then
If InStr(1, CurrentLine, "Additional effect: ") = 0 Then
Stats(i, 2) = CDbl(Stats(i, 2)) + CDbl(P1Stat)
Else
Stats(i, 28) = CDbl(Stats(i, 28)) + CDbl(P1Stat)
End If
If InStr(1, CurrentLine, "Additional effect: ") = 0 Then
Stats(i, 4) = CDbl(Stats(i, 4)) + 1
End If
If InStr(1, LCase(CurrentLine), "counter") Then
Stats(i, 15) = CDbl(Stats(i, 15)) + 1
End If
Stats(i, 9) = CDbl(Stats(i, 9)) + CDbl(P1Stat)
If InStr(1, LCase(CurrentLine), "ranged attack") Then
If Stats(i, 13) = "" Then
Stats(i, 13) = P1Stat
Else
Stats(i, 13) = Stats(i, 13) & ", " & P1Stat
End If
Else
If Stats(i, 10) = "" Then
Stats(i, 10) = P1Stat
Else
Stats(i, 10) = Stats(i, 10) & ", " & P1Stat
End If
End If
If P1Stat > CDbl(Stats(i, 18)) Then
Stats(i, 18) = P1Stat
End If
If P1Stat < CDbl(Stats(i, 19)) Or CDbl(Stats(i, 19)) = 0 Then
Stats(i, 19) = P1Stat
End If
If InStr(1, CurrentLine, " counter") Then
Stats(i, 30) = CDbl(Stats(i, 30)) + 1
End If
FoundP1 = True
Exit For
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1
Stats(i, 1) = P1Opp
Stats(i, 18) = P1Stat
Stats(i, 19) = P1Stat
If InStr(1, CurrentLine, "Additional effect: ") = 0 Then
Stats(i, 2) = CDbl(Stats(i, 2)) + CDbl(P1Stat)
Else
Stats(i, 28) = CDbl(Stats(i, 28)) + CDbl(P1Stat)
End If
If InStr(1, CurrentLine, "Additional effect: ") = 0 Then
Stats(i, 4) = "1"
End If
If InStr(1, CurrentLine, " counter") Then
Stats(i, 30) = "1"
Stats(i, 15) = "1"
End If
Stats(i, 9) = CDbl(Stats(i, 9)) + CDbl(P1Stat)
If InStr(1, LCase(CurrentLine), "ranged attack") Then
Stats(i, 13) = P1Stat
Else
Stats(i, 10) = P1Stat
End If
Exit For
End If
Next
End If
FoundP1 = False
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1Opp) And LCase(Stats(i, 1)) = LCase(P1) Then
Stats(i, 16) = CDbl(Stats(i, 16)) + 1
Stats(i, 17) = CDbl(Stats(i, 17)) + CDbl(P1Stat)
FoundP1 = True
Exit For
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1Opp
Stats(i, 1) = P1
Stats(i, 16) = "1"
Stats(i, 17) = P1Stat
Exit For
End If
Next
End If
FoundP1 = False
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
End If
'SPECIAL/CRIT/SPELL USER
ElseIf (InStr(1, LCase(CurrentLine), " uses ") <> 0 Or InStr(1, LCase(CurrentLine), "s use ") <> 0 Or InStr(1, LCase(CurrentLine), "critical hit!") <> 0 Or InStr(1, LCase(CurrentLine), "skillchain: ") <> 0 Or InStr(1, LCase(CurrentLine), " casts ") <> 0) And InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06,0f", LineType) = 0 Then
PrevUseType = LineType
If InStr(1, LCase(CurrentLine), "critical hit!") Then
Critical = True
Else
Critical = False
End If
If InStr(1, LCase(CurrentLine), " casts ") Then
Casts = True
Else
Casts = False
End If
MyPos = InStr(3, CurrentLine, " uses ")
If InStr(1, LCase(CurrentLine), "s use ") Then
MyPos = InStr(3, CurrentLine, "s use ")
P1Uses = Mid$(CurrentLine, 3, MyPos - 2)
ElseIf InStr(1, LCase(CurrentLine), " uses ") Then
MyPos = InStr(3, CurrentLine, " uses ")
P1Uses = Mid$(CurrentLine, 3, MyPos - 3)
MyPos = InStr(1, CurrentLine, ".")
If MyPos = 0 Then
MyPos = InStr(1, CurrentLine, "!")
End If
If MyPos = 0 Then
MyPos = InStrRev(CurrentLine, " ")
End If
P1Special = Mid$(CurrentLine, InStr(1, CurrentLine, " uses ") + 6, MyPos - (InStr(1, CurrentLine, " uses ") + 6))
ElseIf InStr(1, LCase(CurrentLine), " casts ") Then
MyPos = InStr(3, CurrentLine, " casts ")
P1Uses = Mid$(CurrentLine, 3, MyPos - 3)
MyPos = InStr(1, CurrentLine, ".")
If MyPos = 0 Then
MyPos = InStr(1, CurrentLine, "!")
End If
P1Special = Mid$(CurrentLine, InStr(1, CurrentLine, " casts ") + 7, MyPos - (InStr(1, CurrentLine, " casts ") + 7))
ElseIf InStr(1, LCase(CurrentLine), "skillchain: ") Then
MyPos = InStr(3, CurrentLine, ".")
P1Uses = "Skillchain: " & Mid$(CurrentLine, 15, MyPos - 15)
Else
MyPos = InStr(3, CurrentLine, " score")
P1Uses = Mid$(CurrentLine, 3, MyPos - 3)
End If
If InStr(1, P1Uses, "ranged") Then P1Uses = Replace(P1Uses, "'s ranged attack", "")
If InStr(1, P1Uses, "'s") Then P1Uses = Replace(P1Uses, "'s", "")
P1Uses = Replace(P1Uses, "Cover! ", "")
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
'SPECIAL/CRIT/SPELL
ElseIf ((InStr(1, LCase(CurrentLine), " take") <> 0 And InStr(1, LCase(CurrentLine), "damage") <> 0) Or InStr(1, CurrentLine, "HP drained from") <> 0) And InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06,0f", LineType) = 0 And PrevUseType <> "18" Then
If InStr(1, PrevlineA, "cast") = 0 And InStr(1, PrevlineA, "use") = 0 Then
P1Special = ""
End If
FoundP1 = False
If InStr(1, CurrentLine, "drained") Then
MyPos = InStr(3, CurrentLine, " from ")
P1Takes = Mid$(CurrentLine, MyPos + 6, InStr(1, CurrentLine, ".") - (MyPos + 6))
Else
MyPos = InStr(3, CurrentLine, " take")
P1Takes = Mid$(CurrentLine, 3, MyPos - 3)
P1Takes = Replace(P1Takes, "Additional effect: ", "")
End If
If InStr(1, LCase(P1Takes), "magic burst! ") Then
P1Takes = Mid$(P1Takes, 14)
MB = True
Else
MB = False
End If
MyPos3 = InStr(1, CurrentLine, " points of ")
If MyPos3 = 0 Then
MyPos3 = InStr(1, CurrentLine, " point of ")
End If
If InStr(1, CurrentLine, "Additional effect: ") Then
MyPos3 = MyPos3 - 11
P1Uses = P1
End If
If InStr(1, CurrentLine, "drained") Then
MyPos3 = InStr(1, CurrentLine, " HP ")
P1Stat = Mid$(CurrentLine, 3, MyPos3 - 3)
P1Stat = Replace(P1Stat, "Additional effect: ", "")
Else
P1Stat = Mid$(CurrentLine, MyPos + 6, MyPos3 - (MyPos + 6))
End If
If StopDPS = False And BeginDPS = True Then
If LineType <> "20" And LineType <> "1c" Then
For i = 0 To UBound(DPS)
If LCase(DPS(i, 0)) = LCase(P1Uses) Then
DPS(i, 1) = CDbl(DPS(i, 1)) + CDbl(P1Stat)
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(DPS)
If DPS(i, 0) = "" Then
DPS(i, 0) = P1Uses
DPS(i, 1) = CDbl(P1Stat)
Exit For
End If
Next
End If
FoundP1 = False
End If
End If
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1Uses) And LCase(Stats(i, 1)) = LCase(P1Takes) Then
If Casts = False Then
Stats(i, 4) = CDbl(Stats(i, 4)) + 1
End If
If Casts = False And Critical = False Then
Stats(i, 5) = CDbl(Stats(i, 5)) + CDbl(P1Stat)
Stats(i, 29) = CDbl(Stats(i, 29)) + 1
ElseIf Casts = True Then
Stats(i, 6) = CDbl(Stats(i, 6)) + CDbl(P1Stat)
ElseIf Critical = True Then
Stats(i, 7) = CDbl(Stats(i, 7)) + CDbl(P1Stat)
Stats(i, 8) = CDbl(Stats(i, 8)) + 1
End If
Stats(i, 9) = CDbl(Stats(i, 9)) + CDbl(P1Stat)
If Casts = False And Critical = False And P1Special <> "" Then
If Stats(i, 11) = "" Then
Stats(i, 11) = P1Stat & "(" & P1Special & ")"
Else
Stats(i, 11) = Stats(i, 11) & ", " & P1Stat & "(" & P1Special & ")"
End If
ElseIf Critical = False And P1Special <> "" Then
If MB Then
P1Special = P1Special & "-MB"
End If
If Stats(i, 12) = "" Then
Stats(i, 12) = P1Stat & "(" & P1Special & ")"
Else
Stats(i, 12) = Stats(i, 12) & ", " & P1Stat & "(" & P1Special & ")"
End If
Else
If Stats(i, 10) = "" Then
Stats(i, 10) = P1Stat
Else
Stats(i, 10) = Stats(i, 10) & ", " & P1Stat
End If
End If
P1Special = ""
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1Uses
Stats(i, 1) = P1Takes
If Casts = False Then
Stats(i, 4) = "1"
End If
If Casts = False And Critical = False Then
Stats(i, 5) = CDbl(Stats(i, 5)) + CDbl(P1Stat)
Stats(i, 29) = "1"
ElseIf Casts = True Then
Stats(i, 6) = CDbl(Stats(i, 6)) + CDbl(P1Stat)
ElseIf Critical = True Then
Stats(i, 7) = CDbl(Stats(i, 7)) + CDbl(P1Stat)
Stats(i, 8) = CDbl(Stats(i, 8)) + 1
End If
Stats(i, 9) = CDbl(Stats(i, 9)) + CDbl(P1Stat)
If Casts = False And Critical = False And P1Special <> "" Then
Stats(i, 11) = P1Stat & "(" & P1Special & ")"
ElseIf Critical = False And P1Special <> "" Then
Stats(i, 12) = P1Stat & "(" & P1Special & ")"
Else
Stats(i, 10) = P1Stat
End If
P1Special = ""
Exit For
End If
Next
End If
FoundP1 = False
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1Takes) And LCase(Stats(i, 1)) = LCase(P1Uses) Then
Stats(i, 16) = CDbl(Stats(i, 16)) + 1
Stats(i, 17) = CDbl(Stats(i, 17)) + CDbl(P1Stat)
FoundP1 = True
Exit For
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1Takes
Stats(i, 1) = P1Uses
Stats(i, 16) = "1"
Stats(i, 17) = CDbl(P1Stat)
Exit For
End If
Next
End If
FoundP1 = False
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf CurrentFight <> "" And InStr(1, LCase(CurrentLine), " recovers ") <> 0 And InStr(1, CurrentLine, " MP.") = 0 And Mid$(CurrentLine, 3, 1) <> "<" And Mid$(CurrentLine, 3, 1) <> ">" And Mid$(CurrentLine, 3, 1) <> "(" And InStr(1, CurrentLine, " : ") = 0 Then
MyPos = InStr(1, CurrentLine, " recovers ")
MyPos2 = InStr(1, CurrentLine, " HP")
P1Stat = Mid$(CurrentLine, MyPos + 10, MyPos2 - (MyPos + 10))
MyPos = InStr(3, CurrentLine, " recovers ")
P1 = Mid$(CurrentLine, 3, MyPos - 3)
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1) And LCase(Stats(i, 1)) = LCase(CurrentFight) Then
If Stats(i, 14) = "" Then Stats(i, 14) = "0"
Stats(i, 14) = CDbl(Stats(i, 14)) + P1Stat
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1
Stats(i, 1) = CurrentFight
Stats(i, 14) = P1Stat
Exit For
End If
Next
End If
FoundP1 = False
For i = 0 To UBound(Stats)
If LCase(Stats(i, 0)) = LCase(P1Uses) And LCase(Stats(i, 1)) = LCase(CurrentFight) Then
Stats(i, 26) = CDbl(Stats(i, 26)) + P1Stat
FoundP1 = True
End If
Next
If FoundP1 = False Then
For i = 0 To UBound(Stats)
If Stats(i, 0) = "" Then
NewStatsArray i, 30
Stats(i, 0) = P1Uses
Stats(i, 1) = CurrentFight
Stats(i, 26) = P1Stat
Exit For
End If
Next
End If
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
'FINISHED
ElseIf ((InStr(1, LCase(CurrentLine), "falls to the ground") <> 0 Or InStr(1, LCase(CurrentLine), "fall to the ground") <> 0) Or InStr(1, LCase(CurrentLine), "defeats") <> 0) And InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06,0f,2c", LineType) = 0 Then
If InStr(1, LCase(CurrentLine), "defeats") Then
MyPos = InStr(1, CurrentLine, "defeats ")
MyPos2 = InStr(1, CurrentLine, ".")
P1Opp = Mid$(CurrentLine, MyPos + 8, MyPos2 - (MyPos + 8))
Else
MyPos = InStr(1, CurrentLine, "fall")
P1Opp = Mid$(CurrentLine, 3, MyPos - 4)
End If
If CustomMode = True Then
If listResults.Selected(UniqueMOB) = True Then
CustomAdd = True
Else
CustomAdd = False
End If
Else
CustomAdd = True
End If
If CustomAdd Then
For i = 0 To UBound(Stats)
If LCase(Stats(i, 1)) = LCase(P1Opp) Or LCase(Stats(i, 0)) = LCase(P1Opp) Then
If mnuPlayer.Checked = True Then
If InStr(1, Stats(i, 0), " ") = 0 Or InStr(1, Stats(i, 0), "Skillchain") <> 0 Then
SkipIt = False
Else
SkipIt = True
End If
ElseIf mnuMonster.Checked = True Then
If InStr(1, Stats(i, 0), " ") <> 0 And InStr(1, Stats(i, 0), "Skillchain") = 0 Then
SkipIt = False
Else
SkipIt = True
End If
Else
SkipIt = False
End If
If SkipIt = False Then
If LCase(Stats(i, 0)) <> LCase(P1Opp) Then
If Stats(i, 10) = "" And Stats(i, 11) = "" And Stats(i, 12) = "" And Stats(i, 13) = "" Then
Else
With RTB_Details
.SelBold = True
.SelColor = vbBlue
.SelText = Stats(i, 0) & " - " & Stats(i, 1) & vbNewLine
.SelColor = vbBlack
.SelBold = False
If Stats(i, 10) <> "" Then
.SelBold = True
.SelText = vbTab & "Basic Damage: "
.SelBold = False
.SelText = Stats(i, 10) & vbNewLine
End If
If Stats(i, 13) <> "" Then
.SelBold = True
.SelText = vbTab & "Ranged Damage: "
.SelBold = False
.SelText = Stats(i, 13) & vbNewLine
End If
If Stats(i, 11) <> "" Then
.SelBold = True
.SelText = vbTab & "WeaponSkills: "
.SelBold = False
.SelText = Stats(i, 11) & vbNewLine
End If
If Stats(i, 12) <> "" Then
.SelBold = True
.SelText = vbTab & "Spells: "
.SelBold = False
.SelText = Stats(i, 12) & vbNewLine
End If
.SelBold = True
.SelText = vbTab & "Total Damage: "
.SelBold = False
.SelColor = vbRed
.SelText = Stats(i, 9) & vbNewLine
.SelColor = vbBlack
.SelText = vbNewLine
End With
End If
End If
End If
If (InStr(1, Stats(i, 0), " ") = 0 Or InStr(1, Stats(i, 0), "Skillchain") <> 0) And LCase(Stats(i, 0)) <> LCase(P1Opp) Then
TotalDMG = CDbl(TotalDMG) + CDbl(Stats(i, 9))
TotalHit = CDbl(TotalHit) + CDbl(Stats(i, 4))
TotalSwing = CDbl(TotalSwing) + CDbl(Stats(i, 3)) + CDbl(Stats(i, 4))
TotalSwingTaken = CDbl(TotalSwingTaken) + CDbl(Stats(i, 15)) + CDbl(Stats(i, 16))
TotalBase = TotalBase + CDbl(Stats(i, 2)) + CDbl(Stats(i, 7))
TotalSpell = TotalSpell + CDbl(Stats(i, 6))
TotalSkill = TotalSkill + CDbl(Stats(i, 5))
TotalTaken = TotalTaken + CDbl(Stats(i, 17))
TotalEffect = TotalEffect + CDbl(Stats(i, 28))
TotalHP = TotalHP + CDbl(Stats(i, 14))
TotalHPH = TotalHPH + CDbl(Stats(i, 26))
For p = 0 To UBound(PList)
If PList(p, 0) = "" Then
PList(p, 0) = Stats(i, 0)
Do Until Len(PList(p, 0)) >= 25
PList(p, 0) = PList(p, 0) & " "
Loop
PList(p, 1) = Stats(i, 9)
PList(p, 4) = Stats(i, 4)
PList(p, 5) = CDbl(Stats(i, 3)) + CDbl(Stats(i, 4))
PList(p, 6) = Stats(i, 3)
PList(p, 7) = Stats(i, 8)
PList(p, 8) = Stats(i, 10)
PList(p, 9) = Stats(i, 2)
PList(p, 10) = Stats(i, 7)
PList(p, 11) = Stats(i, 5)
PList(p, 12) = Stats(i, 6)
PList(p, 13) = Stats(i, 14)
PList(p, 14) = Stats(i, 15)
PList(p, 15) = Stats(i, 16)
PList(p, 16) = Stats(i, 17)
PList(p, 17) = Stats(i, 18)
PList(p, 18) = Stats(i, 19)
PList(p, 19) = Stats(i, 21)
PList(p, 20) = Stats(i, 22)
PList(p, 21) = Stats(i, 23)
PList(p, 22) = Stats(i, 24)
PList(p, 23) = Stats(i, 25)
PList(p, 24) = Stats(i, 26)
PList(p, 25) = Stats(i, 27)
PList(p, 26) = Stats(i, 28)
PList(p, 27) = Stats(i, 29)
PList(p, 28) = Stats(i, 30)
If InStr(1, PList(p, 0), "Skillchain: ") = 0 Then
If CDbl(Stats(i, 9)) > dHigh Then
dHigh = CDbl(Stats(i, 9))
End If
If CDbl(Stats(i, 9)) < dLow And CDbl(Stats(i, 9)) <> 0 Then
dLow = CDbl(Stats(i, 9))
End If
End If
Exit For
End If
Next
FoundP1 = False
For p = 0 To UBound(GrandPList)
If Trim(GrandPList(p, 0)) = Trim(Stats(i, 0)) Then
FoundP1 = True
GrandPList(p, 1) = CDbl(GrandPList(p, 1)) + CDbl(Stats(i, 9))
GrandPList(p, 4) = CDbl(GrandPList(p, 4)) + CDbl(Stats(i, 4))
GrandPList(p, 5) = CDbl(GrandPList(p, 5)) + CDbl(Stats(i, 3)) + CDbl(Stats(i, 4))
GrandPList(p, 6) = CDbl(GrandPList(p, 6)) + CDbl(Stats(i, 3))
GrandPList(p, 7) = CDbl(GrandPList(p, 7)) + CDbl(Stats(i, 8))
GrandPList(p, 9) = CDbl(GrandPList(p, 9)) + CDbl(Stats(i, 2))
GrandPList(p, 10) = CDbl(GrandPList(p, 10)) + CDbl(Stats(i, 7))
GrandPList(p, 11) = CDbl(GrandPList(p, 11)) + CDbl(Stats(i, 5))
GrandPList(p, 12) = CDbl(GrandPList(p, 12)) + CDbl(Stats(i, 6))
GrandPList(p, 13) = CDbl(GrandPList(p, 13)) + CDbl(Stats(i, 14))
GrandPList(p, 14) = CDbl(GrandPList(p, 14)) + CDbl(Stats(i, 15))
GrandPList(p, 15) = CDbl(GrandPList(p, 15)) + CDbl(Stats(i, 16))
GrandPList(p, 16) = CDbl(GrandPList(p, 16)) + CDbl(Stats(i, 17))
GrandPList(p, 19) = CDbl(GrandPList(p, 19)) + CDbl(Stats(i, 21))
GrandPList(p, 20) = CDbl(GrandPList(p, 20)) + CDbl(Stats(i, 22))
GrandPList(p, 21) = CDbl(GrandPList(p, 21)) + CDbl(Stats(i, 23))
GrandPList(p, 22) = CDbl(GrandPList(p, 22)) + CDbl(Stats(i, 24))
GrandPList(p, 23) = CDbl(GrandPList(p, 23)) + CDbl(Stats(i, 25))
GrandPList(p, 24) = CDbl(GrandPList(p, 24)) + CDbl(Stats(i, 26))
GrandPList(p, 25) = CDbl(GrandPList(p, 25)) + CDbl(Stats(i, 27))
GrandPList(p, 26) = CDbl(GrandPList(p, 26)) + CDbl(Stats(i, 28))
GrandPList(p, 27) = CDbl(GrandPList(p, 27)) + CDbl(Stats(i, 29))
GrandPList(p, 28) = CDbl(GrandPList(p, 28)) + CDbl(Stats(i, 30))
If CDbl(Stats(i, 18)) > CDbl(GrandPList(p, 17)) Then
GrandPList(p, 17) = CDbl(Stats(i, 18))
End If
If CDbl(Stats(i, 19)) < CDbl(GrandPList(p, 18)) Then
GrandPList(p, 18) = CDbl(Stats(i, 19))
End If
Exit For
End If
Next
If FoundP1 = False Then
For p = 0 To UBound(GrandPList)
If Trim(GrandPList(p, 0)) = "" Then
GrandPList(p, 0) = Stats(i, 0)
GrandPList(p, 1) = Stats(i, 9)
GrandPList(p, 4) = Stats(i, 4)
GrandPList(p, 5) = CDbl(Stats(i, 3)) + CDbl(Stats(i, 4))
GrandPList(p, 6) = Stats(i, 3)
GrandPList(p, 7) = Stats(i, 8)
GrandPList(p, 9) = Stats(i, 2)
GrandPList(p, 10) = Stats(i, 7)
GrandPList(p, 11) = Stats(i, 5)
GrandPList(p, 12) = Stats(i, 6)
GrandPList(p, 13) = Stats(i, 14)
GrandPList(p, 14) = Stats(i, 15)
GrandPList(p, 15) = Stats(i, 16)
GrandPList(p, 16) = Stats(i, 17)
GrandPList(p, 17) = Stats(i, 18)
GrandPList(p, 18) = Stats(i, 19)
GrandPList(p, 19) = Stats(i, 21)
GrandPList(p, 20) = Stats(i, 22)
GrandPList(p, 21) = Stats(i, 23)
GrandPList(p, 22) = Stats(i, 24)
GrandPList(p, 23) = Stats(i, 25)
GrandPList(p, 24) = Stats(i, 26)
GrandPList(p, 25) = Stats(i, 27)
GrandPList(p, 26) = Stats(i, 28)
GrandPList(p, 27) = Stats(i, 29)
GrandPList(p, 28) = Stats(i, 30)
Exit For
End If
Next
End If
End If
For StatClear = 0 To 30
Stats(i, StatClear) = ""
Next
End If
Next
For pl = 0 To UBound(PList)
If PList(pl, 0) <> "" Then
For p = 0 To UBound(Players)
If Players(p, 0) = "" Then
Players(p, 0) = PList(pl, 0)
Players(p, 1) = "1"
Players(p, 2) = PList(pl, 1)
If TotalDMG <> 0 Then Players(p, 3) = (PList(pl, 1) / TotalDMG) * 100
If CDbl(PList(pl, 4)) <> 0 And CDbl(PList(pl, 5)) <> 0 Then
Players(p, 4) = Format(Round((CDbl(PList(pl, 4)) / CDbl(PList(pl, 5))) * 100, 2), "0#.#0")
Else
Players(p, 4) = "00.00"
End If
Exit For
ElseIf Players(p, 0) = PList(pl, 0) Then
Players(p, 1) = Players(p, 1) + 1
Players(p, 2) = CDbl(Players(p, 2)) + CDbl(PList(pl, 1))
If CDbl(PList(pl, 1)) <> 0 Then
Players(p, 3) = CDbl(Players(p, 3)) + CDbl(((CDbl(PList(pl, 1)) / CDbl(TotalDMG)) * 100))
Else
Players(p, 3) = "0"
End If
If CDbl(PList(pl, 4)) <> 0 And CDbl(PList(pl, 5)) <> 0 Then
Players(p, 4) = CDbl(Players(p, 4)) + Format(Round((CDbl(PList(pl, 4)) / CDbl(PList(pl, 5))) * 100, 2), "0#.#0")
End If
Exit For
End If
Next
End If
Next
For p = 0 To UBound(PList)
If PList(p, 0) <> "" Then
If TotalDMG <> 0 Then
PList(p, 2) = Round((CDbl(PList(p, 1)) / TotalDMG) * 100, 2)
Else
PList(p, 2) = 0
End If
If CDbl(PList(p, 1)) = dHigh Then
PList(p, 3) = "H"
ElseIf CDbl(PList(p, 1)) = dLow Then
PList(p, 3) = "L"
End If
Else
Exit For
End If
Next
SelStart = Len(RTB_Report.Text)
If TotalDMG <> 0 Then
ExpLine = ff
Do Until InStr(1, NextLine, "experience points.") <> 0
If ExpLine + 1 <= UBound(FullFile) Then
NextLine = FullFile(ExpLine + 1)
Else
NextLine = ""
Exit Do
End If
ExpChecks = ExpChecks + 1
ExpLine = ExpLine + 1
If ExpChecks > 160 Then
NextLine = ""
Exit Do
End If
Loop
If NextLine <> "" Then
MyPos = InStr(1, NextLine, "gains ")
MyPos2 = InStr(1, NextLine, "exp")
ExpGain = "(" & Mid$(NextLine, MyPos + 6, MyPos2 - (MyPos + 7)) & " exp)"
Else
ExpGain = ""
End If
ExpLine = 0
ExpChecks = 0
With RTB_Report
.SelText = UniqueMOB & " - " & Replace(P1Opp, "the ", "The ") & ExpGain & MonsterCheck & " " & FightComment & vbNewLine
.SelStart = SelStart
.SelLength = Len(UniqueMOB & " - " & Replace(P1Opp, "the ", "The ") & ExpGain & MonsterCheck & " " & FightComment)
.SelBold = True
.SelColor = &H40097
.SelStart = Len(.Text)
.SelColor = vbBlack
.SelBold = True
.SelUnderline = True
.SelText = ColumnText & vbNewLine
.SelUnderline = False
.SelBold = False
.SelStart = Len(.Text)
End With
With RTB_Averages
.Text = ""
.SelBold = True
.SelText = "Experience" & vbNewLine
.SelBold = False
If TotalExp <> 0 And StartTime <> "12:00:00 AM" And StopTime <> "12:00:00 AM" Then
.SelText = "Start: " & StartTime & " / Stop: " & StopTime & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: " & Round(TotalExp / DateDiff("n", StartTime, StopTime), 2) * 60 & vbNewLine & "Per Minute: " & Round(TotalExp / DateDiff("n", StartTime, StopTime), 2) & vbNewLine & vbNewLine
ElseIf TotalExp <> 0 And StartTime <> "12:00:00 AM" Then
.SelText = "Start: " & StartTime & " / Stop: " & Now & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: " & Round(TotalExp / DateDiff("n", StartTime, Now), 2) * 60 & vbNewLine & "Per Minute: " & Round(TotalExp / DateDiff("n", StartTime, Now), 2) & vbNewLine & vbNewLine
Else
.SelText = "Start: " & StartTime & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: 0" & vbNewLine & "Per Minute: 0" & vbNewLine & vbNewLine
End If
End With
For p = 0 To UBound(Players)
If Players(p, 0) <> "" Then
With RTB_Averages
SelStart = Len(.Text)
.SelText = Players(p, 0)
.SelStart = SelStart
.SelLength = Len(Players(p, 0))
.SelBold = True
.SelStart = Len(.Text)
.SelBold = False
AvgAcc = Round(Players(p, 4) / Players(p, 1), 2)
EstDPS = ""
For dp = 0 To UBound(DPS)
If DPS(dp, 0) = Trim(Players(p, 0)) Then
If DPS(dp, 0) <> "" Then
If DPS(dp, 1) <> "0" And DPS(dp, 2) <> "0" And DPS(dp, 2) <> "" And DPS(dp, 1) <> "" Then
EstDPS = Round(DPS(dp, 1) / DPS(dp, 2), 2) & " (" & DPS(dp, 2) & " seconds / " & DPS(dp, 1) & " dmg)"
Else
EstDPS = 0
End If
Exit For
End If
End If
Next
If Players(p, 3) = "0" Or Players(p, 3) = "" Then Players(p, 3) = "1"
If Players(p, 2) = "0" Or Players(p, 2) = "" Then Players(p, 2) = "1"
.SelText = vbNewLine & ResizePart("Total Fights:", 1500) & vbTab & Players(p, 1) & vbNewLine & ResizePart("Average Damage:", 1500) & vbTab & Round(CDbl(Players(p, 2)) / CDbl(Players(p, 1)), 3) & vbNewLine & ResizePart("Average Percent:", 1500) & vbTab & Round(CDbl(Players(p, 3)) / CDbl(Players(p, 1)), 3) & vbNewLine & ResizePart("Average Accuracy:", 1500) & vbTab & AvgAcc & vbNewLine & ResizePart("Estimated DPS:", 1500) & vbTab & EstDPS & vbNewLine & vbNewLine
End With
End If
Next
RTB_Averages.SelStart = 0
LastPlayer = False
For p = 0 To UBound(PList)
If PList(p, 0) <> "" Then
If p = UBound(PList) Then
LastPlayer = True
ElseIf PList(p + 1, 0) = "" Then
LastPlayer = True
End If
SelStart = Len(RTB_Report.Text)
Erase Part
Part(0) = ResizePart(Replace(Trim(PList(p, 0)), "Skillchain: ", "SC: "), 1000)
Part(1) = ResizePart(Trim(PList(p, 1)), 525)
If ReportOptions(18, 0) = 1 Then Part(2) = ResizePart(Replace(Format(PList(p, 2), "0.#0"), "100.00", "100") & "%", 525)
If ReportOptions(0, 0) = 1 Then Part(3) = ResizePart(CDbl(PList(p, 9)) + CDbl(PList(p, 10)), 525)
If ReportOptions(1, 0) = 1 Then Part(4) = ResizePart(PList(p, 11), 525)
If ReportOptions(2, 0) = 1 Then Part(5) = ResizePart(PList(p, 12), 525)
If ReportOptions(3, 0) = 1 Then Part(6) = ResizePart(PList(p, 17) & "/" & PList(p, 18), 525)
If ReportOptions(4, 0) = 1 Then
If PList(p, 4) <> 0 Then
Part(7) = ResizePart(CStr(Round(CDbl(PList(p, 9)) / CDbl(PList(p, 4)), 2)), 525)
Else
Part(7) = ResizePart("0", 525)
End If
End If
If ReportOptions(5, 0) = 1 Then
If PList(p, 7) <> 0 And PList(p, 4) <> 0 Then
Part(8) = ResizePart(CStr(Round((CDbl(PList(p, 7)) / CDbl(PList(p, 4)) * 100), 2)) & "%", 525)
Else
Part(8) = ResizePart("0.00%", 525)
End If
End If
If ReportOptions(6, 0) = 1 Then Part(9) = ResizePart(PList(p, 7), 525)
If ReportOptions(21, 0) = 1 Then Part(10) = ResizePart(PList(p, 26), 525)
If ReportOptions(22, 0) = 1 Then Part(11) = ResizePart(PList(p, 27), 525)
If ReportOptions(7, 0) = 1 Then
If CDbl(PList(p, 4)) <> 0 And CDbl(PList(p, 5)) <> 0 Then
Part(12) = ResizePart(Format(Round((CDbl(PList(p, 4)) / CDbl(PList(p, 5))) * 100, 2), "0.#0") & "% ", 525)
Else
Part(12) = ResizePart("0.00%", 525)
End If
End If
If ReportOptions(8, 0) = 1 Then Part(13) = ResizePart(PList(p, 4) & "/" & PList(p, 6), 525)
If ReportOptions(9, 0) = 1 Then
If CDbl(PList(p, 14)) <> 0 Then
Part(14) = ResizePart(CStr(Round((CDbl(PList(p, 14)) / (CDbl(PList(p, 14)) + CDbl(PList(p, 15))) * 100), 2)) & "%", 525)
Else
Part(14) = ResizePart("0.00%", 525)
End If
End If
If ReportOptions(10, 0) = 1 Then Part(15) = ResizePart(PList(p, 15) & "/" & PList(p, 14), 525)
If ReportOptions(11, 0) = 1 Then Part(16) = ResizePart(PList(p, 19), 525)
If ReportOptions(12, 0) = 1 Then Part(17) = ResizePart(PList(p, 20), 525)
If ReportOptions(13, 0) = 1 Then Part(18) = ResizePart(PList(p, 21), 525)
If ReportOptions(14, 0) = 1 Then Part(19) = ResizePart(PList(p, 22), 525)
If ReportOptions(15, 0) = 1 Then Part(20) = ResizePart(PList(p, 23), 525)
If ReportOptions(20, 0) = 1 Then Part(21) = ResizePart(PList(p, 25), 525)
If ReportOptions(23, 0) = 1 Then Part(22) = ResizePart(PList(p, 28), 525)
If ReportOptions(16, 0) = 1 Then Part(23) = ResizePart(PList(p, 16), 525)
If ReportOptions(17, 0) = 1 Then Part(24) = ResizePart(PList(p, 13), 525)
If ReportOptions(19, 0) = 1 Then Part(25) = ResizePart(PList(p, 24), 525)
CurrentSel = ""
For Parts = 0 To 25
If Part(Parts) <> "" Then
CurrentSel = CurrentSel & Part(Parts) & vbTab
End If
Next
If LastPlayer Then RTB_Report.SelUnderline = True
RTB_Report.SelText = CurrentSel & vbNewLine
RTB_Report.SelUnderline = False
If InStr(1, PList(p, 0), "Skillchain: ") = 0 Then
With RTB_Report
.SelStart = SelStart
.SelLength = Len(CurrentSel)
If PList(p, 3) = "H" Then
.SelColor = vbBlue
ElseIf PList(p, 3) = "L" Then
.SelColor = vbRed
End If
.SelStart = Len(.Text)
End With
End If
'ADD TO SINGLE USER RPT
For u = 0 To UBound(UserLog)
If LCase(Trim(PList(p, 0))) = LCase(Trim(UserLog(u, 0))) Then
If Mid$(UserLog(u, 7), 1, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 1), 10) & vbTab
If Mid$(UserLog(u, 7), 3, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 9), 10) & vbTab
If Mid$(UserLog(u, 7), 5, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 10), 10) & vbTab
If Mid$(UserLog(u, 7), 7, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 11), 10) & vbTab
If Mid$(UserLog(u, 7), 9, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 12), 10) & vbTab
If Mid$(UserLog(u, 7), 11, 1) = "1" Then UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(PList(p, 7), 10) & vbTab
If Mid$(UserLog(u, 7), 13, 1) = "1" Then
PartA = ResizeSimplePart(CStr(PList(p, 4)) & "/" & CStr(PList(p, 6)), 10)
UserLog(u, 1) = UserLog(u, 1) & PartA & vbTab
End If
If CDbl(PList(p, 4)) <> 0 And CDbl(PList(p, 5)) <> 0 Then
If Mid$(UserLog(u, 7), 15, 1) = "1" Then
PartA = ResizeSimplePart(Format(Round((CDbl(PList(p, 4)) / CDbl(PList(p, 5))) * 100, 2), "0#.#0") & "%", 10)
UserLog(u, 1) = UserLog(u, 1) & PartA & vbTab
End If
Else
UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart("0.00%", 10) & vbTab
End If
UserLog(u, 1) = UserLog(u, 1) & ResizeSimplePart(Replace(P1Opp, "the ", "The ") & MonsterCheck, 23)
If Mid$(UserLog(u, 7), 17, 1) = "1" Then
UserLog(u, 1) = UserLog(u, 1) & vbTab & FightComment & vbNewLine
Else
UserLog(u, 1) = UserLog(u, 1) & vbNewLine
End If
UserLog(u, 2) = CDbl(UserLog(u, 2)) + CDbl(PList(p, 1)) 'Total Damage
UserLog(u, 3) = CDbl(UserLog(u, 3)) + CDbl(PList(p, 4)) 'Total Hits
UserLog(u, 4) = CDbl(UserLog(u, 4)) + CDbl(PList(p, 6)) 'Total Misses
UserLog(u, 5) = CDbl(UserLog(u, 5)) + CDbl(PList(p, 7)) 'Total Crits
UserLog(u, 6) = CDbl(UserLog(u, 6)) + 1 'Total Fights
UserLog(u, 8) = CDbl(UserLog(u, 8)) + CDbl(PList(p, 9)) 'Total Base dmg
UserLog(u, 9) = CDbl(UserLog(u, 9)) + CDbl(PList(p, 10)) 'Total Crit dmg
UserLog(u, 10) = CDbl(UserLog(u, 10)) + CDbl(PList(p, 11)) 'Total Skill dmg
UserLog(u, 11) = CDbl(UserLog(u, 11)) + CDbl(PList(p, 12)) 'Total Spell dmg
End If
Next
Else
Exit For
End If
Next
SelStart = Len(RTB_Report.Text)
Erase Part
Part(0) = ResizePart("Totals:", 1000)
Part(1) = ResizePart(CStr(TotalDMG), 525)
If ReportOptions(18, 0) = 1 Then Part(2) = ResizePart("100%", 525)
If ReportOptions(0, 0) = 1 Then Part(3) = ResizePart(CStr(TotalBase), 525)
If ReportOptions(1, 0) = 1 Then Part(4) = ResizePart(CStr(TotalSkill), 525)
If ReportOptions(2, 0) = 1 Then Part(5) = ResizePart(CStr(TotalSpell), 525)
If ReportOptions(3, 0) = 1 Then Part(6) = ResizePart("", 525)
If ReportOptions(4, 0) = 1 Then Part(7) = ResizePart("", 525)
If ReportOptions(5, 0) = 1 Then Part(8) = ResizePart("", 525)
If ReportOptions(6, 0) = 1 Then Part(9) = ResizePart("", 525)
If ReportOptions(21, 0) = 1 Then Part(10) = ResizePart("", 525)
If ReportOptions(22, 0) = 1 Then Part(11) = ResizePart("", 525)
If ReportOptions(7, 0) = 1 Then Part(12) = ResizePart("", 525)
If ReportOptions(8, 0) = 1 Then Part(13) = ResizePart("", 525)
If ReportOptions(9, 0) = 1 Then Part(14) = ResizePart("", 525)
If ReportOptions(10, 0) = 1 Then Part(15) = ResizePart("", 525)
If ReportOptions(11, 0) = 1 Then Part(16) = ResizePart("", 525)
If ReportOptions(12, 0) = 1 Then Part(17) = ResizePart("", 525)
If ReportOptions(13, 0) = 1 Then Part(18) = ResizePart("", 525)
If ReportOptions(14, 0) = 1 Then Part(19) = ResizePart("", 525)
If ReportOptions(15, 0) = 1 Then Part(20) = ResizePart("", 525)
If ReportOptions(20, 0) = 1 Then Part(21) = ResizePart("", 525)
If ReportOptions(23, 0) = 1 Then Part(22) = ResizePart("", 525)
If ReportOptions(16, 0) = 1 Then Part(23) = ResizePart(CStr(TotalTaken), 525)
If ReportOptions(17, 0) = 1 Then Part(24) = ResizePart(CStr(TotalHP), 525)
If ReportOptions(19, 0) = 1 Then Part(25) = ResizePart(CStr(TotalHPH), 525)
CurrentSel = ""
For Parts = 0 To 25
If Part(Parts) <> "" Then
CurrentSel = CurrentSel & Part(Parts) & vbTab
End If
Next
With RTB_Report
.SelText = CurrentSel & vbNewLine & vbNewLine
.SelStart = SelStart
.SelLength = Len(CurrentSel)
.SelBold = True
.SelStart = Len(.Text)
End With
End If
If CustomMode = False Then
For i = 0 To comboMOB.ListCount - 1
If comboMOB.List(i) = Replace(P1Opp, "the ", "The ") Then
AddMOB = False
Exit For
Else
AddMOB = True
End If
Next
If AddMOB Or comboMOB.ListCount = 0 Then
comboMOB.AddItem Replace(P1Opp, "the ", "The ")
End If
If FightComment <> "" Then
listResults.AddItem UniqueMOB & " " & Replace(P1Opp, "the ", "The ") & " (" & TotalDMG & ") - " & FightComment
Else
listResults.AddItem UniqueMOB & " " & Replace(P1Opp, "the ", "The ") & " (" & TotalDMG & ")"
End If
listResults.Selected(listResults.ListCount - 1) = True
Print #EditFile, CurrentLine
End If
Else
For i = 0 To UBound(Stats)
If LCase(Stats(i, 1)) = LCase(P1Opp) Or LCase(Stats(i, 0)) = LCase(P1Opp) Then
If mnuPlayer.Checked = True Then
If InStr(1, Stats(i, 0), " ") = 0 Or InStr(1, Stats(i, 0), "Skillchain") <> 0 Then
SkipIt = False
Else
SkipIt = True
End If
ElseIf mnuMonster.Checked = True Then
If InStr(1, Stats(i, 0), " ") <> 0 And InStr(1, Stats(i, 0), "Skillchain") = 0 Then
SkipIt = False
Else
SkipIt = True
End If
Else
SkipIt = False
End If
If SkipIt = False Then
For StatClear = 0 To 30
Stats(i, StatClear) = ""
Next
End If
End If
Next
End If
If TotalDMG <> 0 And GenerateHTML And ExportOptions(18, 0) = 0 Then
HTMLCodeNew = ""
HTMLCodeNew = HTMLCodeNew & "<CENTER><TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 style=""PADDING-LEFT: 3px;PADDING-RIGHT: 3px;BORDER-COLLAPSE:collapse;font-family:verdana;font-size:7pt;color:black"">" & vbNewLine
HTMLCodeNew = HTMLCodeNew & "<TR><TH colSpan=25 align=""Left"" BGColor=""7CB1CB"">" & Replace(P1Opp, "the ", "The ") & " - (ID: " & UniqueMOB & ")</font></TH></TR>" & vbNewLine
HTMLCodeNew = HTMLCodeHeader
End If
For p = 0 To UBound(PList)
If PList(p, 0) <> "" Then
If GenerateHTML And ExportOptions(18, 0) = 0 Then
HTMLCodeNew = HTMLCodeNew & "<TR style=""BACKGROUND-COLOR:#dae6ec"">" & vbNewLine
HTMLCodeNew = HTMLCodeNew & "<TD BGCOLOR=""#b8ced9""><b>" & Replace(Trim$(PList(p, 0)), "Skillchain: ", "SC:") & "</b></TD>" & vbNewLine 'PLAYER NAME
If ExportOptions(0, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & CDbl(PList(p, 9)) + CDbl(PList(p, 10)) & "</TD>" & vbNewLine 'BASIC DMG
If ExportOptions(1, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 11) & "</TD>" & vbNewLine 'SKILL DMG
If ExportOptions(2, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 12) & "</TD>" & vbNewLine 'SPELL DMG
If ExportOptions(21, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 26) & "</TD>" & vbNewLine 'EFFECT DMG
If ExportOptions(22, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 27) & "</TD>" & vbNewLine 'WS #
If ExportOptions(3, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 17) & "/" & PList(p, 18) & "</TD>" & vbNewLine 'High/Low
If ExportOptions(4, 0) = 1 Then
If PList(p, 5) <> 0 And (CDbl(PList(p, 9)) + CDbl(PList(p, 10))) <> 0 Then 'Average
HTMLCodeNew = HTMLCodeNew & "<TD>" & Round((CDbl(PList(p, 9)) + CDbl(PList(p, 10))) / PList(p, 4), 2) & "</TD>" & vbNewLine
Else
HTMLCodeNew = HTMLCodeNew & "<TD>0</TD>" & vbNewLine
End If
End If
If ExportOptions(5, 0) = 1 Then
If PList(p, 7) <> "0" Then 'CRIT %
HTMLCodeNew = HTMLCodeNew & "<TD>" & Round((CDbl(PList(p, 7)) / CDbl(PList(p, 4))) * 100, 2) & "%</TD>" & vbNewLine
Else
HTMLCodeNew = HTMLCodeNew & "<TD>0%</TD>" & vbNewLine
End If
End If
If ExportOptions(6, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 7) & "</TD>" & vbNewLine 'CRIT COUNT
If ExportOptions(7, 0) = 1 Then
If PList(p, 4) <> "0" Then 'HIT %
HTMLCodeNew = HTMLCodeNew & "<TD>" & Round((CDbl(PList(p, 4)) / CDbl(PList(p, 5))) * 100, 2) & "%</TD>" & vbNewLine
Else
HTMLCodeNew = HTMLCodeNew & "<TD>0%</TD>" & vbNewLine
End If
End If
If ExportOptions(8, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 4) & "/" & PList(p, 6) & "</TD>" & vbNewLine 'HIT/MISS
If ExportOptions(9, 0) = 1 Then
If PList(p, 14) <> "0" Then 'Avoid %
HTMLCodeNew = HTMLCodeNew & "<TD>" & Round((CDbl(PList(p, 14)) / (CDbl(PList(p, 14)) + CDbl(PList(p, 15)))) * 100, 2) & "%</TD>" & vbNewLine
Else
HTMLCodeNew = HTMLCodeNew & "<TD>0%</TD>" & vbNewLine
End If
End If
If ExportOptions(10, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 15) & "/" & PList(p, 14) & "</TD>" & vbNewLine 'TAKE/Avoid
If ExportOptions(11, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 19) & "</TD>" & vbNewLine 'Evades
If ExportOptions(12, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 20) & "</TD>" & vbNewLine 'Parries
If ExportOptions(13, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 21) & "</TD>" & vbNewLine 'Blocks
If ExportOptions(23, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 28) & "</TD>" & vbNewLine 'Counters
If ExportOptions(20, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 25) & "</TD>" & vbNewLine 'Anti
If ExportOptions(14, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 22) & "</TD>" & vbNewLine 'Absorbs
If ExportOptions(15, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 23) & "</TD>" & vbNewLine 'Avoids
If ExportOptions(16, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 16) & "</TD>" & vbNewLine 'DMG TAKEN
If ExportOptions(17, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 13) & "</TD>" & vbNewLine 'HP REC'D
If ExportOptions(19, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD>" & PList(p, 24) & "</TD>" & vbNewLine 'HP Healed
HTMLCodeNew = HTMLCodeNew & "<TD BGCOLOR=""#b8ced9""><B>" & PList(p, 1) & "</b> <FONT style=""font-family:small fonts;font-size:6pt"">(" & PList(p, 2) & "%)</TD></TR>" & vbNewLine 'TOTAL AND % OF DMG
End If
For StatClear = 0 To 28
PList(p, StatClear) = ""
Next
End If
Next
If TotalDMG <> 0 And GenerateHTML And ExportOptions(18, 0) = 0 Then
HTMLCodeNew = HTMLCodeNew & "<TR style=""BACKGROUND-COLOR:#7CB1CB"">" & vbNewLine
HTMLCodeNew = HTMLCodeNew & "<TD><B>Totals</B></TD>" & vbNewLine
If ExportOptions(0, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalBase, "#,###") & "</B> <FONT style=""font-family:small fonts;font-size:6pt""><br>(" & Round((TotalBase / TotalDMG) * 100, 2) & "%)</TD>" & vbNewLine 'TOTAL BASIC
If ExportOptions(1, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalSkill, "#,###") & "</B> <FONT style=""font-family:small fonts;font-size:6pt""><br>(" & Round((TotalSkill / TotalDMG) * 100, 2) & "%)</TD>" & vbNewLine 'TOTAL SKILL
If ExportOptions(2, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalSpell, "#,###") & "</B> <FONT style=""font-family:small fonts;font-size:6pt""><br>(" & Round((TotalSpell / TotalDMG) * 100, 2) & "%)</TD>" & vbNewLine 'TOTAL SPELL
If ExportOptions(21, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalEffect, "#,###") & "</B> <FONT style=""font-family:small fonts;font-size:6pt""><br>(" & Round((TotalEffect / TotalDMG) * 100, 2) & "%)</TD>" & vbNewLine 'EFFECT
If ExportOptions(22, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'WS COUNT
If ExportOptions(3, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'High/Low
If ExportOptions(4, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Average
If ExportOptions(5, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'CRIT %
If ExportOptions(6, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'CRIT COUNT
If ExportOptions(7, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'HIT %
If ExportOptions(8, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'HIT/MISS
If ExportOptions(9, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Avoid %
If ExportOptions(10, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'TAKE/Avoid
If ExportOptions(11, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Evades
If ExportOptions(12, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Parries
If ExportOptions(13, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Blocks
If ExportOptions(23, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Counters
If ExportOptions(20, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Anti
If ExportOptions(14, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Absorbs
If ExportOptions(15, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD></TD>" & vbNewLine 'Avoids
If ExportOptions(16, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalTaken, "#,###") & "</B></TD>" & vbNewLine 'TOTAL TAKEN
If ExportOptions(17, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalHP, "#,###") & "</B></TD>" & vbNewLine 'TOTAL HP REC'D
If ExportOptions(19, 0) = 1 Then HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalHPH, "#,###") & "</B></TD>" & vbNewLine 'TOTAL HP GIVEN
HTMLCodeNew = HTMLCodeNew & "<TD><B>" & Format(TotalDMG, "#,###") & "</B></TD>" & vbNewLine 'TOTAL DMG DEALT
HTMLCodeNew = HTMLCodeNew & "</TR>" & vbNewLine
If FightComment <> "" Then
HTMLCodeNew = HTMLCodeNew & "<TR><TH colSpan=25 align=""Left"" BGColor=""7CB1CB"">Comment: " & FightComment & "</TR>" & vbNewLine
End If
HTMLCodeNew = HTMLCodeNew & "</TABLE><P></CENTER>"
HTMLCode = HTMLCodeNew & HTMLCode
End If
For i = 0 To UBound(Stats)
If Stats(i, 0) <> "" Then
If Stats(i, 20) = "" Then
Stats(i, 20) = "1"
ElseIf CDbl(Stats(i, 20)) < 5 Then
Stats(i, 20) = CDbl(Stats(i, 20)) + 1
Else
For StatClear = 0 To 30
Stats(i, StatClear) = ""
Next
End If
End If
Next
PrevTotalDMG = PrevTotalDMG + TotalDMG
PrevSwings = PrevSwings + TotalSwing
PrevTotalTaken = PrevTotalTaken + TotalTaken
PrevTakenSwings = PrevTakenSwings + TotalSwingTaken
EffList = EffList & CStr(UniqueMOB) & ", "
UniqueMOB = UniqueMOB + 1
TotalSwingTaken = 0
TotalDMG = 0
TotalTaken = 0
TotalHP = 0
TotalHPH = 0
TotalHit = 0
TotalSwing = 0
TotalEffect = 0
dHigh = 0
dLow = 10000
TotalBase = 0
TotalSpell = 0
TotalSkill = 0
FightComment = ""
MonsterCheck = ""
CurrentFight = ""
ElseIf LineType = "bf" Then
If InStr(1, LCase(CurrentLine), "decent") Then
MonsterCheck = "(DC)"
ElseIf InStr(1, LCase(CurrentLine), "very tough") Then
MonsterCheck = "(VT)"
ElseIf InStr(1, LCase(CurrentLine), "incredibly tough") Then
MonsterCheck = "(IT)"
ElseIf InStr(1, LCase(CurrentLine), "tough") Then
MonsterCheck = "(T)"
ElseIf InStr(1, LCase(CurrentLine), "weak") Then
MonsterCheck = "(TW)"
ElseIf InStr(1, LCase(CurrentLine), "easy") Then
MonsterCheck = "(EP)"
ElseIf InStr(1, LCase(CurrentLine), "even") Then
MonsterCheck = "(EM)"
End If
ElseIf InStr(1, "09,0a,01,02,0c,04,0d,05,0e,06", LineType) Then
ChatText(UBound(ChatText)) = CurrentLine
ReDim Preserve ChatText(UBound(ChatText) + 1)
ElseIf (Left$(LCase(CurrentLine), 18) = "parser start dps") Then
ReadDPS_Start = True
BeginDPS = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 18) = "parser start exp") Then
ReadEXP_Start = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 20) = "parser start fight") Then
Read_Start = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 19) = "parser stop fight") Then
Read_Stop = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 17) = "parser stop dps") Then
BeginDPS = False
ReadDPS_Stop = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 18) = "parser clear dps") Then
BeginDPS = False
ReadDPS_Stop = False
ReadDPS_Start = False
Erase DPS
ElseIf (Left$(LCase(CurrentLine), 17) = "parser stop exp") Then
ReadEXP_Stop = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 19) = "parser start fish") Then
FishRPT
Erase FishFound
ReDim FishFound(0)
ReadFISH_Start = True
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 18) = "parser stop fish") Then
FishRPT
Erase FishFound
ReDim FishFound(0)
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf InStr(1, CurrentLine, "Earth:") And LineType = "8c" Then
If Read_Start Then
EffList = ""
PrevTotalDMG = 0
PrevSwings = 0
PrevTotalTaken = 0
PrevTakenSwings = 0
BeginDPS = True
StartTimeDPS = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
ReadDPS_Start = False
StopDPS = False
FightStartTime = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
Read_Start = False
ElseIf Read_Stop Then
BeginDPS = False
StopTimeDPS = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
For i = 0 To UBound(DPS)
If DPS(i, 2) = "" Then DPS(i, 2) = "0"
DPS(i, 2) = CDbl(DPS(i, 2)) + CDbl(DateDiff("s", StartTimeDPS, StopTimeDPS))
DPS(i, 0) = DPS(i, 0)
DPS(i, 1) = DPS(i, 1)
DPS(i, 2) = DPS(i, 2)
Next
ReadDPS_Stop = False
StopDPS = True
FightStopTime = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
With RTB_Report
TotalSeconds = DateDiff("s", FightStartTime, FightStopTime)
.SelStart = Len(.Text) - 2
.SelBold = True
.SelText = vbNewLine & Mid(EffList, 1, Len(EffList) - 2) & " - Efficiency" & vbNewLine
.SelBold = False
.SelColor = &HC00000
.SelText = "Time Taken: "
.SelColor = &HC0&
.SelText = Format(FightStopTime - FightStartTime & vbNewLine, "HH:MM:SS") & vbNewLine
.SelColor = &HC00000
.SelText = "Damage Per Second: "
.SelColor = &HC0&
.SelText = Round(PrevTotalDMG / TotalSeconds, 2) & vbNewLine
.SelColor = &HC00000
.SelText = "Attacks Per Second: "
.SelColor = &HC0&
.SelText = Round(PrevSwings / TotalSeconds, 2) & vbNewLine
.SelColor = &HC00000
.SelText = "Damage Taken Per Second: "
.SelColor = &HC0&
.SelText = Round(PrevTotalTaken / TotalSeconds, 2) & vbNewLine
.SelColor = &HC00000
.SelText = "Attacks Taken Per Second: "
.SelColor = &HC0&
.SelText = Round(PrevTakenSwings / TotalSeconds, 2) & vbNewLine
.SelStart = Len(.Text)
End With
Read_Stop = False
End If
If ReadEXP_Start Then
TotalExp = 0
StartTime = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
ReadEXP_Start = False
StopEXP = False
ElseIf ReadEXP_Stop Then
StopTime = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
ReadEXP_Stop = False
StopEXP = True
End If
If ReadFISH_Start Then
MyPos = InStr(1, PrevlineB, ",")
If MyPos <> 0 Then
FishHeader = Trim(Left(Mid(PrevlineB, MyPos + 2), Len(Mid(PrevlineB, MyPos + 2)) - 2))
FishHeader = FishHeader & " - " & Left(Trim(Mid(PrevlineA, 3)), Len(Trim(Mid(PrevlineA, 3))) - 2)
FishHeader = FishHeader & " - Earth: " & Trim(Mid(CurrentLine, 24, Len(CurrentLine) - 26))
End If
ReadFISH_Start = False
End If
If ReadDPS_Start Then
StartTimeDPS = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
ReadDPS_Start = False
StopDPS = False
ElseIf ReadDPS_Stop Then
StopTimeDPS = Replace(Mid(CurrentLine, 10, Len(CurrentLine) - 13), ".", "")
For i = 0 To UBound(DPS)
If DPS(i, 2) = "" Then DPS(i, 2) = "0"
DPS(i, 2) = CDbl(DPS(i, 2)) + CDbl(DateDiff("s", StartTimeDPS, StopTimeDPS))
DPS(i, 0) = DPS(i, 0)
DPS(i, 1) = DPS(i, 1)
DPS(i, 2) = DPS(i, 2)
Next
ReadDPS_Stop = False
StopDPS = True
End If
If StopEXP Or StopDPS Then
RTB_Averages.Text = ""
RTB_Averages.SelBold = True
RTB_Averages.SelText = "Experience" & vbNewLine
RTB_Averages.SelBold = False
If TotalExp <> 0 And StartTime <> "12:00:00 AM" And StopTime <> "12:00:00 AM" Then
RTB_Averages.SelText = "Start: " & StartTime & " / Stop: " & StopTime & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: " & Round(TotalExp / DateDiff("n", StartTime, StopTime), 2) * 60 & vbNewLine & "Per Minute: " & Round(TotalExp / DateDiff("n", StartTime, StopTime), 2) & vbNewLine & vbNewLine
ElseIf TotalExp <> 0 And StartTime <> "12:00:00 AM" Then
RTB_Averages.SelText = "Start: " & StartTime & " / Stop: " & Now & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: " & Round(TotalExp / DateDiff("n", StartTime, Now), 2) * 60 & vbNewLine & "Per Minute: " & Round(TotalExp / DateDiff("n", StartTime, Now), 2) & vbNewLine & vbNewLine
Else
RTB_Averages.SelText = "Start: " & StartTime & vbNewLine & "Total Exp: " & TotalExp & vbNewLine & "Per Hour: 0" & vbNewLine & "Per Minute: 0" & vbNewLine & vbNewLine
End If
For p = 0 To UBound(Players)
If Players(p, 0) <> "" Then
With RTB_Averages
SelStart = Len(.Text)
.SelText = Players(p, 0)
.SelStart = SelStart
.SelLength = Len(Players(p, 0))
.SelBold = True
.SelStart = Len(.Text)
.SelBold = False
AvgAcc = Round(Players(p, 4) / Players(p, 1), 2)
EstDPS = ""
For dp = 0 To UBound(DPS)
If DPS(dp, 0) = Trim(Players(p, 0)) Then
If DPS(dp, 0) <> "" Then
If DPS(dp, 1) <> "0" And DPS(dp, 2) <> "0" And DPS(dp, 2) <> "" And DPS(dp, 1) <> "" Then
EstDPS = Round(DPS(dp, 1) / DPS(dp, 2), 2) & " (" & DPS(dp, 2) & " seconds / " & DPS(dp, 1) & " dmg)"
Else
EstDPS = 0
End If
Exit For
End If
End If
Next
If Players(p, 3) = "0" Or Players(p, 3) = "" Then Players(p, 3) = "1"
If Players(p, 2) = "0" Or Players(p, 2) = "" Then Players(p, 2) = "1"
.SelText = vbNewLine & ResizePart("Total Fights:", 1500) & vbTab & Players(p, 1) & vbNewLine & ResizePart("Average Damage:", 1500) & vbTab & Round(CDbl(Players(p, 2)) / CDbl(Players(p, 1)), 3) & vbNewLine & ResizePart("Average Percent:", 1500) & vbTab & Round(CDbl(Players(p, 3)) / CDbl(Players(p, 1)), 3) & vbNewLine & ResizePart("Average Accuracy:", 1500) & vbTab & AvgAcc & vbNewLine & ResizePart("Estimated DPS:", 1500) & vbTab & EstDPS & vbNewLine & vbNewLine
End With
'RTB_Averages.SelText = vbNewLine & "Total Fights: " & vbTab & Players(p, 1) & vbNewLine & "Average Damage: " & vbTab & Round(CDbl(Players(p, 2)) / CDbl(Players(p, 1)), 3) & vbNewLine & "Average Percent: " & vbTab & Round(CDbl(Players(p, 3)) / CDbl(Players(p, 1)), 3) & vbNewLine & "Average Accuracy: " & AvgAcc & vbTab & vbNewLine & "Estimated DPS: " & vbTab & EstDPS & vbNewLine & vbNewLine
End If
Next
RTB_Averages.SelStart = 0
End If
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf InStr(1, CurrentLine, "experience points.") And LineType = "79" Then
MyPos = InStr(1, CurrentLine, "gains ")
MyPos2 = InStr(1, CurrentLine, "exp")
If StopEXP = False Then
TotalExp = TotalExp + CDbl(Mid$(CurrentLine, MyPos + 6, MyPos2 - (MyPos + 7)))
End If
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 14) = "parser clear") And CustomMode = False Then
Close #EditFile
ClearEdit = True
mnuClear_Click
CustomMode = False
ClearEdit = False
EditFile = FreeFile
Open App.Path & "\EditFile.log" For Append As #EditFile
ElseIf (Left$(LCase(CurrentLine), 13) = "parser save") Then
MyPos = InStr(1, CurrentLine, ".rtf")
MyPos2 = InStrRev(CurrentLine, " ", MyPos)
SaveFileName = Mid$(CurrentLine, MyPos2 + 1, (MyPos + 4) - (MyPos2 + 1))
If InStr(1, LCase(CurrentLine), "save report") Then
RTB_Report.SaveFile SaveFileName, rtfText
ElseIf InStr(1, LCase(CurrentLine), "save player") Then
If InStr(1, LCase(CurrentLine), "save player1") Then
comboUser.ListIndex = 0
ElseIf InStr(1, LCase(CurrentLine), "save player2") Then
comboUser.ListIndex = 1
ElseIf InStr(1, LCase(CurrentLine), "save player3") Then
comboUser.ListIndex = 2
ElseIf InStr(1, LCase(CurrentLine), "save player4") Then
comboUser.ListIndex = 3
ElseIf InStr(1, LCase(CurrentLine), "save player5") Then
comboUser.ListIndex = 4
ElseIf InStr(1, LCase(CurrentLine), "save player6") Then
comboUser.ListIndex = 5
End If
comboUser_Click
RTB_User.SaveFile SaveFileName, rtfText
ElseIf InStr(1, LCase(CurrentLine), "save summary") Then
RTB_Averages.SaveFile SaveFileName, rtfText
ElseIf InStr(1, LCase(CurrentLine), "save details") Then
RTB_Details.SaveFile SaveFileName, rtfText
End If
ElseIf (Left$(LCase(CurrentLine), 15) = "parser player") Then
MyPos = InStr(1, CurrentLine, "'")
MyPos2 = InStr(MyPos + 1, CurrentLine, "'")
If MyPos <> 0 And MyPos2 <> 0 Then
NewPlayer = Mid$(CurrentLine, MyPos + 1, MyPos2 - (MyPos + 1))
Else
NewPlayer = ""
End If
If Trim(NewPlayer) <> "" Then
If InStr(1, LCase(CurrentLine), "player1") Then
i = 0
comboUser.List(0) = NewPlayer
UserLog(0, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player1", NewPlayer
comboUser.ListIndex = 0
comboUser_Click
ElseIf InStr(1, LCase(CurrentLine), "player2") Then
i = 1
comboUser.List(1) = NewPlayer
UserLog(1, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player2", NewPlayer
comboUser.ListIndex = 1
comboUser_Click
ElseIf InStr(1, LCase(CurrentLine), "player3") Then
i = 2
comboUser.List(2) = NewPlayer
UserLog(2, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player3", NewPlayer
comboUser.ListIndex = 2
comboUser_Click
ElseIf InStr(1, LCase(CurrentLine), "player4") Then
i = 3
comboUser.List(3) = NewPlayer
UserLog(3, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player4", NewPlayer
comboUser.ListIndex = 3
comboUser_Click
ElseIf InStr(1, LCase(CurrentLine), "player5") Then
i = 4
comboUser.List(4) = NewPlayer
UserLog(4, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player5", NewPlayer
comboUser.ListIndex = 4
comboUser_Click
ElseIf InStr(1, LCase(CurrentLine), "player6") Then
i = 5
comboUser.List(5) = NewPlayer
UserLog(5, 0) = NewPlayer
SaveSetting App.Title, "Settings", "Player6", NewPlayer
comboUser.ListIndex = 5
comboUser_Click
End If
comboUser.List(i) = UserLog(i, 0)
UserLog(i, 1) = ""
UserLog(i, 2) = "0"
UserLog(i, 3) = "0"
UserLog(i, 4) = "0"
UserLog(i, 5) = "0"
UserLog(i, 6) = "0"
UserLog(i, 7) = GetSetting(App.Title, "Settings", "PlayerOptions" & i + 1, Default:="1,0,0,0,0,1,1,1,0")
UserLog(i, 8) = "0"
UserLog(i, 9) = "0"
UserLog(i, 10) = "0"
UserLog(i, 11) = "0"
End If
ElseIf (Left$(LCase(CurrentLine), 18) = "parser comment '") Then
MyPos = InStr(1, CurrentLine, "'")
MyPos2 = InStr(MyPos + 1, CurrentLine, "'")
If MyPos2 <> 0 Then
FightComment = Mid$(CurrentLine, MyPos + 1, MyPos2 - (MyPos + 1))
Else
FightComment = "Invalid format."
End If
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(LCase(CurrentLine), 23) = "parser fish comment '") Then
MyPos = InStr(1, CurrentLine, "'")
MyPos2 = InStr(MyPos + 1, CurrentLine, "'")
If MyPos2 <> 0 Then
FishComment = Mid$(CurrentLine, MyPos + 1, MyPos2 - (MyPos + 1))
Else
FishComment = "Invalid format."
End If
If CustomMode = False Then
Print #EditFile, CurrentLine
End If
ElseIf (Left$(CurrentLine, 12) = "yYou find") Then
'LOOT
MyPos = InStr(1, CurrentLine, " ")
MyPos2 = InStr(MyPos + 1, CurrentLine, " ")
LootItem = Mid$(CurrentLine, MyPos + 3, MyPos2 - (MyPos + 3))
PrevLoot = False
For lf = 0 To UBound(LootFound)
If InStr(1, LootFound(lf), LootItem) Then
PrevLoot = True
Exit For
End If
Next
If PrevLoot Then
MyPos = InStr(1, LootFound(lf), " - ")
LootFound(lf) = CDbl(Left$(LootFound(lf), MyPos)) + 1 & " - " & LootItem
Else
LootFound(UBound(LootFound)) = "1 - " & LootItem
ReDim Preserve LootFound(UBound(LootFound) + 1)
End If
ElseIf LineType = "7f" And InStr(1, CurrentLine, " obtains ") And InStr(1, CurrentLine, " gil.") = 0 Then
'PLAYER LOOT
MyPos = InStr(1, CurrentLine, " ")
LootPlayer = Mid(CurrentLine, 5, MyPos - 5)
MyPos = InStr(1, CurrentLine, " ")
MyPos2 = InStr(MyPos + 1, CurrentLine, ".")
LootItem = Mid$(CurrentLine, MyPos + 3, MyPos2 - (MyPos + 3))
PrevLoot = False
For lf = 0 To UBound(PlayerLoot)
If InStr(1, PlayerLoot(lf), LootItem & ";" & LootPlayer) Then
PrevLoot = True
Exit For