Add files via upload

clsOpenAI.cls

@@ -42,7 +42,7 @@ Private mobjHttpRequest As Object
 Private mobjLogger As clsOpenAILogger
 Private mobjRequest As clsOpenAIRequest
 
-'Open AI defined constants
+'OpenAI API Endpoints
 Private Const API_ENDPOINT_CHAT As String = "https://api.openai.com/v1/chat/completions"
 Private Const API_ENDPOINT_COMPLETIONS As String = "https://api.openai.com/v1/completions"
 Private Const API_ENDPOINT_IMAGE_CREATION As String = "https://api.openai.com/v1/images/generations"
@@ -57,11 +57,17 @@ Private Const DEFAULT_TEXT_COMPLETION_MODEL As String = "text-davinci-003"
 Private Const DEFAULT_CHAT_TOKENS_COUNT As Integer = 512
 Private Const DEFAULT_TEXT_TOKENS_COUNT As Integer = 1024
 
+'Project constants
 Private Const UNASSIGNED_VALUE As Integer = -1
 Private Const MESSAGE_INVALID_API_KEY As String = "An OpenAI API key is either invalid or has not been specified!"
 Private Const HTTP_STATUS_OK As Long = 200 ' OK
 Private Const HTTP_REQUEST_COMPLETED As Integer = 4
 
+'This allows configuration of different HHTP Requests
+Private Const MSXML_XML As String = "MSXML2.XMLHTTP"
+Private Const MSXML_SERVER_XML As String = "MSXML2.ServerXMLHTTP"
+Private Const MSXML_DEFAULT As String = MSXML_XML
+Private mstrMSXMLType As String
 
 Private Function IOpenAINameProvider_GetClassName() As String
     IOpenAINameProvider_GetClassName = "clsOpenAI"
@@ -79,6 +85,31 @@ Public Property Get API_KEY() As String
     API_KEY = mstrAPI_KEY
 End Property
 
+Public Property Let MSXMLType(ByVal value As String)
+'This allows calling proceedures to change the default type of XML HTTP Request
+
+    'These are the only values allowed for this
+    If (value <> Me.MSXML_SERVER_XML_VALUE) And (value <> Me.MSXML_XML_VALUE) Then
+        Call mobjLogger.PrintCriticalMessage("Invalid MSXML type specified!")
+    Else
+        mstrMSXMLType = value
+    End If
+End Property
+
+Public Property Get MSXMLType() As String
+    MSXMLType = mstrMSXMLType
+End Property
+
+'This method allows for the MSXML_XML constant to be accessible outside of the class
+Public Property Get MSXML_XML_VALUE() As String
+    MSXML_XML_VALUE = MSXML_XML
+End Property
+
+'This method allows for the MSXML_SERVER_XML constant to be accessible outside of the class
+Public Property Get MSXML_SERVER_XML_VALUE() As String
+    MSXML_SERVER_XML_VALUE = MSXML_SERVER_XML
+End Property
+
 Public Property Let Model(ByVal value As String)
      mobjRequest.Model = value
 End Property
@@ -145,16 +176,21 @@ On Error GoTo ERR_HANDLER:
     'default return value
     Set GetResponseFromAPI = Nothing
 
-    If mobjHttpRequest Is Nothing Then
-        GoTo EXIT_HERE
-    End If
+    Set mobjHttpRequest = CreateObject(mstrMSXMLType)
 
     'talk to OpenAI
     With mobjHttpRequest
+
+        If mstrMSXMLType = MSXML_SERVER_XML Then
+            .setTimeouts mobjRequest.TimeoutResolve, mobjRequest.TimeoutConnect, _
+                         mobjRequest.TimeoutSend, mobjRequest.TimeoutReceive
+        End If
+
         .Open "POST", strEndPoint, False
         .SetRequestHeader "Content-Type", "application/json"
         .SetRequestHeader "Authorization", "Bearer " & mstrAPI_KEY
         .Send (strRequestJson)
+
     End With
 
     ' unblock other processes if still querying OpenAI
@@ -271,7 +307,7 @@ Public Function ChatCompletion(ByVal oMessages As clsOpenAIMessages) As clsOpenA
         Exit Function
     End If
 
-    If mobjHttpRequest Is Nothing Or oMessages Is Nothing Then
+    If oMessages Is Nothing Then
         Exit Function
     End If
 
@@ -302,7 +338,7 @@ Public Function TextCompletion(ByVal strPrompt As String) As clsOpenAIResponse
         Exit Function
     End If
 
-    If mobjHttpRequest Is Nothing Or strPrompt = Empty Then
+    If strPrompt = Empty Then
         Exit Function
     End If
 
@@ -325,7 +361,7 @@ End Function
 
 Private Sub Class_Initialize()
 
-    Set mobjHttpRequest = CreateObject("MSXML2.XMLHTTP")
+    mstrMSXMLType = MSXML_DEFAULT
     Set mobjRequest = GetDefaultRequestSettings
 
     Set mobjLogger = New clsOpenAILogger
@@ -361,13 +397,27 @@ Private Function GetDefaultRequestSettings() As clsOpenAIRequest
         .PresencePenalty = 0
         .ImageHeight = 256
         .ImageWidth = 256
+        .TimeoutConnect = 30000
+        .TimeoutReceive = 30000
+        .TimeoutResolve = 30000
+        .TimeoutSend = 60000
     End With
     Set GetDefaultRequestSettings = oRequest
 
     Set oRequest = Nothing
 End Function
 
 
+Public Sub SetTimeOutDefaults(ByVal lngConnect As Long, ByVal lngReceive As Long, ByVal lngResolve As Long, ByVal lngSend As Long)
+    If Not mobjRequest Is Nothing Then
+        mobjRequest.TimeoutConnect = lngConnect
+        mobjRequest.TimeoutReceive = lngReceive
+        mobjRequest.TimeoutResolve = lngResolve
+        mobjRequest.TimeoutSend = lngSend
+    End If
+End Sub
+
+
 Public Sub ClearSettings()
 'Purpose: Reset the settings if switching between endpoints
 
@@ -411,7 +461,7 @@ Public Function CreateImageFromText(ByVal strPrompt As String, ByVal lngWidth As
         Exit Function
     End If
 
-    If mobjHttpRequest Is Nothing Or strPrompt = Empty Then
+    If strPrompt = Empty Then
         Exit Function
     End If
 

clsOpenAIRequest.cls

@@ -48,6 +48,12 @@ Private mstrPrompt As String
 Private mlngImageWidth As Long
 Private mlngImageHeight As Long
 
+'Resolve, Connect, Send and Receive
+Private mlngTimeoutResolve As Long
+Private mlngTimeoutConnect As Long
+Private mlngTimeoutSend As Long
+Private mlngTimeoutReceive As Long
+
 
 Private Function IOpenAINameProvider_GetClassName() As String
     IOpenAINameProvider_GetClassName = "clsOpenAIRequest"
@@ -125,6 +131,38 @@ Public Property Let ImageWidth(ByVal value As Long)
     mlngImageWidth = value
 End Property
 
+Public Property Let TimeoutResolve(ByVal value As Long)
+    mlngTimeoutResolve = value
+End Property
+
+Public Property Get TimeoutResolve() As Long
+    TimeoutResolve = mlngTimeoutResolve
+End Property
+
+Public Property Let TimeoutConnect(ByVal value As Long)
+    mlngTimeoutConnect = value
+End Property
+
+Public Property Get TimeoutConnect() As Long
+    TimeoutConnect = mlngTimeoutConnect
+End Property
+
+Public Property Let TimeoutSend(ByVal value As Long)
+    mlngTimeoutSend = value
+End Property
+
+Public Property Get TimeoutSend() As Long
+    TimeoutSend = mlngTimeoutSend
+End Property
+
+Public Property Let TimeoutReceive(ByVal value As Long)
+    mlngTimeoutReceive = value
+End Property
+
+Public Property Get TimeoutReceive() As Long
+    TimeoutReceive = mlngTimeoutReceive
+End Property
+
 
 Public Function GetChatSendToAPIJsonString() As String
     GetChatSendToAPIJsonString = "{""model"": """ & mstrModel & """, " & mobjMessages.GetAllMessages & ", ""max_tokens"": " & mlngMaxTokens & ", ""top_p"": " & mdblTopP & ", ""temperature"": " & mdblTemperature & ", ""frequency_penalty"": " & mdblFrequencyPenalty & ", ""presence_penalty"": " & mdlPresencePenalty & "}"

mdOpenAI_Examples.bas

@@ -108,7 +108,7 @@ Public Sub TestTextCompletionOpenAI()
 
     oOpenAI.API_KEY = API_KEY
 
-    sMsg = "Write a Haiku about a Dinosaur that loves to code!"
+    sMsg = "Write a Haiku about a dinosaur that loves to code!"
     Set oResponse = oOpenAI.TextCompletion(sMsg)
 
     If Not oResponse Is Nothing Then
@@ -140,7 +140,7 @@ Public Sub TestTextCompletionSimpleOpenAI()
 
     oOpenAI.API_KEY = API_KEY
 
-    Set oResponse = oOpenAI.TextCompletion("Write a Haiku about a Dinosaur that loves to code!")
+    Set oResponse = oOpenAI.TextCompletion("Write a Haiku about a dinosaur that loves to code!")
 
     If Not oResponse Is Nothing Then
         Debug.Print (oResponse.TextContent)

mdOpenAI_Tests.bas

@@ -27,24 +27,60 @@ Attribute VB_Name = "mdOpenAI_TESTS"
 
 Option Explicit
 
+#If VBA7 Then
+    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
+#Else
+    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+#End If
+
 '******************************************************
 ' GET YOUR API KEY: https://openai.com/api/
 Public Const API_KEY As String = "<API_KEY>"
 '******************************************************
 
 
-Public Sub TestOpenAI()
+Public Sub RunAllTests()
+'********************************************************************************
 'Purpose: This tests all endpoints are being queried correctly and returning data
+'********************************************************************************
+
+    Dim arrMSXMLTypes(1 To 3) As String
+    Dim oOpenAI As New clsOpenAI
+
+    oOpenAI.IsLogOutputRequired True
+    oOpenAI.API_KEY = API_KEY
+
+    ' Assign all posssible MSXML types
+    arrMSXMLTypes(1) = Empty
+    arrMSXMLTypes(2) = oOpenAI.MSXML_XML_VALUE
+    arrMSXMLTypes(3) = oOpenAI.MSXML_SERVER_XML_VALUE
+
+    ' Declare a variable for the loop index
+    Dim i As Integer
+
+    ' Loop through each item in the array
+    For i = LBound(arrMSXMLTypes) To UBound(arrMSXMLTypes)
+        DoEvents
+        oOpenAI.Log arrMSXMLTypes(i)
+        Call TestOpenAI(oOpenAI, arrMSXMLTypes(i))
+        Sleep 1000
+    Next i
+
+    Set oOpenAI = Nothing
+
+End Sub
+
+
+Private Sub TestOpenAI(ByVal oOpenAI As clsOpenAI, Optional ByVal strRequestXMLType As String)
 
-    Dim oOpenAI As clsOpenAI
     Dim oMessages As New clsOpenAIMessages
     Dim oResponse As clsOpenAIResponse
-
-    Set oOpenAI = New clsOpenAI
+
+    If strRequestXMLType <> Empty Then
+        oOpenAI.MSXMLType = oOpenAI.MSXML_SERVER_XML_VALUE
+    End If
 
     'All output to sent to immediate window
-    oOpenAI.IsLogOutputRequired True
-    oOpenAI.API_KEY = API_KEY
     oOpenAI.Temperature = 0
 
     '*********************************************
@@ -70,7 +106,20 @@ Public Sub TestOpenAI()
     '*********************************************
 
     oMessages.AddUserMessage "write a string of digits in order up to 9"
+    oOpenAI.Temperature = 0.9
+    Set oResponse = oOpenAI.ChatCompletion(oMessages)
+
+    Debug.Assert Not oResponse Is Nothing
+    Debug.Assert Len(oResponse.MessageContent) > 0
+    Debug.Assert oResponse.MessageContent = "123456789"
+    Debug.Assert oResponse.MessageRole = "assistant"
+
+    '*********************************************
+    '(3) Change timeouts
+    '*********************************************
 
+    oMessages.AddUserMessage "write a string of digits in order up to 9"
+    oOpenAI.SetTimeOutDefaults 5000, 5000, 5000, 5000
     Set oResponse = oOpenAI.ChatCompletion(oMessages)
 
     Debug.Assert Not oResponse Is Nothing
@@ -79,7 +128,7 @@ Public Sub TestOpenAI()
     Debug.Assert oResponse.MessageRole = "assistant"
 
     '*********************************************
-    '(3) Text completion test
+    '(4) Text completion test
     '*********************************************
 
     Dim strMsg As String
@@ -95,7 +144,7 @@ Public Sub TestOpenAI()
     oOpenAI.Log (oResponse.TextContent)
 
     '*********************************************
-    '(4) Image creation from prompt test
+    '(5) Image creation from prompt test
     '*********************************************
 
     oOpenAI.ClearSettings
@@ -106,7 +155,6 @@ Public Sub TestOpenAI()
     Debug.Assert Len(Dir(oResponse.SavedLocalFile)) > 0
 
     Set oResponse = Nothing
-    Set oOpenAI = Nothing
     Set oMessages = Nothing
 
 End Sub