Show Posts
1
General Discussion / Re: Calling all Coders, Programmers and VB6 writers
« 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(
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
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(
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