Attribute VB_Name = "M_file"
Option Explicit

Const GC_INVALID_CHARS As String = ";*""<>|"
Public Const GC_FILE_DIR As String = "C:\tmp"

Public Type XML_LINE    '*** XML line入力構造体 ***
    line As String
    quot As String
    fEOF As Integer
End Type

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : open_file                                                   *
'*  機能 : ファイルをオープンする                                      *
'*  引数 : IN  :     fname     : ファイル名                            *
'*          Optional mode      : オープンモード                        *
'*                               (r)/w/a = input/output/append         *
'*                               (t)/b   = text/binary                 *
'*         OUT : なし                                                  *
'*  返却 : >0  : ファイル番号                                          *
'*         <=0 : エラー                                                *
'*         =-2 : file not found                                        *
'*  作成 : 2016/11/22 Akito Kobayashi                                  *
'*  更新 : 2017/09/06 Akito Kobayashi Add return code (-2)             *
'***********************************************************************
Function open_file(ByRef fname As String, Optional ByVal mode As String = "rt") As Long
    Dim fn As Long
    Dim rw As Integer
    Dim dat As String

    On Error GoTo Err

    mode = UCase(mode)
    If InStr(mode, "W") > 0 Then
        rw = 1
    ElseIf InStr(mode, "A") > 0 Then
        rw = 2
    Else
        rw = 0
        dat = dir(fname)
        If dat = "" Then
            Call MsgBox("ファイル(" & fname & ")がありません。")
            open_file = -2
            Exit Function
        End If
    End If
    fn = FreeFile()
    If fn > 0 Then
        If InStr(mode, "B") = 0 Then
            If rw = 0 Then
                Open fname For Input As #fn
            ElseIf rw = 1 Then
                Open fname For Output As #fn
            Else
                Open fname For Append As #fn
            End If
        Else
            If rw = 0 Then
                Open fname For Binary Access Read As #fn
            Else
                Open fname For Binary Access Write As #fn
            End If
        End If
    End If
    open_file = fn
    Exit Function
Err:
    On Error GoTo 0
    Close #fn
    fn = -1
    Resume Next

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : close_file                                                  *
'*  機能 : ファイルをクローズする                                      *
'*  引数 : IN  :     fn      : ファイル番号                            *
'*  作成 : 2016/11/22 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Sub close_file(ByVal fn As Long)

    If fn > 0 Then Close #fn

End Sub

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_line                                                    *
'*  機能 : テキストレコード単位でデータを読み込む                      *
'*  引数 : IN  :     fn        : 読み込むファイル番号                  *
'*         OUT :     line      : 読み込んだレコード                    *
'*  返却 : >=0 : 読み込んだレコード長(文字数)                          *
'*         =-1 : EOF                                                   *
'*  作成 : 2014/01/20 Akito Kobayashi                                  *
'*  更新 : 2018/10/10 Akito Kobayashi Mod return value to Long         *
'***********************************************************************
Function get_line(ByVal fn As Long, ByRef line As String) As Long
    
    If fn > 0 Then
        On Error GoTo Err
        If EOF(fn) = True Then
            line = ""
            get_line = -1
        Else
            Line Input #fn, line
            get_line = Len(line)
        End If
    Else
        line = ""
        get_line = -1
    End If
    Exit Function
Err:
    On Error GoTo 0
    line = ""
    get_line = -1

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : put_line                                                    *
'*  機能 : テキストレコード単位でデータを書き込む                      *
'*  引数 : IN  :     fn        : 書き込むファイル番号                  *
'*                   line      : 書き込むレコード                      *
'*         OUT : なし                                                  *
'*  作成 : 2014/01/20 Akito Kobayashi                                  *
'*  更新 : 2016/11/22 Akito Kobayashi Add check fn                     *
'***********************************************************************
Sub put_line(ByVal fn As Long, ByRef line As String)
 
    If fn > 0 Then
        Print #fn, line
'        Print #fn, line   '改行しない
    End If

End Sub

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_byte                                                    *
'*  機能 : バイト単位でデータを読み込む                                *
'*  引数 : IN  :     rec()     : 読み込む領域                          *
'*                   lrecl     : 読み込むデータ長(バイト)              *
'*                   fn        : 読み込むファイル番号                  *
'*         OUT :     rec()     : 読み込んだレコード                    *
'*  返却 : 読み込んだデータ長(バイト)                                  *
'*         EOF時は、0                                                  *
'*  作成 : 2014/01/20 Akito Kobayashi                                  *
'*  更新 : 2018/10/11 Akito Kobayashi Mod return value to Long         *
'*  更新 : 2020/07/30 Akito Kobayashi Add check fn                     *
'***********************************************************************
Function get_byte(ByRef rec() As Byte, ByVal lrecl As Long, ByVal fn As Long) As Long
    Dim i As Long
    Dim x As Byte

    If fn > 0 Then
        For i = 0 To lrecl - 1
            Get #fn, , x
            If EOF(fn) = True Then Exit For
            rec(i) = x
        Next
    Else
        i = 0
    End If
    get_byte = i

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : put_byte                                                    *
'*  機能 : バイト単位でデータを出力する                                *
'*  引数 : IN  :     rec()     : 出力データ領域                        *
'*                   lrecl     : 出力データ長(バイト)                  *
'*                   fn        : 出力ファイル番号                      *
'*         OUT : なし                                                  *
'*  作成 : 2014/01/20 Akito Kobayashi                                  *
'*  更新 : 2018/10/11 Akito Kobayashi Mod return value to Long         *
'*  更新 : 2020/07/30 Akito Kobayashi Add check fn                     *
'***********************************************************************
Sub put_byte(ByRef rec() As Byte, ByVal lrecl As Long, ByVal fn As Long)
    Dim i As Long
    Dim x As Byte

    If fn > 0 Then
        For i = 0 To lrecl - 1
            Put #fn, , rec(i)
        Next
    End If

End Sub

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_file_path                                               *
'*  機能 : ・入力ファイル用のディレクトリ名とファイル名を入力し、      *
'*         　ファイルパスの存在をチェックする。                        *
'*         ・ディレクトリ名とファイル名のどちらかに"?"が入力されたら、 *
'*         ファイルダイアログから入力する。                            *
'*         　このとき、ファイル名のデフォルト値に拡張子があれば、      *
'*         最初に、そのファイル名のみを表示する。                      *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dira(): 入力名のデフォルト値                 *
'*                                file_dira(0):ディレクトリ名          *
'*                                file_dira(1):ファイル名              *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*          Optional open_save  : ダイアログのモード    (default="")   *
'*                                "Save":出力用ファイル名を選択        *
'*                                その他:入力用ファイル名を選択        *
'*         OUT :     file_dira(): 入力した名前                         *
'*  返却 : ディレクトリ名 + "\" + ファイル名                           *
'*         Cancel時は、""                                              *
'*  作成 : 2014/10/24 Akito Kobayashi                                  *
'*  更新 : 2017/01/24 Akito Kobayashi Add parm. open_save,MsgBox flag  *
'***********************************************************************
Function get_file_path( _
  ByRef msg0 As String _
, ByRef file_dira() As String _
, Optional ByRef cancel_msg As String = "" _
, Optional ByRef open_save As String = "" _
) As String
    Dim file_dir As String
    Dim file_name As String
    Dim file_path As String
    Dim filter As String
    Dim dat As String
    Dim pos As Integer

    get_file_path = ""

    file_dir = file_dira(0)
    file_name = file_dira(1)

    'ディレクトリ名の入力
    file_dir = get_file_dir(msg0, file_dir, cancel_msg)
    If file_dir = "" Then Exit Function
    file_dira(0) = file_dir

    'ファイル名の入力とファイルパスの存在チェック
    file_name = input_name(msg0 & "のファイル名//?", file_name, "パス名入力")
    If file_name <> "" Then
        file_dira(1) = file_name
        If InStr(file_name, "?") = 0 Then
            file_path = file_dir & "\" & file_name
            If UCase(Left(open_save, 1)) = "S" Then
                dat = file_path
            Else
                dat = dir(file_path)
            End If
            If dat <> "" Then
                get_file_path = file_path
                Exit Function
            Else
                Call MsgBox("ファイル(" & file_path & "がありません。", vbCritical + vbOKOnly)
            End If
        End If
    End If

    file_path = ""
    dat = ""
    Do While dat = ""
        file_path = input_file_path(msg0, file_dira, cancel_msg, open_save)
        If file_path = "" Or UCase(Left(open_save, 1)) = "S" Then Exit Do
        dat = dir(file_path)
        If dat = "" Then Call MsgBox("ファイル(" & file_path & "がありません。", vbCritical + vbOKOnly)
    Loop
    get_file_path = file_path

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : input_file_path                                             *
'*  機能 : ・ファイルパス名を入力する。                                *
'*         ・ファイルパス名に"?"が入力されたら、ファイルダイアログから *
'*         入力する。                                                  *
'*         　このとき、ファイル名のデフォルト値に拡張子があれば、      *
'+         最初に、そのファイル名のみを表示する。                      *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dira(): 入力名のデフォルト値                 *
'*                                file_dira(0):ディレクトリ名          *
'*                                file_dira(1):ファイル名              *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*          Optional open_save  : ダイアログのモード    (default="")   *
'*                                "Save":出力用ファイル名を選択        *
'*                                その他:入力用ファイル名を選択        *
'*         OUT :     file_dira(): 入力した名前                         *
'*  返却 : ディレクトリ名 + "\" + ファイル名                           *
'*         Cancel時は、""                                              *
'*  作成 : 2014/10/24 Akito Kobayashi                                  *
'*  更新 : 2018/02/01 Akito Kobayashi Add reset file_path after        *
'*                                                  path_to_dir_file() *
'***********************************************************************
Function input_file_path( _
  ByRef msg0 As String _
, ByRef file_dira() As String _
, Optional ByRef cancel_msg As String = "" _
, Optional ByRef open_save As String = "" _
) As String
    Dim file_dir As String
    Dim file_name As String
    Dim file_path As String
    Dim filter As String
    Dim dat As String
    Dim msg1 As String
    Dim msg2 As String
    Dim ret As Integer
    Dim pos As Integer

    file_dir = file_dira(0)
    file_name = file_dira(1)
    file_path = file_dir & "\" & file_name

    pos = InStr(file_path, "?")
    Do While True
        file_dira(0) = ""
        file_dira(1) = ""
        If pos = 0 Then
            dat = input_name(msg0 & "のパス名//?", file_path, cancel_msg)
            file_path = dat
            If file_path = "" Then Exit Do
            pos = InStr(file_path, "?")
        End If
        If pos > 0 Then
            file_path = Replace(file_path, "?", "")
            Call path_to_dir_file(file_path, file_dira)
            file_name = file_dira(1)
            file_path = file_dir & "\" & file_name
            dat = GetAppFilePath(msg0, file_path, "ファイル入力", open_save)
            pos = 0
        End If
        If dat <> "" Then
            file_path = dat
            Call path_to_dir_file(file_path, file_dira)
            file_dir = file_dira(0)
            file_name = file_dira(1)
            If file_name <> "" Then
                If str_chars(file_path, GC_INVALID_CHARS) > 0 Then
                    MsgBox "Invalid file name[" & file_name & "]"
                Else
                    Exit Do
                End If
            End If
        End If
    Loop
    input_file_path = file_path

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : input_name                                                  *
'*  機能 : 入力する対象の名称に対応する名前を入力する。                *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   name0      : 入力名のデフォルト値                 *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : 入力した名前                                                *
'*         Cancel時は、""                                              *
'*  作成 : 2014/10/24 Akito Kobayashi                                  *
'*  更新 : 2016/04/07 Akito Kobayashi Mod change function name         *
'***********************************************************************
Function input_name( _
  ByRef msg0 As String _
, ByRef name0 As String _
, Optional ByRef cancel_msg As String = "" _
) As String
    Dim msga(1) As String

    '名称の設定
    Call set_input_name(msg0, msga, cancel_msg)
    input_name = InputBox(msga(0), msga(1), name0)

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : set_input_name                                              *
'*  機能 : 入力する対象の名称に対応するタイトル名と説明文設定する      *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                               末尾が"//?"のときは、説明文の中に、   *
'*                               "?でダイアログ入力。"を入れる         *
'*         OUT :     msga()     : msga(0):説明文                       *
'*                                msga(1):タイトル文字列               *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         Cancel時は、""                                              *
'*  作成 : 2015/11/20 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Sub set_input_name( _
  ByRef msg0 As String _
, ByRef msga() As String _
, Optional ByRef cancel_msg As String = "" _
)
    Dim msg1 As String
    Dim msg2 As String
    Dim msg3 As String
 
    If cancel_msg = "" Then
        msg2 = "終了"
    Else
        msg2 = cancel_msg
    End If

    msg3 = "を入力して下さい。" & vbLf & " ("
    If Right(msg0, 3) = "//?" Then
        msg1 = axLeft(msg0, -3)
        msg3 = msg3 & "?でダイアログ入力。"
    Else
        msg1 = msg0
    End If

    msga(0) = msg1 & msg3 & "キャンセル または 入力なしで、" & msg2 & ")"
    msga(1) = msg1 & "入力"

End Sub

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : chk_file_dir                                                *
'*  機能 : ディレクトリの存在をチェックする。                          *
'*  引数 : IN  :     file_dir0   : チェックするディレクトリ名          *
'*                                 "" または "?"のときは、default_dir0 *
'*                                 を返す                              *
'*          Optional default_dir0: デフォルトのディレクトリ名          *
'*                                  (default="C:\")                    *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2014/10/24 Akito Kobayashi                                  *
'*  更新 : 2017/01/24 Akito Kobayashi Add MsgBox flag                  *
'***********************************************************************
Function chk_file_dir( _
  ByRef file_dir0 As String _
, Optional ByRef default_dir0 As String = "C:\" _
) As String
    Dim dat As String
    Dim myDir As String

    If file_dir0 = "" Or file_dir0 = "?" Then
        myDir = default_dir0
    Else
        dat = dir(file_dir0, vbDirectory)
        If dat = "" Then
            Call MsgBox(file_dir0 & "がありません。", vbCritical + vbOKOnly)
            myDir = default_dir0
        Else
            myDir = file_dir0
        End If
    End If
    chk_file_dir = myDir

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_file_dir_opt                                            *
'*  機能 : ディレクトリ名入力画面出力タイミングを指定して              *
'*         ディレクトリ名を入力し、存在をチェックする。                *
'*         入力地が"?"のときは、ファイルダイアログから入力する。       *
'+         最初に、そのファイル名のみを表示する。                      *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dir0  : 入力ディレクトリ名のデフォルト値     *
'*                   opt0       : ディレクトリ名入力画面出力タイミング *
'*                                = 0 : 指定ディレクトリ名がないとき   *
'*                                <>0 : ディレクトリ存在チェック前     *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2016/06/09 Akito Kobayashi                                  *
'*  更新 : 2017/01/24 Akito Kobayashi Add MsgBox flag                  *
'***********************************************************************
Function get_file_dir_opt( _
  ByRef msg0 As String _
, ByRef file_dir0 As String _
, ByVal opt0 As Integer _
, Optional ByRef cancel_msg As String = "" _
) As String
    Dim msg1 As String
    Dim msg2 As String
    Dim nam As String
    Dim dat As String
    Dim file_dir As String
    Dim opt As Integer
    Dim opt1 As Integer
    Dim msgno As Integer
    Dim pos As Integer

    opt = Abs(opt0)
    opt1 = (opt Mod 10) And &H1
    opt = Int(opt / 10)
    msgno = -opt

    file_dir = file_dir0
'    If file_dir = "" Then file_dir = "?"

    get_file_dir_opt = ""
    dat = ""
    If InStr(file_dir, "?") > 0 Then opt1 = 1
    If opt1 <> 0 Then
        file_dir = input_file_dir(msg0, file_dir, cancel_msg)
        If file_dir = "" Then Exit Function
    End If
    
    Do While dat = ""
        dat = dir(file_dir, vbDirectory)
        If dat = "" Or file_dir = "" Then   'file_dir=""のときは、dat=""にならないので、file_dir=""の条件が必要
            If file_dir <> "" Then
                msg1 = "ファイル(" & file_dir & "がありません。"
                If msgno = 0 Then
                    Call MsgBox(msg1, vbCritical + vbOKOnly)
                Else
                    Call ERROROUT(msgno, msg1)
                End If
            End If
            file_dir = input_file_dir(msg0, file_dir, cancel_msg)
            If file_dir = "" Then Exit Do
            dat = ""   'file_dir=""のときは、dat=""にならないので、dat=""とする
        End If
    Loop

    get_file_dir_opt = file_dir

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_file_dir                                                *
'*  機能 : ディレクトリ名を入力し、存在をチェックする。                *
'*         入力地が"?"のときは、ファイルダイアログから入力する。       *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dir0  : 入力ディレクトリ名のデフォルト値     *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2014/10/24 Akito Kobayashi                                  *
'*  更新 : 2017/01/24 Akito Kobayashi Mod use get_file_dir_opt()       *
'***********************************************************************
Function get_file_dir( _
  ByRef msg0 As String _
, ByRef file_dir0 As String _
, Optional ByRef cancel_msg As String = "" _
) As String

    get_file_dir = get_file_dir_opt(msg0, file_dir0, 1, cancel_msg)

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : input_file_dir                                              *
'*  機能 : ディレクトリ名を入力する。                                  *
'*         入力地が"?"のときは、ファイルダイアログから入力する。       *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dir0  : 入力ディレクトリ名のデフォルト値     *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2016/06/09 Akito Kobayashi                                  *
'*  更新 : 2017/01/24 Akito Kobayashi Add MsgBox flag                  *
'***********************************************************************
Function input_file_dir( _
  ByRef msg0 As String _
, ByRef file_dir0 As String _
, Optional ByRef cancel_msg As String = "" _
) As String
    Dim dat As String
    Dim file_dir As String
    Dim pos As Integer

    file_dir = file_dir0
    pos = InStr(file_dir, "?")
    Do While True
        If pos = 0 Then
            file_dir = input_name(msg0 & "格納directory名//?", file_dir, cancel_msg)
            If file_dir = "" Then Exit Do
            pos = InStr(file_dir, "?")
        End If
        If pos > 0 Then
            dat = file_dir
            file_dir = Left(file_dir, pos - 1)
'            file_dir = GetShellFolder(msg0 & "格納directory名", file_dir, "dirctory名入力に戻る")
            file_dir = GetAppFolder(msg0 & "格納directory名", file_dir, "dirctory名入力に戻る")
            If file_dir <> "" Then Exit Do
            file_dir = dat
            pos = 0
        Else
            If str_chars(file_dir, GC_INVALID_CHARS) > 0 Then
                Call MsgBox("Invalid dir name[" & file_dir & "]", vbCritical + vbOKOnly)
            Else
                Exit Do
            End If
        End If
    Loop
    input_file_dir = file_dir

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : path_to_dir_file                                            *
'*  機能 : ファイルパス名をフォルダ名とファイル名に分ける。            *
'*  引数 : IN  :     file_path  : ファイルパス名                       *
'*         OUT :     nama()     : nama(0)=フォルダ名                   *
'*                                nama(1)=ファイル名                   *
'*  作成 : 2016/12/29 Akito Kobayashi                                  *
'*  更新 : 2018/02/01 Akito Kobayashi Mod delete tail "\"              *
'***********************************************************************
Sub path_to_dir_file( _
  ByRef file_path As String _
, ByRef nama() As String _
)
    Dim nam As String
    Dim pos As Integer

    pos = str_rchars(file_path, "\")
    If pos = 0 Then
        nama(0) = ""
        nama(1) = file_path
    Else
        nam = Left(file_path, pos - 1)
        Do While Right(nam, 1) = "\"
            nam = axLeft(nam, -1)
        Loop
        nama(0) = nam
        nama(1) = Mid(file_path, pos + 1)
    End If

End Sub

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_lineXML                                                 *
'*  機能 : XMLファイルをテキストレコード単位で読み込む。               *
'*         2重引用符で始まるデータが閉じていない場合は、閉じるまで     *
'*         レコードを読み込む                                          *
'*  引数 : IN  :     fn    : 読み込むファイル番号                      *
'*                   parm  : XML入力構造体                             *
'*                           line(  O): 入力LINE                       *
'*                           quot(I/O): 2重引用符記号                  *
'*                                 =2重引用符(")のとき、引用符の内側   *
'*                                 =""のとき、引用符の外側             *
'*                           fEOF(I/O): EOFフラグ                      *
'*                                 =1のとき、EOF                       *
'*         OUT : なし                                                  *
'*  返却 : 読み込んだレコード文字数                                    *
'*  作成 : 2015/08/13 Akito Kobayashi                                  *
'*  更新 : 2018/10/10 Akito Kobayashi Mod length to Long               *
'***********************************************************************
Function get_lineXML(ByVal fn As Long, ByRef parm As XML_LINE) As Long
    Dim line As String
    Dim c As String
    Dim c2 As String
    Dim line_len As Long
    Dim i As Long
    Dim ret As Long

    ret = get_line(fn, line)
    If ret < 0 Then
        parm.fEOF = 1
    Else
        line = Trim(line)
        line_len = Len(line)
        i = 1
        Do While i <= line_len
            c = Mid(line, i, 1)
            If c = """" Then
                If parm.quot <> "" Then
                    If i < line_len Then
                        c2 = Mid(line, i + 1, 1)
                    Else
                        c2 = ""
                    End If
                    If c2 = parm.quot Then
                        i = i + 1
                    Else
                        parm.quot = ""
                    End If
                Else
                    parm.quot = c
                End If
            End If
            i = i + 1
        Loop
        If parm.quot <> "" Then
            ret = get_lineXML(fn, parm)
            line = line & parm.line
        End If
        ret = Len(line)
    End If
    parm.line = line
    get_lineXML = ret

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : GetAppFolder                                                *
'*  機能 : ディレクトリ名を入力し、ファイルダイアログから              *
'*         ディレクトリ名を取得する。                                  *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dir0  : 入力ディレクトリ名のデフォルト値     *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2015/11/20 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Function GetAppFolder( _
  ByRef msg0 As String _
, ByRef file_dir0 As String _
, Optional ByRef cancel_msg As String = "" _
) As String
    Dim msga(1) As String
    Dim file_dir As String

    Call set_input_name(msg0, msga, cancel_msg)
    file_dir = chk_file_dir(file_dir0)
    If Right(file_dir, 1) <> "\" Then file_dir = file_dir & "\"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = file_dir
        .Title = msga(1)
        If .Show = True Then
            file_dir = .SelectedItems(1)
        Else
            file_dir = ""
        End If
    End With
    GetAppFolder = file_dir

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : GetShellFolder                                              *
'*  機能 : ディレクトリ名を入力し、ファイルダイアログから              *
'*         ディレクトリ名を取得する。                                  *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_dir0  : 入力ディレクトリ名のデフォルト値     *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名                                              *
'*  作成 : 2015/11/20 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Function GetShellFolder( _
  ByRef msg0 As String _
, ByRef file_dir0 As String _
, Optional ByRef cancel_msg As String = "" _
) As String
    Dim Shell, myDir
    Dim myDir0 As String
    Dim msga(1) As String
    Dim dat As String
    Dim file_dir As String

    Call set_input_name(msg0, msga, cancel_msg)
    myDir0 = chk_file_dir(file_dir0)
'    If Right(file_dir, 1) <> "\" Then file_dir = file_dir & "\"

    Set Shell = CreateObject("Shell.Application")
    Set myDir = Shell.BrowsForFolder(0, msga(0), &H1 + &H10, CVar(myDir0))
    If Not myDir Is Nothing Then
        file_dir = myDir.Items.Item.Path
    Else
        file_dir = ""
    End If
    Set Shell = Nothing
    Set myDir = Nothing
    GetShellFolder = file_dir

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : GetAppFilePath                                              *
'*  機能 : ディレクトリ名とファイル名フィルタを入力し、                *
'*         ファイルダイアログからファイル名へのパスを取得する          *
'*  引数 : IN  :     msg0       : メッセージ出力する入力する対象の名称 *
'*                               ("XXXX用のファイル名"等)              *
'*                   file_path0 : ファイルパス名のデフォルト値         *
'*          Optional cancel_msg : Cancel時の説明文      (default="")   *
'*          Optional open_save  : ダイアログのモード    (default="")   *
'*                                "Save":出力用ファイル名を選択        *
'*                                その他:入力用ファイル名を選択        *
'*         OUT : なし                                                  *
'*  返却 : ディレクトリ名 + "\" + ファイル名                           *
'*         Cancel時は、""                                              *
'*  作成 : 2015/11/20 Akito Kobayashi                                  *
'*  更新 : 2017/02/01 Akito Kobayashi Del parm, file_filter0           *
'***********************************************************************
Function GetAppFilePath( _
  ByRef msg0 As String _
, ByRef file_path0 As String _
, Optional ByRef cancel_msg As String = "" _
, Optional ByRef open_save As String = "" _
) As String
    Const C_FILTER As String = "SQL file(*.sql),*.sql,XML file(*.XML),*.XML,Text file(*.txt),*.txt,All file(*.*),*.*"
    Dim file_ret
    Dim file_path As String
    Dim nama(1) As String
    Dim file_filter0 As String
    Dim file_filter As String
    Dim fila() As String
    Dim filters As String
    Dim filter1 As String
    Dim filter2 As String
    Dim dat As String
    Dim msga(1) As String
    Dim myDir As String
    Dim max_ix2 As Integer
    Dim i As Integer
    Dim ix As Integer

    fila = Split(C_FILTER, ",")
    max_ix2 = UBound(fila)

    GetAppFilePath = ""
    Call set_input_name(msg0, msga, cancel_msg)
    
    filter1 = ""
    filter2 = ""
    ix = 4
    filters = C_FILTER
    file_filter0 = ""
    i = InStr(file_path0, ".")
    If i > 0 Then file_filter0 = "*" & Mid(file_path0, i)

    If file_filter0 <> "" Then
        file_filter = UCase(file_filter0)
        ix = 0
        For i = 0 To max_ix2 Step 2
            If InStr(UCase(fila(i)), file_filter) > 0 Then
                ix = Int(i / 2) + 1
                Exit For
            End If
        Next
        If ix = 0 Then
            ix = 1
            i = InStr(file_filter0, ".")
            If i = 0 Then
                dat = "?"
                file_filter = "*." & file_filter
            Else
                dat = Mid(file_filter0, i + 1)
                file_filter = file_filter0
            End If
            filter1 = dat & " file(" & file_filter & ")"
            filter2 = file_filter
            filters = filter1 & "," & filter2 & "," & C_FILTER
        End If
    End If

    file_path = file_path0
    Call path_to_dir_file(file_path0, nama)
    myDir = chk_file_dir(nama(0), "")
    If myDir = "" Then file_path = nama(1)

    If UCase(Left(open_save, 1)) = "S" Then
        file_ret = Application.GetSaveAsFilename( _
            InitialFileName:=file_path _
            , filefilter:=filters _
            , FilterIndex:=ix _
            , Title:=msga(1))
        If file_ret <> False Then
            file_path = file_ret
        Else
            file_path = ""
        End If
    Else
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .filters.Clear
            If filter1 <> "" Then
                .filters.add filter1, filter2
            End If
            For i = 0 To max_ix2 Step 2
                .filters.add fila(i), fila(i + 1)
            Next
            .FilterIndex = ix
            .InitialFileName = file_path
            .InitialView = msoFileDialogViewDetails
            .Title = msga(1)
            If .Show = True Then
                file_path = .SelectedItems(1)
            Else
                file_path = ""
            End If
        End With
    End If
    GetAppFilePath = file_path
    
End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : get_dir_array                                               *
'*  機能 : 指定したディレクトリ名配下のディレクトリ名を取得する。      *
'*  引数 : IN  :     sDir         : 指定ディレクトリ名                 *
'*                   max_dir_nama : 取得するディレクトリ名の最大数     *
'*         OUT :     dir_nama()   : 取得したディレクトリ名             *
'*  返却 : 取得したディレクトリ名数                                    *
'*  作成 : 2017/01/11 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Function get_dir_array( _
  ByRef sDir As String _
, ByRef dir_nama() As String _
, ByVal max_dir_nama As Integer _
) As Integer
    Dim dir_nam As String
    Dim n As Integer

    n = 0
    dir_nam = dir(sDir & "\.", vbDirectory)
    Do While dir_nam <> ""
        If n >= max_dir_nama Then Exit Do
        If dir_nam <> "." And dir_nam <> ".." Then
            If (GetAttr(sDir & "\" & dir_nam) And vbDirectory) <> 0 Then
                dir_nama(n) = dir_nam
                n = n + 1
            End If
        End If
        dir_nam = dir()
    Loop
    get_dir_array = n

End Function

'********1*********2*********3*********4*********5*********6*********7**
'*  名称 : GetLineCount                                                *
'*  機能 : ファイル行数を取得する                                      *
'*  引数 : IN  :     file_path    : ファイルパス名                     *
'*         OUT : なし                                                  *
'*  返却 : ファイル行数                                                *
'*  作成 : 2018/05/25 Akito Kobayashi                                  *
'*  更新 :                                                             *
'***********************************************************************
Function GetLineCount(ByRef file_path As String) As Long
    Dim oFS As New FileSystemObject
    Dim oTS As TextStream

    If oFS.FileExists(file_path) = False Then
        GetLineCount = -1
    Else
        Set oTS = oFS.OpenTextFile(file_path, ForAppending)
        GetLineCount = oTS.line - 1
    End If

End Function