Imports System.Text
Imports System.IO
Imports System.Reflection
Imports System.Windows.Forms
'*******************************************************************************
'* 作成者   : 株式会社エコー・システム 
'* 作成日   : 2004/10/02
'* 概要     : PICS2004 共通処理
'* 更新履歴 : 
'* ﾊﾞｰｼﾞｮﾝ  : 1.0
'*******************************************************************************


Module modPublic


    '*******************************************************************************
    '   概要：日付チェックモード(fCheckDate関数の日付チェック形式)
    '*******************************************************************************
    Public Const G_CONST_CHK_YEAR_DATE As Integer = 0   '年月日形式
    Public Const G_CONST_CHK_MONTH_DATE As Integer = 1  '月日形式
    Public Const G_CONST_CHK_YEAR_MONTH As Integer = 2  '年月形式
    '*******************************************************************************
    '   概要：時刻チェックモード(fCheckTime関数の日付チェック形式)
    '*******************************************************************************
    Public Const G_CONST_CHK_HHMM As Integer = 0   '時分形式
    Public Const G_CONST_CHK_HHMMSS As Integer = 1  '時分秒形式
    '*******************************************************************************
    '   概要：メッセージ戻り値
    '*******************************************************************************
    Public Enum MSG_RET As Integer
        OK = 1
        ABORT = 2
        RETRY = 3
        IGNORE = 4
        CANCEL = 5
        YES = 6
        NO = 7
    End Enum
    '*******************************************************************************
    '   概要：Key入力制限
    '*******************************************************************************
    Public Enum KEY As Integer
        Number = 1
        Alpha = 2
        NumAlpha = 3
        TelPost = 4
        NumberDec = 5
        DateShift = 6
    End Enum
    '*******************************************************************************
    '   概要：処理ログ出力区分
    '*******************************************************************************
    Public Enum EVENT_RTN As Integer
        JOB_SRT = 1
        JOB_NML = 2
        JOB_ERR = 3
        DAT_ERR = 4
        DAT_NON = 5
    End Enum

    '*******************************************************************************
    '   変数
    '*******************************************************************************

    '*******************************************************************************
    '* 機能     : アプリケーションの初期処理を行います
    '* 引数     : pstrPrgID    String  起動プログラムID（拡張子無し)
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fAppInit(ByVal pstrPrgID As String) As Boolean

        fAppInit = False
        gAppName = fGetAppName()

        ''// 二重起動の防止
        'gobjMutex = New System.Threading.Mutex(False, gAppName)
        'If gobjMutex.WaitOne(0, False) = False Then
        '    Application.Exit()
        'End If

        '// INIﾌｧｲﾙ読み込み
        If fGetIniPics() = False Then Exit Function
        If fGetIniParam(pstrPrgID) = False Then Exit Function

        '// 起動ﾓｰﾄﾞｾｯﾄ
        If gstrctParamIni.intKeyCount = 0 Then
            gintAppMode = G_CONST_APP_NEW
        Else
            gintAppMode = G_CONST_APP_UPD
        End If

        '// DB接続
        'If gclsDB.fOpenDB(gstrctPicsIni.strMain_PICS2004) = False Then
        '    sErrLog(gAppName, "fAppInit", gclsDB.ErrMsg)
        '    MsgBox("DB OPEN ERROR", MsgBoxStyle.Critical)
        '    Exit Function
        'End If

        fAppInit = True

    End Function

    '*******************************************************************************
    '* 機能     : アプリケーションの初期処理を行います
    '* 引数     : pobjForm     Object  ﾌｫｰﾑ
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Sub sFormStandardSetting(ByVal pobjForm As Object)
        'pobjForm.MaximizeBox = False
        'pobjForm.MinimizeBox = True
        'pobjForm.FormBorderStyle = FormBorderStyle.FixedDialog
        'pobjForm.StartPosition = FormStartPosition.CenterScreen
    End Sub

    '*******************************************************************************
    '* 機能     : Pics.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : 
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetIniPics() As Boolean
        Dim wstrBuf As String

        Try
            '// PICS.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrPicsIniPath = fgetAppPath() & "\" & G_CONST_PICSINI

            '// PICS.INI読み込み
            With gstrctPicsIni
                .strImport_SPM = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec01, G_CONST_PicsKey01)
                .strImport_PLAN = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec01, G_CONST_PicsKey02)
                .strImport_RCVJUMP = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec01, G_CONST_PicsKey03)
                .strImport_MCLOCATION = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec01, G_CONST_PicsKey04)
                .strImport_MATERIAL = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec01, G_CONST_PicsKey05)

                .strMain_PICS2004 = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec02, G_CONST_PicsKey06)

                .strExport_SENDJUMP = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec03, G_CONST_PicsKey07)
                .strExport_SENDPACK1 = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec03, G_CONST_PicsKey08)
                .strExport_SENDPACK2 = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec03, G_CONST_PicsKey09)
                .strExport_SENDVAN = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec03, G_CONST_PicsKey10)

                .strErrorLog_Path = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec04, G_CONST_PicsKey11)

                .strParameter_Path = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec05, G_CONST_PicsKey12)

                .strConstant_DataKeepYear = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec06, G_CONST_PicsKey13)
                .strConstant_EditDate = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec06, G_CONST_PicsKey14)
                .strConstant_WaitTime = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec06, G_CONST_PicsKey28)

                .strOutput_PICSC = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey15)
                .strOutput_PICSH = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey16)
                .strOutput_PICSI = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey17)
                .strOutput_PICSM = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey18)
                .strOutput_KDPA = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey19)
                .strOutput_KDST = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey26)
                .strOutput_KDPP = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey27)
                .strOutput_KDPL = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec07, G_CONST_PicsKey29)

                .strLabelWork_LABELWORK = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec08, G_CONST_PicsKey20)
                .strMtlWork_MTLWORK = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec09, G_CONST_PicsKey21)
                .strWork_PSERIAL = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec10, G_CONST_PicsKey22)
                .strWork_FREELOCATION = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec11, G_CONST_PicsKey23)
                .strWork_LOOKLCTN = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec12, G_CONST_PicsKey24)
                .strPicsc114_Def = gclsReg.fGetIniValue(gstrPicsIniPath, G_CONST_PicsSec13, G_CONST_PicsKey25)
            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetIniPics", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : PICSPARAM.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : pstrPrgID    String　プログラムID（拡張子無し）
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetIniParam(ByVal pstrPrgID As String) As Boolean
        Dim wstrBuf As String

        Try

            '// PICSPARAM.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrParamIniPath = fgetAppPath() & G_CONST_PARAMINI

            '// PICS.INI読み込み
            With gstrctParamIni
                .strUserID = gclsReg.fGetIniValue(gstrParamIniPath, G_CONST_ParamSec01, G_CONST_ParamKey01)
                .strProgramID = gclsReg.fGetIniValue(gstrParamIniPath, pstrPrgID, G_CONST_ParamKey02)
                If .strProgramID = "0" Then
                    .intKeyCount = 0
                Else
                    wstrBuf = gclsReg.fGetIniValue(gstrParamIniPath, pstrPrgID, G_CONST_ParamKey03)
                    'If Trim(wstrBuf) = "" Then
                    If Trim(wstrBuf).Replace(",", "") = "" Then
                        .intKeyCount = 0
                    Else
                        .intKeyCount = fStringSep(wstrBuf, ",", .strKey)
                        'KDST1000ﾃｷｽﾄ用
                        'gstrctS1000.strdata = .strKey(0)

                    End If
                End If
            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetIniPics", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : Relese.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : 
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetIniRelese() As Boolean
        Dim wstrBuf As String

        Try
            '// RELESE.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrReleceIniPath = fgetAppPath() & G_CONST_RELECEINI

            '// RELESE.INI読み込み
            With gstrctReleceIni
                .strProduction = gclsReg.fGetIniValue(gstrReleceIniPath, G_CONST_RelecSec01, G_CONST_RelecKey01)
                .strShipPlan = gclsReg.fGetIniValue(gstrReleceIniPath, G_CONST_RelecSec01, G_CONST_RelecKey02)
                .strProductFrom = gclsReg.fGetIniValue(gstrReleceIniPath, G_CONST_RelecSec01, G_CONST_RelecKey03)
                .strProductTo = gclsReg.fGetIniValue(gstrReleceIniPath, G_CONST_RelecSec01, G_CONST_RelecKey04)
            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetIniRelese", ex.ToString)
            Return False
        End Try

    End Function
    '*******************************************************************************
    '* 機能     : ZAIKO.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : 
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetIniZaiko() As Boolean
        Dim wstrBuf As String

        Try
            '// Zaiko.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrZaikoIniPath = fgetAppPath() & G_CONST_ZAIKOINI

            '// Zaiko.INI読み込み
            With gstrctZaikoIni
                .strDate = gclsReg.fGetIniValue(gstrZaikoIniPath, G_CONST_ZaikoSec01, G_CONST_ZaikoKey01)

            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetIniZaiko", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : APLINK.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : 
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetCreateAPFlag() As Boolean
        Dim wstrBuf As String

        Try
            '// APLINK.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrAPLinkIniPath = gstrctPicsIni.strMain_PICS2004 & "\" & G_CONST_APLINKINI

            '// APLINK.INI読み込み
            With gstrctKDHT
                If UCase(gclsReg.fGetIniValue(gstrAPLinkIniPath, G_CONST_APLinkSec01, G_CONST_APLinkKey01)) = "ON" Then
                    '.bLinkFlag = True
                End If
            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetCreateAPFlag", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : KDMC.INIﾌｧｲﾙより情報を読み込み構造体にｾｯﾄします
    '* 引数     : 
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetIniKdmc() As Boolean
        Dim wstrBuf As String

        Try
            '// KDMC.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrKdmcIniPath = fgetAppPath() & G_CONST_KDMCINI

            '// KDMC.INI読み込み
            With gstrctKdmcIni
                .strMain_PicsType = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey01)
                .strMain_CstmID = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey02)
                .strMain_CstmCode = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey03)
                .strMain_CenterCode = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey04)
                .strMain_Bhk = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey05)
                .strMain_SectionID = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey06)
                .strMain_SectionCode = gclsReg.fGetIniValue(gstrKdmcIniPath, G_CONST_KdmcSec01, G_CONST_KdmcKey07)
            End With

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fGetIniKdmc", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : 引数より渡された情報をPICSPARAM.INIﾌｧｲﾙにｾｯﾄします
    '* 引数     : pstrAppID    String　プログラムID（拡張子無し）
    '*          : pstrPrgID    String　ProgramID(INIﾌｧｲﾙ)
    '*          : pstrKey      String　key(INIﾌｧｲﾙ)
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fPutIniParam(ByVal pstrAppID As String, ByVal pstrPrgID As String, ByVal ParamArray pstrKey() As String) As Boolean
        Dim wstrBuf As String
        Dim wblnRet As Boolean
        Dim i As Integer

        Try

            '// PICSPARAM.INIのﾌｧｲﾙﾊﾟｽ取得
            gstrParamIniPath = fgetAppPath() & G_CONST_PARAMINI

            '// PICSPARAM.INI読み込み
            wblnRet = gclsReg.fPutIniValue(gstrParamIniPath, pstrAppID, G_CONST_ParamKey02, pstrPrgID)

            If pstrPrgID = "0" Then
                wblnRet = gclsReg.fPutIniValue(gstrParamIniPath, pstrAppID, G_CONST_ParamKey03, "")
            Else
                wstrBuf = ""
                For i = 0 To UBound(pstrKey)
                    If i = 0 Then
                        wstrBuf = pstrKey(i)
                    Else
                        wstrBuf &= "," & pstrKey(i)
                    End If
                Next
                wblnRet = gclsReg.fPutIniValue(gstrParamIniPath, pstrAppID, G_CONST_ParamKey03, wstrBuf)
            End If

            Return True
            Exit Function

        Catch ex As Exception
            sErrLog(gAppName, "fPutIniParam", ex.ToString)
            Return False
        End Try

    End Function

    '*******************************************************************************
    '* 機能     : エラー発生時に、詳細をログファイルに吐き出します
    '* 引数     : pstrPGName     String　プログラムID
    '            : pstrSubName    String  プロシジャーID
    '            : plngErrCode    String  エラーコード
    '            : pstrErrName    String  エラーメッセージ
    '* 戻り値   : なし
    '* 備考     : なし
    '*******************************************************************************
    Public Sub sErrLog(ByVal pstrPGName As String, ByVal pstrSubName As String, ByVal pstrErrName As String)
        Dim wstrCode As String
        Dim wstrWorkCode As String
        Dim wstrDate As String
        Dim wstrTime As String
        Dim wstrRecord As String
        Dim wstrFileName As String
        Dim wintFileNum As Integer
        Dim wintRecCount As Integer
        Dim wintSpace As Integer
        Dim wstrSub As String
        Dim wstrPG As String
        Dim wintErrCode As Integer
        Dim wstrErrMsg As String

        Try

            wintSpace = 12 - Len(pstrPGName) ' プログラム名の文字数の取得とスペースの個数の取得
            wstrPG = Left(pstrPGName & Space(wintSpace), 12) ' 変数領域へスペースを付加して代入

            wintSpace = 30 - Len(pstrSubName) ' サブルーチン名の文字数の取得とスペースの個数の取得
            wstrSub = Left(pstrSubName & Space(wintSpace), 30) ' 変数領域へスペースを付加して代入

            wstrTime = fgetDefaultTime(":") ' "hh:mm:ss" を返します。
            wstrDate = fgetDefaultDate("/") ' "yyyy/mm/dd" を返します。

            'ワープエラーメッセージの取得
            'If pstrErrName.IndexOf("WarpError") > 0 Then
            '    f0.WarpCtrl1.GetLastError(wintErrCode)
            '    Select Case wintErrCode
            '        Case 10001
            '            wstrErrMsg = "Screen not open."
            '            'wstrErrMsg = "画面がオープンされていません"
            '        Case 10002
            '            wstrErrMsg = "Object non support."
            '            'wstrErrMsg = "オブジェクトがサポートされていない機能を利用しました"
            '        Case 10003
            '            wstrErrMsg = "Screen open over."
            '            'wstrErrMsg = "画面がそれ以上オープンできません"
            '        Case 10004
            '            wstrErrMsg = "Memory over flow."
            '            'wstrErrMsg = "メモリの空き容量が足りません"
            '        Case 10005
            '            wstrErrMsg = "Parameter error."
            '            'wstrErrMsg = "パラメータ等が一致していません"
            '        Case 10006
            '            wstrErrMsg = "Screen double open."
            '            'wstrErrMsg = "オープンされている画面をさらにオープンしました"
            '        Case 10009
            '            wstrErrMsg = "I/O error."
            '            'wstrErrMsg = "IOエラー"
            '        Case 10010
            '            wstrErrMsg = "Screen error. Object used."
            '            'wstrErrMsg = "オープンされていない画面にオブジェクトを利用しました"
            '        Case 20000
            '            wstrErrMsg = "Not initialize."
            '            'wstrErrMsg = "初期化されていません"
            '        Case 20001
            '            wstrErrMsg = "Initialize parameter error."
            '            'wstrErrMsg = "初期化のパラメータが違います"
            '        Case 20002
            '            wstrErrMsg = "Parameter error."
            '            'wstrErrMsg = "パラメータが違います"
            '        Case 20003
            '            wstrErrMsg = "Not object."
            '            'wstrErrMsg = "オブジェクトが存在しません"
            '        Case 20004
            '            wstrErrMsg = "The buffer doesn't exist in the bar code buffer."
            '            'wstrErrMsg = "バーコードバッファにバッファが存在しません"
            '        Case 20005
            '            wstrErrMsg = "Warp message error."
            '            'wstrErrMsg = "ワープのメッセージエラー"
            '        Case 30000
            '            wstrErrMsg = "MORS network error."
            '            'wstrErrMsg = "MORSのネットワークに異常が発生しました"
            '        Case 30001
            '            wstrErrMsg = "MORS is not running."
            '            'wstrErrMsg = "MORSが稼動していません"
            '        Case 30002
            '            wstrErrMsg = "MORS frame error."
            '            'wstrErrMsg = "MORSが通信路の確立に失敗しました"
            '        Case 30003
            '            wstrErrMsg = "MORS data send error."
            '            'wstrErrMsg = "MORSがデータの送信に失敗しました"
            '        Case 30004
            '            wstrErrMsg = "MORS data recive error."
            '            'wstrErrMsg = "MORSがデータの受信に失敗しました"
            '        Case 30005
            '            wstrErrMsg = "MORS wait error."
            '            'wstrErrMsg = "MORSのウエイトエラーが発生しました"
            '    End Select

            '    wstrErrMsg = "WarpError:" & wstrErrMsg

            '    ' wstrRecord に取得したパラメータを編集して格納
            '    wstrRecord = wstrDate & "   " & wstrTime & "   " & gstrctKDHT.strHdNo & "   " & wstrPG & "   " & wstrSub & "   " & wstrErrMsg

            'Else

            ' wstrRecord に取得したパラメータを編集して格納
            wstrRecord = wstrDate & "   " & wstrTime & "   " & gstrctKDHT.strHdNo & "   " & wstrPG & "   " & wstrSub & "   " & pstrErrName

            'End If

            'wintFileNum = FreeFile() ' フリーのファイルナンバーを取得

            wstrFileName = Trim(gstrctPicsIni.strErrorLog_Path)
            If wstrFileName = "" Then wstrFileName = ".\PICSERR.LOG"
            ' 出力ファイルのオープン
            'FileOpen(wintFileNum, wstrFileName, OpenMode.Append)

            'PrintLine(wintFileNum, wstrRecord) 'ログの書き出し
            'FileClose(wintFileNum) ' 出力ファイルのクローズ

            Try
                ' Open the file in append mode
                Using writer As StreamWriter = New StreamWriter(wstrFileName, True)
                    ' Write the record to the file
                    writer.WriteLine(wstrRecord)
                End Using
            Catch ex As Exception
                ' Handle any potential exceptions here
                MessageBox.Show("An error occurred while writing to the log file: " & ex.Message)
            End Try

            Exit Sub

        Catch ex As Exception
            'f0.WarpCtrl1.MessageBox(G_CONST_EMT_FILEIO, G_CONST_EM_FILEIO, MWA_DB_WARNING, MWA_DB_OK)
            MessageBox.Show(G_CONST_EM_FILEIO, G_CONST_EMT_FILEIO, MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1)

        End Try

    End Sub

    '*******************************************************************************
    '* 機能     : 処理内容をログファイルに吐き出します
    '* 引数     : pstrPath     String　ファイルパス
    '           : pstrPGName   String  プログラムID
    '           : pintIvent    Integer 処理メッセージ
    '           : pstrMsg      String  詳細メッセージ
    '           : pstrNaiyou   String  詳細内容
    '* 戻り値   : なし
    '* 備考     : なし
    '*******************************************************************************
    Public Sub sOutputLog(ByVal pstrPath As String, ByVal pstrMsgNo As String, Optional ByVal pstrTrueScan As String = " ", Optional ByVal pstrFalseScan As String = " ")

        Dim wstrRecord As String
        Dim wstrFileName As String
        Dim wintFileNum As Integer

        Try
            wstrRecord = fgetDefaultDate()         'ｼｽﾃﾑ日付
            wstrRecord &= fgetDefaultTime()        'ｼｽﾃﾑ時刻
            wstrRecord &= gstrctKDHT.strUserNo
            wstrRecord &= Space(1) & Space(8)
            wstrRecord &= gstrctKDHT.strPrgID
            wstrRecord &= pstrMsgNo
            wstrRecord &= Space(1) & Space(30)
            pstrTrueScan = pstrTrueScan.PadRight(40)
            wstrRecord &= pstrTrueScan
            pstrFalseScan = pstrFalseScan.PadRight(40)
            wstrRecord &= pstrFalseScan
            wstrRecord &= Space(14)

            'wintFileNum = FreeFile() ' フリーのファイルナンバーを取得

            wstrFileName = Trim(pstrPath)
            If wstrFileName = "" Then wstrFileName = "C:\HTERRLOG.TXT"
            ' 出力ファイルのオープン
            'FileOpen(wintFileNum, wstrFileName, OpenMode.Append)

            'PrintLine(wintFileNum, wstrRecord) 'ログの書き出し
            'FileClose(wintFileNum) ' 出力ファイルのクローズ

            Try
                ' Open the file in append mode
                Using writer As StreamWriter = New StreamWriter(wstrFileName, True)
                    ' Write the record to the file
                    writer.WriteLine(wstrRecord)
                End Using
            Catch ex As Exception
                ' Handle any potential exceptions here
                MessageBox.Show("An error occurred while writing to the log file: " & ex.Message)
            End Try

            Exit Sub

        Catch ex As Exception
            'f0.WarpCtrl1.MessageBox(G_CONST_EMT_FILEIO, G_CONST_EM_FILEIO, MWA_DB_WARNING, MWA_DB_OK)
            MessageBox.Show(G_CONST_EM_FILEIO, G_CONST_EMT_FILEIO, MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1)

        End Try
    End Sub

    '*******************************************************************************
    '* 機能     : プログラムIDを取得する
    '* 戻り値   : String　カレントディレクトリ
    '* 　　     : 取得失敗時は空文字を返却
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetPrgID() As String
        Dim wstrAppName As String
        On Error Resume Next

        wstrAppName = fGetAppName()
        wstrAppName = Left(wstrAppName, Len(wstrAppName) - 4)

        Return wstrAppName

    End Function
    '*******************************************************************************
    '* 機能     : アプリケーションのカレントディレクトリを取得する
    '* 戻り値   : String　カレントディレクトリ
    '* 　　     : 取得失敗時は空文字を返却
    '* 備考     : なし
    '*******************************************************************************
    Public Function fGetAppName() As String
        Dim wstrAppName As String
        On Error Resume Next

        wstrAppName = ""
        wstrAppName = System.AppDomain.CurrentDomain.FriendlyName

        Return wstrAppName

    End Function

    '*******************************************************************************
    '* 機能     : アプリケーションのカレントディレクトリを取得する
    '* 戻り値   : String　カレントディレクトリ（末尾に"\"付加）
    '* 　　     : 取得失敗時は空文字を返却
    '* 備考     : なし
    '*******************************************************************************
    Public Function fgetAppPath() As String
        Dim wstrPath As String
        On Error Resume Next

        'wstrPath = ""

        ''カレントディレクトリ取得
        'wstrPath = System.Environment.CurrentDirectory
        'wstrPath += "\"

        'Return wstrPath


        Return Path.GetDirectoryName(Assembly.GetExecutingAssembly().GetName().CodeBase)
    End Function

    '*******************************************************************************
    '* 機能     : 文字列をﾃﾞﾘﾐﾀで分割して返却します
    '* 引数     : pstrTarget     String　対象文字列
    '            : pstrDelimiter  String  ﾃﾞﾘﾐﾀ
    '            : pstrResult()   String  分割後文字列配列
    '* 戻り値   : 分割数
    '* 備考     : なし
    '*******************************************************************************
    Public Function fStringSep(ByVal strTarget As String, ByVal strDelimiter As String, ByRef strResult() As String) As Integer
        Dim wstrArray() As String

        wstrArray = Split(strTarget, strDelimiter)
        strResult = wstrArray
        Return wstrArray.Length

    End Function


    '*******************************************************************************
    '   概要：NULLチェック(文字列)
    '   ﾊﾟﾗﾒｰﾀ：data, Object, チェック対象項目
    '           ret, Object, 初期値（省略時は空文字）
    '   戻り値：String　NullまたはDBNullの時はデフォルト値、
    '                   それ以外はdataをそのまま返却
    '*******************************************************************************
    Public Function fcheckNullString(ByVal data As Object, Optional ByVal ret As String = "", Optional ByVal pbilTrimMode As Boolean = True) As String
        On Error GoTo checkNullString_ERR

        If IsNothing(data) Or IsDBNull(data) Then
            Return ret
        Else
            If pbilTrimMode Then
                Return Trim(data)
            Else
                Return data
            End If
        End If
        Exit Function

checkNullString_ERR:
        Return ret
    End Function


    '*******************************************************************************
    '   概要：NULLチェック(数値)
    '   ﾊﾟﾗﾒｰﾀ：data, Object, チェック対象項目
    '           ret, Object, 初期値（省略時は0）
    '   戻り値：Integer　NullまたはDBNullの時はデフォルト値、
    '                   それ以外はdataをそのまま返却
    '*******************************************************************************
    Public Function fcheckNullInt(ByVal data As Object, Optional ByVal ret As Integer = 0) As Integer

        Try
            If IsNothing(data) Or IsDBNull(data) Then
                Return ret
            Else
                Return data
            End If

            Exit Function

        Catch ex As Exception
            Return ret
        End Try

    End Function


    '*******************************************************************************
    '   概要：システム日付をYYYYMMDD書式で返却
    '   ﾊﾟﾗﾒｰﾀ：なし
    '   戻り値：String　書式変換後の日付文字列
    '*******************************************************************************
    Public Function fgetDefaultDate(Optional ByVal pstrSep As String = "") As String
        Dim strY As String
        Dim strM As String
        Dim strD As String

        strY = Now.Year
        strM = Now.Month
        strM = strM.PadLeft(2, "0")
        strD = Now.Day
        strD = strD.PadLeft(2, "0")

        Return strY & pstrSep & strM & pstrSep & strD

    End Function

    '*******************************************************************************
    '   概要：システム時刻をHHNNSS書式で返却
    '   ﾊﾟﾗﾒｰﾀ：なし
    '   戻り値：String　書式変換後の日付文字列
    '*******************************************************************************
    Public Function fgetDefaultTime(Optional ByVal pstrSep As String = "") As String
        Dim strH As String
        Dim strM As String
        Dim strS As String

        strH = Now.Hour
        strH = strH.PadLeft(2, "0")
        strM = Now.Minute
        strM = strM.PadLeft(2, "0")
        strS = Now.Second
        strS = strS.PadLeft(2, "0")

        Return strH + pstrSep + strM + pstrSep + strS

    End Function

    '*******************************************************************************
    '   概要：全角半角チェック
    '   ﾊﾟﾗﾒｰﾀ：PIstrChkstr チェックする文字列
    '           PIintChktype チェックするタイプ 0:半角 1:全角
    '   戻り値：チェックOK：0　チェックNG：1
    '*******************************************************************************
    Public Function fchk_HanZenString(ByVal PIstrChkstr As String, _
            ByVal PIintChktype As Integer) As Integer

        Dim utfEnc As Encoding = utfEnc.GetEncoding("utf-8")
        Dim intStrLen As Integer    '文字数
        Dim intStrByte As Integer   'バイト数

        intStrLen = PIstrChkstr.Length
        intStrByte = utfEnc.GetByteCount(PIstrChkstr)

        Select Case PIintChktype
            Case 0                                  '半角
                If intStrByte = intStrLen Then
                    fchk_HanZenString = 0
                Else
                    fchk_HanZenString = 1
                End If

            Case 1                                  '全角
                If intStrByte = (intStrLen * 2) Then
                    fchk_HanZenString = 0
                Else
                    fchk_HanZenString = 1
                End If

            Case Else

        End Select

    End Function


    '*******************************************************************************
    '   概要：数値チェック（数値チェック、べき乗文字有無チェック、円マークチェック、カンマチェック）
    '   ﾊﾟﾗﾒｰﾀ：pstrNum, String, チェック対象文字列
    '   戻り値：Boolean　True チェックOK、　False チェックNG
    '*******************************************************************************
    Public Function fChkNum(ByVal pstrNum As String) As Boolean

        Try

            If Len(pstrNum.Trim) = 0 Then                          '未入力チェック

                '未入力の場合
                fChkNum = True
            Else
                '入力されている場合
                fChkNum = IsNumeric(pstrNum)                       '数値チェック
                fChkNum = fChkNum And InStr(pstrNum, "e") = 0     'べき乗文字チェック
                fChkNum = fChkNum And InStr(pstrNum, "\") = 0     '円マークチェック
                fChkNum = fChkNum And InStr(pstrNum, ",") = 0     'カンマチェック

                fChkNum = True

            End If

            Exit Function

        Catch ex As Exception
            fChkNum = False
        End Try

    End Function

    '*******************************************************************************
    '   概要：指定日付をYYYYMMDD書式で返却
    '   ﾊﾟﾗﾒｰﾀ：Value, String, 変換対象文字列
    '   戻り値：String　書式変換後の日付文字列
    '                   変換失敗時は空文字を返却
    '*******************************************************************************
    Public Function fformatDateStr(ByVal Value As String) As String
        Dim ret As String
        Dim strChk As String
        Dim intLength As Integer

        Try
            '空文字は何もしない
            intLength = Value.Length
            If intLength = 0 Then Return ""

            '"/"が入力されているかどうかチェック
            If String.Compare(Value, "/") > 0 Then
                Value = Value.Replace("/", "")
            End If

            intLength = Value.Length

            '桁数チェック
            If intLength = 8 Then
                ret = Value

            ElseIf intLength = 6 Then
                '年を４桁にする
                ret = "20" + Value

            ElseIf intLength = 4 Then
                '年を付加する
                ret = CStr(Now.Year) + Value

            Else
                'それ以外は受け付けない
                ret = ""
            End If

            'YYYY/MM/DDに変換(変換チェック用)
            strChk = ret.Substring(0, 4) + "/" + ret.Substring(4, 2) + "/" + ret.Substring(6, 2)

            '変換結果が日付変換できるかどうか確認
            If Not IsDate(strChk) Then ret = ""

            Return ret

        Catch ex As Exception
            Return ""
        End Try

    End Function


    '*******************************************************************************
    '   概要：グローバルクラスなどを破棄の終了処理
    '   ﾊﾟﾗﾒｰﾀ：frmMe, Form, 終了するフォーム
    '   戻り値：
    '*******************************************************************************
    Public Sub sEnd(ByRef frmMe As Form)

        frmMe.Dispose()

        'If Not IsNothing(gclsDB) Then
        '    gclsDB = Nothing       'Perbasive接続用のインスタンス破棄
        'End If

        'gobjMutex.Close()

        Application.Exit()

    End Sub

    '*******************************************************************************
    '   概要：グローバルクラスなどを破棄の終了処理
    '   ﾊﾟﾗﾒｰﾀ：
    '   戻り値：
    '*******************************************************************************
    Public Sub sEnd()

        'If Not IsNothing(gclsDB) Then
        '    gclsDB = Nothing       'Perbasive接続用のインスタンス破棄
        'End If

        'gobjMutex.Close()

        Application.Exit()

    End Sub
    '*******************************************************************************
    '   概要：MsgBoxフォームを呼出す
    '   ﾊﾟﾗﾒｰﾀ：wMsgId, String, メッセージID
    '           wDispMode, String, ボタン表示フラグ (1:ボタン　2:バーコード  3:4秒表示)
    '           wMsgName, String, "@" 置き換えメッセージ
    '           wButton, String, ボタンID
    '           wIcon,  String, アイコンID
    '   戻り値：String　MsgBoxフォーム終了時の押下ボタン名
    '                   (ボタンがない場合はFormから"OK"が返却される)
    '*******************************************************************************
    'Public Function fFnc_Msg(ByVal wMsgId As String, ByVal wDispMode As String, Optional ByVal wMsgName As String = "", _
    '                         Optional ByVal wMessage As String = "", Optional ByVal wButton As String = "", Optional ByVal wIcon As String = "") As Integer
    '    Dim wMsg As New clsMsg

    '    With wMsg
    '        .pDispMode = wDispMode
    '        .sMsgBox(wMsgId, wMsgName, wMessage, wButton, wIcon)
    '        Return .gintRtnCode
    '    End With

    'End Function

    '*******************************************************************************
    '   概要：TextBox文字列入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckText(ByVal obj As System.Object, Optional ByVal pintTrimMode As Boolean = True) As Boolean
        Dim strText As String

        Try
            strText = fcheckNullString(DirectCast(obj, TextBox).Text(), "", pintTrimMode)
            If strText = "" Then
                fCheckText = False
                DirectCast(obj, TextBox).Focus()
                DirectCast(obj, TextBox).Text = ""
            Else
                fCheckText = True
                DirectCast(obj, TextBox).Text = strText
            End If
        Catch ex As Exception
            fCheckText = False
            Return False
        End Try
    End Function

    '*******************************************************************************
    '   概要：TextBox文字列入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckInt(ByVal obj As System.Object, Optional ByVal min As System.Int64 = 0, Optional ByVal max As System.Int64 = -1) As System.Boolean
        Dim intValue As System.Int64
        Dim intMax As System.Int64
        Dim intCnt As System.Int32
        Dim intIndex As System.Int32

        'On Error GoTo CheckInt_ERR
        Try

            fCheckInt = True

            '入力データが数値の場合
            If Microsoft.VisualBasic.IsNumeric(DirectCast(obj, TextBox).Text()) Then
                intValue = System.Convert.ToInt64(DirectCast(obj, TextBox).Text())
                '最小値チェック
                If min <= intValue Then
                    '最大値が指定されている場合
                    If max <> -1 Then
                        If max < intValue Then
                            fCheckInt = False
                        End If
                    Else '最大値が指定されていない場合
                        '最大値の指定がない場合は最大入力桁数=入力可能文字数,全桁9ででチェック
                        intMax = 0
                        intCnt = DirectCast(obj, TextBox).MaxLength()
                        For intIndex = 1 To intCnt
                            intMax = (intMax * 10) + 9
                        Next
                        '入力値が最大値を超えている
                        If intMax < intValue Then
                            fCheckInt = False
                        End If
                    End If
                Else '入力値が最小値以下
                    fCheckInt = False
                End If
            Else '入力データが数値でない場合はエラー
                fCheckInt = False
            End If

        Catch ex As Exception
            fCheckInt = False
            Return False
        End Try
    End Function

    '*******************************************************************************
    '   概要：ComboBox数値入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckCombo(ByVal obj As System.Object) As Boolean
        Dim strText As String

        Try
            strText = fcheckNullString(DirectCast(obj, ComboBox).Text())
            DirectCast(obj, ComboBox).Text = strText
            If strText = "" Then
                DirectCast(obj, ComboBox).Focus()
                fCheckCombo = False
            Else
                fCheckCombo = True
            End If
        Catch ex As Exception
            fCheckCombo = False
            Return False
        End Try
    End Function

    '*******************************************************************************
    '   概要：TextBox日付入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckDate(ByVal obj As System.Object, Optional ByVal mode As Integer = G_CONST_CHK_YEAR_DATE) As Boolean

        fCheckDate = False
        If fCheckDate(DirectCast(obj, TextBox).Text(), mode) Then
            fCheckDate = True
        Else
            DirectCast(obj, TextBox).Focus()
        End If
    End Function

    '*******************************************************************************
    '   概要：日付文字列チェック処理
    '   ﾊﾟﾗﾒｰﾀ：pstrDate  日付文字列
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckDate(ByVal pstrDate As String, Optional ByVal mode As Integer = G_CONST_CHK_YEAR_DATE) As Boolean
        Dim strText As String
        Dim strYear As String
        Dim strMonth As String
        Dim strDay As String
        Dim strDate As String
        Dim intLength As Integer

        fCheckDate = False
        strText = ""
        Try
            strText = fcheckNullString(pstrDate)
            intLength = strText.Length

            If mode = G_CONST_CHK_YEAR_DATE Then
                If intLength <> 8 Then
                    strText = ""
                Else
                    strYear = Left(strText, 4)
                    strText = Right(strText, 4)
                    intLength = intLength - 4
                End If
            ElseIf mode = G_CONST_CHK_YEAR_MONTH Then
                If intLength <> 6 Then
                    strText = ""
                Else
                    strYear = Left(strText, 4)
                    strText = Right(strText, 2)
                    intLength = intLength - 4
                End If
            Else
                strYear = Now().Year
            End If

            If strText <> "" Then
                If intLength = 4 Then
                    strMonth = Left(strText, 2)
                    strDay = Right(strText, 2)

                    strDate = strYear & "/" & strMonth & "/" & strDay
                    If G_CONST_CHK_MONTH_DATE = mode Then
                        strText = strMonth & strDay
                    Else
                        strText = strYear & strMonth & strDay
                    End If
                    fCheckDate = True

                    If Not IsDate(strDate) Then
                        fCheckDate = False
                        strText = ""
                    End If
                ElseIf intLength = 2 Then
                    strMonth = Left(strText, 2)
                    strDay = "01"
                    strDate = strYear & "/" & strMonth & "/" & strDay
                    strText = strYear & strMonth
                    fCheckDate = True

                    If Not IsDate(strDate) Then
                        fCheckDate = False
                        strText = ""
                    End If
                Else
                    strDate = strYear & "/" & strMonth & "/" & strDay
                    fCheckDate = True
                    If Not IsDate(strDate) Then
                        fCheckDate = False
                        strText = ""
                    End If
                End If
            Else
                strText = ""
            End If
            Return fCheckDate

        Catch ex As Exception
            Return False
        End Try
    End Function

    '*******************************************************************************
    '   概要：TextBox時刻入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckTime(ByVal obj As System.Object, Optional ByVal mode As Integer = G_CONST_CHK_HHMM) As Boolean
        Dim strText As String

        strText = fcheckNullString(DirectCast(obj, TextBox).Text())

        If fCheckTime(DirectCast(obj, TextBox).Text(), mode) = False Then
            DirectCast(obj, TextBox).Text = strText
            DirectCast(obj, TextBox).Focus()
            fCheckTime = False
        Else
            DirectCast(obj, TextBox).Text = Microsoft.VisualBasic.Left(strText, strText.Length)
            fCheckTime = True
        End If

    End Function

    '*******************************************************************************
    '   概要：TextBox時刻入力チェック処理
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckTime(ByVal pstrTime As String, Optional ByVal mode As Integer = G_CONST_CHK_HHMM) As Boolean
        Dim strText As String
        Dim strHour As String
        Dim strMin As String
        Dim strSec As String
        Dim strTime As String
        Dim intLength As Integer

        fCheckTime = True

        Try
            strText = fcheckNullString(pstrTime)
            intLength = strText.Length

            If mode = G_CONST_CHK_HHMM Then
                If intLength = 3 Or intLength = 4 Then
                    '3桁(HMM)・4桁(HHMM)ならﾁｪｯｸ
                    If intLength = 3 Then
                        strHour = fcheckNullString(Microsoft.VisualBasic.Left(strText, 1))
                        strMin = fcheckNullString(Microsoft.VisualBasic.Right(strText, 2))
                        strSec = "00"
                    Else
                        strHour = fcheckNullString(Microsoft.VisualBasic.Left(strText, 2))
                        strMin = fcheckNullString(Microsoft.VisualBasic.Right(strText, 2))
                        strSec = "00"
                    End If
                    intLength = 4
                Else
                    '桁数ｴﾗｰ
                    fCheckTime = False
                End If

            ElseIf mode = G_CONST_CHK_HHMMSS Then
                If intLength = 5 Or intLength = 6 Then
                    '5桁(HMMSS)・6桁(HHMMSS)ならﾁｪｯｸ
                    If intLength = 5 Then
                        strHour = fcheckNullString(Microsoft.VisualBasic.Left(strText, 1))
                        strMin = fcheckNullString(Microsoft.VisualBasic.Mid(strText, 2, 2))
                        strSec = fcheckNullString(Microsoft.VisualBasic.Right(strText, 2))
                    Else
                        strHour = fcheckNullString(Microsoft.VisualBasic.Left(strText, 2))
                        strMin = fcheckNullString(Microsoft.VisualBasic.Mid(strText, 3, 2))
                        strSec = fcheckNullString(Microsoft.VisualBasic.Right(strText, 2))
                    End If
                    intLength = 6
                Else
                    '桁数ｴﾗｰ
                    fCheckTime = False
                End If
            End If

            '時ﾁｪｯｸ
            If fCheckTime = True Then
                If IsNumeric(strHour) Then
                    If fcheckNullInt(strHour) >= 0 And fcheckNullInt(strHour) <= 23 Then
                        strTime = strHour.PadLeft(2, "0")
                    Else
                        '時ｴﾗｰ
                        fCheckTime = False
                    End If
                Else
                    fCheckTime = False
                End If
            End If

            '分ﾁｪｯｸ
            If fCheckTime = True Then
                If IsNumeric(strMin) Then
                    If fcheckNullInt(strMin) >= 0 And fcheckNullInt(strMin) <= 59 Then
                        strTime = strTime & strMin.PadLeft(2, "0")
                    Else
                        '分ｴﾗｰ
                        fCheckTime = False
                    End If
                Else
                    fCheckTime = False
                End If
            End If

            '秒ﾁｪｯｸ
            If fCheckTime = True Then
                If IsNumeric(strSec) Then
                    If fcheckNullInt(strSec) >= 0 And fcheckNullInt(strSec) <= 59 Then
                        strTime = strTime & strSec.PadLeft(2, "0")
                    Else
                        '分ｴﾗｰ
                        fCheckTime = False
                    End If
                Else
                    fCheckTime = False
                End If
            End If

            Return fCheckTime

        Catch ex As Exception
            fCheckTime = False
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fCheckIntZero
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Public Function fCheckIntZero(ByVal obj As System.Object, Optional ByVal min As System.Int64 = 0, Optional ByVal max As System.Int64 = -1) As System.Boolean

        fCheckIntZero = True

        Try
            '入力データが数値の場合
            If fCheckInt(obj, min, max) Then
                DirectCast(obj, TextBox).Text = DirectCast(obj, TextBox).Text.PadLeft(DirectCast(obj, TextBox).MaxLength(), "0")
            Else
                fCheckIntZero = False
                DirectCast(obj, TextBox).Focus()
                DirectCast(obj, TextBox).Text = ""
            End If
        Catch ex As Exception
            fCheckIntZero = False
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fCheckIntZeroSupless
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Public Function fCheckIntZeroSupless(ByVal obj As System.Object, Optional ByVal min As System.Int64 = 0, Optional ByVal max As System.Int64 = -1) As System.Boolean
        Dim wintText As System.Int64
        Dim wstrText As System.String

        fCheckIntZeroSupless = True

        Try
            '入力データが数値の場合
            If fCheckInt(obj, min, max) Then
                wintText = System.Convert.ToInt64(DirectCast(obj, TextBox).Text)
                wstrText = System.Convert.ToString(wintText)
                DirectCast(obj, TextBox).Text = wstrText
            Else '最大値が指定されていない場合
                fCheckIntZeroSupless = False
                DirectCast(obj, TextBox).Focus()
                DirectCast(obj, TextBox).Text = ""
            End If
        Catch ex As Exception
            fCheckIntZeroSupless = False
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fCheckIntZeroSuplessAll
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Public Function fCheckIntZeroSuplessAll(ByVal obj As System.Object, Optional ByVal min As System.Int64 = 0, Optional ByVal max As System.Int64 = -1) As System.Boolean
        Dim wintText As System.Int64
        Dim wstrText As System.String

        fCheckIntZeroSuplessAll = True

        Try
            '入力データが数値の場合
            If fCheckInt(obj, min, max) Then
                wintText = System.Convert.ToInt64(DirectCast(obj, TextBox).Text)
                wstrText = System.Convert.ToString(wintText)
                If wstrText = "0" Then
                    DirectCast(obj, TextBox).Text = ""
                Else
                    DirectCast(obj, TextBox).Text = wstrText
                End If
            Else '最大値が指定されていない場合
                fCheckIntZeroSuplessAll = False
                DirectCast(obj, TextBox).Focus()
                DirectCast(obj, TextBox).Text = ""
            End If
        Catch ex As Exception
            fCheckIntZeroSuplessAll = False
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fCheckDbl
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Public Function fCheckDbl(ByVal obj As System.Object, ByVal dot As System.Int16, Optional ByVal min As System.Double = 0.0, Optional ByVal max As System.Double = -1) As System.Boolean

        fCheckDbl = False
        If fCheckDbl(DirectCast(obj, TextBox).Text(), _
                     DirectCast(obj, TextBox).MaxLength, _
                     dot, min, max) Then
            fCheckDbl = True
        End If
    End Function

    '/*
    '|| 関数名：fCheckDbl
    '|| 概要      ：浮動小数点文字列チェック処理
    '|| 引数      ：True OK False NG 浮動小数点文字列
    '*/
    Public Function fCheckDbl(ByVal pstrDbl As String, ByVal pintMaxLength As Integer, ByVal dot As System.Int16, _
                              Optional ByVal min As System.Double = 0.0, _
                              Optional ByVal max As System.Double = -1) As Boolean
        Dim wdblValue As System.Double
        Dim wintBeams As System.Int16 '整数部桁数
        Dim wintDeciml As System.Int16  '小数部桁数
        Dim wintCnt As System.Int32
        Dim wintIndex As System.Int32
        Dim wdblMaxValue As System.Double
        Dim wdblTmp As System.Double

        fCheckDbl = True

        Try
            '整数部桁数を取得
            wintBeams = pintMaxLength - dot
            '小数点以下桁数を取得
            wintDeciml = dot - 1

            '最大値算出
            If max = -1 Then
                wdblMaxValue = 0
                wdblTmp = 0.9
                '小数点以下算出
                For wintIndex = 1 To wintDeciml
                    wdblMaxValue = wdblMaxValue + wdblTmp
                    wdblTmp = wdblTmp / 10
                Next

                wdblTmp = 9
                '整数部算出
                For wintIndex = 1 To wintBeams
                    wdblMaxValue = wdblMaxValue + wdblTmp
                    wdblTmp = wdblTmp * 10
                Next
            End If

            '入力データが数値の場合
            If Microsoft.VisualBasic.IsNumeric(pstrDbl) Then
                wdblValue = System.Convert.ToDouble(pstrDbl)
                '最小値チェック
                If min <= wdblValue Then
                    '最大値が指定されている場合
                    If max <> -1 Then
                        If max < wdblValue Then
                            fCheckDbl = False
                        End If
                    Else '最大値が指定されていない場合
                        If wdblMaxValue < wdblValue Then
                            fCheckDbl = False
                        End If

                    End If
                Else
                    fCheckDbl = False
                End If
            Else '入力データが数値でない場合はエラー
                fCheckDbl = False
            End If
        Catch ex As Exception
            fCheckDbl = False
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fCheckDblZeroSupless
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Function fCheckDblZeroSupless(ByVal obj As System.Object, ByVal dot As System.Int16, Optional ByVal min As System.Double = 0.0, Optional ByVal max As System.Double = -1) As Boolean
        Dim wstrValue As String

        fCheckDblZeroSupless = True

        wstrValue = fCheckDblZeroSuplessS(DirectCast(obj, TextBox).Text, DirectCast(obj, TextBox).MaxLength, dot, min, max)
        If wstrValue = "" Then
            fCheckDblZeroSupless = False
            DirectCast(obj, TextBox).Focus()
            DirectCast(obj, TextBox).Text = ""
        Else
            DirectCast(obj, TextBox).Text = wstrValue
        End If

    End Function

    '/*
    '|| 関数名：fCheckDblZeroSupless
    '|| 概要      ：TextBox数値入力チェック処理
    '|| 引数      ：obj テキストオブジェクト
    '*/
    Function fCheckDblZeroSuplessS(ByVal pstrNum As String, ByVal pintMaxLength As Integer, ByVal dot As System.Int16, _
                                  Optional ByVal min As System.Double = 0.0, Optional ByVal max As System.Double = -1) As String
        Dim wstrFormat As System.String
        Dim wstrFormat2 As System.String
        Dim wintBeams As System.Int16 '整数部桁数
        Dim wintDeciml As System.Int16  '小数部桁数
        Dim wdblValue As System.Double
        Dim wintIndex As System.Int32

        fCheckDblZeroSuplessS = ""

        Try
            If fCheckDbl(pstrNum, pintMaxLength, dot, min, max) Then
                '整数部桁数を取得
                wintBeams = pintMaxLength - dot
                '小数点以下桁数を取得
                wintDeciml = dot - 1

                wstrFormat = ""
                '小数点以下算出
                For wintIndex = 1 To wintDeciml
                    wstrFormat = wstrFormat + "0"
                Next

                wstrFormat = "0." & wstrFormat
                wintBeams = wintBeams - 1
                wstrFormat2 = ""
                '整数部算出
                For wintIndex = 1 To wintBeams
                    wstrFormat2 = wstrFormat2 + "#"
                Next
                wstrFormat = wstrFormat2 + wstrFormat
                wdblValue = System.Convert.ToDouble(pstrNum)
                fCheckDblZeroSuplessS = wdblValue.ToString(wstrFormat)
            Else '最大値が指定されていない場合
                fCheckDblZeroSuplessS = ""
            End If
        Catch ex As Exception
            fCheckDblZeroSuplessS = ""
            Return False
        End Try
    End Function

    '/*
    '|| 関数名：fChkOpenText
    '|| 概要  ：ファイルオープン確認
    '*/
    Public Function fChkOpenText(ByVal pstrFileName As String) As Boolean
        Dim wintFileNum As Integer

        Try

            'wintFileNum = FreeFile() ' フリーのファイルナンバーを取得

            'ファイルのオープン
            'FileOpen(wintFileNum, pstrFileName, OpenMode.Input)

            ''ファイルのクローズ
            'FileClose(wintFileNum)

            'fChkOpenText = True

            Try
                ' Open the file in append mode
                Using writer As StreamWriter = New StreamWriter(pstrFileName, True)
                    ' Write the record to the file
                    'writer.WriteLine(wstrRecord)
                End Using

                fChkOpenText = True

            Catch ex As Exception
                ' Handle any potential exceptions here
                MessageBox.Show("An error occurred while writing to the log file: " & ex.Message)
                fChkOpenText = False
            End Try

            Exit Function

        Catch ex As Exception
            fChkOpenText = False
        End Try

    End Function

    '/*
    '|| 関数名：fChkOpenRecord
    '|| 概要  ：オープンレコードチェック処理
    '|| 引数  ：clsDB,    clsDBAccess, DBオブジェクト
    '||       ：pstrtbl,  String,      テーブル名
    '||       ：pstrkey,  String,      インデックス名
    '||       ：pintMode, Integer,     メッセージボックス表示
    '*/
    'Public Function fChkOpenRecord(ByVal clsDB As clsDBAccess, ByVal pstrtbl As String, ByVal pstrkey As String, Optional ByVal pintMode As Integer = 1) As Boolean

    '    Dim wintcnt As Integer

    '    fChkOpenRecord = False

    '    Try
    '        wintcnt = clsDB.fOpenRecord(pstrtbl, pstrkey, "CHK")
    '        If wintcnt = -1 Then
    '            If pintMode = 3 Then
    '                '4秒後に閉じるDBエラーメッセージボックス
    '                'fFnc_Msg("", "3", "", "DB Error.", "3", "S")
    '            Else
    '                'DB接続エラーの場合（開発用）
    '                MsgBox("DB Error.")
    '                Exit Function
    '            End If
    '        End If

    '        clsDB.fCloseRecord("CHK")
    '        fChkOpenRecord = True

    '        Exit Function

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fChkOpenRecord", ex.ToString)
    '    End Try
    'End Function

    '/*
    '|| 関数名：fGetIniData
    '|| 概要  ：アプリケーションの初期処理を行います（PICSI用）
    '|| 引数  ：pstrPrgID    String  起動プログラムID（拡張子無し)
    '|| 引数  ：pstrIniName  String  処理中のINIﾌｧｲﾙ名
    '*/
    Public Function fGetIniData(ByVal pstrPrgID As String, ByRef pstrIniName As String) As Boolean

        fGetIniData = False

        gAppName = fGetAppName()
        pstrIniName = G_CONST_PICSINI

        '// 二重起動の防止
        'gobjMutex = New System.Threading.Mutex(False, gAppName)
        'If gobjMutex.WaitOne(0, False) = False Then
        'Application.Exit()
        'End If

        '// PICS.INIﾌｧｲﾙ読み込み
        'If Dir(fgetAppPath() & G_CONST_PICSINI) = "" Then Exit Function

        If Not FileExistsInAppDirectory(G_CONST_PICSINI) Then
            Exit Function ' Exit the function if the file does not exist
        End If


        If fGetIniPics() = False Then Exit Function


        '// PICSPARAM.INIﾌｧｲﾙ読み込み
        pstrIniName = G_CONST_PARAMINI
        'If Dir(fgetAppPath() & G_CONST_PICSINI) = "" Then Exit Function
        If Not FileExistsInAppDirectory(G_CONST_PICSINI) Then
            Exit Function ' Exit the function if the file does not exist
        End If

        'If fGetIniParam(pstrPrgID) = False Then Exit Function

        '// 起動ﾓｰﾄﾞｾｯﾄ
        If gstrctParamIni.intKeyCount = 0 Then
            gintAppMode = G_CONST_APP_NEW
        Else
            gintAppMode = G_CONST_APP_UPD
        End If

        fGetIniData = True

    End Function

    ' Function to check if a file exists in the application directory
    Public Function FileExistsInAppDirectory(ByVal fileName As String) As Boolean
        Dim appPath As String = fgetAppPath() ' Assuming fgetAppPath() retrieves the application directory
        Dim filePath As String = Path.Combine(appPath, fileName)

        Return File.Exists(filePath)
    End Function

    '/*
    '|| 関数名：fSerch_File
    '|| 概要  ：ファイルパス検索処理
    '|| 引数  ：wstrPath, String, パス名
    '*/
    Public Function fSerch_File(ByVal ParamArray wstrPath() As String) As Boolean
        Dim strGetPath As String
        Dim i As Integer
        Dim wMessage As String

        fSerch_File = False

        'パスチェック
        For i = 0 To UBound(wstrPath)
            'strGetPath = Dir(wstrPath(i), FileAttribute.Normal)

            If Not FileExistsInAppDirectory(wstrPath(i)) Then
                'Exit Function ' Exit the function if the file does not exist
                strGetPath = ""
            Else
                strGetPath = wstrPath(i)
            End If

            If strGetPath = "" Then
                wMessage = "File not found (*" & wstrPath(i) & "*)"
                'fFnc_Msg("0103", "1", , wMessage, "3", "S")
                Exit Function
            End If
        Next

        fSerch_File = True

    End Function

    '/*
    '|| 関数名：fOpenDB
    '|| 概要  ：DB接続処理
    '|| 引数  ：pclsDB,     clsDBAccess, DBクラス
    '||       ：pstrDbPath, String,      パス名
    '*/
    'Public Function fOpenDB(ByVal pstrDbPath As String) As Boolean


    '    Dim wstrImage As String
    '    fOpenDB = False

    '    'DB接続
    '    If gclsDB.fOpenDB(pstrDbPath) = False Then
    '        sErrLog(gAppName, "fOpenDB", gclsDB.ErrMsg)
    '        'MsgBox("DB OPEN ERROR", MsgBoxStyle.Critical)
    '        Exit Function
    '    End If

    '    fOpenDB = True

    'End Function

    '*******************************************************************************
    '* 機能     : 指定された変換ﾊﾟﾀｰﾝに従って、ｺｰﾄﾞを表示用ｺｰﾄﾞに変換します
    '* 引数     : pintPat        Integer 変換ﾊﾟﾀｰﾝ
    '           : pstrCode       String  変換元ｺｰﾄﾞ
    '* 戻り値   : 変換後表示用文字列 String
    '* 備考     : なし
    '*******************************************************************************
    Public Function fDispItemChg(ByVal pintPat As DispItemChg, ByVal pstrCode As String) As String
        Dim wstrDispCode As String

        wstrDispCode = ""
        Select Case pintPat
            '// 変換なし
        Case 0 : wstrDispCode = pstrCode
                '// ﾏﾂﾀﾞ変換
            Case 1 : wstrDispCode = fChgMazda(pintPat, pstrCode)
        End Select
        Return wstrDispCode

    End Function
    '*******************************************************************************
    '* マツダ変換
    '*******************************************************************************
    Private Function fChgMazda(ByVal pintPat As DispItemChg, ByVal pstrCode As String) As String
        '・ 部品番号の1桁目が“9”の場合
        '    先頭が5文字(+"-" + 後ろ5文字)
        '　　「9123456780」⇒“91234-56780”
        '    ・上記以外の場合()
        '     6文字目から4桁+ “-” +1文字目から2桁 + "-”+ 3文字目から3桁 + 10文字目から1桁 + " " +
        '     11文字目 + 12文字目 + " " +13文字目以降
        '　　「1234567890ABC」⇒“6789-12-345-0 AB C ”  ※13桁目以降はﾊｲﾌﾝなしで末尾にすべて付加する
        Dim wstrChg As String
        Dim wstrArray(30) As String
        Dim i As Integer

        wstrChg = ""

        '// 配列にｾｯﾄ
        For i = 1 To 30
            wstrArray(i) = Mid(pstrCode, i, 1)
        Next

        If wstrArray(1) = "9" Then
            wstrChg = wstrArray(1) & wstrArray(2) & wstrArray(3) & wstrArray(4) & wstrArray(5) & "-" & _
                      wstrArray(6) & wstrArray(7) & wstrArray(8) & wstrArray(9) & wstrArray(10) & _
                      wstrArray(11) & wstrArray(12) & wstrArray(13) & wstrArray(14) & wstrArray(15) & _
                      wstrArray(16) & wstrArray(17) & wstrArray(18) & wstrArray(19) & wstrArray(20) & _
                      wstrArray(21) & wstrArray(22) & wstrArray(23) & wstrArray(24) & wstrArray(25) & _
                      wstrArray(26) & wstrArray(27) & wstrArray(28) & wstrArray(29) & wstrArray(30)
        Else
            wstrChg = wstrArray(6) & wstrArray(7) & wstrArray(8) & wstrArray(9) & "-" & _
                      wstrArray(1) & wstrArray(2) & "-" & _
                      wstrArray(3) & wstrArray(4) & wstrArray(5) & wstrArray(10) & " " & _
                      wstrArray(11) & wstrArray(12) & " " & _
                      wstrArray(13) & wstrArray(14) & wstrArray(15) & _
                      wstrArray(16) & wstrArray(17) & wstrArray(18) & wstrArray(19) & wstrArray(20) & _
                      wstrArray(21) & wstrArray(22) & wstrArray(23) & wstrArray(24) & wstrArray(25) & _
                      wstrArray(26) & wstrArray(27) & wstrArray(28) & wstrArray(29) & wstrArray(30)
        End If

        Return wstrChg
    End Function

    '*******************************************************************************
    '* 機能     : 表示用ｺｰﾄﾞを通常ｺｰﾄﾞに変換します
    '* 引数     : pstrCode       String  変換元ｺｰﾄﾞ
    '           :
    '* 戻り値   : 変換後表示用文字列 String
    '* 備考     : なし
    '*******************************************************************************
    Public Function fBackDispItem(ByVal pstrCode As String, Optional ByVal pbolNoSep As Boolean = False) As String
        Dim wstrChg As String
        Dim wstrArray(34) As String
        Dim wintCnt As Integer
        Dim i As Integer

        wstrChg = ""

        '// 配列にｾｯﾄ
        For i = 1 To 34
            wstrArray(i) = Mid(pstrCode, i, 1)
            If wstrArray(i) = "-" Then wintCnt = wintCnt + 1
        Next

        'コード変換
        If wintCnt = 1 Then
            wstrChg = wstrArray(1) & wstrArray(2) & wstrArray(3) & wstrArray(4) & wstrArray(5) & _
                      wstrArray(7) & wstrArray(8) & wstrArray(9) & wstrArray(10) & wstrArray(11) & _
                      wstrArray(12) & wstrArray(13) & wstrArray(14) & wstrArray(15) & wstrArray(16) & _
                      wstrArray(17) & wstrArray(18) & wstrArray(19) & wstrArray(20) & wstrArray(21) & _
                      wstrArray(22) & wstrArray(23) & wstrArray(24) & wstrArray(25) & wstrArray(26) & _
                      wstrArray(27) & wstrArray(28) & wstrArray(29) & wstrArray(30) & wstrArray(31)
        ElseIf wintCnt = 2 Then
            wstrChg = wstrArray(6) & wstrArray(7) & wstrArray(9) & wstrArray(10) & wstrArray(11) & _
                      wstrArray(1) & wstrArray(2) & wstrArray(3) & wstrArray(4) & wstrArray(12) & _
                      wstrArray(14) & wstrArray(15) & wstrArray(17) & wstrArray(18) & wstrArray(19) & _
                      wstrArray(20) & wstrArray(21) & wstrArray(22) & wstrArray(23) & wstrArray(24) & _
                      wstrArray(25) & wstrArray(26) & wstrArray(27) & wstrArray(28) & wstrArray(29) & _
                      wstrArray(30) & wstrArray(31) & wstrArray(32) & wstrArray(33) & wstrArray(34)
        Else
            If pbolNoSep Then
                If wstrArray(1) = "9" Then
                    wstrChg = wstrArray(1) & wstrArray(2) & wstrArray(3) & wstrArray(4) & wstrArray(5) & _
                              wstrArray(6) & wstrArray(7) & wstrArray(8) & wstrArray(9) & wstrArray(10) & _
                              wstrArray(11) & wstrArray(12) & wstrArray(13) & wstrArray(14) & wstrArray(15) & _
                              wstrArray(16) & wstrArray(17) & wstrArray(18) & wstrArray(19) & wstrArray(20) & _
                              wstrArray(21) & wstrArray(22) & wstrArray(23) & wstrArray(24) & wstrArray(25) & _
                              wstrArray(26) & wstrArray(27) & wstrArray(28) & wstrArray(29) & wstrArray(30)
                Else
                    wstrChg = wstrArray(5) & wstrArray(6) & wstrArray(7) & wstrArray(8) & wstrArray(9) & _
                              wstrArray(1) & wstrArray(2) & wstrArray(3) & wstrArray(4) & wstrArray(10) & _
                              wstrArray(11) & wstrArray(12) & wstrArray(13) & wstrArray(14) & wstrArray(15) & _
                              wstrArray(16) & wstrArray(17) & wstrArray(18) & wstrArray(19) & wstrArray(20) & _
                              wstrArray(21) & wstrArray(22) & wstrArray(23) & wstrArray(24) & wstrArray(25) & _
                              wstrArray(26) & wstrArray(27) & wstrArray(28) & wstrArray(29) & wstrArray(30)
                End If
            Else
                wstrChg = pstrCode
            End If
        End If

        fBackDispItem = wstrChg

        Return wstrChg
    End Function

    '*******************************************************************************
    '   概要：出荷ﾀｲﾌﾟの値をTBLより取得し初期値としてComboBoxに設定させる処理
    '   ﾊﾟﾗﾒｰﾀ：obj ｺﾝﾎﾞﾎﾞｯｸｽｵﾌﾞｼﾞｪｸﾄ
    '   戻り値：なし
    '*******************************************************************************
    'Public Sub sGetPicsType(ByVal obj As System.Object)
    '    Dim strText As String

    '    '対象ﾃｰﾌﾞﾙ検索(出荷ﾀｲﾌﾟ)
    '    If gclsDB.fOpenRecord("PICSTYPE", "PICSTYPEKEY00", "TBL1") = -1 Then
    '        'DB接続エラーの場合（開発用）
    '        MsgBox("DB Error.")
    '        Exit Sub
    '    End If

    '    '対象ﾚｺｰﾄﾞ検索
    '    With gclsDB.Records("TBL1")
    '        Do
    '            If .Item("Permit") = "1" Then         '使用可のもののみ対象とする
    '                DirectCast(obj, ComboBox).Items.Add(.Item("PicsType"))  '出荷ﾀｲﾌﾟ
    '            End If
    '            '次レコードを取得する
    '            If .Read(BtLib.Operation.GetNext) <> 0 Then
    '                'レコードがなくなれば終了する
    '                Exit Do
    '            End If
    '        Loop
    '        gclsDB.fCloseRecord("TBL1")
    '    End With

    'End Sub

    '*******************************************************************************
    '   概要：ｶｽﾀﾏｰﾀｲﾌﾟのｶｽﾀﾏｰIDをTBLより取得し初期値としてComboBoxに設定させる処理
    '   ﾊﾟﾗﾒｰﾀ：obj ｺﾝﾎﾞﾎﾞｯｸｽｵﾌﾞｼﾞｪｸﾄ
    '   戻り値：なし
    '*******************************************************************************
    'Public Sub sGetCustType(ByVal obj As System.Object, Optional ByVal pstrPicsType As String = "")
    '    Dim strText As String
    '    Dim wbulF As Boolean

    '    '対象ﾃｰﾌﾞﾙ検索(出荷ﾀｲﾌﾟ)
    '    If gclsDB.fOpenRecord(G_CONST_TBL_CUSTTYPE, G_CONST_KEY_CUSTTYPEKEY00, "TBL1") = -1 Then
    '        'DB接続エラーの場合（開発用）
    '        MsgBox("DB Error.")
    '        Exit Sub
    '    End If

    '    '対象ﾚｺｰﾄﾞ検索
    '    With gclsDB.Records("TBL1")
    '        Do
    '            wbulF = True
    '            If pstrPicsType <> "" Then
    '                If .Item("PicsType") <> pstrPicsType Then
    '                    wbulF = False
    '                End If
    '            End If

    '            If wbulF Then
    '                DirectCast(obj, ComboBox).Items.Add(.Item("CstmId"))  '出荷ﾀｲﾌﾟ
    '            End If

    '            If .Read(BtLib.Operation.GetNext) <> 0 Then
    '                'レコードがなくなれば終了する
    '                Exit Do
    '            End If
    '        Loop
    '        gclsDB.fCloseRecord("TBL1")
    '    End With

    'End Sub

    '*******************************************************************************
    '   概要：部品庫の値をTBLより取得し初期値としてComboBoxに設定させる処理
    '   ﾊﾟﾗﾒｰﾀ：obj ｺﾝﾎﾞﾎﾞｯｸｽｵﾌﾞｼﾞｪｸﾄ
    '   戻り値：なし
    '*******************************************************************************
    'Public Sub sGetBhk(ByVal obj As System.Object)
    '    Dim strText As String

    '    '対象ﾃｰﾌﾞﾙ検索(部品庫)
    '    If gclsDB.fOpenRecord("RL2RL", "RL2RLKEY00", "TBL1") = -1 Then
    '        'DB接続エラーの場合（開発用）
    '        MsgBox("DB Error.")
    '        Exit Sub
    '    End If

    '    '対象ﾚｺｰﾄﾞ検索
    '    With gclsDB.Records("TBL1")
    '        Do
    '            DirectCast(obj, ComboBox).Items.Add(.Item("ChgBhk"))  '部品庫

    '            '次レコードを取得する
    '            If .Read(BtLib.Operation.GetNext) <> 0 Then
    '                'レコードがなくなれば終了する
    '                Exit Do
    '            End If
    '        Loop
    '        gclsDB.fCloseRecord("TBL1")
    '    End With

    'End Sub

    '*******************************************************************************
    '   概要：Spreadの行選択を行う
    '   ﾊﾟﾗﾒｰﾀ：pobjSpread  Spreadｵﾌﾞｼﾞｪｸﾄ
    '         ：pintRow     選択行
    '   戻り値：なし
    '*******************************************************************************
    'Public Sub sCellColorChg(ByVal pobjSpread As Object, ByVal pintRow As Long)
    '    Dim i As Integer
    '    Dim j As Integer

    '    With pobjSpread.ActiveSheet
    '        For i = 0 To .RowCount - 1
    '            For j = 0 To .ColumnCount - 1
    '                .Cells(i, j).BackColor = Color.White
    '                .Cells(i, j).ForeColor = Color.Black
    '            Next j
    '        Next i
    '        For j = 0 To .ColumnCount - 1
    '            .Cells(pintRow, j).BackColor = Color.Navy
    '            .Cells(pintRow, j).ForeColor = Color.White
    '        Next j
    '    End With

    'End Sub

    '*******************************************************************************
    '   概要  ：小数点付数値文字列をDB登録用文字列に編集し返却する
    '   ﾊﾟﾗﾒｰﾀ：pstrDbl     小数点付数値文字列
    '         ：pintPadCnt  ｾﾞﾛ埋桁数
    '   戻り値：DB登録用文字列 ( 99.99 ⇒ 00999900 )
    '*******************************************************************************
    Public Function fDblToDBString(ByVal pstrDbl As String, ByVal pintPadCnt As Integer) As String
        Dim wstrValue As String

        wstrValue = pstrDbl.Replace(".", "").PadLeft(pintPadCnt, "0")
        fDblToDBString = wstrValue

    End Function

    '*******************************************************************************
    '   概要  ：DB登録用文字列を小数点付数値文字列に編集し返却する
    '   ﾊﾟﾗﾒｰﾀ：pstrDbl     DB登録用文字列
    '         ：pintIntCnt  整数部桁数
    '         ：pintDecCnt  小数部桁数
    '   戻り値：DB登録用文字列 ( 00999900⇒ 99.99 )
    '*******************************************************************************
    Public Function fDBStringToDbl(ByVal pstrDbl As String, ByVal pintIntCnt As Integer, ByVal pintDecCnt As Integer) As String
        Dim wstrValue As String

        wstrValue = Microsoft.VisualBasic.Left(pstrDbl, pintIntCnt) & "." & Microsoft.VisualBasic.Right(pstrDbl, pintDecCnt)
        fDBStringToDbl = fCheckDblZeroSuplessS(wstrValue, pintIntCnt + pintDecCnt + 1, pintDecCnt + 1)

    End Function

    '*******************************************************************************
    '   概要  ：ｾﾞﾛ埋め数値文字列を画面表示用文字列に編集し返却する
    '   ﾊﾟﾗﾒｰﾀ：pstrData    ｾﾞﾛ埋数値文字列
    '         ：pintPadCnt  ｾﾞﾛ埋桁数
    '   戻り値：DB登録用文字列 ( 00999 ⇒ 999 )
    '*******************************************************************************
    Public Function fIntZerosapress(ByVal pstrData As String) As String
        Dim wstrValue As String
        Dim wlngData As Long

        wlngData = CLng(pstrData)
        wstrValue = wlngData.ToString("#0")
        fIntZerosapress = wstrValue

    End Function

    '*******************************************************************************
    '   概要  ：ｷｰ入力値の制限を行う
    '   ﾊﾟﾗﾒｰﾀ：pstrChr     入力文字
    '         ：pintMode    制限(KEY)
    '   戻り値：True 規定外  
    '*******************************************************************************
    Public Function sKeyPress(ByVal pstrChr As Char, ByVal pintMode As KEY) As Boolean
        sKeyPress = False
        Select Case pintMode
            Case KEY.Number
                If (pstrChr < "0"c Or pstrChr > "9"c) And _
                    pstrChr <> vbBack Then
                    sKeyPress = True
                End If
            Case KEY.Alpha
                If (pstrChr < "a"c Or pstrChr > "z"c) And _
                   (pstrChr < "A"c Or pstrChr > "Z"c) And _
                    pstrChr <> vbBack Then
                    sKeyPress = True
                End If
            Case KEY.NumAlpha
                If (pstrChr < "0"c Or pstrChr > "9"c) And _
                   (pstrChr < "a"c Or pstrChr > "z"c) And _
                   (pstrChr < "A"c Or pstrChr > "Z"c) And _
                    pstrChr <> vbBack Then
                    sKeyPress = True
                End If
            Case KEY.TelPost
                If (pstrChr < "0"c Or pstrChr > "9"c) And _
                    pstrChr <> vbBack And pstrChr <> "-"c Then
                    sKeyPress = True
                End If
            Case KEY.NumberDec
                If (pstrChr < "0"c Or pstrChr > "9"c) And _
                    pstrChr <> vbBack And pstrChr <> "."c Then
                    sKeyPress = True
                End If
            Case KEY.DateShift
                If (pstrChr < "0"c Or pstrChr > "9"c) And _
                    pstrChr <> "d"c And pstrChr <> "n"c And _
                    pstrChr <> "D"c And pstrChr <> "N"c And _
                    pstrChr <> vbBack Then
                    sKeyPress = True
                End If
        End Select
    End Function

    '*******************************************************************************
    '   概要  ：ﾌｧｲﾙﾊﾟｽを生成する
    '   ﾊﾟﾗﾒｰﾀ：pstrDir     ﾃﾞｨﾚｸﾄﾘ
    '         ：pstrFile    ﾌｧｲﾙ名
    '   戻り値：ﾊﾟｽ
    '*******************************************************************************
    Public Function fMakeFilePath(ByVal pstrDir As String, ByVal pstrFile As String) As String
        Dim wstrPath As String

        wstrPath = pstrDir
        If Microsoft.VisualBasic.Right(wstrPath, 1) <> "" Then wstrPath &= "\"
        Return wstrPath & pstrFile

    End Function

    '*******************************************************************************
    '   概要：部品庫の値をTBLより取得し初期値としてComboBoxに設定させる処理
    '   ﾊﾟﾗﾒｰﾀ：obj ｺﾝﾎﾞﾎﾞｯｸｽｵﾌﾞｼﾞｪｸﾄ
    '   戻り値：なし
    '*******************************************************************************
    'Public Sub sGetCenterCode(ByVal obj As System.Object)
    '    Dim strText As String

    '    '対象ﾃｰﾌﾞﾙ検索(ｾﾝﾀｰｺｰﾄﾞ)
    '    If gclsDB.fOpenRecord("CENTER", "CENTERKEY00", "TBL1") = -1 Then
    '        'DB接続エラーの場合（開発用）
    '        MsgBox("DB Error.")
    '        Exit Sub
    '    End If
    '    '対象ﾚｺｰﾄﾞ検索
    '    With gclsDB.Records("TBL1")
    '        Do
    '            DirectCast(obj, ComboBox).Items.Add(.Item("CenterCode"))  '部品庫

    '            '次レコードを取得する
    '            If .Read(BtLib.Operation.GetNext) <> 0 Then
    '                'レコードがなくなれば終了する
    '                Exit Do
    '            End If
    '        Loop
    '        gclsDB.fCloseRecord("TBL1")
    '    End With


    'End Sub

    '*******************************************************************************
    '   概要：LN2RLを読み、ﾒﾓﾘに展開する
    '   ﾊﾟﾗﾒｰﾀ：pstrctLN2RL LN2RL構造体
    '   戻り値：True/False
    '*******************************************************************************
    'Public Function fLN2RL_Set(ByRef pstrctLN2RL() As LN2RL_STR) As Boolean
    '    Dim wstrSql As String
    '    Dim wlngCnt As Long
    '    Dim i As Long
    '    Const Key1 = "LN2RL"

    '    fLN2RL_Set = False
    '    Try
    '        wlngCnt = gclsDB.fOpenRecord(G_CONST_TBL_PRESETBHK, G_CONST_KEY_PRESETBHKKEY00, Key1)
    '        If wlngCnt = -1 Then
    '            'DB接続エラーの場合
    '            Exit Function
    '        End If

    '        If wlngCnt = 0 Then
    '            i = 0
    '            Do
    '                ReDim Preserve pstrctLN2RL(i)
    '                pstrctLN2RL(i).PackLine = gclsDB.Records(Key1).Item("PackLine")
    '                pstrctLN2RL(i).PreBhk = gclsDB.Records(Key1).Item("PreBhk")
    '                If gclsDB.Records(Key1).Read(BtLib.Operation.GetNext) = 9 Then
    '                    Exit Do
    '                End If
    '                i += 1
    '            Loop
    '            fLN2RL_Set = True
    '        End If
    '        gclsDB.fCloseRecord(Key1)

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fLN2RL_Set", ex.Message)

    '    End Try

    'End Function

    '*******************************************************************************
    '   概要：ﾒﾓﾘ上のLR2RNから該当ﾃﾞｰﾀを取得する
    '   ﾊﾟﾗﾒｰﾀ：pstrPackLine 検索値
    '         ：pstrctLN2RL  LN2RL構造体
    '   戻り値：検索結果　該当無しの場合は空白
    '*******************************************************************************
    Public Function fLN2RL_Serch(ByVal pstrPackLine As String, ByVal pstrctLN2RL() As LN2RL_STR, ByRef pintIndex As Integer) As String
        Dim wstrSql As String
        Dim wlngCnt As Long
        Dim i As Long

        fLN2RL_Serch = ""
        Try
            For i = 0 To UBound(pstrctLN2RL)
                If pstrctLN2RL(i).PackLine = pstrPackLine Then
                    pintIndex = i
                    fLN2RL_Serch = pstrctLN2RL(i).PreBhk
                    Exit Function
                End If
            Next

        Catch ex As Exception
            sErrLog(gAppName, "fLN2RL_Serch", ex.Message)

        End Try

    End Function

    '*******************************************************************************
    '   概要：RN2RLを読み、ﾒﾓﾘに展開する
    '   ﾊﾟﾗﾒｰﾀ：pstrctRN2RL RN2RL構造体
    '   戻り値：True/False
    '*******************************************************************************
    'Public Function fRL2RL_Set(ByRef pstrctRL2RL() As RL2RL_STR) As Boolean
    '    Dim wstrSql As String
    '    Dim wlngCnt As Long
    '    Dim i As Long
    '    Const Key1 = "RL2RL"

    '    fRL2RL_Set = False
    '    Try
    '        wlngCnt = gclsDB.fOpenRecord(G_CONST_TBL_RL2RL, G_CONST_KEY_RL2RLKEY00, Key1)
    '        If wlngCnt = -1 Then
    '            'DB接続エラーの場合
    '            Exit Function
    '        End If

    '        If wlngCnt = 0 Then
    '            i = 0
    '            Do
    '                ReDim Preserve pstrctRL2RL(i)
    '                pstrctRL2RL(i).Bhk = gclsDB.Records(Key1).Item("Bhk")
    '                pstrctRL2RL(i).ChgBhk = gclsDB.Records(Key1).Item("ChgBhk")
    '                pstrctRL2RL(i).CenterCode = gclsDB.Records(Key1).Item("CenterCode")
    '                If gclsDB.Records(Key1).Read(BtLib.Operation.GetNext) = 9 Then
    '                    Exit Do
    '                End If
    '                i += 1
    '            Loop
    '            fRL2RL_Set = True
    '        End If
    '        gclsDB.fCloseRecord(Key1)

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fRL2RL_Set", ex.Message)

    '    End Try

    'End Function

    '*******************************************************************************
    '   概要：ﾒﾓﾘ上のRL2RLから該当ﾃﾞｰﾀを取得する
    '   ﾊﾟﾗﾒｰﾀ：pstrBhk      検索値
    '         ：pstrctRL2RL  RL2RL構造体
    '   戻り値：検索結果　該当無しの場合は空白
    '*******************************************************************************
    Public Function fRL2RL_Serch(ByVal pstrBhk As String, ByVal pstrctRL2RL() As RL2RL_STR, ByRef pintIndex As Integer) As String
        Dim wstrSql As String
        Dim wlngCnt As Long
        Dim i As Long

        fRL2RL_Serch = ""
        Try
            For i = 0 To UBound(pstrctRL2RL)
                If pstrctRL2RL(i).Bhk = pstrBhk Then
                    pintIndex = i
                    fRL2RL_Serch = pstrctRL2RL(i).ChgBhk
                    Exit Function
                End If
            Next

        Catch ex As Exception
            sErrLog(gAppName, "fRL2RL_Serch", ex.Message)

        End Try

    End Function

    '*******************************************************************************
    '   概要：LN2LNを読み、ﾒﾓﾘに展開する
    '   ﾊﾟﾗﾒｰﾀ：pstrctRN2RL RN2RL構造体
    '   戻り値：True/False
    '*******************************************************************************
    'Public Function fLN2LN_Set(ByRef pstrctLN2LN() As LN2LN_STR) As Boolean
    '    Dim wstrSql As String
    '    Dim wlngCnt As Long
    '    Dim i As Long
    '    Const Key1 = "LN2LN"

    '    fLN2LN_Set = False
    '    Try
    '        wlngCnt = gclsDB.fOpenRecord(G_CONST_TBL_LN2LN, G_CONST_KEY_LN2LNKEY00, Key1)
    '        If wlngCnt = -1 Then
    '            'DB接続エラーの場合
    '            Exit Function
    '        End If

    '        If wlngCnt = 0 Then
    '            i = 0
    '            Do
    '                ReDim Preserve pstrctLN2LN(i)
    '                pstrctLN2LN(i).PackLine = gclsDB.Records(Key1).Item("PackLine")
    '                pstrctLN2LN(i).ChgPackLine = gclsDB.Records(Key1).Item("ChgPackLine")
    '                pstrctLN2LN(i).CenterCode = gclsDB.Records(Key1).Item("CenterCode")
    '                pstrctLN2LN(i).CalFlag = gclsDB.Records(Key1).Item("CalFlag")
    '                If gclsDB.Records(Key1).Read(BtLib.Operation.GetNext) = 9 Then
    '                    Exit Do
    '                End If
    '                i += 1
    '            Loop
    '            fLN2LN_Set = True
    '        End If
    '        gclsDB.fCloseRecord(Key1)

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fLN2LN_Set", ex.Message)

    '    End Try

    'End Function

    '*******************************************************************************
    '   概要：ﾒﾓﾘ上のLN2LNから該当ﾃﾞｰﾀを取得する
    '   ﾊﾟﾗﾒｰﾀ：pstrBhk      検索値
    '         ：pstrctLN2LN  LN2LN構造体
    '   戻り値：検索結果　該当無しの場合は空白
    '*******************************************************************************
    Public Function fLN2LN_Serch(ByVal pstrPackLine As String, ByVal pstrctLN2LN() As LN2LN_STR, ByRef pintIndex As Integer) As String
        Dim wstrSql As String
        Dim wlngCnt As Long
        Dim i As Long

        fLN2LN_Serch = ""
        Try
            For i = 0 To UBound(pstrctLN2LN)
                If pstrctLN2LN(i).PackLine = pstrPackLine Then
                    pintIndex = i
                    fLN2LN_Serch = pstrctLN2LN(i).ChgPackLine
                    Exit Function
                End If
            Next

        Catch ex As Exception
            sErrLog(gAppName, "fLN2LN_Serch", ex.Message)

        End Try

    End Function

    '*******************************************************************************
    '   概要：IDCNVを読み、ﾒﾓﾘに展開する
    '   ﾊﾟﾗﾒｰﾀ：pstrctIDCNV  IDCNV構造体
    '   戻り値：True/False
    '*******************************************************************************
    'Public Function fIDCNV_Set(ByRef pstrctIDCNV() As IDCNV_STR) As Boolean
    '    Dim wstrSql As String
    '    Dim wlngCnt As Long
    '    Dim i As Long
    '    Const Key1 = "IDCNV"

    '    fIDCNV_Set = False
    '    Try
    '        wlngCnt = gclsDB.fOpenRecord(G_CONST_TBL_IDCNV, G_CONST_KEY_IDCNVKEY00, Key1)
    '        If wlngCnt = -1 Then
    '            'DB接続エラーの場合
    '            Exit Function
    '        End If

    '        If wlngCnt = 0 Then
    '            i = 0
    '            Do
    '                ReDim Preserve pstrctIDCNV(i)
    '                pstrctIDCNV(i).Code = gclsDB.Records(Key1).Item("Code")
    '                pstrctIDCNV(i).Znc = gclsDB.Records(Key1).Item("Znc")
    '                If gclsDB.Records(Key1).Read(BtLib.Operation.GetNext) = 9 Then
    '                    Exit Do
    '                End If
    '                i += 1
    '            Loop
    '            fIDCNV_Set = True
    '        End If
    '        gclsDB.fCloseRecord(Key1)

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fIDCNV_Set", ex.Message)

    '    End Try

    'End Function

    '*******************************************************************************
    '   概要：ﾒﾓﾘ上のIDCNVから該当ﾃﾞｰﾀを取得する
    '   ﾊﾟﾗﾒｰﾀ：pstrCode     検索値
    '         ：pstrctIDCNV  IDCNV構造体
    '   戻り値：検索結果　該当無しの場合は空白
    '*******************************************************************************
    Public Function fIDCNV_Serch(ByVal pstrCode As String, ByVal pstrctIDCNV() As IDCNV_STR, ByRef pintIndex As Integer) As String
        Dim wstrSql As String
        Dim wlngCnt As Long
        Dim i As Long

        fIDCNV_Serch = ""
        Try
            For i = 0 To UBound(pstrctIDCNV)
                If pstrctIDCNV(i).Code = pstrCode Then
                    fIDCNV_Serch = pstrctIDCNV(i).Znc
                    Exit Function
                End If
            Next

        Catch ex As Exception
            sErrLog(gAppName, "fIDCNV_Serch", ex.Message)

        End Try

    End Function

    '*******************************************************************************
    '   概要  ：ﾌﾟﾘﾌｨｯｸｽ、ｻﾌｨｯｸｽ、ﾁｪｯｸﾃﾞｼﾞｯﾄを付加した文字列を返す
    '   ﾊﾟﾗﾒｰﾀ：pstrCode    String      バーコード
    '   戻り値：ﾌﾟﾘﾌｨｯｸｽ、ｻﾌｨｯｸｽ、ﾁｪｯｸﾃﾞｼﾞｯﾄを付加した文字列
    '*******************************************************************************
    Public Function fConvBarcode(ByVal pstrCode As String) As String
        Const c_MOJ43 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*"    'ﾓｼﾞｭﾗｽ43
        Dim wlngAll As Long
        Dim wlngBar As Long
        Dim wlngMoju43 As Long
        Dim wstrMojuCd As String

        fConvBarcode = pstrCode
        wlngAll = 0

        'ﾌﾟﾘﾌｨｯｸｽﾁｪｯｸ
        If Mid(pstrCode, 1, 1) = "*" Then Exit Function

        'ﾁｪｯｸﾃﾞｼﾞｯﾄ計算
        For wlngBar = 1 To Len(pstrCode)
            For wlngMoju43 = 1 To 43
                If Mid(pstrCode, wlngBar, 1) = Mid(c_MOJ43, wlngMoju43, 1) Then
                    '一致すれば次の文字へ
                    wlngAll = wlngAll + wlngMoju43 - 1
                    Exit For
                End If
            Next wlngMoju43
        Next wlngBar

        wlngAll = wlngAll Mod 43
        wstrMojuCd = "*" & pstrCode & Mid(c_MOJ43, wlngAll + 1, 1) & "*"
        'ﾊﾞｰｺｰﾄﾞ
        fConvBarcode = wstrMojuCd

    End Function

    '*******************************************************************************
    ' 概要      : ファイルオープンチェック
    ' 引数      : pintOpen  Integer    (0:Append / 1:Binary / 2:Input / 3:Output / 4:Random)
    '           : pstrPath  String     ﾌｧｲﾙﾊﾟｽ
    ' 戻り値    : Boolean　True:ｵｰﾌﾟﾝ成功 False:ｵｰﾌﾟﾝ失敗
    ' 備考      : 
    '*******************************************************************************
    'Public Function fCheckOpenFile(ByVal pintOpen As Integer, ByVal pstrPath As String) As Boolean
    '    Dim wintFileNum As Integer

    '    fCheckOpenFile = False

    '    Try
    '        wintFileNum = FreeFile() ' フリーのファイルナンバーを取得

    '        ' 出力ファイルのオープン
    '        Select Case pintOpen
    '            Case 0
    '                FileOpen(wintFileNum, pstrPath, OpenMode.Append)
    '            Case 1
    '                FileOpen(wintFileNum, pstrPath, OpenMode.Binary)
    '            Case 2
    '                FileOpen(wintFileNum, pstrPath, OpenMode.Input)
    '            Case 3
    '                FileOpen(wintFileNum, pstrPath, OpenMode.Output)
    '            Case 4
    '                FileOpen(wintFileNum, pstrPath, OpenMode.Random)
    '        End Select

    '        FileClose(wintFileNum) ' 出力ファイルのクローズ

    '        fCheckOpenFile = True
    '        Exit Function

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fCheckOpenFile", ex.ToString)
    '    End Try
    'End Function

    '*******************************************************************************
    '   機能　：1桁の年を4桁に変換する
    '   戻り値：String      短縮型文字列
    '   引数  ：pstrY     String      年下1桁 (y)
    '         ：pstrDate  String      変換年  (yyyy)
    '   備考　：なし
    '*******************************************************************************
    'Public Function fIoYyyyCtl(ByVal pstrY As String, ByRef pstrDate As String) As Boolean

    '    Dim wstrFileName As String
    '    Dim wintFileNum As Integer
    '    Dim strGetY As String
    '    Dim strYear As String

    '    fIoYyyyCtl = False
    '    Try

    '        'ファイルオープン
    '        wintFileNum = FreeFile()
    '        wstrFileName = fMakeFilePath(fgetAppPath(), G_CONST_YYYY_CTL)
    '        FileOpen(wintFileNum, wstrFileName, OpenMode.Input)

    '        'YYYY.CTLから取得
    '        Input(wintFileNum, strGetY)
    '        '出力ファイルのクローズ
    '        FileClose(wintFileNum)

    '        strGetY = strGetY.PadRight(4, " ")
    '        pstrY = pstrY.PadRight(1, " ")

    '        'YYYY.CTLの頭３桁(XXX_) & 年下1桁(X)
    '        strYear = strGetY.Substring(0, 3) & pstrY.Substring(0, 1)

    '        If strGetY = strYear Then
    '            'YYYY.CTLが"2000", 年下1桁 = "0"の場合
    '            strGetY = CStr(2000 + 10)
    '            strYear = strGetY

    '            'ファイル出力
    '            wintFileNum = FreeFile()
    '            FileOpen(wintFileNum, wstrFileName, OpenMode.Output)
    '            Print(wintFileNum, strYear)
    '            '出力ファイルのクローズ
    '            FileClose(wintFileNum)
    '        End If

    '        pstrDate = strYear
    '        fIoYyyyCtl = True
    '        Exit Function

    '    Catch ex As Exception
    '        sErrLog(gAppName, "fIoYyyyCtl", ex.ToString)
    '        FileClose(wintFileNum)                  ' 出力ファイルのクローズ
    '    End Try
    'End Function

    '*******************************************************************************
    '   機能　：YYYYMMDD形式の短縮型を返す
    '   戻り値：String      短縮型文字列
    '   引数  ：pstrNow     String      日付(yyyyMMdd)
    '   備考　：なし
    '*******************************************************************************
    Public Function fYmdToShorten(ByVal pstrNow As String) As String
        Dim wstrYear As String
        Dim wstrTuki As String
        Dim wstrMonth As String
        Dim wstrDay As String

        wstrYear = Mid(pstrNow, 4, 1)   '年の下1桁
        wstrTuki = Mid(pstrNow, 5, 2)   '月2桁
        '各月に対応する文字
        Select Case wstrTuki
            Case "01"
                wstrMonth = "A"
            Case "02"
                wstrMonth = "B"
            Case "03"
                wstrMonth = "C"
            Case "04"
                wstrMonth = "D"
            Case "05"
                wstrMonth = "E"
            Case "06"
                wstrMonth = "F"
            Case "07"
                wstrMonth = "G"
            Case "08"
                wstrMonth = "H"
            Case "09"
                wstrMonth = "I"
            Case "10"
                wstrMonth = "J"
            Case "11"
                wstrMonth = "K"
            Case "12"
                wstrMonth = "L"
        End Select
        wstrDay = fDayToShorten(Mid(pstrNow, 7, 2))    '日2桁

        '年の下1桁 + 各月に対応する文字 + 日2桁
        fYmdToShorten = wstrYear & wstrMonth & wstrDay

    End Function

    '*******************************************************************************
    '   機能　：短縮型日付をYYYYMMDD形式で返す
    '   戻り値：String      YYYYMMDD
    '   引数  ：pstrNow     String      日付(短縮型)
    '   備考　：なし
    '*******************************************************************************
    'Public Function fShortenToYMD(ByVal pstrNow As String) As String
    '    Dim wstrYear, wstrY As String
    '    Dim wstrTuki As String
    '    Dim wstrMonth As String
    '    Dim wstrDay As String
    '    wstrY = Mid(pstrNow, 1, 1)

    '    fIoYyyyCtl(wstrY, wstrYear) '西暦YYYY

    '    wstrMonth = Mid(pstrNow, 2, 1)   '月2桁
    '    '各月に対応する文字
    '    Select Case wstrMonth
    '        Case "A"
    '            wstrTuki = "01"
    '        Case "B"
    '            wstrTuki = "02"
    '        Case "C"
    '            wstrTuki = "03"
    '        Case "D"
    '            wstrTuki = "04"
    '        Case "E"
    '            wstrTuki = "05"
    '        Case "F"
    '            wstrTuki = "06"
    '        Case "G"
    '            wstrTuki = "07"
    '        Case "H"
    '            wstrTuki = "08"
    '        Case "I"
    '            wstrTuki = "09"
    '        Case "J"
    '            wstrTuki = "10"
    '        Case "K"
    '            wstrTuki = "11"
    '        Case "L"
    '            wstrTuki = "12"
    '    End Select
    '    wstrDay = fShortenToDay(Mid(pstrNow, 3, 1))    '日2桁

    '    '年の下1桁 + 各月に対応する文字 + 日2桁
    '    fShortenToYMD = wstrYear & wstrTuki & wstrDay

    'End Function

    '*******************************************************************************
    '   機能　：日を短縮型に変換する
    '   戻り値：String      短縮型文字列
    '   引数  ：pstrDate    String    日
    '   備考　：なし
    '*******************************************************************************
    Public Function fDayToShorten(ByVal pstrDate As String) As String
        Dim wstrSDayArray() As String = {"1", "2", "3", "4", "5", "6", "7", "8", "9", "A", _
                                         "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", _
                                         "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", _
                                         "V"}
        Dim wintDay As Integer

        fDayToShorten = ""

        If Not IsNumeric(pstrDate) Then Exit Function

        wintDay = CInt(pstrDate)
        If wintDay < 1 Or wintDay > 31 Then Exit Function

        fDayToShorten = wstrSDayArray(wintDay - 1)

    End Function

    '*******************************************************************************
    '   機能　：短縮型の日を2桁の日に変換する
    '   戻り値：String      2桁の文字列
    '   引数  ：pstrDate    String    短縮日
    '   備考　：なし
    '*******************************************************************************
    Public Function fShortenToDay(ByVal pstrDate As String) As String
        Dim wintDayArray() As Integer = {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}
        Dim wstrSDayArray() As String = {"1", "2", "3", "4", "5", "6", "7", "8", "9", "A", _
                                         "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", _
                                         "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", _
                                         "V"}
        Dim i As Integer, wintIndex As Integer

        fShortenToDay = ""

        wintIndex = -1
        For i = 0 To wstrSDayArray.Length - 1
            If pstrDate = wstrSDayArray(i) Then
                wintIndex = i
                Exit For
            End If
        Next
        If wintIndex < 0 Then Exit Function

        fShortenToDay = Microsoft.VisualBasic.Format(wintDayArray(wintIndex), "00")

    End Function

    '*******************************************************************************
    '   機能　：文字を指定回数連結させる
    '   戻り値：String      連結文字列
    '   引数  ：pintRepeat    Integer    連結回数
    '         ：pstrMoji      String     連結文字
    '   備考　：なし
    '*******************************************************************************
    Public Function fStrRepeat(ByVal pintRepeat As Integer, ByVal pstrMoji As String) As String
        Dim i As Integer
        Dim wstrLine As String

        fStrRepeat = ""
        wstrLine = ""

        If pintRepeat < 1 Then Exit Function

        '繰り返し連結
        For i = 0 To pintRepeat - 1
            wstrLine &= pstrMoji
        Next

        fStrRepeat = wstrLine

    End Function

    '*******************************************************************************
    '   概要：入力されたシフトつき日付のチェックを行う
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckDateS(ByVal obj As System.Object) As Integer

        Dim wintRet As Integer
        fCheckDateS = -1
        wintRet = fCheckDateS(DirectCast(obj, TextBox).Text())
        If wintRet <> 0 Then
            DirectCast(obj, TextBox).Focus()
        End If

        fCheckDateS = wintRet
    End Function

    '*******************************************************************************
    '   機能　：入力されたシフトつき日付のチェックを行う
    '   戻り値：Integer       Integer    0:OK -1:NG
    '   引数  ：pstrDate      String     入力値
    '   備考　：なし
    '*******************************************************************************
    Public Function fCheckDateS(ByVal pstrDate As String) As Integer
        Dim wstrText As String
        Dim wstrShift As String
        Dim wstrYear As String
        Dim wstrMonth As String
        Dim wstrDay As String
        Dim wstrDate As String
        Dim wintLength As Integer

        fCheckDateS = 0
        wstrText = ""
        Try
            wstrText = fcheckNullString(pstrDate)
            wintLength = wstrText.Length

            If (wintLength = 9 Or wintLength = 8) Then

                wstrYear = Mid(pstrDate, 1, 4)
                wstrMonth = Mid(pstrDate, 5, 2)
                wstrDay = Mid(pstrDate, 7, 2)
                wstrShift = Mid(pstrDate, 9, 1)
                wstrDate = wstrYear & "/" & wstrMonth & "/" & wstrDay

                If Not (IsDate(wstrDate)) Then
                    fCheckDateS = -1
                    Exit Function
                End If
                If wstrShift <> "D" And wstrShift <> "N" Then
                    fCheckDateS = -2
                    Exit Function
                End If
            Else
                fCheckDateS = -1
                Exit Function
            End If

            fCheckDateS = 0

        Catch ex As Exception
            Return False
        End Try
    End Function

    '*******************************************************************************
    '   機能　：入力された日付の相関関係をチェックする
    '   戻り値：Integer       Integer    0:OK -1:NG
    '   引数  ：pstrFromDate  String     From Date
    '   　　  ：pstrToDate    String     To Date
    '   備考　：なし
    '*******************************************************************************
    Public Function fCheckDateDiff(ByVal pstrFromDate As String, ByVal pstrToDate As String) As Integer

        fCheckDateDiff = 0
        If pstrFromDate.Trim <> "" And pstrToDate.Trim <> "" Then
            If pstrFromDate > pstrToDate Then
                fCheckDateDiff = -1
            End If
        End If

    End Function

    '*******************************************************************************
    '   概要：入力された日付のチェックを行う(末尾00許可)
    '   ﾊﾟﾗﾒｰﾀ：obj テキストオブジェクト
    '   戻り値：Boolean　True:OK False:NG
    '*******************************************************************************
    Public Function fCheckDateZero(ByVal obj As System.Object) As Boolean

        fCheckDateZero = False
        If fCheckDateZero(DirectCast(obj, TextBox).Text()) Then
            fCheckDateZero = True
        Else
            DirectCast(obj, TextBox).Focus()
        End If
    End Function

    '*******************************************************************************
    '   機能　：入力された日付のチェックを行う(末尾00許可)
    '   戻り値：Integer       Integer    0:OK -1:NG
    '   引数  ：pstrDate      String     入力値
    '   備考　：なし
    '*******************************************************************************
    Public Function fCheckDateZero(ByRef pstrDate As String) As Boolean

        fCheckDateZero = False

        '文字列長が6ﾊﾞｲﾄ場合、末尾に"00"をつける。末尾"00"の場合は年月だけでﾁｪｯｸする
        If pstrDate.Trim <> "" Then
            If pstrDate.Length = 6 Then
                If Not fCheckDate(pstrDate, G_CONST_CHK_YEAR_MONTH) Then Exit Function
                pstrDate = pstrDate & "00"
            ElseIf pstrDate.Length = 8 Then
                If Microsoft.VisualBasic.Right(pstrDate, 2) = "00" Then
                    If Not fCheckDate(Microsoft.VisualBasic.Left(pstrDate, 6), G_CONST_CHK_YEAR_MONTH) Then Exit Function
                Else
                    If Not fCheckDate(pstrDate, G_CONST_CHK_YEAR_DATE) Then Exit Function
                End If
            Else
                If Not fCheckDate(pstrDate, G_CONST_CHK_YEAR_DATE) Then Exit Function
            End If
        Else
            Exit Function
        End If
        fCheckDateZero = True

    End Function

End Module

