Just vbScript Code

March 11, 2011 09:37AM
Dim counter
Dim columnArray
Dim rsItemDB
Dim itemName, align, itemLevel, itemAV, itemSavSpell, itemSavBreath, itemSavPar, itemDam
Dim itemHit, itemArmorAdj, itemHP, itemMP, itemMoves, itemStr, itemDex, itemCon, itemSavMent
Dim itemInt, itemWis, itemCha, itemMat, itemWt, itemSpcFlag, itemSpcAff, itemLoc
Dim itemDictionary

Set myFSO = CreateObject("Scripting.FileSystemObject")
Set rsData = CreateObject("ADODB.Recordset")
Set oConn = CreateObject("ADODB.Connection")
Set oConn2 = CreateObject("ADODB.Connection")
set itemDictionary = CreateObject("Scripting.Dictionary")

addItemDictionary
itemDictionary.CompareMode = BinaryCompare


filePath = "E:\Games\Carrionfields"
fileName = "carritems.txt"
itemCSVDB = "itemList.csv"

With oConn
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.Properties ("Extended Properties").Value = "text;HDR=No;FMT=Delimited"""
.Open filePath
End With

With oConn2
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.Properties ("Extended Properties").Value = "text;HDR=Yes;FMT=Delimited"""
.Open filePath
End With

matArray = array("cloth", "stone", "onyx", "energy", "silver", "gold", "iron", "brass", "flesh", "gem",_
"wood", "glass", "obsidian", "moonstone", "leather", "coral", "adamantite")

Set rsData = oConn.Execute("SELECT * FROM " & fileName)

counter = 0


While Not rsData.EOF

updateValues 'sub which sets all variable fields to blank

m = 0 'used as a boolean for a blank line

For each field in rsData.Fields

If isNull(field) = False Then 'skips processing the field if there's nothing in it

If field = rsData(0) Then 'parses the description field for item name, align flag, and item level

If InStr(field, "+"& [G,E,N]) <> 0 Then
align = "[" & Trim(Mid(field, InStrRev(field, "+")-1, InStrRev(field, " ") - InStrRev(field, "+")+1)) & "]"
itemName = Replace(Trim(Left(field, InStrRev(field, "+")-1)), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
ElseIf InStr(field, "-" & [G,E,N]) <> 0 Then
align = "[" & Trim(Mid(field, InStrRev(field, "-")-1, Len(field) - InStrRev(field," ")+1)) & "]"
itemName = Replace(Trim(Left(field, InStrRev(field, "-")-1)), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
Else
itemName = Replace(Trim(Left(field, InStrRev(field, " "))), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
End If

End If

If field = rsData(1) Then
RegExpTest field 'tests for non-alpha characters, sets itemAV if none are present
End If

If InStr(field, "w") <> 0 And field <> rsData(0)Then
RegExpTest field 'tests for field leading with "w" and then looking for numbers
End If

If InStr(LCase(field), "special:") <> 0 Then
itemSpcAff = Trim(Replace(field, "'", ""))
Else
tempItem = LCase(Trim(Left(field, InStrRev(field, " "))))
tempItem = Replace(tempItem, "'", "")
parseItems(tempItem)
End If


m=1 'boolean for non-blank field, if not set, blank rows returned

End If
next

'need argument for \dd\d (avg damage)
'need argument for good, neut, evil flag
'need to account for tab delimited
'successfully parse 'identify' output

updateValues2 'sets variables to current values


If m = 1 Then
oConn2.Execute rsItemDB
End If

counter = counter + 1
rsData.movenext

Wend
oConn.Close
oConn2.Close

MsgBox "Inventory Parsing Complete"

Sub updateValues
itemName = ""
align = ""
itemLevel = ""
itemAV = ""
itemSavSpell = ""
itemSavBreath = ""
itemSavPar = ""
itemSavMent = ""
itemDam = ""
itemHit = ""
itemArmorAdj = ""
itemHP = ""
itemMP = ""
itemMoves = ""
itemStr = ""
itemDex = ""
itemCon = ""
itemInt = ""
itemWis = ""
itemCha = ""
itemMat = ""
itemWt = ""
itemSpcFlag = ""
itemSpcAff = ""
itemLoc = ""
End Sub

Sub updateValues2
rsItemDB = "INSERT INTO " &_
itemCSVDB &_
" VALUES ('" &_
itemName & "', '" &_
align & "', '" &_
itemLevel & "', '" &_
itemAV & "', '" &_
itemSavSpell & "', '" &_
itemSavBreath & "', '" &_
itemSavPar & "', '" &_
itemSavMent & "', '" &_
itemDam & "', '" &_
itemHit & "', '" &_
itemArmorAdj & "', '" &_
itemHP & "', '" &_
itemMP & "', '" &_
itemMoves & "', '" &_
itemStr & "', '" &_
itemDex & "', '" &_
itemCon & "', '" &_
itemInt & "', '" &_
itemWis & "', '" &_
itemCha & "', '" &_
itemMat & "', '" &_
itemWt & "', '" &_
itemSpcFlag & "', '" &_
itemSpcAff & "', '" &_
itemLoc & "')"
End Sub


Sub addItemDictionary
With itemDictionary
.Add "dam", 1
.Add "hit", 2
.Add "hp", 3
.Add "spar", 4
.Add "sbreath", 5
.Add "sspell", 6
.Add "arm", 7
.Add "mana", 8
.Add "str", 9
.Add "dex", 10
.Add "con", 11
.Add "int", 12
.Add "wis", 13
.Add "cha", 14
.Add "moves", 15
.Add "smental", 16
End With
End Sub

Sub parseItems(n)
Select Case itemDictionary.Item(n)
Case 1: itemDam = field
Case 2: itemHit = field
Case 3: itemHP = field
Case 4: itemSavPar = field
Case 5: itemSavBreath = field
Case 6: itemSavSpell = field
Case 7: itemArmorAdj = field
Case 8: itemMP = field
Case 9: itemStr = field
Case 10: itemDex = field
Case 11: itemCon = field
Case 12: itemInt = field
Case 13: itemWis = field
Case 14: itemCha = field
Case 15: itemMoves = field
Case 16: itemSavMent = field
Case Else:
For x=0 to UBound(matArray)
If field = matArray(x) Then
itemMat = field
End If
next
End Select

End Sub

'code borrowed and modified from Microsoft website
Sub RegExpTest(str)

Set objRegEx = New RegExp

'find all matches
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = "[^a-z]"

'create the collection of matches
Set Matches = objRegEx.Execute(str)

'print out all matches
For Each Match in Matches
strReturnStr = strReturnStr & Match.value
Next

If Len(field) = Len(strReturnStr) Then
itemAV = field
End If

'determines if field is the "item weight" field
If field <> itemAV And InStr(field, "w") <> 0 Then

objRegEx.Global = False
str = Trim(LCase(str))
objRegEx.Pattern = "[w\d\.]"
Set Matches = objRegEx.Execute(str)

For Each Match in Matches
strReturnStr = strReturnStr & Match.value
Next

If Len(Trim(field)) = Len(strReturnStr) Then
itemWt = field
End If

End If

End Sub
Subject Author Posted

zMUD Item DB into Queriable .csv

The Baron March 11, 2011 09:36AM

Just vbScript Code

The Baron March 11, 2011 09:37AM



Sorry, you do not have permission to post/reply in this forum.

Online Users

Guests: 64
Record Number of Users: 5 November 04, 2022
Record Number of Guests: 358 August 31, 2022