1  |   Order by index

Aug 1, 2002, 8:38pm

I created a function for coming up with parameters of stuff (well you'll see
since I can't really explain it) but it is definitely OBSOLETE. This would
be a lot easier with C++, but I use VB so oh well ^_^

Aug 1, 2002, 8:51pm

Oops, forgot some stuff! Good luck trying to decipher the function, I can
barely understand it myself. I am not a very efficient programmer (as you
will see) but the function does work, it is just very slow. Here is an
example of what it does.
Dim colPars as New Collection
Set colPars = GetParameters("goto Atlantis, 0n 0w", "^goto *, *")
Debug.Print colPars(1)
Debug.Print colPars(2)
This would display Atlantis and 0n 0w in the Immediate log thingy. The ^ is
there because it tells the function to read from the beginning of the
strMain instead of looking from anywhere, for example:
Dim colPars as New Collection
Set colPars = GetParameters("lalalala goto Atlantis, 0n 0w", "goto *, *")
Debug.Print colPars(1)
Debug.Print colPars(2)
That would display the same as the above function. I made it for a MUD
client I was working on. Anyway, It seems to be pretty slow, so maybe
someone can help correct it or tell me a better function (good luck looking
at mine!) Here it is:

Public Function GetParameters(ByVal strMain As String, ByVal szFormat As
String, Optional CaseSensitive As Boolean = True, Optional DoTrim As Boolean
= False) As Collection
On Error Resume Next
Dim Args1 As New Collection
Dim i As Integer
Dim Letter As String
Dim Args2 As Collection
Dim strTemp As String
Dim buffer1 As String
Dim buffer2 As String
Dim strLeft As String
Dim ToGoTo As Integer
Dim DoAtEnd As Boolean
Dim MustLine As Boolean
Dim SoFar As String
Dim boolHadWS As Boolean
Dim WhiteSpace As New Collection
Dim TrimL As New Collection
Dim TrimR As New Collection
If Strings.Left(szFormat, 1) = "*" Then szFormat = "^" & szFormat
strLeft = " " & strMain & " "
szFormat = VBA.Replace(szFormat, "\*", " at at (S)")
szFormat = VBA.Replace(szFormat, "\^", " at at (U)")
'szFormat = VBA.Replace(szFormat, "\&", " at at (AND)")
szFormat = VBA.Replace(szFormat, "\#", " at at (NUM)")
szFormat = VBA.Replace(szFormat, "\~", " at at (WS)")
If InStr(szFormat, "~*") Or InStr(szFormat, "*~") Then
Err.Raise 55103, , "Whitespace characters cannot appear next to *'s
as this does not fit their conversion process."
Exit Function
End If
If CountSubstring(szFormat, "~") > 20 Then
Err.Raise 51502, , "Too many whitespace characters (~)! Limit is 20,
0 is not counted."
Exit Function
End If
If CountSubstring(szFormat, "~") > 0 Then
Dim buff1 As String
Dim buff2 As String
Dim p As Integer
Dim buffleft As String
Dim thing As String
thing = "~"
buffleft = szFormat
buffleft = Replace(buffleft, "*~", " at at (ASTWS)")
buffleft = Replace(buffleft, "~*", " at at (WSAST)")
NumP3:
If VBA.InStr(buffleft, "~") Then
p = InStr(buffleft, "~")
buff1 = VBA.Left(buffleft, VBA.InStr(buffleft, "~") - 1)
WhiteSpace.Add CountSubstring(buff1, "*") + 1
buff2 = VBA.Right(buffleft, Len(buffleft) - Len(buff1) - 1)
buffleft = buff1 & "*" & buff2
End If
If VBA.InStr(buffleft, "~") Then GoTo NumP3
buffleft = Replace(buffleft, " at at (ASTWS)", "*~")
buffleft = Replace(buffleft, " at at (WSAST)", "~*")
szFormat = buffleft
End If
If VBA.Left(szFormat, 1) = "^" Then szFormat = VBA.Right(szFormat,
Len(szFormat) - 1): MustLine = True
If MustLine = False Then
szFormat = "*" & szFormat
End If
If CountSubstring(szFormat, "*") - WhiteSpace.Count > 19 And MustLine =
True Then
Err.Raise 51502, , "Too many *'s! Limit is 9, 0 can't be used."
Exit Function
End If
If CountSubstring(szFormat, "*") - WhiteSpace.Count > 20 And MustLine =
False Then
Err.Raise 51502, , "Too many *'s! Limit is 9, 0 is not counted."
Exit Function
End If
szFormat = VBA.Replace(szFormat, "\^", " at at (U)")
strLeft = VBA.Replace(strLeft, "*", " at at (S)")
strLeft = VBA.Replace(strLeft, "^", " at at (U)")
If VBA.Left(szFormat, 1) = "^" Then szFormat = VBA.Right(szFormat,
Len(szFormat) - 1): MustLine = True
szFormat = " " & szFormat & " "
Set Args2 = GetArgs(szFormat, "*")
If CaseSensitive = True And InStr(szFormat, "*") = False Then GoTo TheOk
If CaseSensitive = True And Lin(strLeft, Args2(1)) = False Then GoTo
ThePlace
If CaseSensitive = False And Lin(LCase(strLeft), LCase(Args2(1))) =
False Then GoTo ThePlace
If CaseSensitive = True And strLeft = szFormat Then GoTo TheOk
If CaseSensitive = False And LCase(strLeft) = LCase(szFormat) Then GoTo
TheOk
Dim Compare1 As String
Dim Compare2 As String
If VBA.Right(szFormat, 1) <> "*" Then ToGoTo = Args2.Count
For i = 1 To ToGoTo
If i < ToGoTo Then
If CaseSensitive = True Then _
strTemp = VBA.Mid(strLeft, InStr(strLeft, Args2(i)) + _
Len(Args2(i)), Len(strLeft) - InStr(strLeft, Args2(i)) +
_
Len(Args2(i))) _
Else _
strTemp = VBA.Mid(strLeft, InStr(LCase(strLeft),
LCase(Args2(i))) + _
Len(Args2(i)), Len(strLeft) - InStr(LCase(strLeft) _
, LCase(Args2(i))) + Len(Args2(i)))
If CaseSensitive = True Then _
buffer1 = VBA.Left(strLeft, _
InStr(strLeft, Args2(i)) + Len(Args2(i))) _
Else _
buffer1 = VBA.Left(strLeft, InStr(LCase(strLeft), _
LCase(Args2(i))) + Len(Args2(i)))
strLeft = VBA.Right(strLeft, Len(strLeft) - Len(buffer1) + 1)
If Lin(strLeft, strTemp) = False And i > 1 Then GoTo ThePlace
If CaseSensitive = True Then _
strTemp = VBA.Left(strTemp, InStr(strTemp, Args2(i + 1)) -
1) _
Else strTemp = VBA.Left(strTemp _
, InStr(LCase(strTemp), LCase(Args2(i + 1))) - 1)
strTemp = VBA.Replace(strTemp, " at at (S)", "*")
strTemp = VBA.Replace(strTemp, " at at (U)", "^")
strTemp = VBA.Replace(strTemp, " at at (NUM)", "#")
strTemp = VBA.Replace(strTemp, " at at (WS)", "~")
If DoTrim = False Then Args1.Add strTemp Else Args1.Add
Trim(strTemp)
SoFar = SoFar & Args2(i) & strTemp
'Else
End If
Next i
If DoAtEnd = True Then
Args1.Add strLeft
SoFar = SoFar & Args2(Args2.Count) & strLeft
Else
SoFar = SoFar & Args2(Args2.Count)
End If
SoFar = VBA.Left(SoFar, Len(SoFar) - 2)
SoFar = VBA.Right(SoFar, Len(SoFar) - 1)
ThePlace:
LastActual = SoFar
If CaseSensitive = True Then
If SoFar <> strMain Then Err.Raise 51501, , "Values aren't alike: "
& Chr(34) & strMain & Chr(34) & " vs. " & Chr(34) & SoFar & Chr(34): Exit
Function
Else
If LCase(SoFar) <> LCase(strMain) Then Err.Raise 51501, , "Values
aren't alike: " & LCase(strMain) & "vs. " & LCase(SoFar): Exit Function
End If
TheOk:
If MustLine = False Then Args1.Remove 1
If WhiteSpace.Count > 0 Then
Dim l As Integer
Dim l1 As Integer
Dim strbuff As String
Dim num1 As Integer
':S don't ask!
For l = 1 To WhiteSpace.Count
strbuff = Args1(WhiteSpace(l) - num1)
If strbuff = Space(Len(strbuff)) Then
Args1.Remove (WhiteSpace(l) - num1)
num1 = num1 + 1
Else
Exit Function
End If
Next l
End If
Set GetParameters = Args1
End Function

[View Quote]

Aug 1, 2002, 8:55pm

Oh and here's the CountSubstring function:
Public Function CountSubstring(ByVal strInput As String, ByVal strFind As
String) As Long
CountSubstring = (Len(strInput) - Len(Replace(strInput, strFind, ""))) /
Len(strFind)
End Function


[View Quote]

Aug 2, 2002, 3:49pm

Why not just use a split to get perams

Aug 6, 2002, 1:08am

umm cos when I made it I didn't know about split? But thanks for the tip, I
may rewrite the function soon

[View Quote]

Aug 6, 2002, 4:03am

Thanks to Strike, I have revised my function and have created a debug
function to show statistics. It turns out that it takes longer for the old
function to process when the strings aren't alike than it does for the old
function to process when it returns a group and they are a like! (This is
crazy so go oh my god in your head whether you understand it or not). Each
of these were tested with Set colpars = GetParameters("goto AW, 10N 15W",
"goto *,*")

Results for strings alike (return collection):
The new method took 0.2969 seconds. The old method took 0.5312 seconds.
Difference: 0.234375. Test results from 2000 tests.

Results for strings not alike (no return collection, which SHOULD be quicker
but wasn't on the old function):
The new method took 0.0938 seconds. The old method took 2.6328 seconds.
Difference: 2.539063. Test results from 2000 tests.

Believe it or not, this is a very useful function that I have been searching
for for a very long time. I couldn't find it so I had to make one :( .
Contact homeworkkid at msn.com (me of course) if you find any bugs or want to
know how to use it (though I will explain below).
Say you wanted to make a function for a bot. You would do something like
this:

Dim colPars as new Collection
Set colPars = GetParameters(TheMessage, "whisper *,*")
If colpars.Count > 0 Then
sdk1.Aw_Whisper AwUsers(colpars(1)), colpars(2)
Goto Bottom
end if

This command would, if the user used the command, whisper a message to a
specific user (considering your user classes work the same way).

Well, now you see how inefficient the old function was and have learned how
to use the GetParameters function. Here is the new one and its supporting
functions that I have made to make the coding easier for me :) :

Public Function GetParameters(strMain As String, ByVal szFormat As String,
Optional CaseSensitive As Boolean = False, Optional DoTrim As Boolean =
True) As Collection
On Error Resume Next
Dim pars() As String
Dim retpars As New Collection
Dim strTemp As String
Dim strLeft As String
Dim i As Integer
Dim t1 As Integer 'for InStr functions
Dim t2 As Integer 'for InStr functions
strLeft = strMain
If szFormat = "*" Then retpars.Add strMain: Set GetParameters = retpars:
Exit Function
''The below involves \ before ^, *, etc.
strLeft = Replace(strLeft, " at ", " at at ( at )")
strLeft = Replace(strLeft, "\", " at at (S)")
strLeft = Replace(strLeft, "*", " at at (A)")
strLeft = Replace(strLeft, "^", " at at (E)")
szFormat = Replace(szFormat, " at ", " at at ( at )")
szFormat = Replace(szFormat, "\\", " at at (S)")
szFormat = Replace(szFormat, "\*", " at at (A)")
szFormat = Replace(szFormat, "\^", " at at (E)")
'
pars = Split(szFormat, "*")
If Strings.Left(szFormat, 1) = "^" Then
szFormat = Strings.Right(szFormat, Len(szFormat) - 1)
pars(0) = Right(pars(0), Len(pars(0)) - 1)
If Strings.Left(strLeft, Len(pars(i))) <> pars(0) Then Exit Function
End If
For i = 0 To UBound(pars)
If CaseSensitive = True Then t1 = InStrEnd(strLeft, pars(i)) Else t1
= InStrEnd(LCase(strLeft), LCase(pars(i)))
If t1 = 0 Then Exit Function
If CaseSensitive = True Then t2 = InStr(ToEnd(strLeft, t1), pars(i +
1)) + t1 Else t2 = InStr(LCase(ToEnd(strLeft, t1)), LCase(pars(i + 1))) + t1
If t2 = 0 Then Exit Function
strTemp = PosToPos(strLeft, t1, t2)
'The below involves \ before ^, *, etc.
strTemp = Replace(strTemp, " at at (E)", "^")
strTemp = Replace(strTemp, " at at (A)", "*")
strTemp = Replace(strTemp, " at at (S)", "\")
strTemp = Replace(strTemp, " at at ( at )", " at ")
'
If DoTrim = False Then retpars.Add strTemp Else retpars.Add
Trim(strTemp)
strLeft = ToEnd(strLeft, t1)
Next i
'There seemed to be a problem if the last character of an szFormat
'was * so it was fixed below.
If Strings.Right(szFormat, 1) = "*" Then
Dim toadd As String
toadd = retpars(retpars.Count - 1) & retpars(retpars.Count)
retpars.Remove retpars.Count
retpars.Remove retpars.Count
'The below involves \ before ^, *, etc.
toadd = Replace(toadd, " at at (E)", "^")
toadd = Replace(toadd, " at at (A)", "*")
toadd = Replace(toadd, " at at (S)", "\")
toadd = Replace(toadd, " at at ( at )", " at ")
'
If DoTrim = False Then retpars.Add toadd Else retpars.Add
Trim(toadd)
Else
retpars.Remove retpars.Count
End If
Set GetParameters = retpars
End Function

Public Function InStrEnd(Start As String, String1 As String) As Integer
InStrEnd = InStr(Start, String1)
If InStrEnd <> 0 Then InStrEnd = InStrEnd + Len(String1)
End Function

Public Function ToEnd(strMain As String, Pos1 As Integer) As String
ToEnd = Strings.Right(strMain, Len(strMain) - Pos1)
End Function

Public Function PosToPos(strMain As String, Pos1 As Integer, Pos2 As
Integer) As String
PosToPos = Mid(strMain, Pos1, Pos2 - Pos1)
End Function

[View Quote]

Aug 7, 2002, 3:24pm

Are you just trying to get a function to get a string saying "goto *,*" and get it to get the teleport stuff from there?

'A simple set of functions that will allow you to take a phrase such as 'Goto awteen, 0n 0w'
'The results will be given as StrWorld and StrCoords
'A existing coords$ and State_Change function is required.

Global ReportErrorsAsMsgbox as Boolean

Function B_InStr(Source as string, Find as string) 'Boolean InStr function for ease
B_InStr = cbool(instr(1, Source, Find))
End Function

Function GetGotoTeleportPerameters(StrData as string) as Boolean
Dim VntSplit as Variant, StrWorld as String, StrCoords as String
On error goto errhandler
If B_InStr(StrData, ",") = True and Left(Lcase(StrData), 5) = "goto " and B_InStr(StrData, " ") then
VntSplit = Split(StrData, ",")
StrCoords = VntSplit(1) 'This is the coords section, use the coords function
VntSplit = Split(VntSplit(0), " ")
StrWorld = VntSplit(1)
GetGotoTeleportPerameters = True
Else
GetGotoTeleportPerameters = False
End if
Exit Function

Errhandler:
GetGotoTeleportPerameters = False
debug.print "Error Occured: (" & err.number & ") " err.description
If ReportErrorsAsMsgbox = True then
Msgbox "Error Occured: (" & err.number & ") " err.description, vbExclamation, "Error Report"
End If
End Function

Is this any help? Its only something I cooked up because I was bored, I havent even put it in the IDE but it looks about right.

- Mark

Aug 7, 2002, 6:31pm

:) Thank you, this function will help for my many small command checks.

The old method took 0.4141 seconds. The new method took 0.0469 seconds.
Difference: 0.3671875. Test results from 2000 tests.

As you can see, Strike's method is much faster in this area (the new
method).

[View Quote]

Aug 9, 2002, 5:00am

well, the new function i recently posted doesnt fully work, so i give up and
im learning C++ now :)

[View Quote]

Aug 9, 2002, 8:06am

"tomilius" <homeworkkid at msn.com> wrote in
news:3d536882 at server1.Activeworlds.com:

> well, the new function i recently posted doesnt fully work, so i give
> up and im learning C++ now :)
>
shhhh, don't tell grimble :)

Aug 9, 2002, 10:17am

That logic totally defeats me heh.

[View Quote]

Aug 9, 2002, 10:17am

;OP

[View Quote]

1  |   Order by index