Imports System.Text

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

Imports WarpControl
Imports WarpControl.WarpApi2

Module modPublicHT

    '*******************************************************************************
    '   概要：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_WrpMsg(ByVal pStatus As String, ByVal pMID As String, Optional ByVal pCountry As String = "ND", Optional ByVal wintSelect As Integer = 1) As Integer
        Dim wstrImgFile As String
        Dim wMsg As New clsWrpMsg

        If pCountry = "ND" Then
            pCountry = gstrctKDHT.strCountry
        End If

        Select Case pStatus
            Case "H"
                wstrImgFile = G_CONST_IMG_DIR & "H" & pCountry & "-" & pMID & G_CONST_IMG_EXT
            Case "E"
                wstrImgFile = G_CONST_IMG_DIR & "E" & pCountry & "-" & pMID & G_CONST_IMG_EXT
            Case "S"
                wstrImgFile = G_CONST_IMG_DIR & "S" & pCountry & "-" & pMID & G_CONST_IMG_EXT
        End Select

        With wMsg
            .pImgFile = wstrImgFile
            .pSelection = wintSelect
            .sMsgBox()
            Return .pRtnCode
        End With
    End Function


    Public Sub sSetImgFName(ByVal pMID As String, ByRef pWarpBox As WarpBox, Optional ByVal pintFlag As Integer = 0)
        Dim wstrImgFile As String
        Dim wMsg As New clsWrpMsg

        If pintFlag = 0 Then
            wstrImgFile = G_CONST_IMG_DIR & "H" & gstrctKDHT.strCountry & "-" & pMID & G_CONST_IMG_EXT
        Else
            wstrImgFile = G_CONST_IMG_DIR & "E" & gstrctKDHT.strCountry & "-" & pMID & G_CONST_IMG_EXT
        End If

        pWarpBox.SetImage(wstrImgFile)

    End Sub


    '*******************************************************************************
    '* 機能     : ﾊﾞｰｺｰﾄﾞの整合性をﾁｪｯｸする
    '* 引数     : pstrBarCode    String　 バーコード
    '*          : pblnInp        Boolean　True:ﾊﾞｰｺｰﾄﾞ、False:手入力
    '* 戻り値   : 正常終了時=True
    '* 備考     : なし
    '*******************************************************************************
    Public Function fCheckCode(ByRef pstrBarCode As String) As Boolean
        Dim i As Integer
        Dim wintChr() As Integer
        Dim wintSum As Integer
        Dim wintAmari As Integer
        Dim wstrBarCode As String
        Dim wstrDigit As String

        fCheckCode = False

        If Len(pstrBarCode) = 0 Then Exit Function

        wstrBarCode = Mid(pstrBarCode, 2, Len(pstrBarCode) - 2)
        wstrDigit = Mid(pstrBarCode, Len(pstrBarCode), 1)

        '// ﾁｪｯｸﾃﾞｼﾞｯﾄ(M43)の整合性を確かめる
        ReDim wintChr(Len(wstrBarCode) - 1)
        For i = 1 To Len(wstrBarCode)
            wintChr(i - 1) = wfGetCode(Mid(wstrBarCode, i, 1))
        Next

        wintSum = 0
        For i = 0 To UBound(wintChr)
            wintSum = wintSum + wintChr(i)
        Next

        wintAmari = wintSum Mod 43

        If wfGetValue(wintAmari) <> wstrDigit Then
            'ﾁｪｯｸﾃﾞｼﾞｯﾄが不正です
            'fFnc_Msg("0304", "3")
            Exit Function
        End If

        pstrBarCode = wstrBarCode
        fCheckCode = True

    End Function

    '*******************************************************************************
    '* 機能     : ﾁｪｯｸﾃﾞｼﾞｯﾄ計算用の数値を返す
    '* 引数     : pstrValue    String　文字
    '* 戻り値   : ﾁｪｯｸﾃﾞｼﾞｯﾄ数値
    '* 備考     : なし
    '*******************************************************************************
    Private Function wfGetCode(ByVal pstrValue As String) As Integer
        Dim i As Integer

        wfGetCode = -1

        For i = 0 To UBound(mstrChr)
            If mstrChr(i) = pstrValue Then
                wfGetCode = mintChr(i)
                Exit Function
            End If
        Next

    End Function

    '*******************************************************************************
    '* 機能     : ﾁｪｯｸﾃﾞｼﾞｯﾄ計算用の文字を返す
    '* 引数     : pintValue    Integer　数値
    '* 戻り値   : ﾁｪｯｸﾃﾞｼﾞｯﾄ文字
    '* 備考     : なし
    '*******************************************************************************
    Private Function wfGetValue(ByVal pintValue As Integer) As String
        Dim i As Integer

        wfGetValue = -1

        For i = 0 To UBound(mintChr)
            If mintChr(i) = pintValue Then
                wfGetValue = mstrChr(i)
                Exit Function
            End If
        Next

    End Function

    '*******************************************************************************
    '   概要  ：前ZERO埋めして、返す
    '   ﾊﾟﾗﾒｰﾀ：pstrData    ｾﾞﾛ埋数値文字列
    '         ：pintNum  ｾﾞﾛ埋桁数
    '   戻り値：DB登録用文字列 ( 1 ⇒ 001 )
    '*******************************************************************************
    Public Function fstrZeroput(ByVal pintNum As Integer, ByVal pstrData As String) As String
        Dim wstrValue As String
        Dim wintData As String
        Dim rut As Integer

        rut = pstrData.Length

        If pintNum <> rut Then

            wstrValue = pstrData.PadLeft(pintNum, "0")

        ElseIf pintNum = rut Then

            wstrValue = pstrData

        End If

        fstrZeroput = wstrValue

    End Function

    '*******************************************************************************
    '   概要  ：分割して中にハイフォン（-）を入れる
    '   ﾊﾟﾗﾒｰﾀ：pstrData    数値文字列  
    '   戻り値：文字列 ( 12345 ⇒ 12-345 )
    '*******************************************************************************
    Public Function fstrDivision(ByVal pintCut As Integer, ByVal pstrData As String) As String
        Dim wstrValue As String
        Dim wstrFront As String
        Dim wstrBack As String
        Dim wintData As String
        Dim rut As Integer

        fstrDivision = " "

        Try

            wstrFront = pstrData.Substring(0, pintCut)
            wstrBack = pstrData.Substring(pintCut)

            wstrValue = wstrFront & "-" & wstrBack

            fstrDivision = wstrValue

        Catch ex As Exception
            sErrLog(gAppName, "fstrDivision", ex.ToString)
        End Try

    End Function

    '*******************************************************************************
    '   概要  ：OCMENUBACKでHTCTRL.ExeNameをﾌﾞﾗﾝｸ
    '   ﾊﾟﾗﾒｰﾀ：
    '   戻り値：
    '*******************************************************************************

    Public Sub sFinishApp()

        Dim rut As Integer
        Dim wintCnt As Integer
        Dim wstrWhere As String
        Dim wstrKey(0) As String, wstrKeyValue(0) As String

        Try

            BtLib.Transaction.BeginConCurrent()

            wstrWhere = "@HTNumber = " & gstrctKDHT.strHdNo
            wintCnt = gclsDB.fGetData(G_CONST_TBL_HTCTRL, G_CONST_KEY_HTCTRLKEY00, wstrWhere, "CTRL2")

            If wintCnt > 0 Then
                gclsDB.fCloseRecord("CTRL2")
            ElseIf wintCnt = 0 Then
                gclsDB.fCloseRecord("CTRL2")
                BtLib.Transaction.Abort()
                fFnc_WrpMsg("S", G_CONST_MID_S0010, "001")
                Exit Sub
            ElseIf wintCnt = -1 Then
                gclsDB.fCloseRecord("CTRL2")
                BtLib.Transaction.Abort()
                fFnc_WrpMsg("S", G_CONST_MID_S0010, "001")
                Exit Sub
            End If


            gclsDB.Setcolumn = ("ExeName,SearchKey")                 '登録/更新対象列名
            gclsDB.SetData = Space(8) & "," & Space(30)                       '登録/更新データ

            wstrKey(0) = "HTNumber"
            wstrKeyValue(0) = gstrctKDHT.strHdNo

            If gclsDB.fUpdRecords(G_CONST_TBL_HTCTRL, G_CONST_KEY_HTCTRLKEY00, wstrKey, wstrKeyValue) = -1 Then
                BtLib.Transaction.Abort()

            End If

            BtLib.Transaction.End()


        Catch ex As Exception
            BtLib.Transaction.Abort()
            sErrLog(gAppName, "sFinishApp", ex.ToString)
        End Try

    End Sub

    ''*******************************************************************************
    ''* 機能     : 印刷用にログファイルに吐き出します（STOCK_ALL用）
    ''* 引数     : pstrPath     String　ファイルパス
    ''          
    ''* 戻り値   : True False
    ''* 備考     : なし
    ''*******************************************************************************
    'Public Function sOutputLavel(ByVal pstrPath As String) As Integer

    '    Dim wstrRecord As String
    '    Dim wstrFileName As String
    '    Dim wintFileNum As Integer
    '    Dim i, z As Integer

    '    sOutputLavel = -1

    '    wintFileNum = FreeFile() ' フリーのファイルナンバーを取得
    '    wstrFileName = Trim(pstrPath)
    '    If wstrFileName = "" Then wstrFileName = ""
    '    z = 0
    '    Do
    '        Try
    '            ' 出力ファイルのオープン
    '            FileOpen(wintFileNum, wstrFileName, OpenMode.Append, OpenAccess.Write, OpenShare.LockWrite)
    '            Exit Do
    '        Catch ex As Exception
    '        End Try

    '        If z = 10 Then
    '            sOutputLavel = -2
    '            Exit Function
    '        End If
    '        z += 1
    '        System.Threading.Thread.Sleep(1000)
    '    Loop

    '    i = 0
    '    Do While i <= gstrctS1000.lngCnt - 1
    '        wstrRecord = gstrctS1000.strRecord(i)

    '        PrintLine(wintFileNum, wstrRecord) 'ログの書き出し

    '        i += 1
    '    Loop


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

    '    sOutputLavel = 0
    '    Exit Function


    'End Function

    ''*******************************************************************************
    ''* 機能     : 印刷用にログファイルに吐き出します（HT用）
    ''* 引数     : pstrPath     String　ファイルパス
    ''           
    ''* 戻り値   : True False
    ''* 備考     : なし
    ''*******************************************************************************
    'Public Function sOutputHT(ByVal pstrPath As String) As Boolean

    '    Dim wstrRecord As String
    '    Dim wstrFileName As String
    '    Dim wintFileNum As Integer
    '    Dim i As Integer

    '    sOutputHT = False

    '    wintFileNum = FreeFile() ' フリーのファイルナンバーを取得
    '    wstrFileName = Trim(pstrPath)
    '    If wstrFileName = "" Then wstrFileName = ""
    '    ' 出力ファイルのオープン
    '    FileOpen(wintFileNum, wstrFileName, OpenMode.Append)

    '    sQtySimple()

    '    Try
    '        i = 0
    '        Do While i <= gstrctS1000.lngCnt - 1
    '            If gstrctS1000.strRecord(i) <> "" Then

    '                wstrRecord = Mid(gstrctS1000.strRecord(i), 1, 43)
    '                wstrRecord &= sItemCodeSimple(i)
    '                wstrRecord &= gstrctKDHT.strUserNo
    '                wstrRecord &= fgetDefaultDate()        'ｼｽﾃﾑ日付

    '                PrintLine(wintFileNum, wstrRecord) 'ログの書き出し
    '            End If
    '            i += 1
    '        Loop

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

    '        sOutputHT = True
    '        Exit Function

    '    Catch ex As Exception
    '        f0.WarpCtrl1.MessageBox(G_CONST_EMT_FILEIO, G_CONST_EM_FILEIO, MWA_DB_WARNING, MWA_DB_OK)
    '    End Try
    'End Function

    ''*******************************************************************************
    ''* 機能     : 
    ''* 引数     : 
    ''           
    ''* 戻り値   : なし
    ''* 備考     : なし
    ''*******************************************************************************
    'Public Sub sQtySimple()
    '    Dim i, z As Integer
    '    Dim wstrRecode() As String

    '    ReDim Preserve wstrRecode(gstrctS1000.lngCnt)

    '    i = 0
    '    Do While i <= gstrctS1000.lngCnt - 1
    '        wstrRecode(i) = Mid(gstrctS1000.strRecord(i), 1, 12)
    '        wstrRecode(i) &= Mid(gstrctS1000.strRecord(i), 14, 41)
    '        i += 1
    '    Loop

    '    i = 0
    '    Do While i <= gstrctS1000.lngCnt - 1
    '        If wstrRecode(i) <> "" Then
    '            z = i + 1
    '            Do While z <= gstrctS1000.lngCnt - 1

    '                If wstrRecode(i) = wstrRecode(z) Then
    '                    wstrRecode(z) = ""
    '                    gstrctS1000.strRecord(z) = ""
    '                End If
    '                z += 1
    '            Loop
    '        End If
    '        i += 1
    '    Loop
    'End Sub

    ''*******************************************************************************
    ''* 機能     : 
    ''* 引数     : 
    ''           
    ''* 戻り値   : なし
    ''* 備考     : なし
    ''*******************************************************************************
    'Public Function sItemCodeSimple(ByVal i As Integer) As String
    '    Dim z As Integer
    '    Dim wstrRecodI As String
    '    Dim wstrRecode() As String
    '    Dim wlngCnt, wlngQty, wlngQty1 As Long

    '    ReDim Preserve wstrRecode(gstrctS1000.lngCnt)
    '    wlngCnt = 0
    '    wlngQty = 0

    '    wstrRecodI = Mid(gstrctS1000.strRecord(i), 1, 12)
    '    wstrRecodI &= Mid(gstrctS1000.strRecord(i), 14, 30)

    '    z = 0
    '    Do While z <= gstrctS1000.lngCnt - 1
    '        If gstrctS1000.strRecord(z) = "" Then
    '            wstrRecode(z) = ""
    '        Else
    '            wstrRecode(z) = Mid(gstrctS1000.strRecord(z), 1, 12)
    '            wstrRecode(z) &= Mid(gstrctS1000.strRecord(z), 14, 30)
    '        End If
    '        z += 1
    '    Loop

    '    z = 0
    '    Do While z <= gstrctS1000.lngCnt - 1
    '        If wstrRecode(z) <> "" Then
    '            If i <> z Then
    '                If wstrRecodI = wstrRecode(z) Then
    '                    wlngQty = CLng(Mid(gstrctS1000.strRecord(z), 44, 5))
    '                    wstrRecode(z) = ""
    '                    gstrctS1000.strRecord(z) = ""
    '                    wlngCnt += wlngQty
    '                End If
    '            Else
    '                wlngQty1 = CLng(Mid(gstrctS1000.strRecord(i), 44, 5))
    '            End If
    '        End If

    '        z += 1
    '    Loop

    '    sItemCodeSimple = fstrZeroput(5, CStr(wlngCnt + wlngQty1))

    'End Function

    '*******************************************************************************
    '* 機能     : FTPファイルアップロード
    '* 引数     : 
    '           
    '* 戻り値   : 
    '* 備考     : なし
    '*******************************************************************************


    Function fFTPUpload(ByVal pstrIPAddress As String, ByVal pstrFilePath As String) As Integer
        'Create an instance of the FTP class that is created.
        Dim ff As clsFTP

        fFTPUpload = -1

        Try

            ff = New clsFTP(pstrIPAddress, _
                            "/PICS2004/", _
                            "anonymous", _
                            "", _
                            21)

            'Try to log on to the FTP server.
            If (ff.Login() = True) Then

                'Upload a file from your local hard disk to the FTP site.
                ff.UploadFile(pstrFilePath)

            End If

        Catch ex As System.Exception
            sErrLog(gAppName, "TestFTP", ex.ToString)
        Finally
            'Always close the connection to make sure that there are not any not-in-use FTP connections.
            'Check if you are logged on to the FTP server and then close the connection.
            If ff.flag_bool = True Then
                ff.CloseConnection()
                fFTPUpload = 0
            End If
        End Try
    End Function

    '// BEEP音
    Public Enum BEEP_TYPE
        A = 1
        B = 2
        C = 3
        D = 4
        E = 5
    End Enum

    Public Enum BEEP_SELECTION
        OK = 1
        NG = 2
    End Enum

    'Public Sub sBeepSound(ByVal pType As BEEP_TYPE, ByVal pSelection As BEEP_SELECTION)

    '    Select Case pSelection

    '        Case BEEP_SELECTION.OK

    '            Select Case pType

    '                Case BEEP_TYPE.A
    '                    f0.WarpCtrl1.BeepEx("<-200>")
    '                Case BEEP_TYPE.B
    '                    f0.WarpCtrl1.BeepEx("<-100>-50<-100>")
    '                Case BEEP_TYPE.C
    '                    f0.WarpCtrl1.BeepEx("<-200>-200<-200>")
    '                Case BEEP_TYPE.D
    '                    f0.WarpCtrl1.BeepEx("<LB+200>-200<LB+200>")
    '                Case BEEP_TYPE.E
    '                    f0.WarpCtrl1.BeepEx("<-200><-200>")
    '            End Select

    '        Case BEEP_SELECTION.NG

    '            Select Case pType
    '                Case BEEP_TYPE.A
    '                    f0.WarpCtrl1.BeepEx("<LB+2000>")
    '                Case BEEP_TYPE.B
    '                    f0.WarpCtrl1.BeepEx("LB+200-100LB+200-100LB+200-100LB+200-100LB+200")
    '                Case BEEP_TYPE.C
    '                    f0.WarpCtrl1.BeepEx("<LB+300><LB+300><LB+300><LB+300><LB+300>")
    '                Case BEEP_TYPE.D
    '                    f0.WarpCtrl1.BeepEx("LB+1000")
    '                    f0.WarpCtrl1.BeepEx("<-200><-200><-200><-200><-200><-200><-200>")
    '                Case BEEP_TYPE.E
    '                    f0.WarpCtrl1.BeepEx("<LB+1000>")
    '            End Select

    '    End Select

    'End Sub

End Module

