SecurityAudit

[vinay]

let me explain my project ...
I was handed this project by the CIO of Henkel CAC Mumbai.
This project wants me to scan the computer for softwares installed in the pc as soon as a pen drive is inserted in the usb slot.Basically he wants the software to auto run.

The organization has certain policies regarding the softwares installed in their PC.They are allowed to install only certain software and the rest of the softwares apart from the ones that they have defined as authorised are to be considered as unauthorized and must not be present.

My software has to scan the computer for both authorised and unauthorised software.
1> If unauthorised software/s is found a message has to be flashed listing the name of the unauthorized software/s and the user should be able to uninstall the software from my software itself and not frm the add or remove.
2> A log file is to be maintained of the scans and the logs should contain name of the computer to differentiate the scans done by the software and the state of authorised and unauthorised software of a particular computer.

So far i am able to list the softwares installed in the computer.

Difficulties:-If an authorized software is not installed ... how am i supposed to search for it and flash a message saying that the software is not installed...Should a database be involved in handling this situation or can it be done without a database.


FORM Code:-

[highlight="VB"]Option Explicit


Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
'Label1 = GetSettingString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll", "")

Dim SubKeys As Variant
Dim KeyLoop As Integer
Dim sDispName As String
SubKeys = GetAllKeys(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll")

If VarType(SubKeys) = vbArray + vbString Then
For KeyLoop = 0 To UBound(SubKeys)
sDispName = GetSettingString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll\" & SubKeys(KeyLoop), "DisplayName")
If sDispName > "" And Left(SubKeys(KeyLoop), 1) <> "{" Then
List1.AddItem sDispName & " / " & SubKeys(KeyLoop)
End If
Next
End If
End Sub


Sub CallCodeForGetAllValuesInAKey(ByVal sIn As String)
Dim Values As Variant
Dim KeyLoop As Integer
Dim RegPath As String
Dim HKCU As Long
Dim sLine As String
HKCU = HKEY_LOCAL_MACHINE 'to save typing
RegPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll\" & sIn

Values = GetAllValues(HKCU, RegPath)

If VarType(Values) = vbArray + vbVariant Then

For KeyLoop = 0 To UBound(Values)
sLine = Values(KeyLoop, 0) & " = "

Select Case Values(KeyLoop, 1)
Case REG_DWORD
sLine = sLine & GetSettingLong(HKCU, RegPath, _
CStr(Values(KeyLoop, 0)))
Case REG_BINARY
sLine = sLine & GetSettingByte(HKCU, RegPath, _
Hex$(Values(KeyLoop, 0)))(0)
Case REG_SZ
sLine = sLine & GetSettingString(HKCU, RegPath, _
CStr(Values(KeyLoop, 0)))
End Select
List2.AddItem sLine
Next KeyLoop

End If

End Sub

Private Sub List1_Click()
If List1.ListIndex < 0 Then
Exit Sub
End If
List2.Clear
CallCodeForGetAllValuesInAKey Mid(List1.Text, InStr(List1.Text, " / ") + 3)

End Sub
[/highlight]


Module code:-
[highlight="VB"]Option Explicit

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 HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1 'Unicode nul terminated string
Public Const REG_BINARY = 3 'Free form binary
Public Const REG_DWORD = 4 '32-bit number
Public Const ERROR_SUCCESS = 0&

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Long) As Long

Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long


Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult As Long) As Long

Public Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _
lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult As Long) As Long

Public 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

Public Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal Reserved As Long, ByVal _
dwType As Long, lpData As Any, ByVal cbData As Long) As Long


Public Function GetSettingString(hKey As Long, _
strPath As String, strValue As String, Optional _
Default As String) As String
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long

'Set up default value
If Not IsEmpty(Default) Then
GetSettingString = Default
Else
GetSettingString = ""
End If

lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
lValueType, ByVal 0&, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

If lValueType = REG_SZ Then

strBuffer = String(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, _
ByVal strBuffer, lDataBufferSize)

intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetSettingString = Left$(strBuffer, intZeroPos - 1)
Else
GetSettingString = strBuffer
End If

End If

Else
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function
Public Function GetSettingLong(ByVal hKey As Long, _
ByVal strPath As String, ByVal strValue As String, _
Optional Default As Long) As Long

Dim lRegResult As Long
Dim lValueType As Long
Dim lBuffer As Long
Dim lDataBufferSize As Long
Dim hCurKey As Long

'Set up default value
If Not IsEmpty(Default) Then
GetSettingLong = Default
Else
GetSettingLong = 0
End If

lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lDataBufferSize = 4 '4 bytes = 32 bits = long

lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
lValueType, lBuffer, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

If lValueType = REG_DWORD Then
GetSettingLong = lBuffer
End If

Else
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function

Public Sub SaveSettingLong(ByVal hKey As Long, ByVal _
strPath As String, ByVal strValue As String, ByVal lData As Long)
Dim hCurKey As Long
Dim lRegResult As Long

lRegResult = RegCreateKey(hKey, strPath, hCurKey)

lRegResult = RegSetValueEx(hCurKey, strValue, 0&, _
REG_DWORD, lData, 4)

If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Sub
Public Sub SaveSettingString(hKey As Long, strPath _
As String, strValue As String, strData As String)
Dim hCurKey As Long
Dim lRegResult As Long

lRegResult = RegCreateKey(hKey, strPath, hCurKey)

lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, _
ByVal strData, Len(strData))

If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Sub

Public Function GetSettingByte(ByVal hKey As Long, _
ByVal strPath As String, ByVal strValueName As String, _
Optional Default As Variant) As Variant
Dim lValueType As Long
Dim byBuffer() As Byte
Dim lDataBufferSize As Long
Dim lRegResult As Long
Dim hCurKey As Long

If Not IsEmpty(Default) Then
If VarType(Default) = vbArray + vbByte Then
GetSettingByte = Default
Else
GetSettingByte = 0
End If

Else
GetSettingByte = 0
End If

lRegResult = RegOpenKey(hKey, strPath, hCurKey)

lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
lValueType, ByVal 0&, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

If lValueType = REG_BINARY Then

ReDim byBuffer(lDataBufferSize - 1) As Byte
lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
lValueType, byBuffer(0), lDataBufferSize)
GetSettingByte = byBuffer

End If

Else
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)

End Function


Public Function GetAllValues(hKey As Long, _
strPath As String) As Variant
'Returns: a 2D array.
'(x,0) is value name
'(x,1) is value type (see constants)

Dim lRegResult As Long
Dim hCurKey As Long
Dim lValueNameSize As Long
Dim strValueName As String
Dim lCounter As Long
Dim byDataBuffer(4000) As Byte
Dim lDataBufferSize As Long
Dim lValueType As Long
Dim strNames() As String
Dim lTypes() As Long
Dim intZeroPos As Integer

lRegResult = RegOpenKey(hKey, strPath, hCurKey)

Do
'Initialise bufffers
lValueNameSize = 255
strValueName = String$(lValueNameSize, " ")
lDataBufferSize = 4000

lRegResult = RegEnumValue(hCurKey, lCounter, _
strValueName, lValueNameSize, 0&, lValueType, _
byDataBuffer(0), lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

'Save the type
ReDim Preserve strNames(lCounter) As String
ReDim Preserve lTypes(lCounter) As Long
lTypes(UBound(lTypes)) = lValueType

'Tidy up string and save it
intZeroPos = InStr(strValueName, Chr$(0))
If intZeroPos > 0 Then
strNames(UBound(strNames)) = _
Left$(strValueName, intZeroPos - 1)
Else
strNames(UBound(strNames)) = strValueName
End If

lCounter = lCounter + 1
Else
Exit Do
End If
Loop

'Move data into array
Dim Finisheddata() As Variant
ReDim Finisheddata(UBound(strNames), 0 To 1) As Variant

For lCounter = 0 To UBound(strNames)
Finisheddata(lCounter, 0) = strNames(lCounter)
Finisheddata(lCounter, 1) = lTypes(lCounter)
Next

GetAllValues = Finisheddata

End Function

Public Function GetAllKeys(hKey As Long, _
strPath As String) As Variant
Dim lRegResult As Long
Dim lCounter As Long
Dim hCurKey As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim strNames() As String
Dim intZeroPos As Integer
lCounter = 0
lRegResult = RegOpenKey(hKey, strPath, hCurKey)

Do
'initialise buffers (longest possible length=255)
lDataBufferSize = 255
strBuffer = String(lDataBufferSize, " ")
lRegResult = RegEnumKey(hCurKey, _
lCounter, strBuffer, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

'tidy up string and save it
ReDim Preserve strNames(lCounter) As String

intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1)
Else
strNames(UBound(strNames)) = strBuffer
End If

lCounter = lCounter + 1
Else
Exit Do
End If
Loop
GetAllKeys = strNames
End Function


Public Sub SaveSettingByte(ByVal hKey As Long, ByVal _
strPath As String, ByVal strValueName As String, byData() As Byte)
Dim lRegResult As Long
Dim hCurKey As Long

lRegResult = RegCreateKey(hKey, strPath, hCurKey)

lRegResult = RegSetValueEx(hCurKey, strValueName, _
0&, REG_BINARY, byData(0), UBound(byData()) + 1)

lRegResult = RegCloseKey(hCurKey)

End Sub



[/highlight]



Please help me out as to how am i supposed to make the software to run as it is supposed to ...Any additions to the features of the software that would accentuate the working of the software is welcome .....


Hope to get a great amount of help from my fellow users....

Thanking all in advance..!!!!

Yours sincerely,
Vinay

P.S. My email-id is fanofshady@gmail.com

[TcM]

As that is too much code, please upload the project. I might help you.

[vinay]

where m i supposed to upload it...u could give me ur mail-addr and i will mail u the code

[TcM]

Just reply to this thread in Advanced mode, then scroll down and you will see this:



Click on Manage Attachments and upload it from there.

[vinay]

Here is the code in rar file

[TcM]

Ok, so in my opinion no database is needed.. although you can implement one. Now your problem was...

If an authorized software is not installed ... how am i supposed to search for it and flash a message saying that the software is not installed...

You can search List1, for the program title (should be exact) and if returned as false (not found) then you popup a message box "The software ........ is not installed"

[vinay]

for example : if i want to search for Oracle
and it is not there in the list , then the message should be flashed.
But if the name is written as ORACLE then wat happens...should i convert the case and search for both uper and lower case..
It would be better if the search is not case sensitive....


The problem is ...My code has to search automatically for the software which is authorised but not installed ....i m not supposed to put a search option....From where will i compare a string to a string in List1???



Jus give me an example explaining the above search with it's criteria... i.e. If MSOffice is one of the authorized software and is not installed in the computer..From where should the string be compared to the string in List1...And how is the string to be searched for....Dats the reason i was confused regarding the usage of a database

I just got an idea of comparing the strings...I would convert all the strings being compared in either lowercase or uppercase and then compare it with the string of the authorized software.....But still the question holds...Should i be using a database or can i insert some 10 to 15 strings in an array???


I want the list of authorised softwares to be a generalized one i.e. if the same software is used in some other place then the list of software names and number of authorised softwares should be flexible....




Cant i search only a part of the string frm the list i.e. If the authorised software name is Oracle9i and the string in the List1 is Oracle and the 9i part is present in its sub keys , then the message would be flashed as " software is not found"....M i saying the right thing here...???

[TcM]

Well it seems like it's going to be a complicated search.. something that I've never done before.

[vinay]

could u help me out with it...???
i would b greatful to get any sort of help...

and should i use a database as i i asked before...???

[TcM]

As I said before.. a DB is optional.

as of helping.. I don't know.. Will try to.

EDIT:- I have a code to search listboxes, but it only finds exact text, but it is not case-sensitive.