clipsed3.20 source

Option Explicit
'basp21のbregexpでperl5互換正規表現を使えるようにするための定義です。
'BREGEXP.DLLをWindowsのsystemディレクトリか
'VBアプリケーションを置くディレクトリにコピーしておく必要があります。
'bregexp.dllは、<Tatsuo Baba> babaq@hi-ho.ne.jpさん作成のdllです。
'http://www.hi-ho.ne.jp/babaq/index.html から入手可能です。
'正規表現の他にもpopメールが使えるなど、便利な機能満載です。

Private Declare Function Match Lib "bregexp" _
      (szRegstr As String, szTarget As String) As String

Private Declare Function MatchEx Lib "bregexp" _
      (szRegstr As String, szTarget As String, mode As Long) As Variant

Private Declare Function bjReplace Lib "bregexp" Alias "Replace" _
      (szRegstr As String, szTarget As String) As String

Private Declare Function Translate Lib "bregexp" _
      (szRegstr As String, szTarget As String, ret As String) As Long

Private Declare Function Split Lib "bregexp" _
      (szRegstr As String, szTarget As String, limit As Long) As Variant

Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
     ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&


'ファイルの関連付けに基づいてファイルを起動する
'http://www.remus.dti.ne.jp/~y-mac/apilib/fileexec.htmを参考にしました。

Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
       (ByVal hwnd As Long, ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'ウィンドウをアクティブにし、現在のサイズと位置で表示する。
Private Const SW_SHOW = 5
'アプリケーションを開始したプログラムによって呼ばれた
'CreateProcess関数のSTARTUPINFO構造体で指定されたSW_フラグにより表示する。
Private Const SW_SHOWDEFAULT = 10
'ウィンドウをアクティブにし、最大化して表示する。
Private Const SW_SHOWMAXIMIZED = 3
'ウィンドウをアクティブにし、最小化して表示する。
Private Const SW_SHOWMINIMIZED = 2
'ウィンドウを最小化して表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWMINNOACTIVE = 7
'ウィンドウを現在の状態で表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWNA = 8
'ウィンドウを前回表示したサイズと位置で表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWNOACTIVATE = 4
'ウィンドウをアクティブにし表示する。ウィンドウが最小化または最大化されているときは
'元の状態に戻します。
Private Const SW_SHOWNORMAL = 1
'-----------------------------------------------------------------------------------------------------
Dim lRet As Long

'-----------------------------------------------------------------------------------------------------

Dim myHistory0
Dim myHistory1
Dim myHistory2
'Dim myHistoryNo As Integer

' 検索履歴のﾒﾓﾘ上のﾃﾞｰﾀﾍﾞｰｽ。
'Dim myHistoryStr As New Collection
Public myFileNo As Integer

' 検索履歴ﾌｧｲﾙのﾌｧｲﾙ名
Const His_FILE = "clipsed1.ini"
Const okimari_FILE = "clipsed0.ini"

' 現在表示されている履歴ｺﾚｸｼｮﾝ内のｲﾝﾃﾞｯｸｽ。
Dim myCurrentHis As Long
Dim mycRows As Double

'◆Replace
Function xRep(inputRegstr As String, inputTarget As String) As String

' Replace関数は、文字列中でパターンを検索し、もし見つかれば、置換テキストで置き換えた
' 文字列を返します。
' szRegstr : パターン。
' szTarget : 対象文字列。
' 戻り値   : 置換後の文字。
' パターンは、次のように指定します。パターンの詳細は、Perlのマニュアルを参照。
'   s/PATTERN/REPLACEMENT/gikm
'
'=xrep("s/<[^>]*>//g",B2)　とすれば、短型一致。
    xRep = bjReplace(inputRegstr, inputTarget)
End Function
'◆Translate
Function xtrans(szRegstr As String, szTarget As String) As String

' Translate関数は、検索リスト (SEARCHLIST) に含まれる文字を、対応する置換リスト
' (REPLACEMENTLIST) の文字に変換します。また、置換または削除が行なわれた、文字数を返します。
' szRegstr : パターン。
' szTarget : 対象文字列。
' ret      : 置換後の文字列。
' 戻り値   : 文字数。
' パターンは、次のように指定します。パターンの詳細は、Perlのマニュアルを参照。
'     tr/SEARCHLIST/REPLACEMENTLIST/cds
'
'        オプションには、
'          c   SEARCHLIST を補集合にする
'          d   見つかったが置換されなかった文字を削除する
'          s   置換された文字が重なったときに圧縮する
'          k   日本語を処理する。日本語をシングル文字として処理しない。
'
'          全角ひらがなを半角カナに変換。　→　　=ASC(xtrans("tr/あ-ん/ア-ン/gk",A2))

Dim ctr As Long
ctr = Translate(szRegstr, szTarget, xtrans)

End Function

Function xsed(myRegexp As String, myTarget As String)
' sedもどきの関数　replaceかtranslateかを先頭のコマンドで判断します。

            xsed = xRep(myRegexp, myTarget)
End Function

Private Sub endcommand_Click()
  Unload Me
End Sub

Private Sub Form_Load()
    ' 履歴ファイルのサイズをチェックする。
    Call myCheckIniFileLen

    'クリップボードの情報をとりあえず表示する。
    clipKakunin_Click

    myHistory0 = Clipboard.GetText()
    LoadHistory App.Path & "\" & His_FILE, myRegstrBox

    LoadHistory App.Path & "\" & okimari_FILE, okimariBox

    myRegstrBox.SelText = "s///gk"

End Sub

Private Sub menu_explorer_Click()
    Dim IDProcess As Long
    IDProcess = ShellExecute(clipsed.hwnd, "open", App.Path, vbNullChar, "", SW_SHOW)

    'IDProcess = Shell(Environ("ComSpec") & " /c start http://hp.vector.co.jp/authors/VA021567/", vbHide)
End Sub

Private Sub myRegstrBox_GotFocus()
   ' myRegstrBoxの挿入位置を 2 文字目の後に設定します。
    'Filterモードか通常モードかのチェック　頭２文字、もしくは３文字で判断する
    Dim myChkFilterS2 As String
    Dim myChkFilterS3 As String

    myChkFilterS2 = Left(myRegstrBox.SelText, 2)
    myChkFilterS3 = Left(myRegstrBox.SelText, 3)


    If myChkFilterS2 = "s/" Or myChkFilterS2 = "m/" Then
        myRegstrBox.SelStart = 2
        myRegstrBox.SelLength = 0
    End If

    If myChkFilterS3 = "tr/" Then
        myRegstrBox.SelStart = 3
        myRegstrBox.SelLength = 0
    End If

    If myChkFilterS2 <> "s/" And myChkFilterS2 <> "m/" And myChkFilterS3 <> "tr/" Then
        myRegstrBox.SelStart = 0
        myRegstrBox.SelLength = 0
    End If
End Sub

Private Sub MenuAbout_Click()
    frmAbout.Show

End Sub

Private Sub MenuGuide_Click()
    Dialog1.Show

End Sub

Private Sub MenuHelpindex_Click()
' コモンダイアログを使って、ヘルプファイルを表示します。
' C:\WINDOWS\SYSTEM\COMDLG32.OCX　が必要です。標準品？

   ' HelpCommand プロパティを設定します。
   CommonDialog1.HelpCommand = cdlHelpForceFile
   ' ヘルプファイルを指定します。
   CommonDialog1.HelpFile = App.Path & "\" & "clipsed.hlp"
'   ' Windows ヘルプエンジンを表示します。
   CommonDialog1.ShowHelp

'ShellExecuteを使用したヘルプ表示
'    Dim IDProcess As Long
'    IDProcess = ShellExecute(clipsed.hwnd, "open", App.Path & "\" & "clipsed.hlp", vbNullChar, "", SW_SHOWDEFAULT)

End Sub

' ########## メニューバー処理 ###############

Private Sub MenuQuit_Click()
    ' 終了します
    Unload Me
End Sub

' ### 文字変換 ###

Private Sub MenuHK2ZK_Click()
    myMojiChikan ("ｶﾀｶﾅをカタカナに")
End Sub

Private Sub MenuZK2HK_Click()
    myMojiChikan ("カタカナをｶﾀｶﾅに")
End Sub

Private Sub MenuXrev_Click()
    myMojiChikan ("文字反転")
End Sub

Private Sub MenuZ2H_Click()
    myMojiChikan ("全角を半角に")
End Sub

Private Sub MenuH2Z_Click()
    myMojiChikan ("半角を全角に")
End Sub

Private Sub MenuACap_Click()
    myMojiChikan ("単語先頭を大文字に")
End Sub

Private Sub MenuOmoji_Click()
    myMojiChikan ("大文字に変換")
End Sub

Private Sub MenuKomoji_Click()
    myMojiChikan ("小文字に変換")
End Sub

Private Sub MenuHira2Kana_Click()
    myMojiChikan ("ひらがなをカタカナに")
End Sub

Private Sub MenuKana2Hira_Click()
    myMojiChikan ("カタカナをひらがなに")
End Sub

Private Sub mojiCvt_Click()
    myMojiChikan ("MIMEデコード")
End Sub

Private Sub mojiCvtB_Click()
    myMojiChikan ("MIMEデコードB")
End Sub

Private Sub mojiCvtQ_Click()
    myMojiChikan ("MIMEデコードQ")
End Sub
Private Sub menu_sort_a_Click()
    myMojiChikan ("昇順ソート")
End Sub

Private Sub menu_sort_d_Click()
    myMojiChikan ("降順ソート")
End Sub

Private Sub menu_fil_uniq_n_Click()
    myMojiChikan ("uniq_n")
End Sub

Private Sub menu_fil_uniq_d_Click()
    myMojiChikan ("uniq_d")
End Sub

Private Sub menu_fil_uniq_dc_Click()
    myMojiChikan ("uniq_dc")
End Sub

'#### 履歴編集  ##############

Private Sub MenuEditHistory_Click()
    Call editIniFile(His_FILE)
End Sub

Private Sub Label1_Click()
    Call editIniFile(His_FILE)
End Sub

Private Sub MenuEditOkimari_Click()
    Call editIniFile(okimari_FILE)
End Sub

Private Sub okimariLabel_Click()
    Call editIniFile(okimari_FILE)

End Sub

'おきまりと履歴のリロード
Private Sub menu_reload_Click()
    LoadHistory App.Path & "\" & His_FILE, myRegstrBox
    myRegstrBox.Text = "s///gk"

    LoadHistory App.Path & "\" & okimari_FILE, okimariBox
End Sub
' ### 補助機能  ###
Private Sub MenuStrcount_Click()
        CountCrLf (myTextBox.Text)
End Sub

Private Sub Menumultidel_Click()
        delJufuku (myTextBox.Text)
End Sub

Private Sub Menumultiview_Click()
        exJufuku (myTextBox.Text)
End Sub

' ##############　フォームの中にあるボタンの処理 #############

Private Sub runSed_Click()
' clipsedの本体です。実行ボタンが押された際の処理です。
    Dim myOutput As String
    Dim mySr As String
    Dim myS As String
    Dim mySedType As Integer
    Dim myRegStart1 As Integer
    Dim myRegStart2 As Integer
    Dim i As Long
    Dim myRegType As String
    Dim myChkFilterS2 As String
    Dim myChkFilterS3 As String
    Dim myChkFilterType As Integer
    Dim myDelmNo As Integer

    mySr = myRegstrBox.Text
    myS = myTextBox.Text


    'Filterモードか通常モードかのチェック　頭２文字、もしくは３文字で判断する
    myChkFilterS2 = Left(mySr, 2)
    myChkFilterS3 = Left(mySr, 3)


    If myChkFilterS2 = "s/" Or myChkFilterS2 = "m/" Or myChkFilterS3 = "tr/" Then
        myChkFilterType = 0 '通常のBregexpを使うタイプが0
    Else
        myChkFilterType = 1 'Filterを使うタイプが1
    End If


    If myChkFilterType = 1 Then 'Filterモードらしきとき
         '状態表示をします。
        jotai.Caption = "変換中"

        myOutput = xFil(mySr, myS) '★Filterの実行！

    Else  ' 通常モードらしいとき

        mySedType = 0

        '初期値でリターンを押してしまった場合。意味がないので警告する。
        If mySr = "s///gk" Then
            MsgBox "入力コマンドを確認してください", vbCritical
            Exit Sub
        End If

        'デリミタの数によるエラー処理
        myDelmNo = CountString(mySr, "/")


        If myDelmNo >= 3 Then
            Else
            If myDelmNo >= 2 And myChkFilterS2 = "m/" Then
                Else
                    MsgBox "入力コマンドを確認してください", vbCritical
                    Exit Sub
            End If
        End If


        ' エラー処理2。
        myRegStart1 = InStr(mySr, "/") '置換パターンのはじまりの区切り位置

        For i = myRegStart1 + 1 To Len(mySr) '置換パターンの終わりの区切り位置
            myRegStart2 = InStr(i, mySr, "/")
            If Mid(mySr, myRegStart2 - 1, 2) <> "\$" Then Exit For
        Next i

        If InStr(mySr, "/") = 0 Then
            MsgBox "入力コマンドを確認してください", vbCritical
            Exit Sub
        End If

        'sedTypeの判断。mオプションを付けるか否かを^と$の有無で判断
        If Mid(mySr, myRegStart1 + 1, 1) = "^" Then
            mySedType = 1
        End If
        If Mid(mySr, myRegStart2 - 1, 1) = "$" And Mid(mySr, myRegStart2 - 2, 1) <> "\" Then
            mySedType = 1
        End If


        '置換実行
    '    myOutput = xsed(myRegstrBox.Text, myTextBox.Text)
    ' sedTypeにより複数行置換を可能にする。ただし、mオプションの方がほんとうはいい。後述。

        On Error Resume Next                ' エラー処理を設定します。

        '状態表示をします。
        jotai.Caption = "変換中"

    '   置換かトランスかを見分けます。
        myRegType = Left(mySr, InStr(mySr, "/") - 1)

        Select Case myRegType
            Case "s"    '置換の場合
                If mySedType = 1 Then
                    myOutput = crdelSed(mySr, myS)
                Else
                    myOutput = xRep(mySr, myS)
                End If

            Case "tr"   'トランスの場合
                myOutput = xtrans(mySr, myS)
            Case "m"    'Matchの場合
                    myOutput = xmatch(mySr, myS, m_rev.Value) 'マッチ行抽出はチェックBOXの状態で反転Xor

        End Select

    End If

    'ヒストリー変数に変換前文字列を代入する
    myHistory1 = myS

    ' 出力します。
    myTextBox.Text = myOutput

    '状態表示をします。
    jotai.Caption = "置換後文字列"
    manualHenko.Caption = ""

    'ヒストリ変数に変換後文字列を代入する
    myHistory2 = myOutput

    '検索式ヒストリをリストとファイルに追加します。
    If mySr <> myRegstrBox.List(0) Then
    'myRegstrBox.ListIndexだとだめなので、0を指定する。
        '履歴の古いものを消し先頭に持っていくルーチン
        'ファイルの削除を追加する必要がある。
        'とりあえず、ほっておく。(2002/01/18)
        'If mySr = myRegstrBox.List(myRegstrBox.ListIndex) Then
        '    myRegstrBox.RemoveItem myRegstrBox.ListIndex
        '    myRegstrBox.SelText = mySr
        'End If
        myRegstrBox.AddItem mySr, 0
        If Len(mySr) <= 200 Then ' 200バイトを超えるときには履歴ファイルに追加しない
            SaveHistory App.Path & "\" & His_FILE, mySr
        End If
    End If

    '状態表示をします。
    jotai.Caption = "変換終了"

End Sub

Private Sub myRegstrBox_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            KeyAscii = 0
            runSed_Click
        End If
End Sub

Private Sub multilineCmd_Click()
' 複数行補助ボタン
    multiLineForm.Show
End Sub

Private Sub History0_Click()
    myTextBox.Text = myHistory0
    jotai.Caption = "起動時のクリップボード内容"

End Sub

Private Sub History1_Click()
    myTextBox.Text = myHistory1
    jotai.Caption = "置換前文字列"
    manualHenko.Caption = ""

End Sub

Private Sub History2_Click()
    myTextBox.Text = myHistory2
    jotai.Caption = "置換後文字列"
    manualHenko.Caption = ""

End Sub

Private Sub okimarituika_Click()
    SaveHistory App.Path & "\" & okimari_FILE, myRegstrBox.Text
    okimariBox.AddItem myRegstrBox.Text, 0

End Sub

Private Sub clipKakunin_Click()
    ' クリップボードから変数にテキストを貼り付けます。
    myTextBox.Text = Clipboard.GetText()
    ' 出力します。
    jotai.Caption = "現在のクリップボード内容"
    manualHenko.Caption = ""

End Sub

Private Sub ClipTenso_Click()
    On Error Resume Next                ' エラー処理を設定します。

    Clipboard.Clear                 ' Clipboard オブジェクトの内容を消去します。
    Clipboard.SetText myTextBox.Text            ' Clipboard オブジェクトへ挿入します。
    jotai.Caption = "現在のクリップボード内容"
    manualHenko.Caption = ""

End Sub
Private Sub okimariBox_Click()
    On Error Resume Next                ' エラー処理を設定します。
    ' お決まりファイルの先頭と末尾の【】をコメントと見なして取り除く
    myRegstrBox.Text = xsed("s/^【.*?】\s*//gk", xrev(xsed("s/^\s*】.*?【\s*//gk", xrev(okimariBox.Text))))

End Sub

Private Sub mytextbox_KeyPress(KeyAscii As Integer)
    manualHenko.Caption = "変更"
End Sub

Private Sub cancel_Click()
    ' 終了します
    Unload Me
End Sub
Function LoadHistory(sFile As String, myTargetBox) As Boolean
    Dim myNextHis As String   ' 各履歴をﾌｧｲﾙから読み込みます。
    Dim InFile As Integer   ' ﾌｧｲﾙのﾃﾞｨｽｸﾘﾌﾟﾀ
    Dim myObjectBox

    Set myObjectBox = myTargetBox
    ' 次の未使用ﾌｧｲﾙﾃﾞｨｽｸﾘﾌﾟﾀを取得します。
    InFile = FreeFile

    ' ﾌｧｲﾙが指定されているかどうかを確認します。
    If sFile = "" Then
        LoadHistory = False
        Exit Function
    End If

    ' ﾌｧｲﾙを開く前に、ﾌｧｲﾙが存在するかどうかを確認します。
    If Dir(sFile) = "" Then
        LoadHistory = False
        Exit Function
    End If

    ' ﾃｷｽﾄﾌｧｲﾙからｺﾚｸｼｮﾝを読み込みます。

    myObjectBox.Visible = False
    myObjectBox.Clear

    Open sFile For Input As InFile
    While Not EOF(InFile)
        Line Input #InFile, myNextHis
        myObjectBox.AddItem myNextHis, 0
    Wend
    Close InFile
    myObjectBox.Visible = True

End Function

Function SaveHistory(sFile As String, myCurrentHis As String) As Boolean
    ' 各履歴を書き込みます。
    Dim OutFile As Integer   ' ﾌｧｲﾙのﾃﾞｨｽｸﾘﾌﾟﾀ

    ' 次の未使用ﾌｧｲﾙﾃﾞｨｽｸﾘﾌﾟﾀを取得します。
    OutFile = FreeFile

    ' ﾌｧｲﾙが指定されているかどうかを確認します。
    If sFile = "" Then
        SaveHistory = False
        Exit Function
    End If

    ' ﾃｷｽﾄﾌｧｲﾙへｺﾚｸｼｮﾝを書き込みます。
    Open sFile For Append As OutFile
    Print #OutFile, myCurrentHis
    Close OutFile

End Function
Function SaveTmpData(sFile As String, myCurrentHis As String) As Boolean
    ' 各履歴を書き込みます。
    Dim OutFile As Integer   ' ﾌｧｲﾙのﾃﾞｨｽｸﾘﾌﾟﾀ

    ' 次の未使用ﾌｧｲﾙﾃﾞｨｽｸﾘﾌﾟﾀを取得します。
    OutFile = FreeFile

    ' ﾌｧｲﾙが指定されているかどうかを確認します。
    If sFile = "" Then
        SaveTmpData = False
        Exit Function
    End If

    ' ﾃｷｽﾄﾌｧｲﾙへｺﾚｸｼｮﾝを書き込みます。
    Open sFile For Output As OutFile
    Print #OutFile, myCurrentHis
    Close OutFile

End Function

'フォームサイズを連動させる。
Private Sub Form_Resize()
    Const buttonArea = 2040
    Const buttonAreaTop1 = 600
    Const buttonAreaTop2 = 1080
    Const buttonAreaLeft1 = 1440
    Const buttonBoxWidth = 975

    myTextBox.Top = buttonArea
    myTextBox.Height = Abs(clipsed.ScaleHeight - buttonArea)
    'myTextBoxのHeightが負の値になるとエラーになる
    myTextBox.Left = 0
    myTextBox.Width = clipsed.ScaleWidth

    myRegstrBox.Top = buttonAreaTop1
    runSed.Top = buttonAreaTop1
    okimariBox.Top = buttonAreaTop2
    ClipTenso.Top = buttonAreaTop2

    myRegstrBox.Left = buttonAreaLeft1
    okimariBox.Left = buttonAreaLeft1

    runSed.Width = buttonBoxWidth
    ClipTenso.Width = buttonBoxWidth

    myRegstrBox.Width = Abs(clipsed.ScaleWidth - 2415)
    okimariBox.Width = Abs(clipsed.ScaleWidth - 2415)

    runSed.Left = Abs(clipsed.ScaleWidth - 990)
    ClipTenso.Left = Abs(clipsed.ScaleWidth - 990)


    'Debug.Print "myRegstrBox top:" & myRegstrBox.Top & " left:" & myRegstrBox.Left & " width:" & myRegstrBox.Width
    'Debug.Print "runsed top:" & runSed.Top & " left:" & runSed.Left & " width:" & runSed.Width

    'Debug.Print "okimariBox top:" & okimariBox.Top & " left:" & okimariBox.Left & " width:" & okimariBox.Width
    'Debug.Print "ClipTenso top:" & ClipTenso.Top & " left:" & ClipTenso.Left & " width:" & ClipTenso.Width

    'Debug.Print clipsed.ScaleWidth

End Sub

Function CountCrLf(myInputS As String) As Long
'
' 文字列数と改行数を計算します。
'
Dim sL As Long
Dim myCrLfC As Long, myPos As Long
  sL = 0
  myCrLfC = 0
  myPos = 0
  If VarType(myInputS) <> 8 Or Len(myInputS) = 0 Then
    CountCrLf = 0
  Else
    myCrLfC = 0
    myPos = InStr(myInputS, vbCrLf)
    Do ;While myPos > 0
      myCrLfC = myCrLfC + 1
      myPos = InStr(myPos + 2, myInputS, vbCrLf)
    Loop
    sL = Len(myInputS) - (myCrLfC * 2) '文字数
    CountCrLf = myCrLfC + 1
  End If
  '状態表示をします。
  jotai.Caption = Format(sL, "##,##0") & "文字，" & Format(CountCrLf, "##,##0") & "行，" & Format(LenB(StrConv(myInputS, vbFromUnicode)), "##,##0") & "バイト"

End Function

'Public Function hankakuToZenkaku(s As String) As String

''  下記の古口さんのコードを大幅に改変したものです。変数名が同じなだけで、かなり異なったコードになりました。
''  連続する半角は、バッファにいれてまとめて変換するようにしました。おかげで濁音、撥音の認識をせずにすむようになったはずです。
''  これで少しはスピードアップできたのではないかとおもいます。が、それにしても遅い(+_;)

''  ハンカクカナを全角カナに変換する。
''  ﾊﾝｶｸｶﾅをゼンカクに変換する関数 hankakuToZenkaku v0.9 1998.6.22
''
''  原作者  古口正巳  [koguchi@sf.airnet.ne.jp http://www.sf.airnet.ne.jp/koguchi/]
''
'
'
'    Dim i As Long 'counter
'    Dim sL As Long 'len(s)
'    Dim sS As String 'temp s
'    Dim sSHk As String '半角ｶﾅを保存するバッファ
'
'    i = 0
'    sL = 0
'    sS = ""
'    sSHk = ""
'
'    sL = Len(s)
'    For i = 1 To sL '最後の文字まで繰り返す
'        sS = Mid(s, i, 1) '文字を取り出して
'        If (sS < Chr(&HA0)) Or (sS > Chr(&HDF)) Then 'ﾊﾝｶｸｶﾅ以外の場合
'            If sSHk <> "" Then '半角カナバッファに文字が有ればそれまでためていた半角バッファを全角変換し加える
'                hankakuToZenkaku = hankakuToZenkaku & StrConv(sSHk, vbWide)
'                sSHk = "" '半角バッファの初期化
'            End If
'            hankakuToZenkaku = hankakuToZenkaku & sS
'        Else
'            sSHk = sSHk & sS '半角バッファに入れる
'        End If
'    Next
'
'    If sSHk <> "" Then '最後が半角カナで終わっていた際の処理
'        hankakuToZenkaku = hankakuToZenkaku & StrConv(sSHk, vbWide)
'    End If
'End Function

Function hankakuToZenkaku2(s As String) As String
'半角カナを一つずつ変換する
'こちらの方が速いなんて信じられないです。VBは &連結が遅すぎ
'NKF32.dllにまかせるという手もありますが、将来的に削除する可能性もあるので。

    Dim mySkana As String

    mySkana = s

    mySkana = xsed("s/ｶﾞ/ガ/gk", mySkana)
    mySkana = xsed("s/ｷﾞ/ギ/gk", mySkana)
    mySkana = xsed("s/ｸﾞ/グ/gk", mySkana)
    mySkana = xsed("s/ｹﾞ/ゲ/gk", mySkana)
    mySkana = xsed("s/ｺﾞ/ゴ/gk", mySkana)
    mySkana = xsed("s/ｻﾞ/ザ/gk", mySkana)
    mySkana = xsed("s/ｼﾞ/ジ/gk", mySkana)
    mySkana = xsed("s/ｽﾞ/ズ/gk", mySkana)
    mySkana = xsed("s/ｾﾞ/ゼ/gk", mySkana)
    mySkana = xsed("s/ｿﾞ/ゾ/gk", mySkana)
    mySkana = xsed("s/ﾀﾞ/ダ/gk", mySkana)
    mySkana = xsed("s/ﾁﾞ/ヂ/gk", mySkana)
    mySkana = xsed("s/ﾂﾞ/ヅ/gk", mySkana)
    mySkana = xsed("s/ﾃﾞ/デ/gk", mySkana)
    mySkana = xsed("s/ﾄﾞ/ド/gk", mySkana)
    mySkana = xsed("s/ﾊﾞ/バ/gk", mySkana)
    mySkana = xsed("s/ﾊﾟ/パ/gk", mySkana)
    mySkana = xsed("s/ﾋﾞ/ビ/gk", mySkana)
    mySkana = xsed("s/ﾋﾟ/ピ/gk", mySkana)
    mySkana = xsed("s/ﾌﾞ/ブ/gk", mySkana)
    mySkana = xsed("s/ﾌﾟ/プ/gk", mySkana)
    mySkana = xsed("s/ﾍﾞ/ベ/gk", mySkana)
    mySkana = xsed("s/ﾍﾟ/ペ/gk", mySkana)
    mySkana = xsed("s/ﾎﾞ/ボ/gk", mySkana)
    mySkana = xsed("s/ﾎﾟ/ポ/gk", mySkana)
    mySkana = xsed("s/ｳﾞ/ヴ/gk", mySkana)
    mySkana = xtrans("tr/ｧｱｨｲｩｳｪｴｫｵｶｷｸｹｺｻｼｽｾｿﾀﾁｯﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓｬﾔｭﾕｮﾖﾗﾘﾙﾚﾛヮﾜヰヱｦﾝヵヶ｡､｢｣･ｰﾟﾞ/ァアィイゥウェエォオカキクケコサシスセソタチッツテトナニヌネノハヒフヘホマミムメモャヤュユョヨラリルレロヮワヰヱヲンヵヶ。、「」・ー゜゛/gk", mySkana)

    hankakuToZenkaku2 = mySkana

End Function

Function zenkakuToHankaku(s As String) As String
'全角カナを半角カナに一つずつ変換する

    Dim mySkana As String

    mySkana = s

    mySkana = xsed("s/ガ/ｶﾞ/gk", mySkana)
    mySkana = xsed("s/ギ/ｷﾞ/gk", mySkana)
    mySkana = xsed("s/グ/ｸﾞ/gk", mySkana)
    mySkana = xsed("s/ゲ/ｹﾞ/gk", mySkana)
    mySkana = xsed("s/ゴ/ｺﾞ/gk", mySkana)
    mySkana = xsed("s/ザ/ｻﾞ/gk", mySkana)
    mySkana = xsed("s/ジ/ｼﾞ/gk", mySkana)
    mySkana = xsed("s/ズ/ｽﾞ/gk", mySkana)
    mySkana = xsed("s/ゼ/ｾﾞ/gk", mySkana)
    mySkana = xsed("s/ゾ/ｿﾞ/gk", mySkana)
    mySkana = xsed("s/ダ/ﾀﾞ/gk", mySkana)
    mySkana = xsed("s/ヂ/ﾁﾞ/gk", mySkana)
    mySkana = xsed("s/ヅ/ﾂﾞ/gk", mySkana)
    mySkana = xsed("s/デ/ﾃﾞ/gk", mySkana)
    mySkana = xsed("s/ド/ﾄﾞ/gk", mySkana)
    mySkana = xsed("s/バ/ﾊﾞ/gk", mySkana)
    mySkana = xsed("s/パ/ﾊﾟ/gk", mySkana)
    mySkana = xsed("s/ビ/ﾋﾞ/gk", mySkana)
    mySkana = xsed("s/ピ/ﾋﾟ/gk", mySkana)
    mySkana = xsed("s/ブ/ﾌﾞ/gk", mySkana)
    mySkana = xsed("s/プ/ﾌﾟ/gk", mySkana)
    mySkana = xsed("s/ベ/ﾍﾞ/gk", mySkana)
    mySkana = xsed("s/ペ/ﾍﾟ/gk", mySkana)
    mySkana = xsed("s/ボ/ﾎﾞ/gk", mySkana)
    mySkana = xsed("s/ポ/ﾎﾟ/gk", mySkana)
    mySkana = xsed("s/ヴ/ｳﾞ/gk", mySkana)
    mySkana = xtrans("tr/ァアィイゥウェエォオカキクケコサシスセソタチッツテトナニヌネノハヒフヘホマミムメモャヤュユョヨラリルレロヮワヰヱヲンヵヶ。、「」・ー゜゛/ｧｱｨｲｩｳｪｴｫｵｶｷｸｹｺｻｼｽｾｿﾀﾁｯﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓｬﾔｭﾕｮﾖﾗﾘﾙﾚﾛヮﾜヰヱｦﾝヵヶ｡､｢｣･ｰﾟﾞ/gk", mySkana)

    zenkakuToHankaku = mySkana

End Function

Public Function delJufuku(s As String) As String '重複行削除
    Dim i As Long 'counter
    Dim sL As Long 'len(s)
    Dim sS As String 'temp s
    Dim myLine1 As String '前の行
    Dim myLine2 As String '次の行
    Dim cJ '重複行カウンタ

    If InStr(s, vbLf) = 0 Then  '一行しかなかったら処理を中断
        jotai.Caption = "中断！　１行しかありません"
        Exit Function
    End If

    sL = Len(s)
    myLine1 = ""
    myLine2 = ""
    cJ = 0

    For i = 1 To sL '最後の文字まで繰り返す
        sS = Mid(s, i, 1)
        myLine2 = myLine2 & sS
        If sS = vbLf Then '改行なら　改行は、LFだけで判定している。
            If StrComp(myLine1, myLine2, 0) <> 0 Then '重複していなかったら
                delJufuku = delJufuku & myLine2 '出力
                myLine1 = myLine2 'L2を L1 にスイッチ。
            Else
                cJ = cJ + 1
            End If
            myLine2 = ""
        End If

    Next i
        myLine1 = Mid(myLine1, 1, Len(myLine1) - 2)
        If StrComp(myLine1, myLine2, 0) <> 0 Then '重複していなかったら
            delJufuku = delJufuku & myLine2 '出力
        Else
            cJ = cJ + 1
        End If

    ' 出力します。
    If cJ = 0 Then
        jotai.Caption = "重複行はありませんでした"
    Else
        myHistory2 = delJufuku
        myHistory1 = s
        myTextBox.Text = delJufuku
        manualHenko.Caption = ""
        jotai.Caption = Format(cJ, "##,##0") & "行の重複行を削除しました"
    End If

End Function

Public Function exJufuku(s As String) As String '重複行抽出
    Dim i As Long 'counter
    Dim sL As Long 'len(s)
    Dim sS As String 'temp s
    Dim myLine1 As String '前の行
    Dim myLine2 As String '次の行
    Dim cJ '重複行カウンタ

    If InStr(s, vbLf) = 0 Then  '一行しかなかったら処理を中断
        jotai.Caption = "中断！　１行しかありません"
        Exit Function
    End If

    sL = Len(s)
    myLine1 = ""
    myLine2 = ""
    cJ = 0
    For i = 1 To sL '最後の文字まで繰り返す
        sS = Mid(s, i, 1)
        myLine2 = myLine2 & sS
        If sS = vbLf Then '改行なら　改行は、LFだけで判定している。
            If StrComp(myLine1, myLine2, 0) = 0 Then '重複していたら
                exJufuku = exJufuku & myLine2 '出力
                cJ = cJ + 1
            End If
            myLine1 = myLine2 'L2を L1 にスイッチ。
            myLine2 = ""
        End If

    Next i
        myLine1 = Mid(myLine1, 1, Len(myLine1) - 2)
        If StrComp(myLine1, myLine2, 0) = 0 Then '重複していたら
            exJufuku = exJufuku & myLine2 '出力
            cJ = cJ + 1
        End If

    ' 出力します。
    If cJ = 0 Then
        jotai.Caption = "重複行はありませんでした"
    Else
        myHistory2 = exJufuku
        myHistory1 = s
        myTextBox.Text = exJufuku
        manualHenko.Caption = ""
        jotai.Caption = Format(cJ, "##,##0") & "行、重複行がありました"
    End If

End Function

' Public Function lineSed(sR As String, s As String) As String '行単位置換（普通のsed）
' ' 2000/09/11 普通のsedと同じく、^や$が使えるようにした。
' ' mオプションを使うのが正当だが、仕様で改行を\nだけで判断しているため、行末$を使うとき\rを
' ' 考慮する必要がある｡よって、その手間をなくすために、本コードがある。

'     Dim i As Long 'counter
'     Dim sL As Long 'len(s)
'     Dim sS As String 'temp s
'     Dim cTmp As Long ' tempCounter
'     Dim myLineOut As String '出力変数
'     Dim myLineTmp As String '処理行
'
'     sL = Len(s)
'     cTmp = 0
'     myLineOut = ""
'     myLineTmp = ""
'     For i = 1 To sL '最後の文字まで繰り返す
'         sS = Mid(s, i, 1)
'         If sS = vbLf Then 'Lfなら
'             sS = Mid(s, i - 1, 1) '一つ前を振り返り
'             If sS = vbCr Then 'それがCrなら、あわせてCrLfになるから改行と判断
'                 cTmp = Len(myLineTmp) 'Crまでの文字数を数えて
'                 myLineTmp = Mid(myLineTmp, 1, cTmp - 1) 'Crを除いた文字列を取り出す
'                 If myLineTmp <> "" Then '空行でなければ
'                     myLineOut = myLineOut & xsed(sR, myLineTmp) & vbCrLf ' 置換して追加
'                 Else
'                     myLineOut = myLineOut & vbCrLf '空行なら改行のみを追加
'                 End If
'                 myLineTmp = "" '処理行の初期化
'                 cTmp = 0
'             End If
'         Else
'             myLineTmp = myLineTmp & sS 'Lf以外なら読み込んだ文字を追加
'         End If
'     Next i
'         If myLineTmp <> "" Then '末尾に改行がないときの処理
'             myLineOut = myLineOut & xsed(sR, myLineTmp) '置換して追加
'         End If
'         lineSed = myLineOut '出力
' End Function

Public Function crdelSed(sR As String, s As String) As String 'CRを無視した置換「mオプション対応用」

crdelSed = xsed("s/\n/\r\n/gk", xsed(sR & "m", xsed("s/\r//gk", s)))

End Function

Public Function xrev(s As String) As String '行単位で文字列逆転
' 行単位で文字反転する．ＶＢ６の「StrReverse」関数を使っている．2001/05/29

     Dim i As Long 'counter
     Dim sL As Long 'len(s)
     Dim sS As String 'temp s
     Dim cTmp As Long ' tempCounter
     Dim myLineOut As String '出力変数
     Dim myLineTmp As String '処理行

     sL = Len(s)
     cTmp = 0
     myLineOut = ""
     myLineTmp = ""
     'myTextBox.Text = ""

     For i = 1 To sL '最後の文字まで繰り返す
         sS = Mid(s, i, 1)
         If sS = vbLf Then 'Lfなら
             sS = Mid(s, i - 1, 1) '一つ前を振り返り
             If sS = vbCr Then 'それがCrなら、あわせてCrLfになるから改行と判断
                 cTmp = Len(myLineTmp) 'Crまでの文字数を数えて
                 myLineTmp = Mid(myLineTmp, 1, cTmp - 1) 'Crを除いた文字列を取り出す
                 If myLineTmp <> "" Then '空行でなければ
                     myLineOut = myLineOut & StrReverse(myLineTmp) & vbCrLf ' ★文字反転して追加★
                        ' 出力します。
                        'myTextBox.SelStart = Len(myTextBox.Text)
                        'myTextBox.SelText = StrReverse(myLineTmp) & vbCrLf
                 Else
                     myLineOut = myLineOut & vbCrLf '空行なら改行のみを追加
                     ' myTextBox.SelStart = Len(myTextBox.Text)
                     ' myTextBox.SelText = vbCrLf

                 End If
                 myLineTmp = "" '処理行の初期化
                 cTmp = 0
             End If
         Else
             myLineTmp = myLineTmp & sS 'Lf以外なら読み込んだ文字を追加
         End If
     Next i
         If myLineTmp <> "" Then '末尾に改行がないときの処理
             myLineOut = myLineOut & StrReverse(myLineTmp) '★文字反転して追加★
             ' myTextBox.SelStart = Len(myTextBox.Text)
             ' myTextBox.SelText = StrReverse(myLineTmp)

         End If
          xrev = myLineOut '出力
          '  jotai.Caption = "置換後文字列"
          '  manualHenko.Caption = ""
          '
          '  myHistory2 = myTextBox.Text


End Function

Private Sub myMojiChikan(myExRepText)
' メニューから選択する場合のサブルーチン 2001/05/02追加
' ドロップダウンリストから援用
' 文字変換をします。半角カタカナ変換以外は、vbの関数のみを使用しています。
    Dim myOutput As String
    On Error Resume Next                ' エラー処理を設定します。

    If myTextBox.Text = "" Then Exit Sub ' 置換対象が空だったら何もしない。

    '状態表示をします。
    jotai.Caption = "変換中"

    myHistory1 = myTextBox.Text

'    myExRepText = zenkakuchikan.Text
'    これがあると、ドロップダウンリスト用になる

    Select Case myExRepText
        Case "大文字に変換"
            myOutput = StrConv(myTextBox.Text, vbUpperCase)
        Case "小文字に変換"
            myOutput = StrConv(myTextBox.Text, vbLowerCase)
        Case "単語先頭を大文字に"
            myOutput = StrConv(myTextBox.Text, vbProperCase)
        Case "半角を全角に"
            myOutput = xsed("s/\\/￥/gk", StrConv(myTextBox.Text, vbWide))
        Case "全角を半角に"
            myOutput = xsed("s/￥/\\/gk", StrConv(myTextBox.Text, vbNarrow))
        Case "ひらがなをカタカナに"
            myOutput = StrConv(myTextBox.Text, vbKatakana)
        Case "カタカナをひらがなに"
            myOutput = StrConv(myTextBox.Text, vbHiragana)
        Case "ｶﾀｶﾅをカタカナに"
            myOutput = hankakuToZenkaku2(myTextBox.Text)
        Case "カタカナをｶﾀｶﾅに"
            myOutput = zenkakuToHankaku(myTextBox.Text)
        Case "文字反転"
            myOutput = xrev(myTextBox.Text)
        Case "MIMEデコード"
            myOutput = chCode(myTextBox.Text)
        Case "MIMEデコードB"
            myOutput = chCode(myTextBox.Text, "msJB")
        Case "MIMEデコードQ"
            myOutput = chCode(xsed("s/=1B/\e/gk", xsed("s/=\r\n//gk", xsed("s/=3D/=/gk", myTextBox.Text))), "msJB")
        Case "昇順ソート"
            myOutput = xFil("sort", myTextBox.Text)
        Case "降順ソート"
            myOutput = xFil("sort /r", myTextBox.Text)
        Case "uniq_n"
            myOutput = xFil("uniq", myTextBox.Text)
        Case "uniq_d"
            myOutput = xFil("uniq -d", myTextBox.Text)
        Case "uniq_dc"
            myOutput = xFil("uniq -dc", myTextBox.Text)
        Case ""
        Exit Sub

    End Select

    outTotxtBox (myOutput)
    '状態表示をします。
    jotai.Caption = "変換終了"


End Sub

Public Sub outTotxtBox(myOutput As String)

    ' 出力します。
    myTextBox.Text = myOutput
    jotai.Caption = "置換後文字列"
    manualHenko.Caption = ""

    myHistory2 = myOutput

End Sub

Public Function xmatch(myRegexp As String, s As String, fV As Integer) As String 'マッチ行抽出
' 2001/07/08

     Dim i As Long 'counter
     Dim sL As Long 'len(s)
     Dim sS As String 'temp s
     Dim cTmp As Long ' tempCounter
     Dim myLineOut As String '出力変数
     Dim myLineTmp As String '処理行
     Dim ret As Integer ' マッチ真偽

     'fVは、-fチェックボックスの真偽を現す。非チェック０、チェック1


     sL = Len(s)
     cTmp = 0
     myLineOut = ""
     myLineTmp = ""
     For i = 1 To sL '最後の文字まで繰り返す
         sS = Mid(s, i, 1)
         If sS = vbLf Then 'Lfなら
             sS = Mid(s, i - 1, 1) '一つ前を振り返り
             If sS = vbCr Then 'それがCrなら、あわせてCrLfになるから改行と判断
                 cTmp = Len(myLineTmp) 'Crまでの文字数を数えて
                 myLineTmp = Mid(myLineTmp, 1, cTmp - 1) 'Crを除いた文字列を取り出す
                 If myLineTmp <> "" Then '空行でなければ
                    ret = Match(myRegexp, myLineTmp) 'マッチを確認
                    If (ret Xor fV) Then  'マッチしたなら
                        myLineOut = myLineOut & myLineTmp & vbCrLf ' ★その行を追加★
                    End If
                 End If
                 myLineTmp = "" '処理行の初期化
                 cTmp = 0
             End If
         Else
             myLineTmp = myLineTmp & sS 'Lf以外なら読み込んだ文字を追加
         End If
     Next i
         If myLineTmp <> "" Then '末尾に改行がないときの処理
            ret = Match(myRegexp, myLineTmp) 'マッチを確認
            If (ret Xor fV) Then  'マッチしたなら
               myLineOut = myLineOut & myLineTmp & vbCrLf ' ★その行を追加★
            End If
         End If
         xmatch = myLineOut '出力
End Function

Sub myCheckIniFileLen()
    Dim lenHisFile  As Long 'ヒストリファイルのサイズを格納
    Dim lenOkiFile  As Long 'お決まりファイルのサイズを格納
    Dim myYesNo As Integer     'ボタンのYes/Noを格納
    Dim myErrMes As String
    Dim myOK As Integer
    myErrMes = vbCrLf & "整理すると起動が速くなります。" & vbCrLf & _
    "clipsedを起動してからOptionでも編集できます" _
    & vbCrLf & "整理しますか？"
        lenHisFile = FileLen(App.Path & "\" & His_FILE) 'ヒストリファイルサイズ
        lenOkiFile = FileLen(App.Path & "\" & okimari_FILE) 'お決まりファイルサイズ

        If lenHisFile >= 50000 Then 'ヒストリが50Kを超えていたら
            myYesNo = MsgBox("履歴ファイルのサイズが50Kを超えています。" & myErrMes, 52)
            Select Case myYesNo
            Case vbYes
                Call editIniFile(His_FILE)
                MsgBox ("編集が終わったらOKを押して下さい")
            End Select
        End If
        If lenOkiFile >= 5000 Then  'お決まりが50Kを超えていたら
            myYesNo = MsgBox("お気まきの表現ファイルのサイズが50Kを超えています。" & myErrMes, 52)
            Select Case myYesNo
            Case vbYes
                Call editIniFile(okimari_FILE)
                MsgBox ("編集が終わったらOKを押して下さい")
            End Select
        End If

End Sub

Function mycCountCrLf(myInputS As String) As Long
'
' 文字列数と改行数を計算します。
'
Dim sL As Long
Dim myCrLfC As Long, myPos As Long
  sL = 0
  myCrLfC = 0
  myPos = 0
  If VarType(myInputS) <> 8 Or Len(myInputS) = 0 Then
    mycCountCrLf = 0
  Else
    myCrLfC = 0
    myPos = InStr(myInputS, vbCrLf)
    Do ;While myPos > 0
      myCrLfC = myCrLfC + 1
      myPos = InStr(myPos + 2, myInputS, vbCrLf)
    Loop
    sL = Len(myInputS) - (myCrLfC * 2) '文字数
    mycCountCrLf = myCrLfC + 1
  End If
'状態表示をします。
If Right(myInputS, 1) <> vbLf Then mycCountCrLf = mycCountCrLf + 1
Debug.Print Format(sL, "##,##0") & "文字，" & Format(mycCountCrLf, "##,##0") & "行，" & Format(LenB(StrConv(myInputS, vbFromUnicode)), "##,##0") & "バイト"

End Function

'テキストファイルからの読み込み
'2001/12/27 Tomo
Function getTextFile(sFile As String) As String

'    Dim myNextLine As String   ' 各履歴をﾌｧｲﾙから読み込みます。
'    Dim myAllText As String
    Dim InFile As Integer   ' ﾌｧｲﾙのﾃﾞｨｽｸﾘﾌﾟﾀ

    ' 次の未使用ﾌｧｲﾙﾃﾞｨｽｸﾘﾌﾟﾀを取得します。
    InFile = FreeFile

    ' ﾌｧｲﾙが指定されているかどうかを確認します。
    If sFile = "" Then
        Exit Function
    End If

    ' ﾌｧｲﾙを開く前に、ﾌｧｲﾙが存在するかどうかを確認します。
    If Dir(sFile) = "" Then
        Exit Function
    End If

    ' ﾃｷｽﾄﾌｧｲﾙからｺﾚｸｼｮﾝを読み込みます。
    Open sFile For Input As InFile

'    While Not EOF(InFile)
'        Line Input #InFile, myNextLine
'        myAllText = myAllText & myNextLine & vbCrLf
'    Wend

    If LOF(InFile) <> 0 Then    '出力結果ファイルサイズが 0　でないならば
        getTextFile = StrConv(InputB(LOF(InFile) - 1, #InFile), vbUnicode)
    Else                        '出力結果ファイルサイズが 0　であれば
        getTextFile = ""        'nullを出力
    End If

    Close InFile

'    getTextFile = myAllText

End Function

'◆filter関数
'2001/12/27 Tomo
Function xFil(inputRegstr As String, inputTarget As String) As String

' Filterモードです。
' 直接sed32 grep nkf等のコマンドがかけます。
' szRegstr : パターン。
' szTarget : 対象文字列。
' 戻り値   : 置換後の文字。

      Dim IDProcess As Long
      Dim hProcess As Long
      Dim ExitCode As Long
      Dim ret As Long

      SaveTmpData App.Path & "\" & "cps0.tmp", inputTarget

      IDProcess = Shell(Environ("ComSpec") & " /c type cps0.tmp| " & inputRegstr & " > cps1.tmp", vbHide)
      hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, IDProcess)
      Do
          ret = GetExitCodeProcess(hProcess, ExitCode)
          DoEvents
      Loop While (ExitCode = STILL_ACTIVE)
      ret = CloseHandle(hProcess)

      'MsgBox " 終了しました ", vbInformation

      xFil = getTextFile(App.Path & "\" & "cps1.tmp")


End Function

Private Sub gotoclipsedHP_Click()
    Dim IDProcess As Long
    IDProcess = ShellExecute(clipsed.hwnd, "open", "http://hp.vector.co.jp/authors/VA021567/", vbNullChar, "", SW_SHOW)

    'IDProcess = Shell(Environ("ComSpec") & " /c start http://hp.vector.co.jp/authors/VA021567/", vbHide)
End Sub

Function CountString(myInputS As String, myTs As String) As Long
'
' 文字数をカウントします。
'
    Dim i As Integer

    CountString = 0

    For i = 1 To Len(myInputS)
    If Mid(myInputS, i, 1) = myTs Then
        CountString = CountString + 1
        End If
    Next

End Function

Private Sub okCmd_Click()
    Dim myRegB, myRegA
    myRegB = ""
    myRegA = ""

    If KensakuBox.Text <> "" Then
        myRegB = xRep("s/\r\n/\\r\\n/gk", xRep("s/[\\^.$|()\[\]*+?\/]/\\$&/gk", KensakuBox.Text))
    End If

    If ChikanBox.Text <> "" Then
        myRegA = xRep("s/\r\n/\\r\\n/gk", xRep("s/[\\^.$|()\[\]*+?\/]/\\$&/gk", ChikanBox.Text))
    End If

    clipsed.myRegstrBox.Text = "s/" & myRegB & "/" & myRegA & "/gk"
    Unload Me

End Sub

'Windows 95/98かWindows NT/2000かを判別する。
'APIの実装が異なることが多いので､これらのOSを判別しなければならないことが良くある｡
'新山(へろぱ)さん＜http://plaza5.mbn.or.jp/~heropa/vb25.htm＞のコードを利用させていただいた。

Option Explicit

'OS判定用
Private Type tagOSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
                                (lpVersionInformation As tagOSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2

'ファイルの関連付けに基づいてファイルを起動する
'http://www.remus.dti.ne.jp/~y-mac/apilib/fileexec.htmを参考にしました。

Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
       (ByVal hwnd As Long, ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'ウィンドウをアクティブにし、現在のサイズと位置で表示する。
Private Const SW_SHOW = 5
'アプリケーションを開始したプログラムによって呼ばれた
'CreateProcess関数のSTARTUPINFO構造体で指定されたSW_フラグにより表示する。
Private Const SW_SHOWDEFAULT = 10
'ウィンドウをアクティブにし、最大化して表示する。
Private Const SW_SHOWMAXIMIZED = 3
'ウィンドウをアクティブにし、最小化して表示する。
Private Const SW_SHOWMINIMIZED = 2
'ウィンドウを最小化して表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWMINNOACTIVE = 7
'ウィンドウを現在の状態で表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWNA = 8
'ウィンドウを前回表示したサイズと位置で表示する。アクティブなウィンドウはアクティブのまま。
Private Const SW_SHOWNOACTIVATE = 4
'ウィンドウをアクティブにし表示する。ウィンドウが最小化または最大化されているときは
'元の状態に戻します。
Private Const SW_SHOWNORMAL = 1
'-----------------------------------------------------------------------------------------------------

'
' Windows NT/2000であればTrueを返す。
'
Public Function IsNT() As Boolean
    Dim osvi        As tagOSVERSIONINFO
    Dim lngResult   As Long

    ' dwOSVersionInfoSizeに構造体のサイズをセットする。
    osvi.dwOSVersionInfoSize = Len(osvi)
    ' OSのバージョン情報を得る。
    lngResult = GetVersionEx(osvi)
    If (lngResult <> 0) Then
        IsNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
    End If
End Function

Sub editIniFile(myEditFileName As String)
'履歴ファイル編集のサブルーチン
    Dim myYesNo1 As Integer
    Dim IDProcess As Long


    If (IsNT = False And FileLen(App.Path & "\" & myEditFileName) >= 64000) Then 'OSチェックもする
        myYesNo1 = MsgBox("ファイルサイズが64Kを超えています。wordpadで開きますか？" & vbCrLf & _
        "Noを選択すると関連づけられたエディタで開きます。" & vbCrLf & _
        "ただし､64K以上を編集できないエディタだと落ちる可能性があります｡ ", 51)
        Select Case myYesNo1
        Case vbYes
            IDProcess = Shell(Wordpaddir & " " & App.Path & "\" & myEditFileName, 1)

        Case vbNo
            'IDProcess = Shell(Environ("ComSpec") & " /c start " & App.Path & "\" & myEditFileName, vbHide)
            IDProcess = ShellExecute(clipsed.hwnd, "open", App.Path & "\" & myEditFileName, vbNullChar, "", SW_SHOW)
        Case vbCancel
            Exit Sub
        End Select
    Else    '2000系列なら
            'IDProcess = Shell(Environ("ComSpec") & " /c start " & App.Path & "\" & myEditFileName, vbHide)
            IDProcess = ShellExecute(clipsed.hwnd, "open", App.Path & "\" & myEditFileName, vbNullChar, "", SW_SHOW)
        'iRtn = Shell("notepad.exe " & App.Path & "\" & myEditFileName, 1)
    End If

End Sub

Function Wordpaddir() As String
    'wordpadの格納されているディレクトリーをレジストリより取得
    'HKEY_CLASSES_ROOT\Wordpad.Document.1\Protocol\StdFileEditing\Server
    Dim dum0
    Wordpaddir = GetKeyValue(HKEY_CLASSES_ROOT, "Wordpad.Document.1\Protocol\StdFileEditing\Server", "")
    Debug.Print Wordpaddir
    If Wordpaddir = "" Then
        dum0 = MsgBox("wordpadがインストールされているか確認してください。", , "Error!")
        Exit Function
    End If
End Function

Private Sub execEx(sExFilename As String)

End Sub