Imports System
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Public Class Form1

    Structure hdb_headerType
        Dim buf01 As Byte
        <VBFixedArray(2)> Dim make_date() As Byte
        <VBFixedArray(3)> Dim data_rec() As Byte
        <VBFixedArray(1)> Dim start_add() As Byte
        <VBFixedArray(1)> Dim qso_rec() As Byte
        <VBFixedArray(3)> Dim buf02() As Byte
        <VBFixedArray(15)> Dim buf03() As Byte
        <VBFixedArray(15)> Dim calls_1() As Byte
        Dim calls_b As Byte
        <VBFixedArray(14)> Dim calls_2() As Byte
        <VBFixedArray(15)> Dim ign_1() As Byte
        Dim ign_b As Byte
        <VBFixedArray(14)> Dim ign_2() As Byte
        <VBFixedArray(15)> Dim date_1() As Byte
        Dim date_b As Byte
        <VBFixedArray(14)> Dim date_2() As Byte
        <VBFixedArray(15)> Dim time_1() As Byte
        Dim time_b As Byte
        <VBFixedArray(14)> Dim time_2() As Byte
        <VBFixedArray(15)> Dim code_1() As Byte
        Dim code_b As Byte
        <VBFixedArray(14)> Dim code_2() As Byte
        <VBFixedArray(15)> Dim gl_1() As Byte
        Dim gl_b As Byte
        <VBFixedArray(14)> Dim gl_2() As Byte
        <VBFixedArray(15)> Dim qsl_1() As Byte
        Dim qsl_b As Byte
        <VBFixedArray(14)> Dim qsl_2() As Byte
        <VBFixedArray(15)> Dim flag_1() As Byte
        Dim flag_b As Byte
        <VBFixedArray(14)> Dim flag_2() As Byte
        <VBFixedArray(15)> Dim his_1() As Byte
        Dim his_b As Byte
        <VBFixedArray(14)> Dim his_2() As Byte
        <VBFixedArray(15)> Dim my_1() As Byte
        Dim my_b As Byte
        <VBFixedArray(14)> Dim my_2() As Byte
        <VBFixedArray(15)> Dim freq_1() As Byte
        Dim freq_b As Byte
        <VBFixedArray(14)> Dim freq_2() As Byte
        <VBFixedArray(15)> Dim mode_1() As Byte
        Dim mode_b As Byte
        <VBFixedArray(14)> Dim mode_2() As Byte
        <VBFixedArray(15)> Dim name_1() As Byte
        Dim name_b As Byte
        <VBFixedArray(14)> Dim name_2() As Byte
        <VBFixedArray(15)> Dim qth_1() As Byte
        Dim qth_b As Byte
        <VBFixedArray(14)> Dim qth_2() As Byte
        <VBFixedArray(15)> Dim rmk1_1() As Byte
        Dim rmk1_b As Byte
        <VBFixedArray(14)> Dim rmk1_2() As Byte
        <VBFixedArray(15)> Dim rmk2_1() As Byte
        Dim rmk2_b As Byte
        <VBFixedArray(14)> Dim rmk2_2() As Byte
        Dim buf04 As Byte '0D

        Public Sub Initialize()
            ReDim make_date(2)
            ReDim data_rec(3)
            ReDim start_add(1)
            ReDim qso_rec(1)
            ReDim buf02(3)
            ReDim buf03(15)
            ReDim calls_1(15)
            ReDim calls_2(14)
            ReDim ign_1(15)
            ReDim ign_2(14)
            ReDim date_1(15)
            ReDim date_2(14)
            ReDim time_1(15)
            ReDim time_2(14)
            ReDim code_1(15)
            ReDim code_2(14)
            ReDim gl_1(15)
            ReDim gl_2(14)
            ReDim qsl_1(15)
            ReDim qsl_2(14)
            ReDim flag_1(15)
            ReDim flag_2(14)
            ReDim his_1(15)
            ReDim his_2(14)
            ReDim my_1(15)
            ReDim my_2(14)
            ReDim freq_1(15)
            ReDim freq_2(14)
            ReDim mode_1(15)
            ReDim mode_2(14)
            ReDim name_1(15)
            ReDim name_2(14)
            ReDim qth_1(15)
            ReDim qth_2(14)
            ReDim rmk1_1(15)
            ReDim rmk1_2(14)
            ReDim rmk2_1(15)
            ReDim rmk2_2(14)
        End Sub
    End Structure

    Dim hh As hdb_headerType

    Dim in_ren As Integer
    Dim in_rec_1 As Integer
    Dim in_rec_2 As Integer
    Dim in_rec_3 As Integer
    Dim in_rec_4 As Integer
    Dim in_rec As Integer

    Dim qso_rec As Integer
    Dim calls_b As Integer
    Dim ign_b As Integer
    Dim date_b As Integer
    Dim time_b As Integer
    Dim code_b As Integer
    Dim gl_b As Integer
    Dim qsl_b As Integer
    Dim flag_b As Integer
    Dim his_b As Integer
    Dim my_b As Integer
    Dim freq_b As Integer
    Dim mode_b As Integer
    Dim name_b As Integer
    Dim qth_b As Integer
    Dim rmk1_b As Integer
    Dim rmk2_b As Integer

    Dim dummy As Byte
    Dim putArray As Byte
    Dim time_00 As String
    Dim time_01 As String
    Dim time_02 As String

    Dim num_0 As Integer
    Dim num_1 As Integer

    Dim calls_c As String
    Dim ign_c As String
    Dim date_c As String
    Dim time_c As String
    Dim code_c As String
    Dim gl_c As String
    Dim qsl_c As String
    Dim flag_c As String
    Dim his_c As String
    Dim my_c As String
    Dim freq_c As String
    Dim mode_c As String
    Dim name_c As String
    Dim qth_c As String
    Dim rmk1_c As String
    Dim rmk2_c As String
    Dim dx_c As String

    Dim date_0 As String
    Dim date_1 As String
    Dim date_2 As String
    Dim date_3 As String
    Dim time_0 As String
    Dim time_1 As String
    Dim k As Integer
    Dim name_in_file As String

    Dim tmp As String
    Dim dat() As String
    Dim nj_rec As Integer

    Dim fileName As String = "C:\Hamlog\VbNet\Hamlog.hdb"
    Dim fileName2 As String = "C:\Hamlog\VbNet\Hamlog_keta.txt"
    Dim fileName3 As String = "C:\Hamlog\VbNet\Hamlog_qso.txt"
    Dim fileName4 As String = "C:\Hamlog\VbNet\LOGLIST_2.csv"

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        'read_hdb

        get_keta_su()

        Dim calls_q(calls_b - 1) As Byte
        Dim date_q(date_b - 1) As Byte
        Dim time_q(time_b - 1) As Byte
        Dim code_q(code_b - 1) As Byte
        Dim gl_q(gl_b - 1) As Byte
        Dim qsl_q(qsl_b - 1) As Byte
        Dim flag_q(flag_b - 1) As Byte
        Dim his_q(his_b - 1) As Byte
        Dim my_q(my_b - 1) As Byte
        Dim freq_q(freq_b - 1) As Byte
        Dim mode_q(mode_b - 1) As Byte
        Dim name_q(name_b - 1) As Byte
        Dim qth_q(qth_b - 1) As Byte
        Dim rmk1_q(rmk1_b - 1) As Byte
        Dim rmk2_q(rmk2_b - 1) As Byte
        Dim dx_q(1) As Byte

        Dim fileNo As Integer = FreeFile()
        FileOpen(fileNo, fileName, OpenMode.Binary)
        Dim fileNo3 As Integer = FreeFile()
        FileOpen(fileNo3, fileName3, OpenMode.Output)

        FileGet(fileNo, hh)

        ProgressBar1.Minimum = 0
        ProgressBar1.Maximum = in_rec

        For i = 1 To in_rec
            FileGet(fileNo, dummy)
            FileGet(fileNo, calls_q)
            FileGet(fileNo, date_q)
            FileGet(fileNo, time_q)
            FileGet(fileNo, code_q)
            FileGet(fileNo, gl_q)
            FileGet(fileNo, qsl_q)
            FileGet(fileNo, flag_q)
            FileGet(fileNo, his_q)
            FileGet(fileNo, my_q)
            FileGet(fileNo, freq_q)
            FileGet(fileNo, mode_q)
            FileGet(fileNo, name_q)
            FileGet(fileNo, qth_q)
            FileGet(fileNo, rmk1_q)
            FileGet(fileNo, rmk2_q)

            calls_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(calls_q))
            code_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(code_q))
            gl_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(gl_q))
            qsl_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(qsl_q))
            his_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(his_q))
            my_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(my_q))
            freq_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(freq_q))
            mode_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(mode_q))
            name_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(name_q))
            qth_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(qth_q))
            rmk1_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(rmk1_q))
            rmk2_c = Microsoft.VisualBasic.Trim(System.Text.Encoding.GetEncoding(932).GetString(rmk2_q))


            date_0 = Microsoft.VisualBasic.Right("0" & CStr(Val("&H" & Hex(date_q(0)))), 2)
            date_1 = Microsoft.VisualBasic.Right("0" & CStr(Val("&H" & Hex(date_q(1)))), 2)
            date_2 = Microsoft.VisualBasic.Right("0" & CStr(Val("&H" & Hex(date_q(2)))), 2)
            date_3 = Microsoft.VisualBasic.Right("0" & CStr(Val("&H" & Hex(date_q(3)))), 2)

            date_c = date_1 & "/" & date_2 & "/" & date_3

            time_0 = Microsoft.VisualBasic.Right("0" & CStr(Val("&H" & Hex(time_q(0)))), 2)

            k = Val("&H" & Hex(time_q(1)))

            If k > 128 Then
                time_1 = Microsoft.VisualBasic.Right("0" & CStr(k - 128), 2)
                time_c = time_0 & ":" & time_1 & "U"
            Else
                time_1 = Microsoft.VisualBasic.Right("0" & CStr(k), 2)
                time_c = time_0 & ":" & time_1 & "J"
            End If

            flag_c = CStr(Val("&H" & Hex(flag_q(0))))

            'UA0LU,62/03/18,11:22U,599,599,7,CW,732A,,J**,,"Asiatic Russia (n=8~0)",,,1,1

            WriteLine(fileNo3, calls_c, date_c, time_c, his_c, my_c, freq_c, mode_c, code_c, gl_c, qsl_c, name_c, qth_c, rmk1_c, rmk2_c, flag_c)
            ProgressBar1.Value = i
        Next i

        FileClose(fileNo)
        FileClose(fileNo3)
        ProgressBar1.Value = 0

        Label1.Text = "終　了"

    End Sub

    Private Sub get_keta_su()

        'get keta_su

        Dim fileNo As Integer = FreeFile()
        FileOpen(fileNo, fileName, OpenMode.Binary)
        Dim fileNo2 As Integer = FreeFile()
        FileOpen(fileNo2, fileName2, OpenMode.Output)

        in_ren = FileLen("C:\Hamlog\VbNet\Hamlog.hdb")

        FileGet(fileNo, hh)
        FileClose(fileNo)

        in_rec_1 = Val("&H" & Hex(hh.data_rec(0)))
        in_rec_2 = Val("&H" & Hex(hh.data_rec(1)))
        in_rec_3 = Val("&H" & Hex(hh.data_rec(2)))
        in_rec_4 = Val("&H" & Hex(hh.data_rec(3)))
        in_rec = in_rec_1 + in_rec_2 * 256 + in_rec_3 * 256 ^ 2 + in_rec_4 * 256 ^ 3

        calls_b = Val("&H" & Hex(hh.calls_b))
        ign_b = Val("&H" & Hex(hh.ign_b))
        date_b = Val("&H" & Hex(hh.date_b))
        time_b = Val("&H" & Hex(hh.time_b))
        code_b = Val("&H" & Hex(hh.code_b))
        gl_b = Val("&H" & Hex(hh.gl_b))
        qsl_b = Val("&H" & Hex(hh.qsl_b))
        flag_b = Val("&H" & Hex(hh.flag_b))
        his_b = Val("&H" & Hex(hh.his_b))
        my_b = Val("&H" & Hex(hh.my_b))
        freq_b = Val("&H" & Hex(hh.freq_b))
        mode_b = Val("&H" & Hex(hh.mode_b))
        name_b = Val("&H" & Hex(hh.name_b))
        qth_b = Val("&H" & Hex(hh.qth_b))
        rmk1_b = Val("&H" & Hex(hh.rmk1_b))
        rmk2_b = Val("&H" & Hex(hh.rmk2_b))

        qso_rec = calls_b + ign_b + date_b + time_b + code_b + gl_b + qsl_b + flag_b + his_b + my_b + freq_b + mode_b + name_b + qth_b + rmk1_b + rmk2_b

        calls_b = calls_b + ign_b

        PrintLine(fileNo2, "calls : " & calls_b)
        PrintLine(fileNo2, "date : " & date_b)
        PrintLine(fileNo2, "time : " & time_b)
        PrintLine(fileNo2, "code : " & code_b)
        PrintLine(fileNo2, "gl : " & gl_b)
        PrintLine(fileNo2, "qsl : " & qsl_b)
        PrintLine(fileNo2, "flag : " & flag_b)
        PrintLine(fileNo2, "his : " & his_b)
        PrintLine(fileNo2, "my : " & my_b)
        PrintLine(fileNo2, "freq : " & freq_b)
        PrintLine(fileNo2, "mode : " & mode_b)
        PrintLine(fileNo2, "name : " & name_b)
        PrintLine(fileNo2, "qth : " & qth_b)
        PrintLine(fileNo2, "rmk1 : " & rmk1_b)
        PrintLine(fileNo2, "rmk2 : " & rmk2_b)
        PrintLine(fileNo2, "qso_rec : " & qso_rec)
        PrintLine(fileNo2, "in_ren : " & in_ren)
        PrintLine(fileNo2, "in_rec : " & in_rec)

        FileClose(fileNo2)


    End Sub

    Private Function fStrCut(ByVal Mystring As String, ByVal nLen As Integer) As String
        '文字列を指定のバイト数にカットする関数(漢字分断回避）
        Dim sjis As System.Text.Encoding = System.Text.Encoding.GetEncoding("Shift_JIS")
        Dim TempLen As Integer = sjis.GetByteCount(Mystring)
        If nLen < 1 Or Mystring.Length < 1 Then Return Mystring
        If TempLen <= nLen Then   '文字列が指定のバイト数未満の場合スペースを付加する
            Return Mystring.PadRight(nLen - (TempLen - Mystring.Length), CChar(" "))
        End If
        Dim tempByt() As Byte = sjis.GetBytes(Mystring)
        Dim strTemp As String = sjis.GetString(tempByt, 0, nLen)
        '末尾が漢字分断されたら半角スペースと置き換え(VB2005="・" で.NET2003=NullChar になります）
        If strTemp.EndsWith(ControlChars.NullChar) Or strTemp.EndsWith("・") Then
            strTemp = sjis.GetString(tempByt, 0, nLen - 1) & " "
        End If
        Return strTemp
    End Function

    Private Function count_file_rec(ByVal name_in_file As String) As Integer
        tmp = ""
        nj_rec = 0
        Dim sr As New System.IO.StreamReader(name_in_file, System.Text.Encoding.Default)
        Dim sb As New System.Text.StringBuilder( _
                CInt(New System.IO.FileInfo(name_in_file).Length))
        Do Until sr.Peek = -1
            sb.Append(sr.ReadLine & vbCrLf)
            nj_rec = nj_rec + 1
        Loop

        sr.Close()

    End Function

End Class