SHARE
TWEET

Untitled

a guest Apr 24th, 2019 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Compare Database
  2. Option Explicit
  3.  
  4.  
  5. Public Sub OpenQueryWW(sQuery As String)
  6.     With DoCmd
  7.         .SetWarnings False
  8.         .OpenQuery sQuery
  9.         .SetWarnings True
  10.     End With
  11. End Sub
  12.  
  13. Public Sub RunSQLWW(sSQL As String)
  14.     With DoCmd
  15.         .SetWarnings False
  16.         .RunSQL sSQL
  17.         .SetWarnings True
  18.     End With
  19. End Sub
  20.  
  21. Public Sub ScanFiles(bAutoDeleteDebugFiles As Long)
  22.     Dim oFSO As New Scripting.FileSystemObject
  23.     Dim oFolder As Scripting.Folder
  24.     Dim sUserPath As String
  25.     Dim sError As String
  26.     Dim iFileFounds As Integer
  27.    
  28.     sUserPath = "C:\Users\" & Environ("USERNAME") & "\"
  29.    
  30.     If Not oFSO.FolderExists(sUserPath) Then
  31.         Form_frmMain.UpdateStatus "User path " & sUserPath & " was not found"
  32.         GoTo exit_sub
  33.     Else
  34.         Set oFolder = oFSO.GetFolder(sUserPath)
  35.         iFileFounds = ReadData(oFolder, bAutoDeleteDebugFiles)
  36.     End If
  37.    
  38.     If iFileFounds = 0 Then
  39.         Form_frmMain.UpdateStatus "No debug files were found, make sure debug is enabled in Fightcade"
  40.         GoTo exit_sub
  41.     Else
  42.         Form_frmMain.UpdateStatus "Idle - Last Scan " & Format(Hour(Time), "00") & ":" & Format(Minute(Time), "00") & ":" & Format(Second(Time), "00")
  43.     End If
  44.    
  45.    
  46. exit_sub:
  47.     Set oFSO = Nothing
  48.     Set oFolder = Nothing
  49. End Sub
  50.  
  51. Private Function scanIP(sArray() As String, iArrayPos, oRS As DAO.Recordset)
  52.     Dim oRegEx As New RegExp
  53.     Dim sPattern As String
  54.     Dim sIP As String
  55.     Dim m
  56.     Dim iCursor As Integer
  57.    
  58.     Set oRegEx = Nothing
  59.     sPattern = "\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b"
  60.  
  61.     oRegEx.Pattern = sPattern
  62.     oRegEx.Global = False
  63.     oRegEx.IgnoreCase = True
  64.    
  65.     For Each m In oRegEx.Execute(sArray(iArrayPos))
  66.         On Error Resume Next
  67.        
  68.        
  69.         With oRS
  70.             iCursor = 1
  71.            
  72.             While sArray(iArrayPos - iCursor) <> "x17y" And sArray(iArrayPos - iCursor) <> "x17x" And sArray(iArrayPos - iCursor) <> "x17z" And sArray(iArrayPos - iCursor) <> "x17w" And sArray(iArrayPos - iCursor) <> "x17v"
  73.                 iCursor = iCursor + 1
  74.             Wend
  75.                      
  76.             .AddNew
  77.             .Fields("IPAddress") = sArray(iArrayPos)
  78.            
  79.             Select Case sArray(iArrayPos - iCursor + 1)
  80.             Case "x01", "x02", "x03", "x04", "x05", "x06", "x07", "x08", "x09"
  81.                 .Fields("Username") = sArray(iArrayPos - iCursor + 2)
  82.             Case Else
  83.                 .Fields("Username") = sArray(iArrayPos - iCursor + 1)
  84.             End Select
  85.            
  86.             .Fields("Country") = sArray(iArrayPos + 2)
  87.  
  88.             .Update
  89.  
  90.         End With
  91.     Next
  92.    
  93.  
  94. End Function
  95.  
  96. Public Function ReadData(oFolder As Scripting.Folder, bAutoDeleteDebugFiles As Long) As Integer
  97.     Dim sTempFile As String
  98.     Dim sTempFile2 As String
  99.    
  100.     Dim sLine As String
  101.     Dim sArrayData() As String
  102.     Dim oRS As DAO.Recordset
  103.    
  104.     Dim oFile As Scripting.File
  105.     Dim oFSO As New Scripting.FileSystemObject
  106.     Dim oStream As Scripting.TextStream
  107.     Dim oStream2 As Scripting.TextStream
  108.     Dim i As Long
  109.     Dim j As Long
  110.     Dim iPos As Integer
  111.    
  112.     Dim iFileFounds As Integer
  113.    
  114.     RunSQLWW "delete * from t_log_temp"
  115.     Set oRS = CurrentDb.OpenRecordset("select * from t_log_temp")
  116.      
  117.     sTempFile = Application.CurrentProject.Path & "\TempData.txt"
  118.     sTempFile2 = Application.CurrentProject.Path & "\TempData2.txt"
  119.    
  120.     If oFSO.FileExists(sTempFile2) Then oFSO.DeleteFile (sTempFile2)
  121.    
  122.     For Each oFile In oFolder.Files
  123.         If Left(oFile.Name, 15) = "fightcade-debug" And InStr(1, oFile.Name, ".log") > 0 Then
  124.             If CDate(oFile.DateLastModified) >= Date Then
  125.                 Form_frmMain.UpdateStatus "Reading " & oFile.Name
  126.            
  127.                 Set oStream2 = oFSO.OpenTextFile(sTempFile2, ForAppending, True)
  128.                
  129.                 If oFSO.FileExists(sTempFile) Then oFSO.DeleteFile (sTempFile)
  130.                 oFSO.CopyFile oFile.Path, sTempFile, True
  131.  
  132.                 Set oStream = oFSO.OpenTextFile(sTempFile, ForReading, False)
  133.                
  134.                 While Not oStream.AtEndOfStream
  135.                     sLine = oStream.ReadLine
  136.                     If Left(sLine, 12) = "Dispatch SEQ" And Not InStr(1, sLine, "Marvel vs Capcom - clash of super heroes") > 0 And Not InStr(1, sLine, "Welcome to FightCade") > 0 And Len(sLine) > 45 Then
  137.                         oStream2.WriteLine Replace(sLine, "\x00", "")
  138.                     End If
  139.                 Wend
  140.                
  141.                 iFileFounds = iFileFounds + 1
  142.                 oStream.Close
  143.                 oStream2.Close
  144.                
  145.             End If
  146.         End If
  147.     Next oFile
  148.    
  149.     If iFileFounds = 0 Then GoTo exit_function
  150.     Set oStream2 = oFSO.OpenTextFile(sTempFile2, ForReading, False)
  151.    
  152.     j = 0
  153.    
  154.     While Not oStream2.AtEndOfStream
  155.         sLine = oStream2.ReadLine
  156.         If Left(sLine, 12) = "Dispatch SEQ" Then
  157.             Form_frmMain.UpdateStatus "Fetching data to temp log - " & j
  158.            
  159.             iPos = InStr(1, sLine, "'") + 1
  160.            
  161.             If Mid(sLine, iPos, 1) <> "\" Then
  162.                 sLine = Left(sLine, iPos - 1) & "\x17y" & Mid(sLine, iPos + 1, Len(sLine))
  163.             End If
  164.            
  165.             sArrayData = Split(sLine, "\")
  166.            
  167.             sArrayData(1) = "x17y"
  168.            
  169.             For i = 0 To UBound(sArrayData)
  170.                 If sArrayData(i) = "x01" Or sArrayData(i) = "x02" Or sArrayData(i) = "x17y" Or sArrayData(i) = "x17x" Or sArrayData(i) = "x03" _
  171.                 Or sArrayData(i) = "x04" Or sArrayData(i) = "x05" Or sArrayData(i) = "x06" Or sArrayData(i) = "x07" Or sArrayData(i) = "x08" Or sArrayData(i) = "x09" _
  172.                 Or sArrayData(i) = "x17z" Or sArrayData(i) = "x17v" Or sArrayData(i) = "x17w" _
  173.                 Then
  174.                     'leave as is
  175.                 ElseIf Left(sArrayData(i), 1) = "x" Then
  176.                     sArrayData(i) = Mid(sArrayData(i), 4, 255)
  177.                 Else
  178.                     sArrayData(i) = Mid(sArrayData(i), 2, 255)
  179.                 End If
  180.                
  181.             Next i
  182.            
  183.             j = j + 1
  184.            
  185.             For i = 0 To UBound(sArrayData)
  186.                 scanIP sArrayData, i, oRS
  187.             Next i
  188.            
  189.         End If
  190.     Wend
  191.    
  192.     OpenQueryWW "qry001AddLog"
  193.    
  194.    
  195.     oStream2.Close
  196.    
  197. exit_function:
  198.     oRS.Close
  199.    
  200.     Set oStream = Nothing
  201.     Set oStream2 = Nothing
  202.     Set oFSO = Nothing
  203.    
  204.     ReadData = iFileFounds
  205.    
  206.     On Error Resume Next
  207.    
  208.     If bAutoDeleteDebugFiles = -1 Then
  209.         For Each oFile In oFolder.Files
  210.             If Left(oFile.Name, 15) = "fightcade-debug" And InStr(1, oFile.Name, ".log") > 0 Then
  211.                 oFile.Delete
  212.             End If
  213.         Next oFile
  214.     End If
  215. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top