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