Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "mdlXlTrans"
Option Explicit

'========= changable constants====================================
'menu Captions
Public MenuCaption As String 'name of the menu     //Made By Yasu

Public Const m_strTipText As String = "Brother P-touch"

Public Const TagTbtnTranslateIcon As String = "brother Toolbar button: Translate with icon face"       '//ADD BY MASIJUN
Public Const TagTbtnTranslateCaption As String = "brother Toolbar button: Translate with caption face" '//ADD BY MASIJUN

'toolbar tip message
Public Const msgTitleInfo As String = "Brother P-touch"
Public Const msgTitleVBError As String = "Brother P-touch"

'レジストリのパス
Public Const m_StrSubKey = "SoftWare\Brother Industries, Ltd.\P-touch Editor\4.2\Settings"
Public Const m_StrItem = "ApplicationPath"
Public m_StrPteditPass As String 'P-touch Editorのレジストリのパス

Public Const m_strSubRegKey = "SoftWare\Brother Industries, Ltd.\P-touch Addins\Ptedit42\Excel"

'PT-Editor動作情報のレジストリのパス[1]
Public Const m_StrActItem = "AddinActionExcel"
Public m_strActFlg As String 'PT-Editor動作情報フラグ(0:アドインプレビュー,1:直接印刷,2:編集)
'取り込み設定ダイアログ表示/非表示のレジストリのパス[2]
Public Const m_strExcelRegDispDlg = "AddinDispExcelDlg"
Public m_lnDispDlgFlg As Long '取り込み設定ダイアログ表示フラグ(0:非表示,1:表示)
'取り込みテキスト情報のレジストリのパス[3]
Public Const m_strRegBodyItem = "AddinExcelText"
Public m_strRegBody As String 'テキスト情報
'取り込みコード情報のレジストリのパス[4]
Public Const m_strRegCodeItem = "AddinExcelCode"
Public m_lnCodeFlg As Long 'コード情報フラグ
Public m_StrCode As String 'コード情報

'取り込みテキスト情報を使用するしないの設定[5]
Public Const m_strLastSetupItem = "AddinExcelLastSetup"
Public m_lnLastSetupFlg As Long '取り込みテキスト情報を使用未使用フラグ(0:未使用,1:使用)

Public m_strArrangement(65536) As String '配列情報
Public m_lnArrangement As Long '列数

Public m_StrFirstRow As String '最初に選択した列数

Public m_bStartPtedit As Boolean 'キャンセルボタン押下の場合は、P-touch Editorを実行しない
 

Public m_strTextBoxBody As String '初回起動時に設定ダイアログの取り込み形式に使用する文字列
 
Public m_bGetText As Boolean '選択したセル内にテキストがあるかどうかを判別する
 
'Registry Open/Create Options
Public Const REG_OPTION_RESERVED = &H0      'Parameter is reserved
Public Const REG_OPTION_NON_VOLATILE = &H0  'Key is preserved
                                            'when system is rebooted
Public Const REG_OPTION_VOLATILE = &H1      'Key is not preserved
                                            ' when system is rebooted
Public Const REG_OPTION_CREATE_LINK = &H2   'Created key is a
                                            'symbolic link
Public Const REG_OPTION_BACKUP_RESTORE = &H4 'open for backup or restore
                                            'special access rules
                                            'privilege required

Public Const m_lMaxNumber As Long = 262144 '最大Byte数(65536*4=262144)に変更する 20050520

Global hMapping As Long
Global pi As PROCESS_INFORMATION

Public m_MinRow, m_MinColumn, m_MaxRow, m_MaxColumn As Long
Public m_StrokeRow, m_StrokeColumn As Long

Public TotalLen As Long

Public m_strPteditText As String 'Excelから取得した文字列
Public m_PteditRow As Long
Public m_PteditColumn As Long

'file names
Public Const fnIconDll As String = "AddinPtouch42_Icon.dll"

'P-touch icon bitmap number in AddinPtouch_Icon.dll file
Public Const IconBmp16Num As Long = 101 'this icon for P-touch,Name:IDB_BITMAP_SMALL

'name of section and keys in registration database
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const MainKey As Long = HKEY_CURRENT_USER
        
'==========global variables and unchangable constants=============
'string length limit constants
'Public Const MaxCellStrLen = 255        'max length of a cell

'number of the icon bitmap in HB_addin.dll
Public Const CF_TEXT As Long = 1        'data format of clipboard
Public Const CF_BITMAP As Long = 2      'data format of clipboard
Public Const CF_DIB As Long = 8      'data format of clipboard
Public Const ERROR_SUCCESS As Long = 0  'flag of success of a function

'Registry key data value type
Public Const REG_NONE = 0                   'No value type
Public Const REG_SZ = 1                     'Unicode nul terminated string
Public Const REG_EXPAND_SZ = 2              'Unicode nul terminated string
                                            'with environment variable references)
Public Const REG_BINARY = 3                 'Free form binary
Public Const REG_DWORD = 4                  '32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4    '32-bit number =same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = 5       '32-bit number
Public Const REG_LINK = 6                   'Symbolic Link =unicode)
Public Const REG_MULTI_SZ = 7               'Multiple Unicode strings
Public Const REG_RESOURCE_LIST = 8          'Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9 'Resource list in the hardware description
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10

'Registry Specific Access Rights.
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
'Public Const KEY_ALL_ACCESS = &H1F003F
  
  '同期
  Public Const SYNCHRONIZE = &H100000
  Public Const STANDARD_RIGHTS_ALL = &H1F0000
  Public Const KEY_ALL_ACCESS = ( _
    (STANDARD_RIGHTS_ALL Or _
    KEY_QUERY_VALUE Or _
    KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY Or _
    KEY_ENUMERATE_SUB_KEYS Or _
    KEY_NOTIFY Or _
    KEY_CREATE_LINK) And _
    (Not SYNCHRONIZE))

'========prototypes of API DLL function======================
'Registry API prototypes
'create or open a new key
Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal Reserved As Long, ByVal lpClass As String, _
        ByVal dwOptions As Long, ByVal samDesired As Long, _
        lpSecurityAttributes As Long, phkResult As Long, _
        lpdwDisposition As Long) As Long

'close a key
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

'open a key
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

'get a key value
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
        (ByVal hKey As Long, ByVal lpValueName As String, _
        ByVal lpReserved As Long, lpType As Long, _
         LpData As Any, lpcbData As Long) As Long
        
'set key value
Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
        (ByVal hKey As Long, ByVal lpValueName As String, _
        ByVal Reserved As Long, ByVal dwType As Long, _
        ByVal LpData As String, ByVal cbData As Long) As Long

'load DLL in which the TransLand Icon exists
Declare Function LoadLibrary Lib "Kernel32" Alias "LoadLibraryA" _
        (ByVal lpLibFileName As String) As Long

'free loaded DLL
Declare Sub FreeLibrary Lib "Kernel32" (ByVal hLibModule As Long)

'load a bitmap from a module
Declare Function LoadBitmapByNum Lib "User32" Alias "LoadBitmapA" _
        (ByVal hInstance As Long, ByVal lpBitmapNum As Long) As Long
        
        
'load a String Table from a module
Declare Function LoadString Lib "User32" Alias "LoadStringA" _
        (ByVal hInstance As Long, ByVal lpBitmapNum As Long, _
        ByVal LpData As String, ByVal cbData As Long) As Long
        

'open the clipboard
Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long

'set data into clipboard
Declare Function SetClipboardData Lib "User32" _
        (ByVal wFormat As Long, ByVal hMem As Long) As Long

'close clipboard
Declare Function CloseClipboard Lib "User32" () As Long

'get handle of the window that has the focus
Declare Function GetFocus Lib "User32" () As Long

'get system direcory. Error: can't find GetSystemDirectory in Kernel32
Declare Function GetSystemDirectory Lib "Kernel32" Alias "GetSystemDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'startup help
Declare Function WinHelp Lib "User32" Alias "WinHelpA" _
        (ByVal hWin As Long, ByVal FileName As String, _
        ByVal uCommand As Integer, ByVal dwData As Long) As Long
        
        
Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type


Declare Function CreateProcess Lib "Kernel32" Alias "CreateProcessA" _
    (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, _
    lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
    
Declare Function WaitForInputIdle Lib "User32" _
    (ByVal hProcess As Long, ByVal nMilliseconds As Long) As Long
    
Declare Function PostThreadMessage Lib "User32" Alias "PostThreadMessageA" _
    (ByVal nThread As Long, ByVal nMsg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
'メモリのロックを解除
Declare Function GlobalUnlock Lib "Kernel32" (ByVal hMem As Long) As Long
'メモリをロック
Declare Function GlobalLock Lib "Kernel32" (ByVal hMem As Long) As Long
'メモリ割り当て
Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'文字列をグローバル メモリへコピー
Declare Function lstrcpy Lib "Kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function lstrlen Lib "Kernel32" (ByVal lpString1 As Any) As Long

'GetLastError
Declare Function GetLastError Lib "Kernel32" () As Long

Declare Function CreateFileMapping Lib "Kernel32" Alias "CreateFileMappingA" (ByVal handle As Long, _
    LPSECURITY_ATTRIBUTES As SECURITY_ATTRIBUTES, ByVal Protect As Long, ByVal MaximumSizeHigh As Long, _
    ByVal MaximumSizeLow As Long, ByVal lpString As String) As Long

Declare Function MapViewOfFile Lib "Kernel32" (ByVal FileMappingObject As Long, ByVal DesiredAccess As Long, _
    ByVal FileOffsetHigh As Long, ByVal FileOffsetLow As Long, ByVal NumberOfBytesToMap As Long) As Long
    
Declare Function UnmapViewOfFile Lib "Kernel32" (ByVal lpBaseAddress As Any) As Long

Declare Function CloseHandle Lib "Kernel32" (ByVal hMapping As Long) As Long

Declare Function LoadBtnBitmap Lib "AddinPtouch_Icon" () As Long

'クリップボードの内容を消去
Declare Function EmptyClipboard Lib "User32" () As Long

Declare Function RegisterClipboardFormat Lib "User32" Alias "RegisterClipboardFormatA" (ByVal lpFormat As String) As Long

Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
'==Excel起動時に最初に呼ばれる====================================
Sub Auto_Open()
On Error GoTo ErrAuto_Open

Dim bPtouchToolBar As Boolean '"Brother P-touch"ツールバーがあることを確認
bPtouchToolBar = False

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
        CommandBars("Brother P-touch").Enabled = True
        bPtouchToolBar = True
        Exit For 'ループを抜ける
    End If
Next

'不測の自体に"Brother P-touch"が削除された場合は、自力で作成する
'(この場合クリップボードはクリアしない)

'"Brother P-touch"ツールバー自体がない場合は、新規作成を行う
Dim oPtouchToolBar As CommandBar
If bPtouchToolBar = False Then
   Set oPtouchToolBar = Application.CommandBars.Add(m_strTipText)
End If

Dim bPtouchIcon As Boolean '"Brother P-touch"ツールバー中にアイコンがあることを確認
bPtouchIcon = False

'"Brother P-touch"の中にアイコンがない場合は、アイコンを作成する
Dim oPtouchItem As CommandBarControl
For Each oPtouchItem In CommandBars("Brother P-touch").Controls
    If Left(oPtouchItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        bPtouchIcon = True
        Exit For 'ループを抜ける
    End If
Next oPtouchItem

If bPtouchIcon = False Then
   AddButton
End If

'MenuCaption = LoadDllStringTable(50)

LoadStandardToolBar  'load ToolBar
LoadMenu             'load Menu
LoadContextMenu      'load Context menu

LoadContextRowMenu 'load Context Row menu
LoadContextColumnMenu 'load Context Column menu

hMapping = 0

For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
        CommandBars("Brother P-touch").Enabled = False
        Exit Sub
    End If
Next

Exit Sub

'Error handler of this function
ErrAuto_Open:
MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": Auto_Open()"

End Sub

'Load DllStringTable
Function LoadDllStringTable(i As Integer) As String
Dim hIconDLL As Long
Dim lBufferSize As Long   '文字列バッファサイズ
Dim strBuffer As String   '文字列バッファ
Dim lRet As Long          'API戻り値

On Error GoTo ErrLoadDllStringTable

hIconDLL = -1
'load DLL in which the TransLand Icon exists
hIconDLL = LoadLibrary(GetWinSysDir() & "\" & fnIconDll)

If hIconDLL = 0 Then 'LoadLibrary()の戻り値がNULLの場合
    MsgBox "No AddinPtouch_Icon.dll file" & Chr(13) & Chr(10) & "(Function: LoadDllStringTable())", vbCritical + vbOKOnly, msgTitleVBError
    Exit Function
End If

'文字列バッファの初期化
lBufferSize = 128
strBuffer = Space(lBufferSize)
lRet = LoadString(hIconDLL, i, strBuffer, lBufferSize)
LoadDllStringTable = strBuffer
    
Dim ptr1 As Long
ptr1 = InStr(strBuffer, vbNullChar)
LoadDllStringTable = Mid(strBuffer, 1, ptr1 - 1)
    
Exit Function
'Error handler of this function
ErrLoadDllStringTable:
    MsgBox "No AddinPtouch_Icon.dll file" & Chr(13) & Chr(10) & "(Function: LoadDllStringTable())", vbCritical + vbOKOnly, msgTitleVBError

End Function

' get windows directory
Function GetWinSysDir() As String
Dim StrBuff As String * 255
Dim DirLen As Long

DirLen = GetSystemDirectory(StrBuff, Len(StrBuff))
If DirLen = 0 Then '[1]
    MsgBox LoadDllStringTable(1), vbInformation + vbOKOnly, msgTitleInfo
    GetWinSysDir = ""
    End
Else
    GetWinSysDir = Left(StrBuff, DirLen)
End If
End Function

'Load DCL menu
Sub LoadMenu()
Dim oMenuItem As CommandBarControl

On Error GoTo ErrLoadMenu

'search the used shortcut character and check if the DCL menu loaded
For Each oMenuItem In CommandBars("Tools").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then Exit Sub
Next oMenuItem
  
Dim iCount As Integer
iCount = CommandBars("Tools").Controls.Count

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
        If iCount > 10 Then
            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
            CommandBars("Tools"), Before:=10
        Else
            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
            CommandBars("Tools"), Before:=iCount - 1
        End If
        Exit For 'ループを抜ける
    End If
Next

For Each oMenuItem In CommandBars("Tools").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
'        CommandBars("Tools").Controls(oMenuItem.Index).Caption = MenuCaption
        CommandBars("Tools").Controls(oMenuItem.Index).OnAction = "StartPtedit" '再定義する
        Exit Sub
    End If
Next oMenuItem

Exit Sub

'Error handler of this function
ErrLoadMenu:
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": LoadMenu()"
    Resume Next
End Sub

'Load Context menu
Sub LoadContextMenu()
Dim oMenuItem As CommandBarControl

On Error GoTo ErrLoadContextMenu
'search the used shortcut character and check if the DCL menu loaded
For Each oMenuItem In CommandBars("Cell").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then Exit Sub
Next oMenuItem
  
Dim iCount As Integer
iCount = CommandBars("Cell").Controls.Count

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
'        If iCount > 14 Then
'            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
'            CommandBars("Cell"), Before:=14
'        Else
            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
            CommandBars("Cell"), Before:=iCount + 1
'        End If
         Exit For 'ループを抜ける
    End If
Next

For Each oMenuItem In CommandBars("Cell").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
'        CommandBars("Cell").Controls(oMenuItem.Index).Caption = MenuCaption
        CommandBars("Cell").Controls(oMenuItem.Index).OnAction = "StartPtedit"
        Exit Sub
    End If
Next oMenuItem

Exit Sub

'Error handler of this function
ErrLoadContextMenu:
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": LoadContextMenu()"
    Resume Next
End Sub

'Load Context Row menu
Sub LoadContextRowMenu()
Dim oMenuItem As CommandBarControl

On Error GoTo ErrLoadContextRowMenu
'search the used shortcut character and check if the DCL menu loaded
For Each oMenuItem In CommandBars("Row").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then Exit Sub
Next oMenuItem
  
Dim iCount As Integer
iCount = CommandBars("Row").Controls.Count

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
'        If iCount > 14 Then
'            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
'            CommandBars("Cell"), Before:=14
'        Else
            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
            CommandBars("Row"), Before:=iCount + 1
'        End If
         Exit For 'ループを抜ける
    End If
Next

For Each oMenuItem In CommandBars("Row").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
'        CommandBars("Row").Controls(oMenuItem.Index).Caption = MenuCaption
        CommandBars("Row").Controls(oMenuItem.Index).OnAction = "StartPtedit"
        Exit Sub
    End If
Next oMenuItem

Exit Sub

'Error handler of this function
ErrLoadContextRowMenu:
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": LoadContextRowMenu()"
    Resume Next
End Sub

'Load Context Column menu
Sub LoadContextColumnMenu()
Dim oMenuItem As CommandBarControl

On Error GoTo ErrLoadContextColumnMenu

'search the used shortcut character and check if the DCL menu loaded
For Each oMenuItem In CommandBars("Column").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then Exit Sub
Next oMenuItem
  
Dim iCount As Integer
iCount = CommandBars("Column").Controls.Count

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
'        If iCount > 14 Then
'            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
'            CommandBars("Cell"), Before:=14
'        Else
            CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
            CommandBars("Column"), Before:=iCount + 1
'        End If
         Exit For 'ループを抜ける
    End If
Next

For Each oMenuItem In CommandBars("Column").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
'        CommandBars("Column").Controls(oMenuItem.Index).Caption = MenuCaption
        CommandBars("Column").Controls(oMenuItem.Index).OnAction = "StartPtedit"
        Exit Sub
    End If
Next oMenuItem

Exit Sub

'Error handler of this function
ErrLoadContextColumnMenu:
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": LoadContextColumnMenu()"
    Resume Next
End Sub

'Create P-touch toolbar
Sub AddButton()
Dim oTbarParent As CommandBar
Dim oTbtnTrans As CommandBarButton
Dim i As Long
Dim TbtnIndex As Long

On Error GoTo ErrAddButton

Dim oTransToolBar As CommandBar
Dim ToolbarButtonLoaded  As Boolean

'MenuCaption = LoadDllStringTable(50)
MenuCaption = "&Brother P-touch"

Set oTbarParent = CommandBars("Brother P-touch")
'    Set oTransButton = oTransToolBar.Controls.Add(msoControlButton, , , 3)

'DCL toolbar buttonを登録する
Set oTbtnTrans = oTbarParent.Controls.Add(msoControlButton, , , 1)

    With oTbtnTrans
        .FaceId = 1
        .ToolTipText = "Brother P-touch"
        .Style = msoButtonAutomatic
        .Caption = MenuCaption
        .Tag = TagTbtnTranslateCaption
        .OnAction = "StartPtedit"
        .Enabled = True
        .Visible = True
    End With
    If oTbtnTrans.Tag <> TagTbtnTranslateIcon Then
        For i = 1 To 3
          With oTbtnTrans
          If EJLoadIconToClipboard() Then
                    .Style = msoButtonAutomatic
                    .PasteFace
                    .Tag = TagTbtnTranslateIcon
                    Exit For
                Else
SetFaceAsText1:
                .Style = msoButtonAutomatic
                .Caption = "PT"
                .Tag = TagTbtnTranslateCaption
                End If
            End With
        Next i
    End If
Exit Sub

'Error handler of this function
ErrAddButton:
If Err.Number = &H80004005 Then
'    Resume SetFaceAsText
Else
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": AddButton()"
'    Resume Next
End If

End Sub

'load DCL toolbar
Sub LoadStandardToolBar()
Dim oTransToolBar As CommandBar
Dim oTransButton As CommandBarButton
Dim i As Long

On Error GoTo ErrLoadStandardToolBar

Set oTransToolBar = CommandBars("Standard")

Dim iCount As Integer
iCount = oTransToolBar.Controls.Count

'check if the P-touch button has been loaded
For i = 1 To oTransToolBar.Controls.Count
    If oTransToolBar.Controls(i).ToolTipText = m_strTipText Then
        Set oTransButton = oTransToolBar.Controls(i)
        Exit Sub
    End If
Next i

Dim cmdbar As CommandBar
For Each cmdbar In CommandBars
    If cmdbar.Name = "Brother P-touch" Then
        If iCount > 7 Then
             CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
             CommandBars("Standard"), Before:=7
        Else
             CommandBars("Brother P-touch").Controls(1).Copy Bar:= _
             CommandBars("Standard"), Before:=iCount - 1
        End If
        Exit For 'ループを抜ける
    End If
Next

For i = 1 To oTransToolBar.Controls.Count
    If oTransToolBar.Controls(i).ToolTipText = m_strTipText Then
'       Set oTransButton = oTransToolBar.Controls(i)
'        CommandBars("standard").Controls(i).Caption = MenuCaption
        CommandBars("standard").Controls(i).OnAction = "StartPtedit" '再定義する
        Exit Sub
    End If
Next i

Exit Sub

'Error handler of this function
ErrLoadStandardToolBar:
If Err.Number = &H80004005 Then
'    Resume SetFaceAsText
Else
    MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": LoadStandardToolBar()"
'    Resume Next
End If

End Sub

Function EJLoadIconToClipboard() As Boolean
Dim hIconDLL As Long
Dim hIcon As Long
Dim SuccessFlag As Boolean
Dim hWin As Long

On Error GoTo ErrEJLoadIconToClipboard
'load DLL in which the TransLand Icon exists
hIconDLL = LoadLibrary(GetWinSysDir() & "\" & fnIconDll)

'load an icon from a resource
hIcon = LoadBtnBitmap
If hIcon = 0 Then 'LoadBtnBitmap()の戻り値がNULLの場合
    hIcon = LoadBitmapByNum(hIconDLL, IconBmp16Num)
End If

'get handle of the window that has the focus
hWin = GetFocus()

'open the clipboard
SuccessFlag = OpenClipboard(hWin)

'set bitmap data into clipboard
EJLoadIconToClipboard = SetClipboardData(CF_BITMAP, hIcon)

'close clipboard
SuccessFlag = CloseClipboard()

'free loaded DLL
Call FreeLibrary(hIconDLL)

Exit Function
'Error handler of this function
ErrEJLoadIconToClipboard:
MsgBox Error(Err.Number), vbInformation + vbOKOnly, msgTitleInfo & ": EJLoadIconToClipboard()"
'Resume Next

End Function

'remove the Standard Tool Bar, Tool Menu and Context Menu
Sub RemovePtouchItem()
Dim oMenuItem As CommandBarControl

'標準ツールバーにおけるP-touch項目の削除
For Each oMenuItem In CommandBars("Standard").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        oMenuItem.Delete
    End If
Next oMenuItem

'ツールメニューにおけるP-touch項目の削除
For Each oMenuItem In CommandBars("Tools").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        oMenuItem.Delete
    End If
Next oMenuItem

'コンテキストメニューにおけるP-touch項目の削除
For Each oMenuItem In CommandBars("Cell").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        oMenuItem.Delete
    End If
Next oMenuItem

'行コンテキストメニューにおけるP-touch項目の削除
For Each oMenuItem In CommandBars("Row").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        oMenuItem.Delete
    End If
Next oMenuItem

'列コンテキストメニューにおけるP-touch項目の削除
For Each oMenuItem In CommandBars("Column").Controls
    If Left(oMenuItem.ToolTipText, Len(m_strTipText)) = m_strTipText Then
        oMenuItem.Delete
    End If
Next oMenuItem

End Sub

'Start P-touch Editor
Sub StartPtedit()
Dim Path As String

On Error GoTo ErrStartPtedit

Dim hIconDLL As Long
hIconDLL = -1
'リソース用dllを読み込む
hIconDLL = LoadLibrary(GetWinSysDir() & "\" & fnIconDll)

If hIconDLL = 0 Then
    MsgBox "No AddinPtouch42_Icon.dll file" & Chr(13) & Chr(10) & "(Function: StartPtedit())", vbCritical + vbOKOnly, msgTitleVBError
    Exit Sub
End If
    
'no doc opened, exit
If ActiveSheet Is Nothing Then '[2]
    MsgBox LoadDllStringTable(2), vbInformation + vbOKOnly, msgTitleInfo
    Exit Sub
End If

'no cell selected ,exit
If ActiveWindow.Selection Is Nothing Then '[4]
    MsgBox LoadDllStringTable(4), vbInformation + vbOKOnly, msgTitleInfo
    Exit Sub
End If

'レジストリからP-touch Editorのパスを取得する
Reg_GetValue
    
Dim Pass  As String
Pass = m_StrPteditPass + "Ptedit42.exe"
' ファイルの存在確認(レジストリから取得した絶対パスにP-touch Editorのexeファイルがない場合は、警告ダイアログを表示する。)
If Dir(Pass) = "" Then '[7]
    MsgBox LoadDllStringTable(7), vbInformation + vbOKOnly, msgTitleInfo
    Exit Sub
End If

'[起動時は必ず初期化する]=======================================================
' 各要素の値を0にします。
Erase m_strArrangement

m_strPteditText = "" ' 取得したテキスト情報(PT-Editorに受け渡す)

m_bGetText = False '選択したセル内にテキストがあるか判別する

m_strTextBoxBody = ""  '初回起動時に設定ダイアログの取り込み形式に使用する文字列

m_bStartPtedit = True 'PT-Editor実行/非実行フラグ(キャンセルボタン押下か否か)
'===============================================================================

'レジストリからテキスト情報、コード情報を取得する
Reg_GetBodyCodeValue

'取り込み設定ダイアログの準備(非表示設定の場合はスキップするが、前回終了時値は次回に引き継ぐため、値は設定する)
Load UserForm1 '設定ダイアログをロードする

'選択されたセルにテキストがない場合は､警告ダイアログを表示する
If m_bGetText = False Then '[8]
    MsgBox LoadDllStringTable(8), vbInformation + vbOKOnly, msgTitleInfo
    Unload UserForm1 '設定ダイアログを開放する
    Exit Sub
End If

'レジストリからPT-Editorの動作情報[1]および取り込み設定ダイアログ表示/非表示情報[2]を取得する
Reg_GetActValue
'アドイン設定におけるExcel設定ダイアログの表示/非表示を反映する
If m_lnDispDlgFlg = 1 Then '取り込み設定ダイアログを表示する
  UserForm1.Show
Else                       '取り込み設定ダイアログを表示しない
  UserForm_PerRow 'データ取り込みを実行し、PT-Editorを起動する
End If
  
Unload UserForm1 '設定ダイアログを開放する

Dim strData As String
strData = m_strPteditText
  
'キャンセルボタン押下時は、PT-Editorを実行せずに終了する。
If m_bStartPtedit = False Then
    Exit Sub
End If


'選択されたセルにテキストがない場合は、警告ダイアログを表示する
'If strData = "" Then '[8]
'    MsgBox LoadDllStringTable(8), vbInformation + vbOKOnly, msgTitleInfo
'    Unload UserForm1
'    Exit Sub
'End If

'////////////////////////////////////////////////////////////////////////////////////
'最初にアドインに関する情報を追加する。
strData = "20000001" + Chr(&H2) + strData

'Dim lBufferSize As Long   '文字列バッファサイズ
'テキストが長過ぎる場合(262144バイト)は、警告ダイアログを表示する(+8は、4だけマージンを持たせている)
If lstrlen(strData) + 8 > m_lMaxNumber Then '[11]
    MsgBox LoadDllStringTable(11), vbInformation + vbOKOnly, msgTitleInfo
'    Unload UserForm1
    Exit Sub
End If


Dim si As STARTUPINFO
Dim Ret As Long
    
si.cb = Len(si)

'    si.wShowWindow = SW_SHOWNORMAL
'    si.dwFlags = STARTF_USESHOWWINDOW
si.wShowWindow = 0 'SW_HIDE = 0
si.dwFlags = 1

Dim bNewCreate As Boolean
bNewCreate = True
If hMapping > 0 Then
    Dim Buf As Long
    Buf = MapViewOfFile(hMapping, 6, 0, 0, 0)
    If Buf <> 0 Then
        Dim s As String * 1
        Ret = lstrcpy(s, Buf)
            Ret = AscB(s) And &H1
            If Ret = 1 Then
           bNewCreate = False
            End If
            Ret = lstrcpy(Buf, "2")
            Ret = lstrcpy(Buf + 4, strData)
        UnmapViewOfFile (Buf)
    End If
 Else
    Dim sa As SECURITY_ATTRIBUTES
        sa.bInheritHandle = True
        sa.lpSecurityDescriptor = 0
        sa.nLength = Len(sa)
        hMapping = CreateFileMapping(-1, sa, &H4, 0, m_lMaxNumber, vbNullString)
        Buf = MapViewOfFile(hMapping, 2, 0, 0, 0)
        
        strData = strData
    If Buf <> 0 Then
        Ret = lstrcpy(Buf, "2")
        Ret = lstrcpy(Buf + 4, strData)
        UnmapViewOfFile (Buf)
    End If
End If
    
Pass = Pass + " /ad" + m_strActFlg
'Pass = Pass + " /adExcel"

If bNewCreate = True Then
Ret = CreateProcess(vbNullString, Pass, ByVal 0&, ByVal 0&, True, _
     &H20&, ByVal 0&, vbNullString, si, pi)

Ret = WaitForInputIdle(pi.hProcess, &HFFFFFFFF)
End If

Dim lnSafeCounter As Long
lnSafeCounter = 0

Do While PostThreadMessage(pi.dwThreadId, &H4F1, hMapping, lstrlen(strData) + 4) = 0
  ' 100回呼び出しに失敗した場合は終了する(永久ループを回避するため) 2005/04/06
  If lnSafeCounter > 100 Then
     Buf = MapViewOfFile(hMapping, 2, 0, 0, 0) 'エディタの終了フラグをセットする
     If Buf <> 0 Then
       Ret = lstrcpy(Buf, "0")
       Ret = lstrcpy(Buf + 4, strData)
       UnmapViewOfFile (Buf)
     End If
     Exit Sub
  End If
  
  Ret = GetLastError()
  If Ret = 1444 Then    'エディタが不正終了した時の対策
    Buf = MapViewOfFile(hMapping, 2, 0, 0, 0)
    If Buf <> 0 Then
        
        s = Chr(&H0) + Chr(&H0) + Chr(&H0) + Chr(&H0)
        Ret = lstrcpy(Buf, s)
        UnmapViewOfFile (Buf)
    End If
    Exit Do
    End If
  Sleep (100)
  lnSafeCounter = lnSafeCounter + 1
…