XProfan

Deutsch

Sven
Bader

Die mächtige Sache hieran ist eigentlich die Verwendung von cURL, da sich so komplexe Web-Anfragen per POST auch JSON kodiert versenden lassen. cURL ist seit 2018 Teil von Windows 10 und auch in Windows 11 verfügbar, mit Windows 7/8 wird es nicht ohne weiteres gehen.

Die Antwort wird dann aus der Konsole geholt.

Ihr benötigt einen eigenen API-Schlüssel. Man muss zwar ein paar Dollar hinterlegen aber ich habe nach rund 100 (kleineren) Anfragen gerade einmal einen Cent verbraucht. ( [...]

)

Der Code funktioniert mit X4 aber auch mit XProfan 10. Viel Spaß beim Testen

Kompilieren Markieren Separieren

 $H Windows.ph
Def GetSysColor(1)      !"USER32", "GetSysColor"'Systemfarben abfragen

Proc Utf8Decode

    'in neueren XProfan Versionen wird automatisch die gleichnamige interne Funktion verwendet
    Parameters utf8$
    Declare ansistring$, unicode$, laenge&
    laenge& = len(utf8$) * 2
    unicode$ = mkstr$(chr$(0),laenge&)
    ~MultiByteToWideChar(~CP_UTF8,0,Addr(utf8$),-1,Addr(unicode$),laenge&)
    ansistring$ = mkstr$(chr$(0),laenge&)
    ~WideCharToMultiByte(~CP_ACP,0,Addr(unicode$),-1,Addr(ansistring$),laenge&,0,0)
    ansistring$ = substr$(ansistring$,1,chr$(0))
    Return ansistring$

EndProc

Proc CMDOut

    'ursprünglich von Andreas Miethe
    Parameters Progname$,Command$,MemBuffer&
    Struct PROCESS_INFORMATION = hProcess&,hThread&,dwProcessId&,dwThreadId&
    Struct SECURITY_ATTRIBUTES =  nLength&,lpSecurityDescriptor&,bInheritHandle&
    Struct STARTUPINFO =cb&,lpReserved&,lpDesktop&,lpTitle&,dwX&,dwY&,dwXSize&,dwYSize&,dwXCountChars&,dwYCountChars&,dwFillAttribute&,dwFlags&,wShowWindow%,cbReserved2%,lpReserved2&,hStdInput&,hStdOutput&,hStdError&
    Def &NORMAL_PRIORITY_CLASS  $20
    Def &STARTF_USESTDHANDLES  $100
    Def &STARTF_USESHOWWINDOW  $1
    Declare hRPipe&,hWPipe&,pRBytes&,Result&
    Declare PI#,SI#,SA#, out$
    Dim PI#,PROCESS_INFORMATION
    Dim SI#,STARTUPINFO
    Dim SA#,SECURITY_ATTRIBUTES
    Declare StringBuffer$, output$
    StringBuffer$ = Space$(MemBuffer&)
    SA#.nLength& =SizeOf(SA#)
    SA#.bInheritHandle& = 1
    SA#.lpSecurityDescriptor& = 0
    Result& = ~CreatePipe(Addr(hRPipe&), Addr(hWPipe&), SA#, 0)

    If Result& = 0

        Return ""'MessageBox("Pipe konnte nicht gestartet werden","",0)

    EndIf

    If Progname$ <> ""

        Command$ = " " + Command$

    EndIf

    SI#.cb& = SizeOf(SI#)
    SI#.dwFlags& = &STARTF_USESHOWWINDOW | &STARTF_USESTDHANDLES
    SI#.hStdOutput& = hWPipe&
    SI#.hStdError& = hWPipe&

    If Progname$ = ""

        Result& = ~CreateProcess(0, Addr(Command$), SA#, SA#, 1, &NORMAL_PRIORITY_CLASS, 0, 0, SI#,PI#)

    Else

        Result& = ~CreateProcess(Addr(Progname$), Addr(Command$),SA#,SA#,1,&NORMAL_PRIORITY_CLASS, 0, 0,SI#,PI#)

    EndIf

    If Result& <> 1

        Return ""'MessageBox("Datei nicht gefunden","",0)

    EndIf

    Result& = ~CloseHandle(hWPipe&)

    While Result& <> 0

        Result& = ~ReadFile(hRPipe&,Addr(StringBuffer$),MemBuffer&,Addr(pRBytes&), 0)

        If pRBytes& > 0

            Out$ = Left$(StringBuffer$,pRBytes&)
            output$ = output$ + Out$

        EndIf

    EndWhile

    ~CloseHandle(PI#.hProcess&)
    ~CloseHandle(PI#.hThread&)
    ~CloseHandle(hRPipe&)
    Dispose PI#
    Dispose SI#
    Dispose SA#
    output$ = Utf8Decode(output$)
    Return output$

EndProc

WindowStyle 1+2+4+8+16
WindowTitle "ChatGPT"
Window 100,100 - 650,600;0
Cls GetSysColor(15)'Fensterfarbe
UserMessages 16
UseFont "Tahoma",15,0,0,0,0'Standardfont
SetDialogFont 1
Declare edit&,font&[10],button&,text&
Font&[1] = Create("Font","Tahoma",15,0,0,0,0)'normal
text& = Create("Text",%hWnd,"", 20, 20, 600, 320)
Edit& = Create("MultiEdit", %hWnd, "", 20, 400, 600, 96)
button& = Create("Button", %hWnd, "Senden", 20, 500, 600, 24)
SetFont Edit&,font&[1]

Proc GPT

    Parameters prompt$
    Declare api_key$, endpoint$, payload$, response$,responseJson$, content$,model$,curl_exe$
    Declare curl_command$
    curl_exe$ =  trim$(CMDOut("", "where curl", 8192))
    api_key$  = "sk-proj-..........................................................................................."
    endpoint$ = "https://api.openai.com/v1/chat/completions"
    content$  = ""'Vorabbriefing, z.B. "Du bist Yoda aus Star Wars."
    model$    = "gpt-4o-mini"
    payload$ = "{\\\qmodel\\\q:\\\q" + model$ + "\\\q,\\\qmessages\\\q:[{\\\qrole\\\q:\\\qsystem\\\q,\\\qcontent\\\q:\\\q" + content$ + "\\\q},{\\\qrole\\\q:\\\quser\\\q,\\\qcontent\\\q:\\\q" + prompt$ + "\\\q}]}"
    curl_command$ = curl_exe$ + " -s -k -X POST " + endpoint$ + " -H \qAuthorization: Bearer " + api_key$ + "\q -H \qContent-Type: application/json\q -d \q" + payload$ + "\q"
    responseJson$ =  CMDOut("", curl_command$, 8192)
    'Man könnte auch die JSON Funktionen von XProfan X4 verwenden, aber nicht ohne Umwege über eine Datei
    response$ =  translate$(responseJson$,"\\\q", "\\q")' \" in XProfan-Syntax umwandeln (noch escaped)
    response$ =  Substr$(response$,2, "\qcontent\q: \q")' Antwort extrahieren
    response$ =  Substr$(response$,1, "\q")' Antwort extrahieren
    response$ =  translate$(response$,"\\q", "\q")' Anführungszeichen final kodieren
    response$ =  translate$(response$,"\\n","\n" )' Zeilenumbrüche

    If (response$ = "")

        SetText text&,  responseJson$

    Else

        SetText text&,  response$

    EndIf

EndProc

WhileNot (%umessage = 16)

    WaitInput

    If Clicked(button&)

        GPT(gettext$(edit&))

    EndIf

EndWhile