Tuesday, June 21, 2005

nabura ko sourcecode ng blockexecute. buti n lng may cache result ang gds(google desktop search)

Attribute VB_Name = "modSystem"
Option Explicit
Option Compare Text
Dim c As ADODB.Connection


Sub Main()

Dim Basename As String

Basename = ""

Set c = New ADODB.Connection
c.CursorLocation = adUseClient
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\BlockExecute.mdb;Persist Security Info=False"


'Provider=Microsoft.Jet.OLEDB.4.0;Password=mikeruth;Data Source=E:\_NOT RELATED_\BlockExecute\BlockExecute.mdb;Persist Security Info=True


Dim I As Long

For I = Len(Command) To 1 Step -1

If Mid(Command, I, 1) = "\" Then
Exit For
End If

Basename = Mid(Command, I, 1) & Basename

Next


If InStr(1, Basename, " ") > 0 Then
Basename = Left(Basename, InStr(1, Basename, " ") - 1)
End If


Dim r As ADODB.Recordset
Set r = New ADODB.Recordset
r.Open "SELECT Filename, DateTimeExecuted FROM LastExecuted WHERE Filename = '" & Basename & "'", c, adOpenStatic, adLockOptimistic


If r.EOF Then
r.AddNew
r!FileName.Value = Basename
End If

r!DateTimeExecuted.Value = Now()
r.Update

r.Close
Set r = Nothing




Dim IsExist As Boolean
IsExist = c.Execute("SELECT COUNT(*) AS Cnt FROM Executable WHERE Filename = '" & Basename & "'").Fields("Cnt").Value > 0

c.Close
Set c = Nothing



If IsExist Then
Shell Command, vbNormalFocus
Else
MsgBox "Program not allowed to run." & vbCrLf & vbCrLf & "Contact MIS Department if you really need this program to run." & vbCrLf & "Look for either B)uen R)amos A)lcala T)olentino" & vbCrLf & """BRAT Boys""", vbExclamation, "BRAT Advisory"
End If


End Sub

0 Comments:

Post a Comment

<< Home