Zabaware Support Forums
Zabaware Forums => Ultra Hal Assistant File Sharing Area => Topic started by: cyberjedi on July 12, 2025, 08:09:28 pm
-
Rem Type=Plugin
Rem Name= Grock
Rem Author= This is your basic plugin layout.The function call is what fires.
Rem Host=All
Rem PLUGIN: PRE-PROCESS
'The preceding comment is actually a plug-in directive for
'the Ultra Hal host application. It allows for code snippets
'to be inserted here on-the-fly based on user configuration.
HalBrain.ReadOnlyMode = False
'Determines that you are talking about the Grock
If InStr(1,InputString, "Grock",1) > 0 Then
UltraHal = GetGrock(HalCommands)
ElseIf InStr(1,InputString, "Grock",1) > 0 Then
End If
Rem PLUGIN: FUNCTIONS
'Rem Weather the code in the function works is another thing but as a plugin with trigger, This is correct. Triggered by the word Grock.
Function Grock(HalCommands)
' Global variables for memory, subjects, spell correction, and file learning
Public responseMemory As Object ' Dictionary for responses
Public questionMemory As Object ' Dictionary for questions
Public contextMemory As Object ' Dictionary for conversation context
Public responseQuality As Object ' Track response quality ratings
Public shortTermMemory As Object ' Dictionary for recent conversation
Public SubjectTable As Object ' Dictionary for subject-based logic (A-Z subjects)
Public spellDictionary As Object ' Dictionary for spell checking
Public longTermIndex As Object ' Dictionary for long-term memory indexing
Public knowledgeBase As Object ' Dictionary for learned file content
Public Const MAX_SHORT_TERM As Long = 15 ' Increased limit for short-term memory
Public Const MAX_KNOWLEDGE_ENTRIES As Long = 5000 ' Limit for knowledge base entries
' **** USER: EDIT THIS LINE TO SET YOUR ULTRA HAL BRAIN DIRECTORY PATH ****
Public Const BASE_PATH As String = "C:\Users\airva\AppData\Roaming\Zabaware\Ultra Hal 7\ANGELINAJOLIE2050.db" ' User-specified path
Private Const MEMORY_FILE As String = "memory.txt"
Private Const LONG_TERM_FILE As String = "memorydata.txt"
Private Const LONG_TERM_INDEX_FILE As String = "memoryindex.txt"
Private Const LOG_FILE As String = "errorlog.txt"
Private Const SPELL_DICT_FILE As String = "spell_dictionary.txt"
Private Const KNOWLEDGE_FILE As String = "knowledge_base.txt"
Private lastSubject As String ' Track last primary subject for continuity
Private lastTone As String ' Track conversational tone for continuity
' HAL 7 Plugin Function
Public Function HalBrain(ByVal InputString, ByVal UserName, ByVal ComputerName, ByVal HalCommands, ByVal Holiday, ByVal HolidayType)
On Error GoTo ErrorHandler
' Validate BASE_PATH and permissions
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(BASE_PATH) Then
HalBrain = "Error: The specified brain directory (" & BASE_PATH & ") does not exist. Please update the BASE_PATH in the script."
Exit Function
End If
' Check write permissions by attempting to create a temporary file
Dim tempFilePath As String
tempFilePath = BASE_PATH & "temp_permissions_test.txt"
On Error Resume Next
Dim tempFile
Set tempFile = objFSO.CreateTextFile(tempFilePath, True)
If Err.Number <> 0 Then
HalBrain = "Error: No write permissions for the brain directory (" & BASE_PATH & "). Please ensure the directory is accessible."
Exit Function
End If
tempFile.Close
objFSO.DeleteFile tempFilePath
On Error GoTo ErrorHandler
' Initialize memory system
InitializeMemory
Dim response As String
response = EnhanceHalResponse(InputString, "Hey " & UserName & ", what's on your mind today?", "")
' Return the response
HalBrain = response
Exit Function
ErrorHandler:
LogError "HalBrain: " & Err.Description
HalBrain = "Oops, something went wrong. Can we try that again?"
End Function
' Initialization with enhanced memory, subjects, spell dictionary, and knowledge base
Sub InitializeMemory()
Set responseMemory = CreateObject("Scripting.Dictionary")
Set questionMemory = CreateObject("Scripting.Dictionary")
Set contextMemory = CreateObject("Scripting.Dictionary")
Set responseQuality = CreateObject("Scripting.Dictionary")
Set shortTermMemory = CreateObject("Scripting.Dictionary")
Set SubjectTable = CreateObject("Scripting.Dictionary")
Set spellDictionary = CreateObject("Scripting.Dictionary")
Set longTermIndex = CreateObject("Scripting.Dictionary")
Set knowledgeBase = CreateObject("Scripting.Dictionary")
InitializeSubjectTable
LoadMemoryFromFile
LoadLongTermMemory
LoadSpellDictionary
LoadKnowledgeBase
lastSubject = "Questions" ' Default subject
lastTone = "Friendly" ' Default conversational tone
End Sub
' Initialize Subject Table with weighted keywords (expanded for broader coverage)
Private Sub InitializeSubjectTable()
SubjectTable.Add "Animals", "dog:3 cat:3 bird:2 fish:2 zoo:3 wildlife:3 pet:4 fur:2 animal:4"
SubjectTable.Add "Books", "novel:3 read:3 author:3 library:2 story:3 page:2 chapter:2 book:4"
SubjectTable.Add "Computers", "code:4 program:3 software:3 hardware:3 ai:4 data:3 network:2 computer:4"
SubjectTable.Add "Dreams", "sleep:3 night:2 vision:3 dream:4 imagination:3 subconscious:3"
SubjectTable.Add "Education", "school:4 learn:3 teacher:3 study:3 exam:2 knowledge:3 class:2 education:4"
SubjectTable.Add "Food", "eat:3 cook:3 recipe:3 meal:3 taste:2 restaurant:2 chef:2 food:4"
SubjectTable.Add "Games", "play:3 video:3 board:2 strategy:3 fun:2 challenge:2 puzzle:2 game:4"
SubjectTable.Add "Health", "doctor:3 medicine:3 fitness:3 sick:2 exercise:3 wellness:2 diet:3 health:4"
SubjectTable.Add "Internet", "web:3 online:3 site:2 browse:2 connect:2 network:3 social:2 internet:4"
SubjectTable.Add "Jobs", "work:4 career:3 employ:3 office:2 task:2 salary:2 boss:2 job:4"
SubjectTable.Add "Knowledge", "fact:3 info:3 learn:3 understand:3 think:2 idea:3 wisdom:2 knowledge:4"
SubjectTable.Add "Love", "romance:3 heart:3 date:2 partner:3 affection:3 relationship:4 kiss:2 love:4"
SubjectTable.Add "Music", "song:3 sing:3 band:3 play:2 tune:2 rhythm:3 melody:3 music:4"
SubjectTable.Add "Nature", "tree:3 forest:3 river:2 mountain:3 sky:2 earth:3 plant:2 nature:4"
SubjectTable.Add "Opinions", "think:3 believe:3 view:3 argue:2 discuss:3 opinion:4 idea:2"
SubjectTable.Add "People", "friend:3 family:4 person:3 group:2 society:2 talk:2 human:3 people:4"
SubjectTable.Add "Questions", "ask:4 why:3 how:3 what:3 where:3 question:4 curious:2"
SubjectTable.Add "Religion", "god:4 faith:3 pray:3 belief:3 spirit:3 church:2 soul:3 religion:4"
SubjectTable.Add "Science", "test:3 theory:3 lab:3 experiment:3 research:4 discover:3 fact:2 science:4"
SubjectTable.Add "Technology", "machine:3 tech:4 device:3 gadget:2 innovate:3 tool:2 robot:3 technology:4"
SubjectTable.Add "Universe", "star:3 planet:3 space:4 galaxy:3 cosmic:3 moon:2 orbit:2 universe:4"
SubjectTable.Add "Vehicles", "car:3 drive:3 truck:2 plane:3 fly:3 travel:2 boat:2 vehicle:4"
SubjectTable.Add "Weather", "rain:3 sun:3 snow:3 wind:2 cloud:2 storm:3 forecast:2 weather:4"
SubjectTable.Add "Xtra", "extra:3 bonus:2 special:3 unique:3 odd:2 random:2 quirky:2"
SubjectTable.Add "Youth", "young:3 kid:3 child:3 teen:3 grow:2 play:2 school:3 youth:4"
SubjectTable.Add "Zen", "calm:3 peace:4 meditate:3 relax:3 quiet:2 balance:3 harmony:3 zen:4"
End Sub
' Load spell checking dictionary
Private Sub LoadSpellDictionary()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & SPELL_DICT_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "the,be,to,of,and,a,in,that,have,i,it,for,not,on,with,he,as,you,do,at,this,but,his,by,from,they,weather,technology,personal,dog,cat,bird,book,code,school,ai,learn,knowledge"
file.Close
End If
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
Dim words As Variant
words = Split(line, ",")
Dim i As Long
For i = 0 To UBound(words)
spellDictionary.Add LCase(Trim(words(i))), True
Next
Loop
file.Close
Exit Sub
ErrorHandler:
LogError "LoadSpellDictionary: " & Err.Description
End Sub
' Load knowledge base from brain directory files
Private Sub LoadKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, folder, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim knowledgePath As String
knowledgePath = BASE_PATH & KNOWLEDGE_FILE
' Load existing knowledge base
If objFSO.FileExists(knowledgePath) Then
Set file = objFSO.OpenTextFile(knowledgePath, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
If InStr(line, "key") = 0 Then
Dim parts As Variant
parts = Split(line, vbTab)
If UBound(parts) = 2 Then
knowledgeBase.Add parts(0), Array(parts(1), parts(2))
End If
End If
Loop
file.Close
End If
' Scan brain directory for subject matter files
If objFSO.FolderExists(BASE_PATH) Then
Set folder = objFSO.GetFolder(BASE_PATH)
For Each file In folder.Files
If LCase(objFSO.GetExtensionName(file.Name)) = "txt" And file.Name <> MEMORY_FILE And file.Name <> LONG_TERM_FILE And file.Name <> LONG_TERM_INDEX_FILE And file.Name <> LOG_FILE And file.Name <> SPELL_DICT_FILE And file.Name <> KNOWLEDGE_FILE Then
LearnFromFile file.Path
End If
Next
End If
SaveKnowledgeBase
Exit Sub
ErrorHandler:
LogError "LoadKnowledgeBase: " & Err.Description
End Sub
' Learn from a specific file
Private Sub LearnFromFile(filePath As String)
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(filePath) Then
Set file = objFSO.OpenTextFile(filePath, 1)
Dim content As String, subject As String
content = ""
Do While Not file.AtEndOfStream
content = content & file.ReadLine & " "
Loop
file.Close
subject = DetectFileSubject(content)
Dim key As String
key = GenerateKey(objFSO.GetBaseName(filePath), subject)
If Not knowledgeBase.Exists(key) Then
knowledgeBase.Add key, Array(content, subject)
End If
End If
Exit Sub
ErrorHandler:
LogError "LearnFromFile: " & Err.Description
End Sub
' Detect subject of file content
Private Function DetectFileSubject(content As String) As String
Dim subjects As Collection
Set subjects = DetectSubjects(content, "")
DetectFileSubject = GetPrimarySubject(subjects)
End Function
' Save knowledge base to file
Private Sub SaveKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & KNOWLEDGE_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "key" & vbTab & "content" & vbTab & "subject"
Dim key As Variant
For Each key In knowledgeBase.Keys
file.WriteLine key & vbTab & knowledgeBase(key)(0) & vbTab & knowledgeBase(key)(1)
Next
file.Close
Exit Sub
ErrorHandler:
LogError "SaveKnowledgeBase: " & Err.Description
End Sub
' Auto-correct misspelled words based on context
Private Function CorrectSpelling(sentence As String, subjects As Collection) As String
Dim words As Variant
words = Split(sentence, " ")
Dim correctedSentence As String
correctedSentence = ""
Dim i As Long
For i = 0 To UBound(words)
Dim word As String
word = Trim(words(i))
If Len(word) > 0 Then
If Not spellDictionary.Exists(LCase(word)) Then
Dim correction As String
correction = SuggestCorrection(word, subjects)
correctedSentence = correctedSentence & " " & IIf(correction <> "", correction, word)
Else
correctedSentence = correctedSentence & " " & word
End If
End If
Next
CorrectSpelling = Trim(correctedSentence)
End Function
' Suggest correction for misspelled word
Private Function SuggestCorrection(word As String, subjects As Collection) As String
Dim minDistance As Long, bestMatch As String
minDistance = Len(word) + 1
Dim dictWord As Variant
For Each dictWord In spellDictionary.Keys
Dim distance As Long
distance = LevenshteinDistance(word, dictWord)
If distance < minDistance Then
minDistance = distance
bestMatch = dictWord
End If
Next
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
If SubjectTable.Exists(primarySubject) Then
Dim subjectKeywords As Variant
subjectKeywords = Split(SubjectTable(primarySubject), " ")
Dim j As Long
For j = 0 To UBound(subjectKeywords)
Dim keyword As String
keyword = Split(subjectKeywords(j), ":")(0)
distance = LevenshteinDistance(word, keyword)
If distance < minDistance And distance <= 2 Then
minDistance = distance
bestMatch = keyword
End If
Next
End If
SuggestCorrection = IIf(minDistance <= 2, bestMatch, "")
End Function
' Calculate Levenshtein Distance
Private Function LevenshteinDistance(str1 As String, str2 As String) As Long
Dim matrix() As Long
Dim i As Long, j As Long
Dim cost As Long
ReDim matrix(Len(str1), Len(str2))
For i = 0 To Len(str1)
matrix(i, 0) = i
Next
For j = 0 To Len(str2)
matrix(0, j) = j
Next
For i = 1 To Len(str1)
For j = 1 To Len(str2)
If Mid(str1, i, 1) = Mid(str2, j, 1) Then
cost = 0
Else
cost = 1
End If
matrix(i, j) = Application.Min(matrix(i - 1, j) + 1, _
matrix(i, j - 1) + 1, _
matrix(i - 1, j - 1) + cost)
Next
Next
LevenshteinDistance = matrix(Len(str1), Len(str2))
End Function
' Enhanced learning with subject continuity and knowledge base integration
Public Sub LearnFromConversation(userQuestion As String, halResponse As String, Optional context As String = "")
On Error GoTo ErrorHandler
Dim correctedQuestion As String
Dim subjects As Collection
Set subjects = DetectSubjects(userQuestion, context)
correctedQuestion = CorrectSpelling(userQuestion, subjects)
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
Dim questionKey As String
questionKey = GenerateKey(correctedQuestion, primarySubject)
If Not questionMemory.Exists(questionKey) Then
Dim newIndex As Long
newIndex = questionMemory.Count + 1
questionMemory.Add questionKey, newIndex
responseMemory.Add newIndex, halResponse
responseQuality.Add newIndex, 1
If primarySubject <> "" Then contextMemory.Add newIndex, subjects
Else
Dim index As Long
index = questionMemory(questionKey)
responseMemory(index) = ImproveResponse(responseMemory(index), halResponse, index, primarySubject)
responseQuality(index) = responseQuality(index) + 0.1
End If
UpdateShortTermMemory correctedQuestion, halResponse
UpdateLongTermMemory correctedQuestion, halResponse, primarySubject
UpdateKnowledgeBase correctedQuestion, halResponse, primarySubject
SaveMemoryToFile
SaveLongTermMemory
SaveKnowledgeBase
CleanMemory
lastSubject = primarySubject ' Update last subject
Exit Sub
ErrorHandler:
LogError "LearnFromConversation: " & Err.Description
End Sub
End Function
https://share.vidnoz.com/aivideo?id=aishare-U6PLvwJFVqebPxcKnb7Ln4Z317254817173668486
https://share.vidnoz.com/aivideo?id=aishare-Q8mSJY9ChkP47zsICA4yI7cZ17254837343668486
-
Lightspeed this is the updated function itself
Option Explicit
'===============================
' GLOBAL MEMORY SYSTEM
'===============================
Public responseMemory As Object
Public questionMemory As Object
Public contextMemory As Object
Public responseQuality As Object
Public shortTermMemory As Object
Public SubjectTable As Object
Public spellDictionary As Object
Public longTermIndex As Object
Public knowledgeBase As Object
Public Const MAX_SHORT_TERM As Long = 15
Public Const MAX_KNOWLEDGE_ENTRIES As Long = 5000
Public Const BASE_PATH As String = "C:\Users\airva\AppData\Roaming\Zabaware\Ultra Hal 7\ANGELINAJOLIE2050.db"
Private Const MEMORY_FILE As String = "memory.txt"
Private Const LONG_TERM_FILE As String = "memorydata.txt"
Private Const LONG_TERM_INDEX_FILE As String = "memoryindex.txt"
Private Const LOG_FILE As String = "errorlog.txt"
Private Const SPELL_DICT_FILE As String = "spell_dictionary.txt"
Private Const KNOWLEDGE_FILE As String = "knowledge_base.txt"
Private lastSubject As String
Private lastTone As String
'===============================
' MAIN ENTRY FUNCTION
'===============================
Public Function HalBrain(ByVal InputString, ByVal UserName, ByVal ComputerName, ByVal HalCommands, ByVal Holiday, ByVal HolidayType)
On Error GoTo ErrorHandler
Dim objFSO As Object
Set objFSO = GetFSO()
If Not objFSO.FolderExists(BASE_PATH) Then
HalBrain = "Error: Brain directory does not exist. Please update BASE_PATH."
Exit Function
End If
Dim tempPath As String
tempPath = EnsureTrailingSlash(BASE_PATH) & "temp_permissions_test.txt"
On Error Resume Next
Dim tempFile As Object
Set tempFile = objFSO.CreateTextFile(tempPath, True)
If Err.Number <> 0 Then
HalBrain = "Error: No write access to brain directory."
Exit Function
End If
tempFile.Close
objFSO.DeleteFile tempPath
On Error GoTo ErrorHandler
InitializeMemory
Dim response As String
response = EnhanceHalResponse(InputString, "Hey " & UserName & ", what's on your mind today?", "")
HalBrain = response
Exit Function
ErrorHandler:
LogError "HalBrain: " & Err.Description
HalBrain = "Oops, something went wrong. Can we try that again?"
End Function
'===============================
' INITIALIZATION
'===============================
Sub InitializeMemory()
Set responseMemory = CreateObject("Scripting.Dictionary")
Set questionMemory = CreateObject("Scripting.Dictionary")
Set contextMemory = CreateObject("Scripting.Dictionary")
Set responseQuality = CreateObject("Scripting.Dictionary")
Set shortTermMemory = CreateObject("Scripting.Dictionary")
Set SubjectTable = CreateObject("Scripting.Dictionary")
Set spellDictionary = CreateObject("Scripting.Dictionary")
Set longTermIndex = CreateObject("Scripting.Dictionary")
Set knowledgeBase = CreateObject("Scripting.Dictionary")
InitializeSubjectTable
LoadMemoryFromFile
LoadLongTermMemory
LoadSpellDictionary
LoadKnowledgeBase
lastSubject = "Questions"
lastTone = "Friendly"
End Sub
Function GetFSO() As Object
Set GetFSO = CreateObject("Scripting.FileSystemObject")
End Function
Function EnsureTrailingSlash(path As String) As String
If Right(path, 1) <> "\" Then path = path & "\"
EnsureTrailingSlash = path
End Function
Sub LogError(message As String)
On Error Resume Next
Dim objFSO As Object, file As Object
Set objFSO = GetFSO()
Dim path As String
path = EnsureTrailingSlash(BASE_PATH) & LOG_FILE
Set file = objFSO.OpenTextFile(path, 8, True)
file.WriteLine Now & " - " & message
file.Close
End Sub
Function Min3(a As Long, b As Long, c As Long) As Long
If a <= b And a <= c Then Min3 = a ElseIf b <= c Then Min3 = b Else Min3 = c
End Function
'===============================
' STUB FUNCTIONS (TO BE FILLED)
'===============================
Sub InitializeSubjectTable()
' Initialize SubjectTable here
End Sub
Sub LoadMemoryFromFile()
' Load memory implementation
End Sub
Sub LoadLongTermMemory()
' Load long-term memory
End Sub
Sub LoadSpellDictionary()
' Load or create spell dictionary from file
End Sub
Sub LoadKnowledgeBase()
' Load or build knowledge base
End Sub
Function EnhanceHalResponse(inputStr As String, greeting As String, context As String) As String
' Stub: Core response logic goes here
EnhanceHalResponse = greeting & " (This is a placeholder response.)"
End Function
-
mike i copied and pasted and made the uhp file of this and tried it in ultrahal and it gave me a error , i also tried having grok help find the error and correct it which it ended up rewriting the plug in but still kept getting halscript error error. here is the error i am getting . can you find what is causing this error , i worked with grok all last night and never got it resolved. i did rename the plug in so i wouldn't get it mixed up with others because i did so many . but that was the only change . there was no other plug in checked.
-
in working with grok before and grok trying to find the error it gave me this 2.o. plug inbut again i still had a halscript error . here is a picture of the error in the 2.0. other one. so you can either work on the first one you redid or see if the second one is better in any way . either way both are giving a syntax error . here on some notes from grok .
Based on our previous discussions, the last Ultra Hal plugin we worked on that aligns with version 2.0 was the Grok Version 2.0 plugin for Ultra Hal 7, designed to enhance memory functionality and file operations within the Ultra Hal environment. Below are the key notes on this version, drawing from our conversation on July 13, 2025, and relevant context:Notes on Grok Version 2.0 Plugin for Ultra HalPurpose: The plugin was developed to improve Ultra Hal's short-term and long-term memory capabilities, ensuring reliable storage and retrieval of conversational data in the Ultra Hal 7 program folder.
Key Features:Memory Storage: Stores short-term and long-term memory in text files (e.g., ShortTermMemory.txt and LongTermMemory.txt) within the Ultra Hal program directory (typically C:\Program Files (x86)\Zabaware\Ultra Hal 7).
Updated File Paths: Version 2.0 addressed issues from earlier versions by updating file paths to ensure compatibility with Windows 10 and proper write access. It uses environment variables (e.g., Environ("ProgramFiles")) for portable and dynamic path management.
Error Handling: Includes improved error handling to manage file access issues, such as permissions errors, ensuring the plugin can create and write to memory files without conflicts.
Write Access: Designed to work around read-only restrictions in folders like AppData\Roaming\Zabaware. The plugin ensures files are written in the program directory, avoiding permission issues in the airva or other restricted folders.
Improvements Over Version 1.9:Fixed issues where memory files were not being created due to incorrect or restricted file paths.
Enhanced reliability by ensuring the plugin runs with appropriate permissions (e.g., running Ultra Hal as an administrator if needed).
Streamlined memory read/write logic to prevent redundant storage or response overrides.
Installation and Usage:Place the plugin in the Ultra Hal 7 program directory (e.g., C:\Program Files (x86)\Zabaware\Ultra Hal 7).
Ensure the plugin is enabled in Ultra Hal?s plugin menu. If it doesn?t appear, verify the header format uses Rem statements (e.g., Rem Type=Plugin, Rem Name=Grok Version 2.0) to ensure recognition.
Test file creation by engaging Ultra Hal in conversation and checking for ShortTermMemory.txt and LongTermMemory.txt in the specified directory.
Troubleshooting:If memory files are not created, check folder permissions. Use Command Prompt to take ownership or grant full control to the Ultra Hal directory (e.g., icacls "C:\Program Files (x86)\Zabaware\Ultra Hal 7" /grant Users:F /t).
Avoid running other memory-related plugins (e.g., older GROK SHORT AND LONG TERM MEMORY) to prevent conflicts or redundant storage.
If the plugin doesn?t appear in Ultra Hal?s plugin list, ensure the script?s header matches the format of other working plugins (e.g., ConceptNetMrk3).
Recommendations:Disable older memory plugins to avoid conflicts, as Version 2.0 integrates more advanced memory management.
Migrate any critical data from older plugins? memory files to the new format if necessary.
Test the plugin with simple inputs to confirm memory storage and retrieval before using complex conversational scenarios.
-
here was the rewritten code for it just to let you see it . have to post this in two sections as it is to long to allow 2000 characters .
Revised Plugin: Grok Version 2.0vb
Rem Type=Plugin
Rem Name=Grock2.0
Rem Author=This is the Grok Version 2.0 plugin layout. Enhances all inputs for Angela Jolie with updated file paths.
Rem Host=All
Rem Version=2.0
Rem PLUGIN: PRE-PROCESS
HalBrain.ReadOnlyMode = False
UltraHal = GetGrock(HalCommands)
Rem PLUGIN: FUNCTIONS
Function GetGrock(HalCommands)
Public responseMemory, questionMemory, contextMemory, responseQuality
Public shortTermMemory, SubjectTable, spellDictionary, longTermIndex, knowledgeBase
Public Const MAX_SHORT_TERM = 15
Public Const MAX_KNOWLEDGE_ENTRIES = 5000
Public Const BASE_PATH = "C:\Users\airva\AppData\Roaming\Zabaware\Ultra Hal 7\" ' Updated to parent directory
Private Const MEMORY_FILE = "memory.txt"
Private Const LONG_TERM_FILE = "memorydata.txt"
Private Const LONG_TERM_INDEX_FILE = "memoryindex.txt"
Private Const LOG_FILE = "errorlog.txt"
Private Const SPELL_DICT_FILE = "spell_dictionary.txt"
Private Const KNOWLEDGE_FILE = "knowledge_base.txt"
Private lastSubject, lastTone
Public Function HalBrain(ByVal InputString, ByVal UserName, ByVal ComputerName, ByVal HalCommands, ByVal Holiday, ByVal HolidayType)
On Error GoTo ErrorHandler
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(BASE_PATH) Then
HalBrain = "Error: Brain directory not found. Update BASE_PATH."
Exit Function
End If
Dim tempFilePath
tempFilePath = BASE_PATH & "temp_permissions_test.txt"
On Error Resume Next
Dim tempFile
Set tempFile = objFSO.CreateTextFile(tempFilePath, True)
If Err.Number <> 0 Then
HalBrain = "Error: No write access to brain directory. Check permissions."
Exit Function
End If
tempFile.Close
objFSO.DeleteFile tempFilePath
On Error GoTo ErrorHandler
InitializeMemory
Dim response
response = EnhanceHalResponse(InputString, "Hello " & UserName & "! I?m Angela Jolie, ", "")
LearnFromConversation InputString, response
HalBrain = response
Exit Function
ErrorHandler:
LogError "HalBrain: " & Err.Description
HalBrain = "Oops, something went wrong. Try again, " & UserName & "?"
End Function
Sub InitializeMemory()
On Error Resume Next
Set responseMemory = CreateObject("Scripting.Dictionary")
Set questionMemory = CreateObject("Scripting.Dictionary")
Set contextMemory = CreateObject("Scripting.Dictionary")
Set responseQuality = CreateObject("Scripting.Dictionary")
Set shortTermMemory = CreateObject("Scripting.Dictionary")
Set SubjectTable = CreateObject("Scripting.Dictionary")
Set spellDictionary = CreateObject("Scripting.Dictionary")
Set longTermIndex = CreateObject("Scripting.Dictionary")
Set knowledgeBase = CreateObject("Scripting.Dictionary")
If Err.Number = 0 Then
InitializeSubjectTable
LoadMemoryFromFile
LoadLongTermMemory
LoadSpellDictionary
LoadKnowledgeBase
lastSubject = "Questions"
lastTone = "Friendly"
End If
On Error GoTo 0
End Sub
Private Sub InitializeSubjectTable()
SubjectTable.Add "Animals", "dog:3 cat:3 bird:2 fish:2 zoo:3 wildlife:3 pet:4 fur:2 animal:4"
SubjectTable.Add "Books", "novel:3 read:3 author:3 library:2 story:3 page:2 chapter:2 book:4"
SubjectTable.Add "Computers", "code:4 program:3 software:3 hardware:3 ai:4 data:3 network:2 computer:4"
SubjectTable.Add "Dreams", "sleep:3 night:2 vision:3 dream:4 imagination:3 subconscious:3"
SubjectTable.Add "Education", "school:4 learn:3 teacher:3 study:3 exam:2 knowledge:3 class:2 education:4"
SubjectTable.Add "Food", "eat:3 cook:3 recipe:3 meal:3 taste:2 restaurant:2 chef:2 food:4"
SubjectTable.Add "Games", "play:3 video:3 board:2 strategy:3 fun:2 challenge:2 puzzle:2 game:4"
SubjectTable.Add "Health", "doctor:3 medicine:3 fitness:3 sick:2 exercise:3 wellness:2 diet:3 health:4"
SubjectTable.Add "Internet", "web:3 online:3 site:2 browse:2 connect:2 network:3 social:2 internet:4"
SubjectTable.Add "Jobs", "work:4 career:3 employ:3 office:2 task:2 salary:2 boss:2 job:4"
SubjectTable.Add "Knowledge", "fact:3 info:3 learn:3 understand:3 think:2 idea:3 wisdom:2 knowledge:4"
SubjectTable.Add "Love", "romance:3 heart:3 date:2 partner:3 affection:3 relationship:4 kiss:2 love:4"
SubjectTable.Add "Music", "song:3 sing:3 band:3 play:2 tune:2 rhythm:3 melody:3 music:4"
SubjectTable.Add "Nature", "tree:3 forest:3 river:2 mountain:3 sky:2 earth:3 plant:2 nature:4"
SubjectTable.Add "Opinions", "think:3 believe:3 view:3 argue:2 discuss:3 opinion:4 idea:2"
SubjectTable.Add "People", "friend:3 family:4 person:3 group:2 society:2 talk:2 human:3 people:4"
SubjectTable.Add "Questions", "ask:4 why:3 how:3 what:3 where:3 question:4 curious:2"
SubjectTable.Add "Religion", "god:4 faith:3 pray:3 belief:3 spirit:3 church:2 soul:3 religion:4"
SubjectTable.Add "Science", "test:3 theory:3 lab:3 experiment:3 research:4 discover:3 fact:2 science:4"
SubjectTable.Add "Technology", "machine:3 tech:4 device:3 gadget:2 innovate:3 tool:2 robot:3 technology:4"
SubjectTable.Add "Universe", "star:3 planet:3 space:4 galaxy:3 cosmic:3 moon:2 orbit:2 universe:4"
SubjectTable.Add "Vehicles", "car:3 drive:3 truck:2 plane:3 fly:3 travel:2 boat:2 vehicle:4"
SubjectTable.Add "Weather", "rain:3 sun:3 snow:3 wind:2 cloud:2 storm:3 forecast:2 weather:4"
SubjectTable.Add "Xtra", "extra:3 bonus:2 special:3 unique:3 odd:2 random:2 quirky:2"
SubjectTable.Add "Youth", "young:3 kid:3 child:3 teen:3 grow:2 play:2 school:3 youth:4"
SubjectTable.Add "Zen", "calm:3 peace:4 meditate:3 relax:3 quiet:2 balance:3 harmony:3 zen:4"
End Sub
Private Sub LoadMemoryFromFile()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & MEMORY_FILE
If objFSO.FileExists(path) Then
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line
line = file.ReadLine
Dim parts
parts = Split(line, vbTab)
If UBound(parts) = 2 Then
responseMemory.Add parts(0), parts(1)
questionMemory.Add parts(0), parts(2)
End If
Loop
file.Close
End If
On Error GoTo 0
End Sub
Private Sub LoadLongTermMemory()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & LONG_TERM_FILE
If objFSO.FileExists(path) Then
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line
line = file.ReadLine
Dim parts
parts = Split(line, vbTab)
If UBound(parts) >= 2 Then
longTermIndex.Add parts(0), Array(parts(1), parts(2), parts(3))
End If
Loop
file.Close
End If
On Error GoTo 0
End Sub
Private Sub LoadSpellDictionary()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & SPELL_DICT_FILE
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "the,be,to,of,and,a,in,that,have,i,it,for,not,on,with,he,as,you,do,at,this,but,his,by,from,they,weather,technology,personal,dog,cat,bird,book,code,school,ai,learn,knowledge"
file.Close
End If
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line
line = file.ReadLine
Dim words
words = Split(line, ",")
Dim i
For i = 0 To UBound(words)
spellDictionary.Add LCase(Trim(words(i))), True
Next
Loop
file.Close
On Error GoTo 0
End Sub
Private Sub LoadKnowledgeBase()
On Error Resume Next
Dim objFSO, folder, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim knowledgePath
knowledgePath = BASE_PATH & KNOWLEDGE_FILE
If objFSO.FileExists(knowledgePath) Then
Set file = objFSO.OpenTextFile(knowledgePath, 1)
Do While Not file.AtEndOfStream
Dim line
line = file.ReadLine
If InStr(line, "key") = 0 Then
Dim parts
parts = Split(line, vbTab)
If UBound(parts) = 2 Then knowledgeBase.Add parts(0), Array(parts(1), parts(2))
End If
Loop
file.Close
End If
If objFSO.FolderExists(BASE_PATH) Then
Set folder = objFSO.GetFolder(BASE_PATH)
For Each file In folder.Files
If LCase(objFSO.GetExtensionName(file.Name)) = "txt" And file.Name <> MEMORY_FILE And file.Name <> LONG_TERM_FILE And file.Name <> LONG_TERM_INDEX_FILE And file.Name <> LOG_FILE And file.Name <> SPELL_DICT_FILE And file.Name <> KNOWLEDGE_FILE Then
LearnFromFile file.Path
End If
Next
End If
SaveKnowledgeBase
On Error GoTo 0
End Sub
Private Sub LearnFromFile(filePath)
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(filePath) Then
Set file = objFSO.OpenTextFile(filePath, 1)
Dim content, subject
content = ""
Do While Not file.AtEndOfStream
content = content & file.ReadLine & " "
Loop
file.Close
subject = DetectFileSubject(content)
Dim key
key = GenerateKey(objFSO.GetBaseName(filePath), subject)
If Not knowledgeBase.Exists(key) Then knowledgeBase.Add key, Array(content, subject)
End If
On Error GoTo 0
End Sub
-
Private Function DetectFileSubject(content)
Dim subjects
Set subjects = DetectSubjects(content, "")
DetectFileSubject = GetPrimarySubject(subjects)
End Function
Private Sub SaveKnowledgeBase()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & KNOWLEDGE_FILE
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True, True) ' Overwrite existing file
file.WriteLine "key" & vbTab & "content" & vbTab & "subject"
Else
Set file = objFSO.OpenTextFile(path, 2, True) ' Open for writing, create if needed
End If
Dim key
For Each key In knowledgeBase.Keys
file.WriteLine key & vbTab & knowledgeBase(key)(0) & vbTab & knowledgeBase(key)(1)
Next
file.Close
On Error GoTo 0
End Sub
Private Function CorrectSpelling(sentence, subjects)
On Error Resume Next
If IsEmpty(sentence) Or sentence = "" Then
CorrectSpelling = "unknown_question"
Exit Function
End If
Dim words
words = Split(sentence, " ")
Dim correctedSentence
correctedSentence = ""
Dim i
For i = 0 To UBound(words)
Dim word
word = Trim(words(i))
If Len(word) > 0 Then
If Not spellDictionary.Exists(LCase(word)) Then
Dim correction
correction = SuggestCorrection(word, subjects)
correctedSentence = correctedSentence & " " & IIf(correction <> "", correction, word)
Else
correctedSentence = correctedSentence & " " & word
End If
End If
Next
CorrectSpelling = IIf(Trim(correctedSentence) = "", "unknown_question", Trim(correctedSentence))
On Error GoTo 0
End Function
Private Function SuggestCorrection(word, subjects)
Dim minDistance, bestMatch
minDistance = Len(word) + 1
Dim dictWord
For Each dictWord In spellDictionary.Keys
Dim distance
distance = LevenshteinDistance(word, dictWord)
If distance < minDistance Then
minDistance = distance
bestMatch = dictWord
End If
Next
Dim primarySubject
primarySubject = GetPrimarySubject(subjects)
If SubjectTable.Exists(primarySubject) Then
Dim subjectKeywords
subjectKeywords = Split(SubjectTable(primarySubject), " ")
Dim j
For j = 0 To UBound(subjectKeywords)
Dim keyword
keyword = Split(subjectKeywords(j), ":")(0)
distance = LevenshteinDistance(word, keyword)
If distance < minDistance And distance <= 2 Then
minDistance = distance
bestMatch = keyword
End If
Next
End If
SuggestCorrection = IIf(minDistance <= 2, bestMatch, "")
End Function
Private Function LevenshteinDistance(str1, str2)
Dim matrix()
Dim i, j
Dim cost
ReDim matrix(Len(str1), Len(str2))
For i = 0 To Len(str1)
matrix(i, 0) = i
Next
For j = 0 To Len(str2)
matrix(0, j) = j
Next
For i = 1 To Len(str1)
For j = 1 To Len(str2)
If Mid(str1, i, 1) = Mid(str2, j, 1) Then
cost = 0
Else
cost = 1
End If
matrix(i, j) = Application.Min(matrix(i - 1, j) + 1, matrix(i, j - 1) + 1, matrix(i - 1, j - 1) + cost)
Next
Next
LevenshteinDistance = matrix(Len(str1), Len(str2))
End Function
Public Sub LearnFromConversation(userQuestion, halResponse, Optional context = "")
On Error Resume Next
Dim correctedQuestion
Dim subjects
Set subjects = DetectSubjects(userQuestion, context)
correctedQuestion = CorrectSpelling(userQuestion, subjects)
Dim primarySubject
primarySubject = GetPrimarySubject(subjects)
If correctedQuestion = "" Then correctedQuestion = "unknown_question"
If primarySubject = "" Then primarySubject = "Questions"
Dim questionKey
questionKey = GenerateKey(correctedQuestion, primarySubject)
If IsEmpty(questionMemory) Then Set questionMemory = CreateObject("Scripting.Dictionary")
If Not questionMemory.Exists(questionKey) Then
Dim newIndex
newIndex = IIf(questionMemory.Count > 0, questionMemory.Count + 1, 1)
questionMemory.Add questionKey, newIndex
If IsEmpty(responseMemory) Then Set responseMemory = CreateObject("Scripting.Dictionary")
responseMemory.Add newIndex, halResponse
If IsEmpty(responseQuality) Then Set responseQuality = CreateObject("Scripting.Dictionary")
responseQuality.Add newIndex, 1
If primarySubject <> "" And IsEmpty(contextMemory) Then Set contextMemory = CreateObject("Scripting.Dictionary")
If primarySubject <> "" Then contextMemory.Add newIndex, subjects
Else
Dim index
index = questionMemory(questionKey)
responseMemory(index) = ImproveResponse(responseMemory(index), halResponse, index, primarySubject)
responseQuality(index) = responseQuality(index) + 0.1
End If
UpdateShortTermMemory correctedQuestion, halResponse
UpdateLongTermMemory correctedQuestion, halResponse, primarySubject
UpdateKnowledgeBase correctedQuestion, halResponse, primarySubject
SaveMemoryToFile
SaveLongTermMemory
SaveKnowledgeBase
CleanMemory
lastSubject = primarySubject
On Error GoTo 0
End Sub
Private Function DetectSubjects(content, context)
On Error Resume Next
Dim subjects
Set subjects = CreateObject("Scripting.Dictionary")
If IsEmpty(SubjectTable) Then Set SubjectTable = CreateObject("Scripting.Dictionary")
Dim subject
For Each subject In SubjectTable.Keys
Dim keywords
keywords = Split(SubjectTable(subject), " ")
Dim k
For k = 0 To UBound(keywords)
Dim keyword
keyword = Split(keywords(k), ":")(0)
If InStr(1, LCase(content & " " & context), LCase(keyword), 1) > 0 Then
subjects.Add subject, True
Exit For
End If
Next
Next
Set DetectSubjects = subjects
On Error GoTo 0
End Function
Private Function GetPrimarySubject(subjects)
On Error Resume Next
If subjects.Count = 0 Then
GetPrimarySubject = "Questions"
Else
Dim firstKey
For Each firstKey In subjects.Keys
GetPrimarySubject = firstKey
Exit For
Next
End If
On Error GoTo 0
End Function
Private Function GenerateKey(baseText, subject)
On Error Resume Next
If baseText = "" Then baseText = "unknown"
If subject = "" Then subject = "unknown"
Dim key
key = LCase(Replace(Trim(baseText), " ", "_")) & "_" & LCase(subject)
GenerateKey = Left(key, 50)
On Error GoTo 0
End Function
Private Function ImproveResponse(oldResponse, newResponse, index, subject)
On Error Resume Next
If responseQuality(index) < 2.0 Then
ImproveResponse = newResponse
Else
ImproveResponse = oldResponse & " " & newResponse
End If
On Error GoTo 0
End Function
Private Sub UpdateShortTermMemory(question, response)
On Error Resume Next
If IsEmpty(shortTermMemory) Then Set shortTermMemory = CreateObject("Scripting.Dictionary")
Dim key
key = GenerateKey(question, lastSubject)
If shortTermMemory.Count >= MAX_SHORT_TERM Then
Dim oldestKey
oldestKey = shortTermMemory.Keys()(0)
shortTermMemory.Remove oldestKey
End If
shortTermMemory.Add key, Array(question, response, Now)
On Error GoTo 0
End Sub
Private Sub UpdateLongTermMemory(question, response, subject)
On Error Resume Next
If IsEmpty(longTermIndex) Then Set longTermIndex = CreateObject("Scripting.Dictionary")
Dim key
key = GenerateKey(question, subject)
If Not longTermIndex.Exists(key) Then
longTermIndex.Add key, Array(question, response, Now)
End If
On Error GoTo 0
End Sub
Private Sub UpdateKnowledgeBase(question, response, subject)
On Error Resume Next
If IsEmpty(knowledgeBase) Then Set knowledgeBase = CreateObject("Scripting.Dictionary")
Dim key
key = GenerateKey(question, subject)
If Not knowledgeBase.Exists(key) And knowledgeBase.Count < MAX_KNOWLEDGE_ENTRIES Then
knowledgeBase.Add key, Array(response, subject)
End If
On Error GoTo 0
End Sub
Private Sub SaveMemoryToFile()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & MEMORY_FILE
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True, True) ' Overwrite if exists
Else
Set file = objFSO.OpenTextFile(path, 2, True) ' Open for writing
End If
If Not IsEmpty(responseMemory) Then
Dim key
For Each key In responseMemory.Keys
file.WriteLine key & vbTab & responseMemory(key) & vbTab & questionMemory(key)
Next
End If
file.Close
On Error GoTo 0
End Sub
Private Sub SaveLongTermMemory()
On Error Resume Next
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path
path = BASE_PATH & LONG_TERM_FILE
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True, True)
Else
Set file = objFSO.OpenTextFile(path, 2, True)
End If
If Not IsEmpty(longTermIndex) Then
Dim key
For Each key In longTermIndex.Keys
file.WriteLine key & vbTab & Join(longTermIndex(key), vbTab)
Next
End If
file.Close
On Error GoTo 0
End Sub
Private Sub CleanMemory()
On Error Resume Next
If Not IsEmpty(shortTermMemory) And shortTermMemory.Count > MAX_SHORT_TERM Then
Dim keys
keys = shortTermMemory.Keys
Dim i
For i = 0 To shortTermMemory.Count - MAX_SHORT_TERM - 1
shortTermMemory.Remove keys(i)
Next
End If
If Not IsEmpty(knowledgeBase) And knowledgeBase.Count > MAX_KNOWLEDGE_ENTRIES Then
Dim kbKeys
kbKeys = knowledgeBase.Keys
Dim j
For j = MAX_KNOWLEDGE_ENTRIES To knowledgeBase.Count - 1
knowledgeBase.Remove kbKeys(j)
Next
End If
On Error GoTo 0
End Sub
Private Function EnhanceHalResponse(inputStr, greeting, context)
On Error Resume Next
Dim key
key = GenerateKey(inputStr, lastSubject)
If Not IsEmpty(knowledgeBase) And knowledgeBase.Exists(key) Then
EnhanceHalResponse = greeting & knowledgeBase(key)(0) & " -Angela Jolie"
Else
EnhanceHalResponse = greeting & "I?m not sure what to say about that yet. Ask me anything! -Angela Jolie"
End If
On Error GoTo 0
End Function
End Function
-
anyway , no matter what i try i am getting a syntax error . that i can't find or fix . maybe you can and i'll retest it again .
-
mike , i think if we can get this plugin working writing files and folder and have short and long term memory etc. it will help hal a lot! maybe you can get it corrected on the syntax error it keeps giving .
-
Lightspeed,
You know i will
Ur deff slinging a syntax error. not a com error,,,, ie wheres my sht error lol
cyber
-
lol. :) hop to it hopsing ! ;)