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