Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Eval() per disphelper.bi(see.rar)

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 27.09.2006, 18:30    Titel: Eval() per disphelper.bi(see.rar) Antworten mit Zitat

Hi,
ich hab mir gedacht, bevor ich einen function-parser selber schreibe, nehme ich einen,
der schon vorhanden ist. Sicherlich könnte ich mir einen von www.freebasic.net/forum ziehen,
aber das wäre langweilig, denn da gibt es soetwas ja schon grinsen
Da war doch noch diese disphelper-Geschichte(..inc\disphelper\disphelper.bi) zusammen mit
v1ctor's vbs.bas und meiner InputBoxVbs müßte es doch möglich sein. daß..
.. es ist:
Code:
Option Escape
Option Explicit
#include once "windows.bi"
#define UNICODE
#include "disphelper/disphelper.bi"
' **************************************************************************
' RunScript:
'   Run a script using the MSScriptControl. Optionally return a result.
' originally by v1ctor, modified for eval 2006 by ytwinky, MD
' compiled with fbc 0.16bSE using FBIde 0.4.6LE
' use option -s gui to avoid the nasty blackbox
'
Sub RunScript(byVal szRetIdentifier As LPWSTR, _
              byVal pResult As LPVOID, _
              byVal szScript As LPWSTR, _
              byVal szLanguage As LPWSTR)
  DISPATCH_OBJ(scrCtl)
   If (SUCCEEDED(dhCreateObject("MSScriptControl.ScriptControl", NULL, @scrCtl))) Then
      If (SUCCEEDED(dhPutValue(scrCtl, ".Language = %T", szLanguage))) Then
         dhPutValue(scrCtl, ".AllowUI = %b", TRUE)
         dhPutValue(scrCtl, ".UseSafeSubset = %b", FALSE)
      If(pResult=FALSE) Then
            dhCallMethod(scrCtl, ".Eval(%T)", szScript)
         Else
            dhGetValue(szRetIdentifier, pResult, scrCtl, ".Eval(%T)", szScript)
         End If
      End If
   End If
   SAFE_RELEASE(scrCtl)
End Sub

Function Eval(sFun As String) As String
  Dim tResult As ZString Ptr
  dhInitialize(TRUE)
  dhToggleExceptions(TRUE)
  RunScript("%s", @tResult, sFun, "VBScript")
  dhUninitialize(TRUE)
  Return *tResult
End Function

'' VBScript sample
MessageBox(Null, Eval("Sqr((23+17*4)^3)"), "RunScript returned:", 1)

Das Beispiel zeigt, daß auch 'komplizierte' Berechnungen mit Eval() möglich sind.
Ich kann also eine Funktion in einem String berechnen, das ist gut.
Soweit die Funktion per Programm zusammengebastelt wird, sollte ich davon ausgehen
können, daß die Formel auch 'richtig' ist, erlaube ich die Formel-Eingabe durch
den Benutzer, muß ich voraussetzen, daß diesem die VBS-Formel-Syntax geläufig ist.
Denn Eval() hat keine Fehlererkennung..
..klappts, klappts, klappts nicht gibts 'n Laufzeitfehler..
(Noch) k.A. wie der abzufangen wäre, da die Doku zu disphelper relativ knapp gehalten
ist, um nicht zu sagen:Die gibt's ja gar nicht!
Aber immerhinque bin ich auf dem Weg zu 'HowTo WMI with FreeBASIC' schon mal wieder
einen Schritt weiter grinsen
Anzumerken bleibt noch, daß der Rückgabewert immer String ist, er muß also noch in das
jeweils benötigte Format umgewandelt werden, Möglichkeiten dazu gibt es reichlich..
..die meisten stehen wohl in der Befehlsreferenz, aber auch im Forum gibts dazu bestimmt etwas grinsen
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..

Zuletzt bearbeitet von ytwinky am 19.08.2007, 14:51, insgesamt 3-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Lutz Ifer
Grillmeister


Anmeldungsdatum: 23.09.2005
Beiträge: 555

BeitragVerfasst am: 28.09.2006, 11:58    Titel: Antworten mit Zitat

Grummel, und ich schreib mir so ne eval() als funktion selber....
mal wieder jede menge arbeit für'n ar...., aber dafür das rad neu erfunden.

Lutz böse Ifer
_________________
Wahnsinn ist nur die Antwort einer gesunden Psyche auf eine kranke Gesellschaft.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 28.09.2006, 18:57    Titel: Antworten mit Zitat

Hi Lutz_Ifer,
durch InputLn.Bas weiß ich, was für eine Schweinearbeit so ein Parser ist,
deshalb wollte ich keinen eigenen schreiben und suchte nach 'ner anderen Lösung.
VBS ist eine gefährliche Waffe für böse Buben, aber ein mächtiges Werkzeug in den richtigen Händen..
Ob j(ava)script das auch kann, weiß ich leider nicht, bleibt aber zu prüfen grinsen
..und schmeiß bloß deinen eigenen Parser nicht weg, der läßt sich bestimmt noch verwenden.
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Lutz Ifer
Grillmeister


Anmeldungsdatum: 23.09.2005
Beiträge: 555

BeitragVerfasst am: 28.09.2006, 21:14    Titel: Antworten mit Zitat

Den hab ich vor locker fünf jahren in Qbasic geschrieben - lach ruhig, aber ich habe keine ahnung mehr, wie er funktioniert.

Lutz böse Ifer
_________________
Wahnsinn ist nur die Antwort einer gesunden Psyche auf eine kranke Gesellschaft.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 28.09.2006, 21:33    Titel: Antworten mit Zitat

Natürlich lach ich lachen, wenn auch aus einem ganz anderen Grund:
Egal, ob ich ein OS programmieren will oder einen Compiler - ich brauch dazu einen Parser grinsen
..und jetzt hoffe ich, daß alle OS- und Compiler-Schreiber dich mit Postings überhäufen, um dich zu überzeugen, das Ding doch zu posten vor lachen auf dem Boden rollen
Bitte nicht böse sein, ist nicht ganz Ernst gemeint zwinkern
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
dreael
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 2529
Wohnort: Hofen SH (Schweiz)

BeitragVerfasst am: 28.09.2006, 22:02    Titel: Antworten mit Zitat

Am einfachsten ist der Aufruf von VBScript mit SHELL und Windows Script Host; dies klappt bereits in QB hervorragend, wie diverse Beispiele aus meinem Beilagenordner zeigen:

http://beilagen.dreael.ch/QB/DESKTOPF.BAS
http://beilagen.dreael.ch/QB/HTML_PRT.BAS
http://beilagen.dreael.ch/QB/LW_LISTE.BAS
http://beilagen.dreael.ch/QB/MKVERKNU.BAS
http://beilagen.dreael.ch/QB/MYSQL.BAS
http://beilagen.dreael.ch/QB/REGISTRY.BAS
http://beilagen.dreael.ch/QB/TASKKILL.BAS (dieses Beispiel benützt übrigens WMI!)
http://beilagen.dreael.ch/QB/WORD_MKR.BAS

Fast alle Beispiele zeigen die Leistungsfähigkeit von VBScript, da dort alles Aufgaben gelöst werden, für die QB schon rein DOS-bedingt keine bordeigenen Mittel mitbringt.

Möglicherweise kann man in FreeBasic COM/ActiveX-Objekte direkt programmieren, ohne dass ein temporäres Script dynamisch erzeugt werden muss.
_________________
Teste die PC-Sicherheit mit www.sec-check.net
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 29.09.2006, 22:12    Titel: Antworten mit Zitat

Danke schön,
ich weiß sehr wohl, wie die WMI in vbs (und auch in AutoIt) benutzt wird..
..interessanter wäre jedoch der Aufruf der WMI per disphelper.bi grinsen
Für den Aufruf von vbs bin ich (in 'einem anderen Forum') schon übelst beschimpft worden
Admin und Hauptbenutzer eines 'anderen Forums' hat Folgendes geschrieben:
..
ytwinky, willst du mich verar...en?
..
Wenn nämlich jemand den WSH ausgeschaltet hat(per
Windows-Registry oder durch Umbenennen, es gibt noch mehr Möglichkeiten)
dann funktioniert das nicht mehr, der Aufruf per disphelper.bi sollte jedoch noch funktionieren..
[Edit]
unter Zuhilfenahme von Vbs ist es kein Problem, zu testen, ob in Lw A: eine Diskette eingelegt ist..
Code:
'Laufwerk A: mit Vbs testen..

Declare Function IsReady(Lw As String)
Const FBQM=Chr(34)
?"Nachsehen, ob Lw A: bereit ist.."
?"Lw A: ist ";
If Not IsReady("a") Then ?"nicht ";
?"bereit!"
?"Eniki.."
Sleep
End

Function IsReady(Lw As String) 'Ohne Doppelpunkt..
  Dim Vbs As String, Dnr=FreeFile
  Vbs=Environ("TEMP") &"\IsReady.Vbs"
  Open Vbs For Output As Dnr
  ? #Dnr, "Set Fso=WScript.CreateObject(" &FBQM &"Scripting.FileSystemObject" &FBQM &")" 'FSO erzeugen
  ? #Dnr, "On Error Resume Next" 'Fehlerbehandlung einschalten
  ? #Dnr, "Set Dr=Fso.GetDrive(" &FBQM &Lw &FBQM &")" 'Laufwerk prüfen, besser ohne ':'
  ? #Dnr, "bereit=Array(0, 1)(Abs(Dr.IsReady))" 'hatt's geklappt, steht in bereit das Ergebnis
  ? #Dnr, "WScript.Quit Array(bereit, 0)(Abs(Err.Number<>0))" 'Falsches Laufwerk übergeben, also NotReady
  Close Dnr
  Dnr=Exec("C:\Windows\System32\WSCRIPT.Exe", "//NoLogo " &Vbs)
  Kill Vbs
  Return Dnr<>0
End Function
Nur mal so, zur Klarstellung..
[Edit]
Fehler berichtigt, sry..
Getestet mit FB0.16bSE und FBIde 0.4.6LE
[Edit2]
Und wer nicht weiß, was hier passiert, der braucht es auch nicht grinsen
Code:
'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=? , ß=á ,§=õ , ©=¸, °=ø
'Product-Key decoden ¸2006 by ytwinky, MD
'DecodeProductKey habe ich von AutoIt nach FreeBASIC portiert..
Declare Function DecodeProductKey() As String
Const FBQM=Chr(34)
?"Decoden.."
?DecodeProductKey();
Sleep
End

Function DecodeProductKey() As String
   Dim dl=29, bKey(15), v, hi, i, n
   Dim As String Vbs, Digits, sKey(dl), Result, s, BinaryDPID
 Vbs=Environ("Tmp") &"\ReadKey.Vbs"
  Open Vbs For OutPut As 1
  ? #1, "Set WshShell=WScript.CreateObject(" &FBQM &"WScript.Shell" &FBQM &")"
  ? #1, "EncodedKey=WshShell.RegRead(" &FBQM &"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductID" &FBQM &")"
  ? #1, "For i=0 To UBound(EncodedKey)"
  ? #1, "EncodedKey(i)=Hex(EncodedKey(i))"
  ? #1, "If Len(EncodedKey(i))<2 Then EncodedKey(i)=" &FBQM &"0" &FBQM &" &EncodedKey(i)"
  ? #1, "Next"
  ? #1, "WScript.Echo Join(EncodedKey, " &FBQM &FBQM &")"
  Close 1
  Open Pipe "CSCRIPT //NoLogo " &Vbs For Input  As 1
  While Not EOF(1)
    Line Input #1, s
    If s<>"" Then BinaryDPID+=s &Chr(10)
  Wend
  Close(1)
  Kill Vbs
   BinaryDPID=Mid(BinaryDPID, 105, 30)
  Digits="BCDFGHJKMPQRTVWXY2346789"
   For i=1 To dl Step 2
      bKey(Int(i/2))=Val("&H" &Mid(BinaryDPID, i, 2))
   Next
   For i=dl-1 To 0 Step-1
      If (i+1) Mod 6 Then
         hi=0
         For n=14 To 0 Step -1
            v=(hi SHL 8) Or bKey(n)
            bKey(n)=Int(v / 24)
            hi=v Mod 24
         Next
         sKey(i)=Mid(Digits, hi+1, 1)
      Else
         sKey(i)+="-"
      EndIf
      Result=sKey(i) &Result
   Next
   Return Result
End Function   '==>DecodeProductKey



Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..

Zuletzt bearbeitet von ytwinky am 11.10.2006, 17:50, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Lutz Ifer
Grillmeister


Anmeldungsdatum: 23.09.2005
Beiträge: 555

BeitragVerfasst am: 06.10.2006, 12:21    Titel: Antworten mit Zitat

Und es ward Abend und es ward Morgen, eine eval()-Funktion tauchte getippt in der FBIDE auf, und Lutz_Ifer sah, dass es Mist war...

Einfach mal bissl mit rumspielen, und Fehler suchen. Wer richtig viel Spaß haben will, unkommentiert mal die define-Zeile. Wirklich sauber arbeiten tut die Funktion nur bei "richtigen" Rechenausdrücken, die möglichst keine negativen Zahlen enthalten.

Code:

' eval() v0.01 - written by Lutz Ifer (c) }:-> published under LGPL!
' 06 oct 2006, about 2:00am...

'#define __debug__

#ifdef __debug__
#   define dprint(x) print x
#else
#   define dprint(x)
#endif

option explicit

enum char
    char_space
    char_bracket
    char_sys
    char_num
    char_alpha
    char_operator
    char_else
end enum

declare function eval(as string) as string
declare function eval_getchar(as ubyte) as char
declare function eval_adspace(as string) as integer
declare function eval_despace(as string) as integer
declare function eval_brackets_scan(as string) as string
declare function eval_functions_scan(as string) as string
declare function eval_functions_resolve(as integer, as string) as string
declare function eval_operators_scan(as string) as string
declare function eval_operators_resolve(as integer, as string, as string) as string

? eval("15")
? eval("&h22")
? eval("4 * atn(1)")
? eval("77/11")
'? eval("hallo + 5 + welt")
'? eval("hallo")
'? eval("#")
'? eval(",")
'? eval("@")
?eval ("~")
'?eval ("+")

? eval("3/0")
'? eval("")
? eval("255 and 18")
? eval("33+(4*(74 - 8^2))+sin(3.1415)-1")
sleep

function eval(expression as string) as string
    if len(expression) = 0 then return " eval() v0.01 - written by Lutz Ifer (c) }:-> published under LGPL! -- 06 oct 2006, about 2:00am..."
    dprint("eval("""""+expression+""""")")
    dim as string e = trim(ucase(expression))
    dprint("- trimmed: "+chr(34)+e+chr(34))
    if eval_adspace(e) then return e
    if eval_despace(e) then return e
    return eval_brackets_scan(e)
end function

function eval_getchar(character as ubyte) as char
    select case as const character
        case 32
            return char_space
        case 33
            return char_alpha
        case 35 to 38
            return char_alpha
        case 40, 41
            return char_bracket
        case 42, 43, 45, 47, 60, 61, 62, 92, 94
            return char_operator
        case 46
            return char_num
        case 48 to 57
            return char_num
        case 65 to 90
            return char_alpha
        case 97 to 112
            return char_alpha
        case else
            return char_else
    end select
end function

function eval_adspace(e as string) as integer
    dprint("- adding space")
    dprint("-- before: "+chr(34)+e+chr(34))

    dim as integer i
    dim as char chThis, chPrev = char_space
   
    do
        i += 1
        if mid(e, i, 2) <> "&H" and mid(e, i, 2) <> "&O" then
            chThis = eval_getchar(e[i-1])
            if chThis = char_else then
                e = "ERROR #1 - komisches Zeichen: [" _
                    + str(e[i-1])+"|"+chr(e[i-1])+"]"
                return -1
            end if
           
            if chPrev = char_sys then
                if ((chThis=char_num) or (chThis=char_alpha)) then
                    chThis = chPrev
                end if
            end if
           
            if chThis <> chPrev then
                e = left(e, i-1) + " " + mid(e, i)
                i += 1
            end if
           
            chPrev = chThis
        else
            chPrev = char_sys
            i += 1
        end if
    loop until i = len(e)
   
    dprint("-- after : "+chr(34)+e+chr(34))
    return 0
end function

function eval_despace(e as string) as integer
    dprint("- removing space")
    dprint("-- before: "+chr(34)+e+chr(34))
    dim as integer i = 1
    do
        if mid(e, i, 2) = "  " then
            e = left(e, i) + mid(e, i + 2)
        else
            i += 1           
        end if
    loop until i >= len(e)

    dprint("-- after : "+chr(34)+e+chr(34))
    return 0
end function

function eval_brackets_scan(e as string) as string
    dprint("- scanning for brackets")
    dim as integer bracket_open, bracket_close, bracket_count
   
    dprint("-- scanning in: "+chr(34)+e+chr(34))
    for bracket_open = 1 to len(e)
        if mid(e, bracket_open, 1) = "(" then exit for
    next
   
    if bracket_open >= len(e) then
        dprint ("-- no opening brackets found")
        return eval_functions_scan(e)
    else
        for bracket_close = bracket_open to len(e)
            if mid(e, bracket_close, 1) = "(" then bracket_count += 1
            if mid(e, bracket_close, 1) = ")" then bracket_count -= 1
            if bracket_count <= 0 then exit for
        next
       
        dprint ("-- bracket found")
        return eval_brackets_scan(_
            left(e, bracket_open - 1) + _
            eval_brackets_scan(_
                mid(e, bracket_open + 1, bracket_close - bracket_open - 1)_
            ) + _
            mid(e, bracket_close + 1))
    end if
end function

function eval_functions_scan(e as string) as string
    dprint("- scanning for functions")
    dprint("-- scanning in "+chr(34)+e+chr(34))
    dim as string functions(7) => {"NOT", "SQR", "SIN", "COS", "TAN", "ATN", "RND", "INT"}
    dim as integer func_found, func_start, func_ende
    for func_found = 0 to 7
        func_start = instr(e, functions(func_found))
        if func_start <> 0 then exit for
    next
   
    if func_start then
        for func_ende = func_start + 5 to len(e)
            if mid(e, func_ende, 1) = " " then exit for
        next
       
        dprint ("-- function found")
        return eval_operators_scan(_
            left(e, func_start - 1) + _
            eval_functions_scan( _
                eval_functions_resolve(func_found, _
                    mid(e, func_start + 3, func_ende - func_start - 3) _
                ) _
            ) + _
            mid(e, func_ende))
    else
        dprint ("-- no functions found")
        return eval_operators_scan(e)
    end if
end function

function eval_functions_resolve(id as integer, e as string) as string
    dprint ("--- functions resolve")
    dprint ("--- resolving ("+str(id)+") <"+e+">")

    select case as const id
        case 0 : return str(not(val(eval_operators_scan(e))))
        case 1 : return str(sqr(val(eval_operators_scan(e))))
        case 2 : return str(sin(val(eval_operators_scan(e))))
        case 3 : return str(cos(val(eval_operators_scan(e))))
        case 4 : return str(tan(val(eval_operators_scan(e))))
        case 5 : return str(atn(val(eval_operators_scan(e))))
        case 6 : return str(rnd(val(eval_operators_scan(e))))
        case 7 : return str(int(val(eval_operators_scan(e))))
    end select
end function

function eval_operators_scan(e as string) as string
    dprint("- scanning for operators")
    dprint("-- scanning in "+chr(34)+e+chr(34))
    dim as string operators(17) => {"^","*","/","\","MOD","+","-",">","<","=",">=","<=","<>","AND","OR","XOR","EQV","IMP"}
    dim as integer oper_found, oper_pos, a_start, a_ende, b_start, b_ende
   
    for oper_found = 0 to 17
        oper_pos = instr(e, operators(oper_found))
        if oper_pos <> 0 then exit for
    next
   
    if oper_pos then
        for b_start = oper_pos + 1 to len(e)
            if mid(e, b_start, 1) = " " then exit for
        next
        for b_ende = b_start + 1 to len(e)
            if mid(e, b_ende, 1) = " " then exit for
        next
       
        for a_ende = oper_pos - 1 to 1 step -1
            if mid(e, a_ende, 1) = " " then exit for
        next
        for a_start = a_ende - 1 to 1 step -1
            if mid(e, a_start, 1) = " " then exit for
        next
       
        if oper_found = 6 then
            if b_start - a_ende - 2 then
                dprint("--- non-oper minus found, ignoring")
                if instr(e, "#") then return e else return str(val(e))
            end if
        end if
       
        dprint("-- operator found")
       
        return eval_operators_scan(_
            left(e, a_start)+_
            eval_operators_resolve(_
                oper_found,_
                mid(e, a_start + 1, a_ende - a_start - 1),_
                mid(e, b_start + 1, b_ende - b_start - 1))+_
            mid(e, b_ende))
       
    else
        dprint("-- no operator found")
        if instr(e, "#") then return e else return str(val(e))
    end if
end function

function eval_operators_resolve(id as integer, a as string, b as string) as string
    dprint ("--- operator resolve")
    dprint ("--- resolving ("+str(id)+") <"+chr(34)+a+chr(34)+","+chr(34)+b+chr(34)+">")
    select case as const id
        case  0 : return str(val(a) ^   val(b))
        case  1 : return str(val(a) *   val(b))
        case  2 : return str(val(a) /   val(b))
        case  3 : return str(val(a) \   val(b))
        case  4 : return str(val(a) MOD val(b))
        case  5 : return str(val(a) +   val(b))
        case  6 : return str(val(a) -   val(b))
        case  7 : return str(val(a) >   val(b))
        case  8 : return str(val(a) <   val(b))
        case  9 : return str(val(a) =   val(b))
        case 10 : return str(val(a) >=  val(b))
        case 11 : return str(val(a) <=  val(b))
        case 12 : return str(val(a) <>  val(b))
        case 13 : return str(val(a) AND val(b))
        case 14 : return str(val(a) OR  val(b))
        case 15 : return str(val(a) XOR val(b))
        case 16 : return str(val(a) EQV val(b))
        case 17 : return str(val(a) IMP val(b))
    end select
end function


Nachdem mich dann die Strings irgendwann so richtig angekotzt haben, kam ich auf die glorreiche Idee, das ganze objektorientiert in Knoten aufzulösen, hübsch in einen Namespace zu verpacken, per automatischen casten umzuwandeln, Variablen einzuführen, *wirr sabbel...*:
Code:
'FIKITIV!

dim foobar as calculation = "33+(4*(74 - 8^2))+sin(2*pi)-1"
foobar.addvar("pi", _SINGLE_, 3.141592)

dim as single foo = foobar.result
dim as integer bar = foobar.result

print foo '71.72058450180107
print bar '71


dim fehlerhaft as calculation
fehlerhaft.expression = "5/0"
print fehlerhaft.result '1.#INF

aber allein der schnell zusammengezimmerte Header hatte schon paar KB...

Gruß
Lutz böse Ifer
_________________
Wahnsinn ist nur die Antwort einer gesunden Psyche auf eine kranke Gesellschaft.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 06.10.2006, 14:23    Titel: Antworten mit Zitat

Hi Euer Hochwohlgegrillt,
(oder wie werden angehende Generäle angesprochen ?)
bestimmt kennst du schon:
http://www.freebasic.net/forum/viewtopic.php?t=5934
Aber auch:
http://www.freebasic.net/forum/viewtopic.php?t=5740
ist nicht uninteressant..
(Deins muß ich erstma ankucken grinsen)
[Edit]
anstatt mit deiner Funktion zu 'spielen' habe ich lieber die
ReadMe von krcko in LiesMich.Txt übersetzt..
[Edit2]
Da freebasic.de down ist, und somit auch meine Seite:
Übersetzt von ytwinky nach bestem Wissen und Gewissen
für krcko
--------------------------------------------------------------

Simple Expression Evaluator
(Einfacher Term Auswerter)
v1.1 (Freitag, 15.September, 2006)

von : Aleksandar Ruzicic a.k.a. krcko
mailto : admin@krcko.net

--------------------------------------------------------------

Simple Expression Evaluator (SEE im weiteren Zusammenhang) ist, wie der Name
schon sagt, ein Auswerter für einen mathematischen Ausdruck(Term). Ich begann SEE als einfachen
Auswerter, nur mit Additions- (+ und -) und Multiplikations- (* und /)
Operationen und mit Klammern, später fügte ich weitere Operatoren hinzu
und Unterstützung von Variablen und Funktionen, die den Auwerter nicht mehr so
einfach zu lesen machten, aber ich entschied mich, den Namensteil 'Simple' zu behalten (denn die
Logik ist immer noch einfach) lächeln.

Egal, wer einen Weg sucht, komplexe Terme in seinen
Anwendungen(zur Laufzeit)zu berechnen, hat ihn mit SEE gefunden.


Features(Das übersetz ich nicht grinsen):

- Operatoren:

+ Addition, unäres Plus
- Subtraktion, unäres Minus
* Multiplikation
/ Division
\ Integer Division
% Modulus Operator(Rest)
^ Exponentiation
> Shift Bit rechts
< shift Bit links
& bitweise AND
| bitweise OR
$ bitweise XOR
! bitweise NOT
@ bitweise IMP
= bitweise EQV

- OperatorRangfolge:

! bitweises NOT (höchste Priorität, zuerst ausgewertet)
& bitweises AND
| bitweises OR
$ bitweises XOR
= bitweises EQV
@ bitweises IMP
^ Exponentiation
+ - unäres Plus, unäres Minus
* / Multiplikation, Division
\ Integer Division
% Modulus Operator(Rest)
< > Shift Bit links, Shift Bit rechts
+ - Addition, Subtraktion (geringste Priorität, zuletzt ausgewertet)


- Klammern:

können benutzt werden, um die Operator-Priorität zu umgehen,
aber in den Klammer wird die normale Operator-Priorität benutzt


- Variablen:

Variablen-Namen können aus Buchstaben, Zahlen und Unterstrich (_) bestehen,
aber sie müssen mit einem Buchstaben oder Unterstrich (_) beginnen


- Funktionen:

Die Regeln für Variablen-Namen gelten auch für Funktions-Namen
Funktions-Argumente müssen in Klammern übergeben werden,
auch wenn es kein Funktions-Argument gibt, müssen Klammern da sein
(oder der Name wird als Variable behandelt)


Anwendung:

SEE bleibt im Eval Namespace, d.h. es muß 'Eval.' eingegeben werden,
um die SEE-Funktionen zu erreichen(oder Benutzung von 'Using Eval', aber
das empfehle ich nicht).

"Public members" von SEE:

' udt enthält die Ergebnisse
Eval.Result

' Haupt-Funktion
Eval.Execute(ExpressionString As String) As Eval.Result

' Variablen-Verwaltung
Eval.SetVariable(ByVal VarName As String, Value As Double)
Eval.UnsetVariable(ByVal VarName As String)
Eval.ClearVariables()

' Funktions-Verwaltung
Eval.SetFunction(ByVal FuncName As String, Wrapper As Function(argc As Integer, argv() As Double) As Double)
Eval.UnsetFunction(ByVal FuncName As String)
Eval.ClearFunctions()
Eval.CurrentFunction


Eval.Result ist ein UDT (User Defined Type, oder einfach Type) der die Ergebnisse
der Eval.Execute-Funktion enthält, die Definition ist folgende:

Type Result
Value As Double ' enthält den Wert des Ausdrucks (0 wenn ein Fehler auftrat)
Success As Boolean ' False (0) wenn ein Fehler auftrat, sonst True (-1)
Error As EvalError ' Fehler-Beschreibung
End Type

EvalError-Definition:

Type EvalError
Number As EvalErrorMessage ' Fehler-Nummer (0 to 5)
Description As String ' kurze Fehler-Beschreibung
Position As Integer ' Position im Eingabe-String, an der der Fehler auftrat
Tag As String ' zusätzliche Fehler-Information (nicht erkanntes Token oder undefinierter Variablen-/Funktionsname)
End Type

EvalErrorMessage-Enum:

Enum EvalErrorMessage
ErrorSuccess = 0 ' kein Fehler
ErrorToken ' unerwartetes Token
ErrorBrace ' offene Klammern
ErrorDivByZero ' Division durch Null (nicht eingebaut..)
ErrorUnknownVar ' undefinierte Variable
ErrorUnknownFunc ' undefinierte Funktion
End Enum


Eval.Execute ist die wichtigste SEE-Funktion, um einen Term auszuwerten, wird sie aufgerufen.
Der Prototyp ist:

Function Execute(ExpressionString As String) As Result

Nur ein Argument(ein Term als String) wird übergeben und liefert die Result-Struktur.


Zum Bearbeiten von Variablen dienen diese Funktionen:

Sub SetVariable(ByVal VarName As String, Value As Double)
Sub UnsetVariable(ByVal VarName As String)
Sub ClearVariables()

Eval.SetVariable dient zu, setzen (hinzufügen)von Variablen (doh), Groß-/Kleinscheibung ist bei den Namen egal
Eval.UnsetVariable wird benutzt, um einzelne Variablen zu entfernen
Eval.ClearVariables wird benutzt, um ALLE Variablen zu entfernen


Und zum Arbeiten mit Funktionen sind diese:

Sub SetFunction(ByVal FuncName As String, Wrapper As Function(argc As Integer, argv() As Double) As Double)
Sub UnsetFunction(ByVal FuncName As String)
Sub ClearFunctions()

und Eval.CurrentFunction "property"

Eval.SetFunction dient zum Setzen (hinzufügen) von Funktionen, zweites Argument ist ein Zeiger auf eine Funktion
mit diesem Prototyp:

Function YourFunctionName(argc As Integer, argv() As Double) As Double

also, muß sie zwei Argumente akzeptieren, ein Integer und Array als Double und sie muß einen Double zurückgeben.

Eval.UnsetFunction wird benutzt, um einzelne Funktionen zu entfernen
Eval.ClearFunctions um ALLE Funktionen zu entfernen

Eval.CurrentFunction ist eine Stringvariable, die nur im Funktions-Wrapper
benutzt werden kann und enthält den Namen, der mit der aufgerufenen Funktion verknüpft ist. Das kann
sinnvoll sein, wenn eine (reale) Funktion mehrere SEE-Funktionen benutzt.
In stdeval.bas wird beschrieben, wie das benutzt werden kann.


Ok, genug geredet, hier ist ein Beispiel (Beispiel.bas):

--- FB-Code ----------------------------------------------------------
Code:

  #include "fbeval.bas"

    Dim Result As Eval.Result

    Result = Eval.Execute("2 + 2 / 2") ' Operator-Priorität
    Print "2 + 2 / 2 = "; Result.Value

    Print ' Trenner

    Result = Eval.Execute("(2 + 2) / 2") ' Klammern
    Print "(2 + 2) / 2 = "; Result.Value

    Print ' Trenner

    Result = Eval.Execute("&hff + &b01100110 + &o42") ' hexadezimale, binäre und oktale Zahlen
    Print "&hff + &b01100110 + &o42 = "; Result.Value

    Print ' Trenner

    ' Variable hinzufügen:
    Eval.SetVariable("pi", 3.1415926535897932)
    Result = Eval.Execute("3^2*pi")
    Print "3^2 * pi = "; Result.Value

    Print ' Trenner

    ' schreibe "reale" Funktionen:
    Function averageValue(argc As Integer, argv() As Double) As Double

        Dim i As Integer
        Dim result As Double = 0

        For i = 0 To argc - 1
            result += argv(i)
        Next

        Return (result / argc)

    End Function

    Function add(argc As Integer, argv() As Double) As Double

        Dim i As Integer
        Dim result As Double = 0

        For i = 0 To argc - 1
            result += argv(i)
        Next

        Return result

    End Function

    ' und ergänze sie bei SEE:
    Eval.SetFunction("avg", @averageValue)
    Eval.SetFunction("add", @add)
    Result = Eval.Execute("avg(add(5,42),8,add(2,48,8))")
    Print "avg(add(5,42),8,add(2,48,8)) = "; Result.Value

    Sleep

--- /FB-Code ----------------------------------------------------------


Anmerkung:

SEE kann in jeder vernünftigen Weise genutzt werden, aber es wäre nett, wenn
ich irgendwo genannt werde, es ist nicht erfordelich, aber bedenke den Spruch:
"Gib Cäsar, was des Cäsars ist" lächeln


Danksagung:

- Jack W. Crenshaw für seine "LET'S BUILD A COMPILER!" Textserie, es ist
ein sehr alter Text(Serie begann am 24. July 1988!) aber sehr, sehr
gut und hilfreich für 'Anfenger'(begginers)!

- V1ctor und "crew" für FreeBASIC!
- DIR! weil du das gelesen hast lächeln


Schlußbemerkung:

stdeval.bas definiert einige "standard" Konstanten und Funktionen und wer die
benutzen möchte, muß einfach nur #include stdeval.bas anstatt fbeval.bas verwenden
(aber stdeval.bas und fbeval.bas müssen im selben Directory sein!)

..wenn dus gelesen hast/oder schon kennst(du bist ja recht schnell im Übersetzen happy), weißt du auch warum.
Ich werde mal schauen, inwieweit SEE etwas für mich ist, denn das ist schon fertig..
..und in FreeBASIC(also plattform-unabhängig).

Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..

Zuletzt bearbeitet von ytwinky am 02.02.2008, 22:56, insgesamt 3-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/

BeitragVerfasst am: 16.07.2007, 22:25    Titel: Antworten mit Zitat

*rauskram*

Ich suche eine eval()-Funktion, kann aber mit den Links in diesem Topic nicht viel anfangen, weil ein paar Download-Links bereits nicht mehr funktionieren und eine andere Download-Seite offenbar umstrukturiert wurde (ist ja auch schon alles über ein halbes Jahr her). Könnt ihr mir beim Suchen einer geeigneten Funktion oder Bibliothek behilflich sein?

Sollte aber auch für Linux funktionieren; steht nur hier, weil es zum Thema passt.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 16.07.2007, 22:56    Titel: Antworten mit Zitat

So, in meinen Posts gibts jetzt keine nicht linkenden Links mehr..
(Schönen Dank für dein Interesse) grinsen
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/

BeitragVerfasst am: 16.07.2007, 23:04    Titel: Antworten mit Zitat

Wo bekommt man denn die Bibliothek her? Wie gesagt, die Seite, auf die krcko auf freebasic.net verwiesen hat, gibt es wohl nicht mehr.

edit: erledigt. Danke für die Hilfe happy
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 16.07.2007, 23:37    Titel: Antworten mit Zitat

Ich denke mal, daß nemored die Datei schon hat, falls sonst noch jemand die Datei benötigt:
[Edit19.08.2007]
see.rar in zwei Versionen mit LiesMich.Txt
..ohne Call und ohne Exe-Dateien, Compiler hat ja wohl jeder lachen
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..

Zuletzt bearbeitet von ytwinky am 19.08.2007, 14:59, insgesamt 3-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 19.08.2007, 11:43    Titel: Antworten mit Zitat

Ich habe gerade noch mal nachgesehen..
In den beiden letzten Posts auf der Seite hat yetifoot Links zu offensichtlich aktuelleren Versionen gepostet..
Die Versionen auf ytwinky.freebasic.de werden heute noch geupdatet..
[Edit]
(Die Datei LiesMich.Txt ist (jetzt) komplett in deutsch)
Link siehe voriger Post.
Sry, my bad verlegen
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..

Zuletzt bearbeitet von ytwinky am 20.08.2007, 16:25, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192

BeitragVerfasst am: 19.08.2007, 21:26    Titel: Antworten mit Zitat

Hi,
in den neueren Versionen sind weniger Funktionen definiert? traurig
Da bleibe ich bei der alten Version. happy
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz