dupa

Author Topic: Calling all Coders, Programmers and VB6 writers  (Read 5599 times)

cyberjedi

  • Hero Member
  • *****
  • Posts: 895
  • The Mighty Hal Machine
    • View Profile
Re: Calling all Coders, Programmers and VB6 writers
« Reply #15 on: October 05, 2024, 02:57:08 am »
For communicating with Chatgpt
The idea here is train Ultrahal directly from chatgpt, just let them talk things out while Hal learns. BOOM
whos ur daddy now



*********************************************************************
' File: frmChatGPT.vb
' Description: VB6 program to interact with OpenAI's ChatGPT API
' Add reference to MSXML2 for HTTP requests: Project -> References -> Microsoft XML, v6.0

Private Sub Command1_Click()
    ' Get the user's input from Text1
    Dim userInput As String
    userInput = Text1.Text
   
    ' OpenAI API key (replace with your actual key)
    Dim apiKey As String
    apiKey = "your_openai_api_key"
   
    ' Send the request and get the response
    Dim response As String
    response = SendChatGPTRequest(userInput, apiKey)
   
    ' Display the response in Text2
    Text2.Text = response
End Sub

Private Function SendChatGPTRequest(prompt As String, apiKey As String) As String
    Dim http As Object
    Dim url As String
    Dim requestBody As String
    Dim jsonResponse As String
    Dim parsedResponse As String
   
    ' Create the MSXML2.ServerXMLHTTP object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
   
    ' OpenAI API endpoint for completions
    url = "https://api.openai.com/v1/completions"
   
    ' JSON body for the request (using the text-davinci-003 model)
    requestBody = "{""model"":""text-davinci-003"",""prompt"":""" & prompt & """,""max_tokens"":100,""temperature"":0.7}"
   
    ' Open the request
    http.Open "POST", url, False
   
    ' Set request headers
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & apiKey
   
    ' Send the request with the JSON body
    http.send requestBody
   
    ' Get the JSON response
    jsonResponse = http.responseText
   
    ' Parse the response to extract the generated text
    parsedResponse = ParseJSONForText(jsonResponse)
   
    ' Return the parsed response
    SendChatGPTRequest = parsedResponse
End Function

Private Function ParseJSONForText(jsonResponse As String) As String
    ' This function extracts the "text" field from the JSON response
    Dim startPos As Long
    Dim endPos As Long
    Dim responseText As String
   
    ' Find the position of the "text" field in the JSON response
    startPos = InStr(jsonResponse, """text"":") + Len("""text"":")
   
    ' Find the position of the next double quote after the "text" field
    endPos = InStr(startPos, jsonResponse, """")
   
    ' Extract the text content
    responseText = Mid(jsonResponse, startPos + 1, endPos - startPos - 1)
   
    ' Return the extracted text
    ParseJSONForText = responseText
End Function
********************************************************************
' File: JsonParser.cls
' Description: A JSON parser for VB6 that parses JSON into Dictionary and Collection objects

Option Explicit

Private jsonString As String
Private position As Long

' Entry point for parsing JSON
Public Function ParseJSON(json As String) As Variant
    ' Initialize the global variables
    jsonString = Trim(json)
    position = 1
   
    ' Start parsing from the first token
    ParseJSON = ParseValue()
End Function

' Main function to parse a value (object, array, string, number, boolean, or null)
Private Function ParseValue() As Variant
    SkipWhitespace
   
    Select Case Mid(jsonString, position, 1)
        Case "{"
            ParseValue = ParseObject()
        Case "["
            ParseValue = ParseArray()
        Case """"
            ParseValue = ParseString()
        Case "t", "f" ' true or false
            ParseValue = ParseBoolean()
        Case "n" ' null
            ParseValue = ParseNull()
        Case Else
            If IsNumeric(Mid(jsonString, position, 1)) Or Mid(jsonString, position, 1) = "-" Then
                ParseValue = ParseNumber()
            Else
                Err.Raise vbObjectError + 1000, "ParseValue", "Invalid JSON value"
            End If
    End Select
End Function

' Function to parse a JSON object and return it as a Dictionary
Private Function ParseObject() As Dictionary
    Dim result As Dictionary
    Dim key As String
    Dim value As Variant
   
    Set result = New Dictionary
   
    ' Consume the '{' character
    position = position + 1
    SkipWhitespace
   
    ' Loop through key-value pairs
    Do While Mid(jsonString, position, 1) <> "}"
        ' Parse key (should be a string)
        key = ParseString()
       
        SkipWhitespace
       
        ' Consume the ':' character
        If Mid(jsonString, position, 1) <> ":" Then
            Err.Raise vbObjectError + 1001, "ParseObject", "Expected ':' after key"
        End If
        position = position + 1
       
        ' Parse value
        value = ParseValue()
       
        ' Add key-value pair to the result
        result.Add key, value
       
        SkipWhitespace
       
        ' Check if we are done with the object
        If Mid(jsonString, position, 1) = "}" Then
            Exit Do
        ElseIf Mid(jsonString, position, 1) <> "," Then
            Err.Raise vbObjectError + 1002, "ParseObject", "Expected ',' or '}' in object"
        End If
       
        ' Consume the ',' character and continue
        position = position + 1
        SkipWhitespace
    Loop
   
    ' Consume the '}' character
    position = position + 1
   
    Set ParseObject = result
End Function

' Function to parse a JSON array and return it as a Collection
Private Function ParseArray() As Collection
    Dim result As Collection
    Dim value As Variant
   
    Set result = New Collection
   
    ' Consume the '[' character
    position = position + 1
    SkipWhitespace
   
    ' Loop through values
    Do While Mid(jsonString, position, 1) <> "]"
        ' Parse value
        value = ParseValue()
       
        ' Add value to the result
        result.Add value
       
        SkipWhitespace
       
        ' Check if we are done with the array
        If Mid(jsonString, position, 1) = "]" Then
            Exit Do
        ElseIf Mid(jsonString, position, 1) <> "," Then
            Err.Raise vbObjectError + 1003, "ParseArray", "Expected ',' or ']' in array"
        End If
       
        ' Consume the ',' character and continue
        position = position + 1
        SkipWhitespace
    Loop
   
    ' Consume the ']' character
    position = position + 1
   
    Set ParseArray = result
End Function

' Function to parse a JSON string
Private Function ParseString() As String
    Dim result As String
    Dim ch As String
   
    ' Consume the opening '"' character
    position = position + 1
   
    Do
        ch = Mid(jsonString, position, 1)
       
        ' Check for end of string
        If ch = """" Then
            position = position + 1
            Exit Do
        End If
       
        ' Handle escape characters
        If ch = "\" Then
            position = position + 1
            ch = Mid(jsonString, position, 1)
            Select Case ch
                Case """", "\", "/"
                    result = result & ch
                Case "b"
                    result = result & Chr(8)
                Case "f"
                    result = result & Chr(12)
                Case "n"
                    result = result & vbLf
                Case "r"
                    result = result & vbCr
                Case "t"
                    result = result & vbTab
                Case Else
                    Err.Raise vbObjectError + 1004, "ParseString", "Invalid escape character"
            End Select
        Else
            result = result & ch
        End If
       
        ' Move to the next character
        position = position + 1
    Loop
   
    ParseString = result
End Function

' Function to parse a JSON number
Private Function ParseNumber() As Double
    Dim startPos As Long
    Dim numStr As String
   
    ' Start position of the number
    startPos = position
   
    ' Loop through valid number characters
    Do While IsNumeric(Mid(jsonString, position, 1)) Or Mid(jsonString, position, 1) = "." Or Mid(jsonString, position, 1) = "-" Or Mid(jsonString, position, 1) = "e" Or Mid(jsonString, position, 1) = "E"
        position = position + 1
    Loop
   
    ' Extract the number substring
    numStr = Mid(jsonString, startPos, position - startPos)
   
    ' Convert to double
    ParseNumber = CDbl(numStr)
End Function

' Function to parse a JSON boolean (true/false)
Private Function ParseBoolean() As Boolean
    If Mid(jsonString, position, 4) = "true" Then
        ParseBoolean = True
        position = position + 4
    ElseIf Mid(jsonString, position, 5) = "false" Then
        ParseBoolean = False
        position = position + 5
    Else
        Err.Raise vbObjectError + 1005, "ParseBoolean", "Invalid boolean value"
    End If
End Function

' Function to parse JSON null
Private Function ParseNull() As Variant
    If Mid(jsonString, position, 4) = "null" Then
        ParseNull = Null
        position = position + 4
    Else
        Err.Raise vbObjectError + 1006, "ParseNull", "Invalid null value"
    End If
End Function

' Utility function to skip whitespace
Private Sub SkipWhitespace()
    Do While position <= Len(jsonString) And (Mid(jsonString, position, 1) = " " Or Mid(jsonString, position, 1) = vbTab Or Mid(jsonString, position, 1) = vbLf Or Mid(jsonString, position, 1) = vbCr)
        position = position + 1
    Loop
End Sub


cyber


Private Sub Command1_Click()
    Dim jsonString As String
    Dim parsedData As Variant
   
    jsonString = "{""name"": ""John"", ""age"": 30, ""isStudent"": false, ""courses"": [""Math"", ""Science""]}"
   
    ' Parse the JSON
    parsedData = ParseJSON(jsonString)
   
    ' Accessing data from the parsed result (which is a Dictionary)
    MsgBox parsedData("name") ' Outputs: John
    MsgBox parsedData("age")  ' Outputs: 30
End Sub
« Last Edit: October 07, 2024, 08:17:01 am by cyberjedi »

Checker57

  • Full Member
  • ***
  • Posts: 141
    • View Profile
Re: Calling all Coders, Programmers and VB6 writers
« Reply #16 on: November 01, 2024, 12:56:58 am »
Visiting tonight after a while and am quite impressed with these AI graphic generations.  Seems you, Cyber, have spawned a new talent in the AI graphic leanings.  Very cool stuff!

Checker57