Macro/投稿/162

http://sakura.qp.land.to/?Macro%2F%C5%EA%B9%C6%2F162


Top > Macro > 投稿 > 162

MRUからタグファイル文字列生成

  • ページ: Macro/投稿
  • 作者: まくろ初心者?
  • カテゴリー: vbs
  • 投稿日: 2007-01-29 (月) 21:53:25

メッセージ

macro:336

  0
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
' createTagByMru
Call Main()
 
Sub Main()
        Const MRU_SECTION_NAME = "MRU"
        Const MRU_ENTRY_NAME = "MRU"
        Const MRU_ENTRY_PATH = ".szPath"
        Const MRU_ENTRY_X = ".nX"
        Const MRU_ENTRY_Y = ".nY"
        Const MRU_ENTRY_CHARCODE = ".nCharCode"
        Const MRU_ENTRY_MAX = "_MRU_Counts"
        Const MRU_FR = 0
 
        Dim iniCtl
 
        Set iniCtl = New clsSakuraIni
 
        Dim sNum
        Dim mruTo
        mruTo = iniCtl.GetProfileString(MRU_SECTION_NAME ,MRU_ENTRY_MAX )
        Dim sCharCode, iCol, iCurLine, FilePath, sLine
        Dim sTag
 
        for i = MRU_FR to mruTo - 1
                if i < 10 then 
                        sNum = "0" & i
                Else
                        sNum = i
                End If
                sCharCode = getCharCodeStr( iniCtl.GetProfileString(MRU_SECTION_NAME ,MRU_ENTRY_NAME & "[" & sNum & "]" & MRU_ENTRY_CHARCODE ) )
                iCol = iniCtl.GetProfileString(MRU_SECTION_NAME ,MRU_ENTRY_NAME & "[" & sNum & "]" & MRU_ENTRY_X)
                iCurLine = iniCtl.GetProfileString(MRU_SECTION_NAME ,MRU_ENTRY_NAME & "[" & sNum & "]" & MRU_ENTRY_Y )
                FilePath = iniCtl.GetProfileString(MRU_SECTION_NAME ,MRU_ENTRY_NAME & "[" & sNum & "]" & MRU_ENTRY_PATH )
                sLine = "" 'GetLineStr(0)
                sTag = FilePath & "(" & iCurLine & "," & iCol & ")  [" & sCharCode & "]:" & sLine
                TraceOut(sTag)
        Next
 
        Set iniCtl = Nothing        ' インスタンスを破棄します。
End Sub
Function getCharCodeStr( charCode )
        if Not isNumeric(charCode) then Exit Function
        aryChar = Array("SJIS", "JIS", "EUC", "UNICODE", "UTF-8", "UTF-7", "UNICODE-BE")
        getCharCodeStr = aryChar( charCode )
End Function
 
' Class 定義
Class clsSakuraIni
        Dim aryLine
        Private Sub Class_Initialize        ' Initialize イベントを設定します。
                Dim objFso
                Dim iniFileName
                Dim objFs
 
                Set objFso = CreateObject("Scripting.FileSystemObject")
                iniFileName = getSakuraIniFileName
 
                Set objFs = objFso.OpenTextFile( iniFileName, 1 )
                aryLine = Split( objFs.ReadAll, vbCrLf )
                objFs.Close
                Set objFs = Nothing
                Set objFso = Nothing
        End Sub
 
        Private Sub Class_Terminate        ' Terminate イベントを設定します。
                ' Do Nothing
        End Sub
 
        ' ini ファイル名生成
        Private Function getSakuraIniFileName()
                Dim sakuraPath, pos, sRet
                sakuraPath = ExpandParameter("$S")
                pos = instrrev(sakuraPath, ".")
                if pos <= 0 then
                        sRet = ""
                Else
                        sRet = Mid(sakuraPath, 1, pos ) & "ini"
                End If
                getSakuraIniFileName  = sRet
        End Function
 
        ' ini ファイルの読み込み
        Function getProfileString( strSection, strEntry)
                Dim i, sRet
 
                if UBound( aryLine ) > 0 then
                        ' ini ファイルの解析
                        Dim bFound,sLine,aryEntity
 
                        sRet = ""                'Empty
                        bFound = False
                        For i = 0 to Ubound( aryLine )-1
                                if bFound then
                                        if Left( aryLine( i ), 1 ) = "[" then Exit For
 
                                        sLine = LTrim( aryLine( i ) )
                                        if Left( sLine, Len(strEntry)) = strEntry then
                                                aryEntity = Split( sLine, "=" )
                                                if Trim(aryEntity(0)) = strEntry then
                                                        if Ubound( aryEntity ) = 1 then
                                                                sRet = Trim( aryEntity( 1 ) )
                                                                Exit For
                                                        end if
                                                end if
                                        end if
                                End if 
                                if aryLine(i) = "[" & strSection & "]" then
                                        bFound = True
                                end if
                        Next
                Else 
                        sRet = ""
                End If
                getProfileString = sRet
        End Function
 
End Class


URL B I U SIZE Black Maroon Green Olive Navy Purple Teal Gray Silver Red Lime Yellow Blue Fuchsia Aqua White

リロード   新規 編集 凍結 差分 添付 複製 名前変更   ホーム 一覧 単語検索 最終更新 バックアップ リンク元   ヘルプ   最終更新のRSS
Last-modified: 2007-01-29 (月) 21:53:25 (4337d)