Private Sub Form_Activate()
'Declaring variables
Dim nMaxRecs, retval, nPrevious
Dim xmlDoc, strLog, retStr
Dim temp1, temp2, last, first, startCon, stopCon
Dim name, logDateCon, logTimeCon
Dim dbs As Database, rst As Recordset
Dim sqlStr1, sqlStr2, retKBLeft, iniKB
'initialize variables
Set xmlDoc = CreateObject("microsoft.xmldom")
xmlDoc.async = False
xmlDoc.Load ("c:\books.xml")
name = ""
logDateCon = ""
logTimeCon = ""
logDateDis = ""
logTimeDis = ""
logDuration = ""
BytesSent = ""
BytesReci = ""
nMaxRecs = 30 'maximum records to retrieve from event log
Set x = CreateObject("Softwing.EventLogReader")
retval = x.OpenLog(vbNullChar, "System")
n = x.GetFirst()
If IsEmpty(n) Then 'Test for empty event log is empty (error checking)
Call Form_Terminate
End If
nPrevious = n
While nMaxRecs > 0
'Test if the event ID is 6006 (error checking)
If EvId = 6006 Then
n = x.GetNext(EvId, EvType, strEvSource, EvDate)
End If
retval = x.GetRecord(n, EvId, EvType, strSource, EvDate, strComputer, strAccount, strDesc)
If EvId = 20048 Then
Set strLog = xmlDoc.createComment(strDesc)
'Retrieving the user name
temp1 = " connected on port "
temp2 = "The user "
last = InStr(1, strDesc, temp1, 1)
first = Len(temp2)
retStr = strLog.subStringData(first, (last - first))
name = Trim(retStr)
first = last
'Retrieving log in Date
temp1 = " at"
last = InStr(first, strDesc, temp1, 1)
first = last - 11
retStr = strLog.subStringData(first, 11)
logDateCon = retStr
first = last
'Retrieving log in time
temp1 = " and"
last = InStr(first, strDesc, temp1, 1)
first = last - 8
retStr = strLog.subStringData(first, 8)
logTimeCon = retStr
first = last
startCon = logDateCon + logTimeCon
'Retrieving log out date
temp1 = " at"
last = InStr(first, strDesc, temp1, 1)
first = last - 11
retStr = strLog.subStringData(first, 11)
logDateDis = retStr
first = last
'Retrieving log out time
temp1 = ". The user"
last = InStr(first, strDesc, temp1, 1) - 1
first = last - 7
retStr = strLog.subStringData(first, 7)
logTimeDis = retStr
first = last
stopCon = logDateDis + logTimeDis
'Retrieving log in Duration
temp1 = "seconds."
temp2 = "active for "
last = InStr(first, strDesc, temp1, 1) + 8
first = InStr(first, strDesc, temp2, 1) + 9
retStr = strLog.subStringData(first, (last - first))
logDuration = retStr
first = last
'Retrieving bytes sent
temp1 = " bytes"
temp2 = "seconds. "
last = InStr(first, strDesc, temp1, 1)
first = InStr(1, strDesc, temp2, 1) + 8
retStr = strLog.subStringData(first, (last - first))
BytesSent = retStr
first = last
'Retrieving bytes received
temp1 = "sent and"
temp2 = "bytes"
first = InStr(first, strDesc, temp1, 1) + 8
last = InStr(first, strDesc, temp2, 1) - 1
retStr = strLog.subStringData(first, (last - first))
BytesReci = retStr
'Retriveing inital KBytes assign to a user from nttacdb remainder
sqlStr2 = "TAC_ID = '" & name & "' and TAC_Attr = '" & "[Credits]TimeInitial'"
With Data2.Recordset
.MoveFirst
.FindNext (sqlStr2)
iniKB = .Fields(2)
End With
'Retriveing KBytes usage from nttacdb remainder
sqlStr2 = "TAC_ID = '" & name & "' and TAC_Attr = '" & "[Credits]KBytesLeft'"
With Data2.Recordset
.MoveFirst
.FindNext (sqlStr2)
retKBLeft = .Fields(2)
End With
'test to see if the retKBLeft is numeric (error checking)
If Not (IsNumeric(retKBLeft)) Then
GoTo lastline
End If
'edit & update the NTTac and stat data base
sqlStr1 = "Username = '" & name & "' and Start between #" & Format(startCon, "m/d/yyyy h:mm:ss AM/PM") & "# and #" & Format(stopCon, "m/d/yyyy h:mm:ss AM/PM") & "#"
With Data1.Recordset
.MoveLast
.FindPrevious (sqlStr1)
If (!KBytesIN = 0) And (!KBytesOut = 0) Then
.Edit
!KBytesLeft = retKBLeft
!KBytesIN = Fix(BytesReci / 1000) + 1
!KBytesOut = Fix(BytesSent / 1000) + 1
!SessionKB = !KBytesIN + !KBytesOut
retKBLeft = retKBLeft - !SessionKB
If retKBLeft < 0 Then
'!KBytesLeft = 0
'!ExtraKB = !SessionKB - iniKB
!ExtraKB = -retKBLeft
!KBytesLeft = 0
Else
!KBytesLeft = retKBLeft
End If
'retKBLeft = !KBytesLeft
.Update
With Data2.Recordset
.Edit
.Fields(2) = Data1.Recordset.Fields(14)
.Update
End With
End If
End With
End If
lastline: 'goto (lines 125)
'next event log
nPrevious = n
nMaxRecs = nMaxRecs - 1
n = x.GetNext(EvId, EvType, strEvSource, EvDate)
Wend
Call Form_Terminate
End Sub
Private Sub Form_Load()
With Data1
.DatabaseName = "C:\NTTacPlus2\ODBC\stat.mdb"
.RecordsetType = 1
.RecordSource = "Accounting"
.ReadOnly = False
End With
With Data2
.DatabaseName = "C:\NTTacPlus2\ODBC\NTTacDB.mdb"
.RecordsetType = 1
.RecordSource = "TAC_USR"
.ReadOnly = False
End With
End Sub
Private Sub Form_Terminate()
End
End Sub
ايشالا كه زودي تمومش كني .