'==================================================
'
'  --------------------
'     StakeCLN R2025
'  --------------------
'
'  For WeekCLN for WIN10
'  For SortFunction for Spread Sheet SoftWear
'      and Making Stake of Commnet TXT
'  Ver 0.01
'
'  Copy right Miyama. 2025 April
'
'  http://kazutomimiyama.sakura.ne.jp
'  KazutomiMiyamaSub@gmail.com
'
'==================================================

Option Explicit On

Imports System
Imports System.IO

Public Class Form1

    Dim FSO As Object = CreateObject("Scripting.FileSystemObject")
    Dim WTS As StreamWriter

    Dim SourceFolderName As String =
        "c:\daily_folder"
    Dim StakeCLNtmpWorkFolderName As String =
        "StakeCLNtmpWorkFolderName"

    Dim StakeCLNtmpWorkFolderNameWithBackSlush As String =
        StakeCLNtmpWorkFolderName + "\"

    Dim CummaCHR As String = ","
    Dim SlushCHR As String = "/"
    Dim VacantCHR As String = ""
    Dim PeriodCHR As String = "."

    Dim MSGCountryMode As Boolean = True

    Dim StartDate As String
    Dim LastDate As String

    Dim ModeIsPay As Boolean

    Dim MSGSTR As String

    Private Function MSGJpnEngSelect(JpnMSG As String, EngMSG As String) As String 'MSGjpnEngselect

        If MSGCountryMode = True Then
            MSGJpnEngSelect = JpnMSG
        Else
            MSGJpnEngSelect = EngMSG
        End If


    End Function

    Private Sub MakeStakeBTN_Click(sender As Object, e As EventArgs) Handles MakeStakeBTN.Click

        Dim DateCHKFlag As Boolean
        Dim CrossBufSTR As String
        Dim tmpMSG As String

        Dim AtWorkNowFileDayLBLTXTMSG As String = "/DateName/"
        Dim StatusModeLBLTXTMSG As String = "/Pay or Day/"

        AtWorkNowFileDayLBL.Text = AtWorkNowFileDayLBLTXTMSG
        StatusModeLBL.Text = StatusModeLBLTXTMSG

        MSGCountryMode = MsgJpn_CHK.Checked
        DateCHKFlag = False
        While DateCHKFlag = False

            MSGSTR = MSGJpnEngSelect(
                "結合範囲を指定します。次の形式で開始日付を指定してください　yyyy/mm/dd",
                "WorKingArea Start Date :style yyyy/mm/dd")

            StartDate = InputBox(MSGSTR)
            StartDate = StartDate.Replace(SlushCHR, VacantCHR)

            DateCHKFlag = DateCHK(StartDate)

        End While
        DateCHKFlag = False

        While DateCHKFlag = False
            MSGSTR = MSGJpnEngSelect(
                "範囲終了日付を指定してください　yyyy/mm/dd",
                "WorkingArea End Date :style yyyy/mm/dd")

            LastDate = InputBox(MSGSTR)
            LastDate = LastDate.Replace(SlushCHR, VacantCHR)

            DateCHKFlag = DateCHK(LastDate)
        End While

        If Val(StartDate) <= Val(LastDate) Then
        Else
            'cross change
            CrossBufSTR = StartDate

            StartDate = LastDate
            LastDate = CrossBufSTR
        End If

        With FSO
            If .FolderExists(StakeCLNtmpWorkFolderName) = False Then
                MSGSTR = MSGJpnEngSelect(
                    "作業フォルダとデータが必要です。コピーには１０分程度かかります。",
                    "WorkingTemporaryFolder & Data, Please wait aboutly 10 minitue.")
                MessageBox.Show(MSGSTR)
                .copyfolder(SourceFolderName, StakeCLNtmpWorkFolderName)
            Else
                MSGSTR = MSGJpnEngSelect(
                    "作業フォルダの内容を更新しますか。コピーには１０分程度かかります。",
                    "Renewal Warking data? can you wait aboutly 10 minute?")

                tmpMSG = CStr(MsgBox(MSGSTR, vbYesNo))
                If Trim(tmpMSG) = "6" Then ' 6 as VBYes
                    FSO.copyfolder(SourceFolderName, StakeCLNtmpWorkFolderName)
                End If
            End If
        End With

        MSGSTR = MSGJpnEngSelect(
            "本処理を行います。大量のファイル検索に数分ごと表示動作が停止することがあります。",
            "Sometimes, display activity may be stopped on the heavy working for many filenames search.")
        MessageBox.Show(MSGSTR)

        With StatusModeLBL
            ModeIsPay = True
            .BackColor = BlueLBL.BackColor
            .Text = "Payment"
            ExecutePayOrDay()

            ModeIsPay = False
            .BackColor = OrengeLBL.BackColor
            .Text = "DailyComment"
            ExecutePayOrDay()

            'back to firstmode
            ModeIsPay = True
            .BackColor = AtWorkNowFileDayLBL.BackColor
            .Text = StatusModeLBLTXTMSG
        End With
        AtWorkNowFileDayLBL.Text = AtWorkNowFileDayLBLTXTMSG

        MSGSTR = MSGJpnEngSelect(
            "処理が終了しました。出力ファイルはかならず別名保存をしてください。",
            "Finished. Please save your own file data to other place.")
        MessageBox.Show(MSGSTR)


    End Sub

    Private Sub ExecutePayOrDay()

        Dim FO = FSO.getfolder(StakeCLNtmpWorkFolderName)
        Dim FilesCollection As Object = FO.Files
        Dim FileElement As Object

        Dim OutFilename As String
        Dim tmpSTR = VacantCHR

        If ModeIsPay = True Then
            OutFilename = "output.csv"
        Else
            OutFilename = "output.txt"
        End If

        WTS = New StreamWriter(OutFilename)

        ' = 50 chrs
        WTS.Write("==================================================" +
                  vbCrLf)
        For Each FileElement In FilesCollection
            tmpSTR = tmpSTR + FileElement.name + vbCrLf
            If FileNameCHK(FileElement.name) = True Then
                EachFileOpen(FileElement.name)
            Else
            End If
        Next

        WTS.Write("==================================================" +
                  vbCrLf)
        WTS.Close()


    End Sub

    Private Function DateCHK(tmpSTR As String) As Boolean

        DateCHK = False
        If DayTrunkCHK(tmpSTR) = 1 Then
            DateCHK = True
        Else
            DateCHK = False
        End If


    End Function

    Private Sub EachFileOpen(FileName As String)

        Dim SlushCHKedReadLine As String ''slush chked read line
        Dim DateSTRwithSlush As String

        Dim tmpBUF() As String
        Dim i, j, L As Integer

        Dim eleFixedSTR(3 + 1) As String 'ele is element
        Dim StoreOrItemName() As String 'with slush store name

        Dim RTS As StreamReader = New StreamReader(
            StakeCLNtmpWorkFolderNameWithBackSlush + FileName)

        Dim StakeNUM As Double = 0

        DateSTRwithSlush = MakeDateSTR(FileName)
        AtWorkNowFileDayLBL.Text = DateSTRwithSlush

        Select Case ModeIsPay
            Case True

                For j = 0 To 3
                    If j = 0 Then
                        eleFixedSTR(i) = DateSTRwithSlush
                    Else
                        eleFixedSTR(j) = VacantCHR
                    End If
                Next j
                WTS.Write("-----" + vbCrLf)
                While RTS.EndOfStream = False

                    SlushCHKedReadLine = OverSlushRMV(
                        RTS.ReadLine)
                    tmpBUF = Split(SlushCHKedReadLine, CummaCHR)

                    If 2 <= tmpBUF.Length Then
                        For i = 0 To 1
                            Select Case i
                                Case 0
                                    If 0 < InStr(tmpBUF(0), SlushCHR) Then
                                        StoreOrItemName = Split(tmpBUF(0), SlushCHR)
                                        eleFixedSTR(1) = StoreOrItemName(0)
                                        eleFixedSTR(2) = StoreOrItemName(1)
                                    Else
                                        'eleFixedSTR(1) = eleFixedSTR(1)
                                        eleFixedSTR(2) = tmpBUF(0)
                                    End If
                                Case 1
                                    eleFixedSTR(3) = tmpBUF(1)
                            End Select
                        Next i

                        For L = 0 To 3
                            WTS.Write(eleFixedSTR(L) + CummaCHR)
                        Next L
                        WTS.Write(vbCrLf)
                        StakeNUM = StakeNUM + Val(eleFixedSTR(3))
                    End If
                End While
                WTS.Write(eleFixedSTR(0) +
                  CummaCHR + CummaCHR + CummaCHR + CummaCHR +
                  "SumOfDay" + CummaCHR +
                  CStr(StakeNUM) + vbCrLf)
            Case False

                ' - 40 chrs
                WTS.Write("--" + DateSTRwithSlush +
                          "----------------------------------------" + vbCrLf)
                While RTS.EndOfStream = False
                    WTS.Write(RTS.ReadLine + vbCrLf)
                End While

        End Select
        RTS.Close()

    End Sub

    Private Function OverSlushRMV(tmpSTR As String) As String 'slush many chk

        Dim i As Integer

        For i = 1 To 20
            tmpSTR = tmpSTR.Replace(SlushCHR + SlushCHR, SlushCHR)
        Next i
        OverSlushRMV = tmpSTR


    End Function

    Private Function MakeDateSTR(tmpSTR As String) As String

        Dim yyyy As String
        Dim mm As String
        Dim dd As String

        yyyy = Mid(tmpSTR, 1, 4)
        mm = Mid(tmpSTR, 5, 2)
        dd = Mid(tmpSTR, 7, 2)

        MakeDateSTR = yyyy + SlushCHR + mm + SlushCHR + dd


    End Function

    Private Function FileNameCHK(FileName As String) As Boolean

        Dim ResultFlag As Boolean

        Dim FileNameTrunkLocal As String =
            Mid(FileName, 1, 8)
        Dim FileNameLen As Integer =
            Len(FileName)

        Dim DayTrunkCHKFileName As Boolean =
            DayTrunkCHK(FileNameTrunkLocal)
        Dim ExtensionCHKFileName As Boolean =
            ExtensionCHK(Mid(FileName, 10, 3))

        Dim StartDateVAL As Integer =
            Val(StartDate)
        Dim FileNameTrunkVAL As Integer =
            Val(FileNameTrunkLocal)
        Dim LastDateVAL As Integer =
            Val(LastDate)

        ResultFlag = False

        '  WTS.Write(FileNameTrunkLocal +
        '      ",FileNameLength" + CStr(FileNameLen) +
        '      ",EXTbool" + CStr(ExtensionCHKFileName) +
        '      ",StartDateVAL" + CStr(StartDateVAL) +
        '      ",FileTrunkVAL" + CStr(FileNameTrunkVAL) +
        '      ",LastDateVAL" + CStr(LastDateVAL))

        If FileNameLen = 8 + 1 + 3 Then
            If DayTrunkCHKFileName = True Then
                If ExtensionCHKFileName = True Then
                    If StartDateVAL <= FileNameTrunkVAL Then
                        If FileNameTrunkVAL <= LastDateVAL Then
                            ResultFlag = True
                        End If
                    End If
                End If
            End If
        End If

        FileNameCHK = ResultFlag


    End Function

    Private Function DayTrunkCHK(FileNameTrunk As String) As Integer

        Dim i As Integer
        Dim CHK0or1 As Integer = 0
        Dim tmpSTR As String

        Dim LengthFilename As Integer = Len(FileNameTrunk) 'lengthfilename
        Dim tmpCHR As String

        If 8 = LengthFilename Then 'FilenameTrunk+.+extention
            CHK0or1 = 1
            tmpSTR = (FileNameTrunk)

            For i = 1 To LengthFilename
                tmpCHR = Mid(tmpSTR, i, 1)
                If 1 <= i And i < 8 + 1 Then
                    CHK0or1 = CHK0or1 * IsItNumCHK(tmpCHR)
                End If
                'If i = 9 And Not tmpCHR = "." Then
                '     CHK0or1 = CHK0or1 * 0
                'End If
            Next i
        End If

        DayTrunkCHK = CHK0or1


    End Function

    Private Function ExtensionCHK(tmpSTR As String) As Integer

        Dim CHK0or1 As Integer

        tmpSTR = TuneExtension(tmpSTR)
        CHK0or1 = 0
        Select Case ModeIsPay
            Case True
                If 0 < InStr(tmpSTR, "pay") Then
                    CHK0or1 = 1
                End If
            Case False
                If 0 < InStr(tmpSTR, "day") Then
                    CHK0or1 = 1
                End If
        End Select

        ExtensionCHK = CHK0or1


    End Function

    Private Function TuneExtension(tmpSTR As String) As String

        Dim i As Integer
        Dim tmpCHR As String
        Dim StakeSTR As String = VacantCHR
        Dim LengthStr As Integer = Len(tmpSTR) 'Length String

        If 0 < LengthStr Then

            For i = 1 To LengthStr
                tmpCHR = Mid(tmpSTR, i, 1)

                Select Case tmpCHR 'd,p,a,y of day ,pay
                    Case "D"
                        tmpCHR = "d"
                    Case "P"
                        tmpCHR = "p"
                    Case "A"
                        tmpCHR = "a"
                    Case "Y"
                        tmpCHR = "y"
                End Select
                StakeSTR = StakeSTR + tmpCHR
            Next i
        End If

        TuneExtension = StakeSTR


    End Function

    Private Function IsItNumCHK(tmpCHR As String) As Integer

        Dim ResultINT As Integer = 0
        Dim i As Integer

        i = 0
        Do While (i < 10)
            If CStr(i) = tmpCHR Then
                ResultINT = 1
            End If
            i = i + 1
        Loop

        IsItNumCHK = ResultINT


    End Function

    '==JyuUTen Kun alittleRenewal on StreamReader/Writer=========
    '
    '  UTF-8 <> ANSI problem solutioned only on this way.
    '
    '============================================================
    Private Sub TuneToBatchResultBTN_Click(sender As Object, e As EventArgs) Handles TuneToBatchResultBtn.Click

        Dim RTS As StreamReader
        Dim WTS As StreamWriter

        Dim ReSourceFileName As String = "output.csv"
        Dim ResultFileName As String = "outTuned.csv"

        Dim MSGSTR As String =
            "前回の出力結果が残っています。上書を避けるためリネームしてください。" +
            "ResultFile exists already, Please rename it."

        Dim tmpBuf As String
        Dim eleSTR() As String
        Dim i, j, L As Integer

        Dim VacantChr As String = ""
        Dim eleFixedSTR(3 + 1) As String

        For j = 0 To 3
            eleFixedSTR(j) = VacantChr
        Next
        If FSO.fileexists(ReSourceFileName) = False Then
            MessageBox.Show("データソースのファイルがありません。" + vbCrLf +
                            "No SourceFile, " + ReSourceFileName)
        Else
            If FSO.fileexists(ResultFileName) = True Then
                MessageBox.Show(MSGSTR)
            Else
                RTS = New StreamReader(ReSourceFileName)
                WTS = New StreamWriter(ResultFileName)

                Do While (RTS.EndOfStream = False)
                    tmpBuf = RTS.ReadLine
                    eleSTR = Split(tmpBuf, ",") 'cumma

                    If 0 <= eleSTR.Length And
                    eleSTR.Length < 4 Then
                        'vacant save
                        eleFixedSTR(3) = VacantChr
                        eleFixedSTR(2) = VacantChr
                        eleFixedSTR(1) = VacantChr
                        eleFixedSTR(0) = eleSTR(0) 'Date Save always
                    Else
                        For i = 0 To 3
                            If Not i = 3 Then
                                If eleSTR(i) = VacantChr Then
                                    eleSTR(i) = eleFixedSTR(i) ' before data call
                                Else
                                    eleFixedSTR(i) = eleSTR(i) ' new data input
                                End If
                            Else 'i=3
                                If eleSTR(3) = VacantChr Then
                                    eleFixedSTR(3) = VacantChr ' Price data nothing
                                    eleFixedSTR(2) = VacantChr ' then all cllear other element
                                    eleFixedSTR(1) = VacantChr ' but not deleate data string
                                Else
                                    eleFixedSTR(3) = eleSTR(3) ' new data input(price)
                                End If
                            End If
                        Next i
                    End If

                    For L = 0 To 3
                        WTS.Write(eleFixedSTR(L) + ",") 'cumma
                    Next L
                    WTS.Write(vbCrLf)
                Loop
                RTS.Close()
                WTS.Close()
            End If
        End If

    End Sub

    Private Sub ExitBtn_Click(sender As Object, e As EventArgs) Handles ExitBtn.Click

        Me.Close()

    End Sub


End Class
'============================================================
'
'     end of file
'
'============================================================