User:Puchacz/Parser

From Europa Universalis 4 Wiki
Jump to navigation Jump to search

Loading into Excel

This code requires creating Excel file with sheets: "Events" and Options". It only loads events into Excel file right now.

Sub Czytaj()
Dim plik As String, text As String, eventText As String, textline As String
Dim liczba As Integer, liczbaopcji As Integer, pozycja As Long, pozycjaOpcji As Long, wiersz As Integer, wierszOpcji As Integer

Call Czyszczenie 'Czyszczenie starych danych

plik = Application.GetOpenFilename()
Open plik For Input As #1
Do Until EOF(1)
    Line Input #1, textline
    'textline = Trim(textline)
    'If Left(textline, 1) = "#" Then
    '    textline = ""
    'End If
    text = text & textline & "|" 'Dodałem Trim, może niepotrzebnie
Loop
Close #1
'Liczenie eventów: założenie = każdy event ma dokładnie 1 obrazek
liczba = (Len(text) - Len(Replace(text, "picture", ""))) / 7
pozycja = 1
wierszOpcji = 1

For wiersz = 2 To liczba + 1
    text = Mid(text, pozycja) 'Ucinamy tekst poprzedzający koniec ostatniego eventu
    
    pozycja = Koniec(text) + 1 'Szukamy końca kolejnego eventu
    eventText = Mid(text, 1, pozycja) 'Wstawiamy event
    Sheets("Events").Cells(wiersz, 1).Value = Scope(eventText, wiersz)
    Sheets("Events").Cells(wiersz, 2).Value = Parametr("id", eventText)
    Sheets("Events").Cells(wiersz, 3).Value = Parametr("title", eventText)
    Sheets("Events").Cells(wiersz, 4).Value = Parametr("desc", eventText)
    Sheets("Events").Cells(wiersz, 5).Value = Replace(Parametr("fire_only_once", eventText), "None.", "no")
    Sheets("Events").Cells(wiersz, 6).Value = Parametr("trigger", eventText)
    Sheets("Events").Cells(wiersz, 7).Value = Replace(Parametr("is_triggered_only", eventText), "None.", "no")
    Sheets("Events").Cells(wiersz, 8).Value = Parametr("mean_time_to_happen", eventText)
    Sheets("Events").Cells(wiersz, 9).Value = Parametr("immediate", eventText)
    'Opcje do oddzielnego arkusza
    pozycjaOpcji = InStr(text, "option")
    Do Until (pozycjaOpcji > pozycja Or pozycjaOpcji = 0)
        wierszOpcji = wierszOpcji + 1
        Sheets("Options").Cells(wierszOpcji, 1).Value = Sheets("Events").Cells(wiersz, 2).Value
        Sheets("Options").Cells(wierszOpcji, 2).Value = Parametr("option", Mid(text, pozycjaOpcji))
        pozycjaOpcji = InStr(pozycjaOpcji + 1, text, "option")
    Loop
Next wiersz


End Sub

'Wskazywanie na "}" w tekście, które zamyka dany event'
Function Koniec(eventText As String) As Long
Dim otw As Long
Dim zam As Long
Dim zlicz As Long
Dim pozycja As Long



otw = InStr(eventText, "{")
If otw = 0 Then
    Koniec = 0
    Exit Function
Else
    Koniec = otw
    zlicz = 1
    Do Until zlicz = 0
        otw = InStr(Koniec + 1, eventText, "{")
        zam = InStr(Koniec + 1, eventText, "}")
            If (otw < zam And otw > 0) Then 'Drugi warunek z powodu końca pliku
                zlicz = zlicz + 1
                Koniec = otw
            Else
                zlicz = zlicz - 1
                Koniec = zam
            End If
    Loop
End If
End Function


Function Scope(eventText As String, wiersz As Integer) As String
Dim eventPos, provicnePos, countryPos As Long
eventPos = InStr(eventText, "_event") 'Może się popsuć jeśli event wystąpi za wcześnie
provincePos = InStr(Mid(eventText, 1, eventPos), "province")
countryPos = InStr(Mid(eventText, 1, eventPos), "country")
If eventPos = 0 Then
    Scope = "ERROR1"
ElseIf (provincePos = 0 And countryPos = 0) Then
    Scope = "ERROR2" 'Może się popsuć jeśli event wystąpi za wcześnie, w komentarzu
ElseIf (provincePos > countryPos) Then
    Scope = "Province"
Else
    Scope = "Country"
End If
End Function


Function Parametr(nazwaParametru As String, eventText As String) As String
Dim idPos As Long
Dim idPosEnd As Long
nazwaParametru = nazwaParametru & " =" 'Problem: niektóre wiersze nie mają spacji
idPos = InStr(eventText, nazwaParametru)
If idPos = 0 Then
    Parametr = "None."
    Exit Function
End If
idPos = idPos + Len(nazwaParametru)
idPosEnd = InStr(idPos, eventText, "|")
Parametr = Mid(eventText, idPos, idPosEnd - idPos)
Parametr = Trim(Replace(Parametr, Chr(34), ""))

If Left(Parametr, 1) = "{" Then 'Left na wypadek jakby nie było końca linii
    Parametr = WNawiasie(Mid(eventText, idPos)) 'idPosEnd wskazuje na | a my chcemy {
End If


End Function


Function WNawiasie(eventText As String) As String
Dim start As Long
Dim meta As Long
start = InStr(eventText, "{")
meta = Koniec(eventText)
WNawiasie = Mid(eventText, start + 1, meta - start - 1)
End Function

Private Sub Czyszczenie()
Sheets("Events").Range("A2:Z9999").ClearContents
Sheets("Options").Range("A2:Z9999").ClearContents
End Sub