Attribute VB_Name = "modMain"
'Created by GPM (c) 2010-2014 - Feb 28, 2014 1900-2100H

'
' Product:     GPM Clam Antivirus
'
' Author:      Gian20 [Gian20 at users dot sourceforge dot net]
'
' Created:     n/a
' Copyright:   Copyright GPM (c) 2013-2014
' Licence:
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 2 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'  You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

   Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
   Public Const REG_SZ As Long = 1
   Public Const REG_DWORD As Long = 4

Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3

Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234

   Public Const HKEY_CLASSES_ROOT = &H80000000
   Public Const HKEY_CURRENT_USER = &H80000001
   Public Const HKEY_LOCAL_MACHINE = &H80000002
   Public Const HKEY_USERS = &H80000003

   Public Const ERROR_NONE = 0
   Public Const ERROR_BADDB = 1
   Public Const ERROR_BADKEY = 2
   Public Const ERROR_CANTOPEN = 3
   Public Const ERROR_CANTREAD = 4
   Public Const ERROR_CANTWRITE = 5
   Public Const ERROR_OUTOFMEMORY = 6
   Public Const ERROR_ARENA_TRASHED = 7
   Public Const ERROR_ACCESS_DENIED = 8
   Public Const ERROR_INVALID_PARAMETERS = 87
   Public Const ERROR_NO_MORE_ITEMS = 259

   Public Const KEY_QUERY_VALUE = &H1
   Public Const KEY_SET_VALUE = &H2
   Public Const KEY_ALL_ACCESS = &H3F

   Public Const REG_OPTION_NON_VOLATILE = 0

   Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
   As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
   Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
   Long) As Long
   Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As String, lpcbData As Long) As Long
   Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, lpData As _
   Long, lpcbData As Long) As Long
   Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As Long, lpcbData As Long) As Long
   Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, ByVal cbData As Long) As Long
   Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long
                




Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
    ByVal lpReserved As Long, lpType As Long, lpData As Any, _
    lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal numBytes As Long)

Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
                          ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                          ' SYNCHRONIZE))


' Read a Registry value
'
' Use KeyName = "" for the default value
' If the value isn't there, it returns the DefaultValue
' argument, or Empty if the argument has been omitted
'
' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
' REG_MULTI_SZ values are returned as a null-delimited stream of strings
' (VB6 users can use SPlit to convert to an array of string)

Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
    ByVal ValueName As String, Optional DefaultValue As Variant) As Variant
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long
    
    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
    
    ' Open the key, exit if not found.
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
        Exit Function
    End If
    
    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
    
    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
        length)
    ' if resBinary was too small, try again
    If retVal = ERROR_MORE_DATA Then
        ' enlarge the resBinary, and read the value again
        ReDim resBinary(0 To length - 1) As Byte
        retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
            length)
    End If
    
    ' return a value corresponding to the value type
    Select Case valueType
        Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong
        Case REG_SZ, REG_EXPAND_SZ
            ' copy everything but the trailing null char
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString
        Case REG_BINARY
            ' resize the result resBinary
            If length <> UBound(resBinary) + 1 Then
                ReDim Preserve resBinary(0 To length - 1) As Byte
            End If
            GetRegistryValue = resBinary()
        Case REG_MULTI_SZ
            ' copy everything but the 2 trailing null chars
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString
        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Unsupported value type"
    End Select
    
    ' close the registry key
    RegCloseKey handle
End Function


   Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
   lType As Long, vValue As Variant) As Long
       Dim lValue As Long
       Dim sValue As String
       Select Case lType
           Case REG_SZ
               sValue = vValue & Chr$(0)
               SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                                              lType, sValue, Len(sValue))
           Case REG_DWORD
               lValue = vValue
               SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
   lType, lValue, 4)
           End Select
   End Function

   Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
   String, vValue As Variant) As Long
       Dim cch As Long
       Dim lrc As Long
       Dim lType As Long
       Dim lValue As Long
       Dim sValue As String

       On Error GoTo QueryValueExError

       ' Determine the size and type of data to be read
       lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
       If lrc <> ERROR_NONE Then Error 5

       Select Case lType
           ' For strings
           Case REG_SZ:
               sValue = String(cch, 0)

   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
   sValue, cch)
               If lrc = ERROR_NONE Then
                   vValue = Left$(sValue, cch - 1)
               Else
                   vValue = Empty
               End If
           ' For DWORDS
           Case REG_DWORD:
   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
   lValue, cch)
               If lrc = ERROR_NONE Then vValue = lValue
           Case Else
               'all other data types not supported
               lrc = -1
       End Select

QueryValueExExit:
       QueryValueEx = lrc
       Exit Function

QueryValueExError:
       Resume QueryValueExExit
   End Function
                
                
                
Public Function CreateKey(KeyName As String, _
ParentKey As Long) As Boolean

Dim lNewKeyHnd As Long
Dim lAns As Long

lAns = RegCreateKeyEx(ParentKey, KeyName, 0&, vbNullString, _
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, lNewKeyHnd, lAns)

RegCloseKey lNewKeyHnd

CreateKey = (lAns = 0)
 'Altenatively, return specific error inormation
 'See declarations for error codes
End Function

   Public Sub SetKeyValueHKLM(sKeyName As String, sValueName As String, _
   vValueSetting As Variant, lValueType As Long)
       Dim lRetVal As Long         'result of the SetValueEx function
       Dim hKey As Long         'handle of open key

       'open the specified key
       lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, _
                                 KEY_SET_VALUE, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)
   End Sub
        
Public Sub SetKeyValueHKCR(sKeyName1 As String, sValueName1 As String, _
   vValueSetting1 As Variant, lValueType1 As Long)
       Dim lRetVal1 As Long         'result of the SetValueEx function
       Dim hKey1 As Long         'handle of open key

       'open the specified key
       
       lRetVal1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName1, 0, _
                                 KEY_SET_VALUE, hKey1)
       lRetVal1 = SetValueEx(hKey1, sValueName1, lValueType1, vValueSetting1)
       RegCloseKey (hKey1)
   End Sub
        
        Sub main()
        App.TaskVisible = False

InitCommonControls


        If GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") = "" Then
        MsgBox "Error GPMClamAV is not Installed, Registry Key doesn't Exists, please Run this Program as Administrator", vbCritical + vbOKOnly, "ERROR"
        Else
       ' MsgBox GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir"), vbInformation
        SetKeyValueHKLM "Software\GPMClamAV", "Scanner", " --tempdir=""" & GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\temp""" & " --unload --keep-mbox --stdout " & "--log=""" & GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\Logs\GPMCNScan.log""" & " --recursive --infected " & " --database=""" & GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\db"" --bell --move=""" & GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\Quarantine""", REG_SZ
        SetKeyValueHKLM "Software\GPMClamAV", "GPMClamAVTray", GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\GPMAV-Tray.exe", REG_SZ
        
        CreateKey "CLSID\{e76d8ce0-8944-4fed-b363-c2df08724673}", HKEY_CLASSES_ROOT
        CreateKey "CLSID\{e76d8ce0-8944-4fed-b363-c2df08724673}\InProcServer32", HKEY_CLASSES_ROOT
        CreateKey "*\shellex\ContextMenuHandlers\GPMAV", HKEY_CLASSES_ROOT
        CreateKey "Folder\shellex\ContextMenuHandlers\GPMAV", HKEY_CLASSES_ROOT
        SetKeyValueHKCR "CLSID\{e76d8ce0-8944-4fed-b363-c2df08724673}", "GPMAV Shell Extension", "", REG_SZ
        SetKeyValueHKCR "CLSID\{e76d8ce0-8944-4fed-b363-c2df08724673}\InProcServer32", "", GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\\ExpShell.dll", REG_SZ
        SetKeyValueHKCR "CLSID\{e76d8ce0-8944-4fed-b363-c2df08724673}\InProcServer32", "ThreadingModel", "Apartment", REG_SZ
        SetKeyValueHKCR "*\shellex\ContextMenuHandlers\GPMAV", "", "{e76d8ce0-8944-4fed-b363-c2df08724673}", REG_SZ
        SetKeyValueHKCR "Folder\shellex\ContextMenuHandlers\GPMAV", "", "{e76d8ce0-8944-4fed-b363-c2df08724673}", REG_SZ
        
        Shell GetRegistryValue(HKEY_LOCAL_MACHINE, "Software\GPMClamAV", "Install_Dir") & "\gpmavupdate.exe", vbHide
        
        End If

        
        End Sub
        

