[VB6] Plugin Engine Source Code

[Dyndrilliac]

I posted this up a long time ago but the download link to the source files broke at some point, and I no longer have the original project files. I do however, still have the source code. I'm really just posting this up so I can add a link to it for the Index thread, and thought a new topic would be more appropriate than necro-posting in a two year old thread.

'// frmMain.frm

Public Sub f_PrintText(sText As String)
    lblText.Caption = sText
End Sub

Private Sub cmdPluginActivate_Click()
    Dim i As Integer, PluginName As String
    For i = 0 To UBound(mdlPlugin.o_Plugins)
        If ((cboPlugins.Text) = (o_Plugins(i).p_Version)) Then
            Call o_Plugins(i).Main
        End If
    Next
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Call mdlPlugin.f_LoadPlugins
    For i = 0 To UBound(o_Plugins)
        cboPlugins.AddItem o_Plugins(i).p_Version()
    Next i
End Sub

'// mdlPlugin.bas

Option Explicit

Public o_Plugins() As Object

Public Sub f_LoadPlugins()
    'On Error GoTo Error
    Dim s() As String, i As Integer, pId As String
    
    s() = f_GetFolderFiles(App.Path & "\Plugins", "*dll")

    If MsgBox("Have all your plugins been registered?", vbQuestion + vbYesNo, "Register") = vbNo Then
         For i = 0 To UBound(s)
            Shell "regsvr32 """ & s(i) & """", vbNormalFocus
         Next
    End If
    
    ReDim o_Plugins(0)
    
    For i = 0 To UBound(s)
        ReDim Preserve o_Plugins(i)
        pId = f_GetBaseName(s(i)) & ".Plugin"
        Debug.Print pId
        Debug.Print s(i)
        '// I'm using "Set" here.
        Set o_Plugins(i) = CreateObject(pId)
        o_Plugins(i).p_HostModule frmMain
    Next
    
    Exit Sub
'Error:
    'MsgBox "A critical error has occurred!" & vbCrLf & "   Error Number: " & Err.Number & vbCrLf & "   Error Description: " & Err.Description & vbCrLf & "   Source Plugin: " & mdlPlugin.o_Plugins(i).p_Version() & vbCrLf & "Please contact the plugin author for more information.", vbCritical + vbOKOnly, "f_LoadPlugins() Error!"
End Sub

Public Function f_GetFolderFiles(Folder As String, Optional Filter As String = ".*", Optional retFullPath As Boolean = True) As String()
   Dim FileNames() As String
   Dim Extension, FS As String
   
   If Not f_FolderExists(Folder) Then
        f_GetFolderFiles = FileNames()
        Exit Function
   End If
   
   Folder = IIf(Right$(Folder, 1) = "\", Folder, Folder & "\")
   If Left$(Filter, 1) = "*" Then Extension = Mid$(Filter, 2, Len(Filter))
   If Left$(Filter, 1) <> "." Then Filter = "." & Filter
   
   FS = Dir$(Folder & "*" & Filter, vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
   While FS <> vbNullString
     If FS <> vbNullString Then f_Push FileNames(), IIf(retFullPath = True, Folder & FS, FS)
     FS = Dir$()
   Wend
   
   f_GetFolderFiles = FileNames()
End Function

Public Function f_FolderExists(Path As String) As Boolean
  If Len(Path) = 0 Then Exit Function
  If Dir$(Path, vbDirectory) <> vbNullString Then f_FolderExists = True
End Function

Public Function f_GetBaseName(Path As String) As String
    Dim s() As String
    Dim ub As String
    s = Split(Path, "\")
    ub = s(UBound(s))
    If InStr(1, ub, ".") > 0 Then
        f_GetBaseName = Mid$(ub, 1, InStrRev(ub, ".") - 1)
    Else
        f_GetBaseName = ub
    End If
End Function

Public Sub f_Push(sArray() As String, Value As Variant)
    On Error GoTo Error
    Dim i
    i = UBound(sArray)
    ReDim Preserve sArray(UBound(sArray) + 1)
    sArray(UBound(sArray)) = Value
    Exit Sub
Error:
    ReDim sArray(0)
    sArray(0) = Value
End Sub

Public Function f_ArrayIsEmpty(sArray() As String) As Boolean
    On Error GoTo Error
    Dim i As Integer
    i = UBound(sArray)
    f_ArrayIsEmpty = False
    Exit Function
Error:
    f_ArrayIsEmpty = True
End Function

And the TestPlugin's code:

'// clsPlugin.cls

Option Explicit

Private o_HostModule    As Object
Private s_PluginVersion As String

Public Property Let p_HostModule(o_NewModule As Object)
    Set o_HostModule = o_NewModule
End Property

Public Property Get p_Version() As String
    p_Version = s_PluginVersion
End Property

Public Sub Main()
    MsgBox "Success! Everything is running fine!", vbExclamation + vbOKOnly, "Plugin is loaded!"
    o_HostModule.f_PrintText (p_Version() & " is running fine!")
End Sub

The only thing stopping this from working via straight up copy/paste is that there are elements that need to be present on the form for the code to work.

[ViperSRT3g]

Wow thanks :D I was looking for something similar to this... >_>