Imports System
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
'上記はどこまで必要かは未確認
Public Class Form1
' 従来API
' Hamlog50.dllやThdll2vb.dllの定義は不要です。ただし、hamlog50.dll自体は必要ですので、
' THW2VBNET.DLLと同じフォルダに格納願います。
' Declare Function HamlogOpen Lib "Hamlog50.dll" (ByVal h As Integer, ByRef th As TThLog, ByVal f As String, ByVal v As Integer) As Integer
' Declare Sub HamlogClose Lib "Hamlog50.dll" (ByRef th As TThLog, ByVal i As Integer)
' Declare Function ThwString Lib "Thdll2Vb.dll" (ByVal s As String, ByRef Th As TThLog, ByVal n As Integer) As Integer
' Declare Function THW_readv Lib "Hamlog50.dll" (ByRef h As TThLog, ByVal n As Integer, ByRef q As TQsoBuff) As Integer
' Declare Function THW_read Lib "Hamlog50.dll" (ByRef h As TThLog, ByVal n As Integer, ByVal i As Integer) As Integer
' Declare Function THW_read Lib "Hamlog50.dll" (<MarshalAs(UnmanagedType.LPStruct)> ByRef h As TThLog, ByVal n As Integer, ByVal i As Integer) As Integer
' Declare Sub SetThBuffer Lib "Thdll2Vb.dll" (ByRef p As TThLog, ByRef s As String, ByRef n As Integer)
' Declare Function THW_update Lib "Hamlog50.dll" (<MarshalAs(UnmanagedType.LPStruct)> ByRef Th As TThLog, <MarshalAs(UnmanagedType.LPStruct)> ByRef Th2 As TThLog, ByVal r As Integer, ByVal f As Integer, ByRef m As Integer) As Integer
' Declare Function THW_update Lib "Hamlog50.dll" (ByRef Th As TThLog, ByRef Th2 As TThLog, ByVal r As Integer, ByRef f As Integer, ByRef m As Integer) As Integer
' Declare Function THW_update Lib "Hamlog50.dll" (ByRef Th As TThLog, ByRef Th2 As TThLog, ByVal r As Integer, ByVal f As Integer, ByRef m As Integer) As Integer
' Declare Function THW_append Lib "Hamlog50.dll" (ByRef Th As TThLog, ByVal f As Integer, ByRef m As Integer) As Integer
' 新API by JO1SIM OM 2009.08.18 http://homepage3.nifty.com/jo1sim/
Declare Function InitHamlogDLL Lib "THW2VBNET.dll" () As Integer
Declare Sub DoneHamlogDLL Lib "THW2VBNET.dll" ()
Declare Function HamlogOpen Lib "THW2VBNET.dll" (ByVal handle As Integer, <MarshalAs(UnmanagedType.LPStr)> ByVal f As String, ByVal v As Integer) As Integer
Declare Sub HamlogClose Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal i As Integer)
Declare Function THW_update Lib "THW2VBNET.dll" (ByVal handle1 As Integer, ByVal handle2 As Integer, ByVal r As Integer, ByVal p As Integer, ByRef m As Integer) As Integer
Declare Function THW_read Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal n As Integer, ByVal i As Integer) As Integer
Declare Function THW_append Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal n As Integer, ByRef i As Integer) As Integer
Declare Function THW_skip Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal n As Integer, ByVal i As Integer) As Integer
Declare Function THW_seek Lib "THW2VBNET.dll" (ByVal handle As Integer, <MarshalAs(UnmanagedType.LPStr)> ByVal s As String, ByVal i As Integer) As Integer
Declare Function THW_top Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal i As Integer) As Integer
Declare Function THW_btm Lib "THW2VBNET.dll" (ByVal handle As Integer, ByVal i As Integer) As Integer
Declare Function THW_flush Lib "THW2VBNET.dll" (ByVal handle As Integer) As Integer
Declare Function THWVB_ReadBuffer Lib "THW2VBNET.dll" (<MarshalAs(UnmanagedType.LPStr)> ByVal s As System.Text.StringBuilder, ByVal buffersize As Integer, ByVal handle As Integer, ByVal index As Integer) As Integer
Declare Function THWVB_SetBuffer Lib "THW2VBNET.dll" (ByVal handle As Integer, <MarshalAs(UnmanagedType.LPStr)> ByVal s As String, ByVal i As Short) As Integer
Declare Function THWVB_CopyBuffer Lib "THW2VBNET.dll" (ByVal handle_dst As Integer, ByVal handle_src As Integer) As Integer
' 構造体定義は(THW2VBNET.DLLのみを使う限り)不要です
'Structure TDBFh
'<VBFixedArray(4), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=4)> Dim lupdt() As Byte
'Dim Rcount As Integer
'Dim hsize As Integer
'Dim recnm As Integer
'Dim fHdl As Integer
'<VBFixedArray(260), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=260)> Dim Temp() As Byte
'Public Sub Initialize()
' ReDim lupdt(4)
' ReDim Temp(260)
'End Sub
'End Structure
'Structure TThLog
'<VBFixedArray(3927), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=3927)> Dim Qso() As Byte ' Ver5.03で変更
'Public Sub Initialize()
' ReDim Qso(3927)
'End Sub
'End Structure
'Structure TQsoBuff
'<VBFixedArray(3927), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=3927)> Dim Qso() As Byte ' Ver5.03で変更
'Public Sub Initialize()
' ReDim Qso(3927)
'End Sub
'End Structure
'Structure TIDXh ' インデックスファイル用
'Dim p As Integer
'Dim fHdl As Integer
'<VBFixedArray(260), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=260)> Dim Temp() As Byte
'Public Sub Initialize()
' ReDim Temp(260)
'End Sub
'End Structure
'Structure TJccgMas
'<VBFixedArray(55), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=55)> Dim buff() As Byte
'Public Sub Initialize()
' ReDim buff(55)
'End Sub
'End Structure
'Public THindx As TIDXh
'Public TJccgMas_ As TJccgMas
'Dim tqbuf As TQsoBuff
'Dim th As TThLog
'Dim th2 As TThLog
Public Const IsQSOdata = 16
Public Const KAKUNIN_NO = 16 ' データ登録時確認メッセージ無し
Dim Th As Integer = 0, Th2 As Integer = 1
Dim DataTbl(17) As String ' 各QSOデータを格納
Dim u_DataTbl(17) As String ' 各QSOデータを格納
Dim Rno As Integer
Dim success As Boolean
Dim ss As String
Dim sss As String = New String(CChar(" "), 256)
Dim UpdateQsoData As String
Dim sd As Integer
Dim rd As Integer
Dim tmp As String
Dim update_flag As Integer
Dim append_flag As Integer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'Read
Me.Label3.Text = ""
Dim f As String = "C:\Hamlog\VbNet\Hamlog.hdb"
Dim sd As Integer
Dim c As Integer
Dim j As Integer
' THW2VBNET.DLLからHamlog50.dllを呼び出す準備をします。
If InitHamlogDLL() <> success Then ' 初期化に失敗すると以後APIを呼べないのでチェック。
Exit Sub
End If
' データベースを開きます。
sd = HamlogOpen(Th, f, 0)
If sd <> success Then
Exit Sub
End If
'Rno = Val(Me.TextBox15.Text) ' 修正対象データ番号を入力する
Rno = 27394
' 文字列を受ける領域として、Stringではなく、StringBuilderを用います。領域の最大サイズを定義して
' おきます。（ここでは分かりやすくするために、極端ですが1000としました）
Dim sss2 As New StringBuilder(1000)
' 読み取ります。
c = THW_read(Th, Rno, 2)
For j = 1 To 14
THWVB_ReadBuffer(sss2, 1000, Th, j) ' ThwStringを呼び出しますが、上記StringBuilderとそのサイズを指定します。
DataTbl(j) = sss2.ToString ' StringBuilderから文字列に変換して格納します。
Next j
THWVB_ReadBuffer(sss2, 1000, Th, 16) ' ThwStringを呼び出しますが、上記StringBuilderとそのサイズを指定します。
DataTbl(15) = sss2.ToString ' StringBuilderから文字列に変換して格納します。
DataTbl(0) = DataTbl(1)
TextBox1.Text = DataTbl(1)
TextBox2.Text = DataTbl(2)
TextBox3.Text = DataTbl(3)
TextBox4.Text = DataTbl(4)
TextBox5.Text = DataTbl(5)
TextBox6.Text = DataTbl(6)
TextBox7.Text = DataTbl(7)
TextBox8.Text = DataTbl(8)
TextBox9.Text = DataTbl(9)
TextBox10.Text = DataTbl(10)
TextBox11.Text = DataTbl(11)
TextBox12.Text = DataTbl(12)
TextBox13.Text = DataTbl(13)
TextBox14.Text = DataTbl(14)
TextBox15.Text = DataTbl(15) 'DX Flag
' Hamlogを閉じます。ここでもTTHlog部分はハンドルです。
Call HamlogClose(0, 0)
' Hamlog50.dllをアンロードします。Hamlog50.dllを直接呼び出す場合はアプリを閉じるときだけ呼んでください。
DoneHamlogDLL()
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
'Update
Me.Label3.Text = ""
' THW2VBNET.DLLからHamlog50.dllを呼び出す準備をします。
InitHamlogDLL()
Hamlog_Update_sub() ' 修正プログラムの呼び出し
' Hamlog50.dllをアンロードします。Hamlog50.dllを直接呼び出す場合はアプリを閉じるときだけ呼んでください。
DoneHamlogDLL()
End Sub
Private Sub Hamlog_Update_sub()
Me.Label3.Text = ""
Rno = 27394 'update するレコード番号
InitHamlogDLL()
Dim f As String = "C:\Hamlog\VbNet\Hamlog.hdb"
' Hamlogを開きます。開くときのハンドルを th
HamlogOpen(Th, f, 0)
' CopyBufferは、内部のバッファ間でのデータコピーを行います。下記の例では、
' ハンドル０のデータをハンドル１にコピーします。これを行わないと、後で行う
' THW_readでハンドル１を指定したときに失敗します。（QSOデータではなく、それ以外の
' hamlogにアクセスするためのデータのコピーが必要）
THWVB_CopyBuffer(1, 0)
' 読みだします。同じものをハンドル th とハンドル th2 の領域に読み出しました。上記
' Copyだけでは内部のポインタもコピーされてしまうので、
'これを行わないと、Updateはうまくいかないと思います。
rd = THW_read(Th, Rno, 0)
rd = THW_read(Th2, Rno, 0)
Text_to_Table_Set_(DataTbl) ' 修正後のTextBoxのデータを配列に格納
' SetThBufferの1つ目のパラメータはハンドル番号です。更新後のデータを０としました。
For d As Integer = 1 To 14
THWVB_SetBuffer(Th, DataTbl(d), d)
Next d
tmp = ""
' 確認用の読み出し
Dim sss2 As New StringBuilder(1000)
For j = 1 To 14
THWVB_ReadBuffer(sss2, 1000, Th, j)
'ss = fNullCut(sss2.ToString) 'ＶＢ６では必要だった
'u_DataTbl(j) = ss
u_DataTbl(j) = sss2.ToString
tmp = tmp & u_DataTbl(j) & vbCrLf
Next j
TextBox16.Text = tmp
' Update処理をします。ハンドル th を更新後、ハンドル th2 を更新前としています。
'それ以外のパラメータは従来通りです。
If update_flag = 1 Then
sd = THW_update(Th, Th2, Rno, IsQSOdata, 0) '確認あり
Else
sd = THW_update(Th, Th2, Rno, IsQSOdata, KAKUNIN_NO + 1) '確認なし
End If
If sd = success Then
Me.Label3.Text = "データ番号 " & Rno & " 修正完了"
Else
Me.Label3.Text = "修正に失敗しました。"
End If
' 閉じます。
HamlogClose(Th, 0)
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
'Append
Me.Label3.Text = ""
InitHamlogDLL()
Dim f As String = "C:\Hamlog\VbNet\Hamlog.hdb"
sd = HamlogOpen(Th, f, 0)
Text_to_Table_Set()
For d As Integer = 1 To 15
THWVB_SetBuffer(Th, DataTbl(d), d)
Next d
If append_flag = 1 Then
sd = THW_append(Th, IsQSOdata, 0) '確認なし
Else
sd = THW_append(Th, IsQSOdata, KAKUNIN_NO + 1) '確認あり
End If
If sd = success Then
Me.Label3.Text = "データ追加完了"
Else
Me.Label3.Text = "追加に失敗しました。"
End If
Call HamlogClose(Th, 0)
DoneHamlogDLL()
End Sub
Public Function fNullCut(ByRef myString As String) As String
'ヌル文字を削除
Dim ii As Integer
ii = InStr(myString, vbNullChar)
If ii > 0 Then
fNullCut = Microsoft.VisualBasic.Strings.Left(myString, ii - 1)
Else
fNullCut = myString
End If
End Function
Public Function Item_Edit(ByVal Rec As String) As String
Dim RLeng As Integer
Dim Item As String
Rec = Rec.Replace(Chr(0), " ")
Rec = Rec.Trim
RLeng = Rec.Length
Item = Rec.Substring(0, RLeng)
Return Item
End Function
Public Sub Text_to_Table_Set()
Array.Clear(DataTbl, 0, 16)
DataTbl(0) = TextBox1.Text
DataTbl(1) = TextBox1.Text
DataTbl(2) = TextBox2.Text
DataTbl(3) = TextBox3.Text
DataTbl(4) = TextBox4.Text
DataTbl(5) = TextBox5.Text
DataTbl(6) = TextBox6.Text
DataTbl(7) = TextBox7.Text
DataTbl(8) = TextBox8.Text
DataTbl(9) = TextBox9.Text
DataTbl(10) = TextBox10.Text
DataTbl(11) = TextBox11.Text
DataTbl(12) = TextBox12.Text
DataTbl(13) = TextBox13.Text
DataTbl(14) = TextBox14.Text
DataTbl(15) = TextBox15.Text 'DX Flag
End Sub
Public Sub Text_to_Table_Set_(ByVal DataTbl() As String)
Array.Clear(DataTbl, 0, 16)
DataTbl(0) = Item_Edit(Me.TextBox1.Text.ToUpper)
DataTbl(1) = Item_Edit(Me.TextBox1.Text.ToUpper)
DataTbl(2) = Item_Edit(Me.TextBox2.Text.ToUpper)
DataTbl(3) = Item_Edit(Me.TextBox3.Text.ToUpper)
DataTbl(4) = Item_Edit(Me.TextBox4.Text.ToUpper)
DataTbl(5) = Item_Edit(Me.TextBox5.Text.ToUpper)
DataTbl(6) = Item_Edit(Me.TextBox6.Text.ToUpper)
DataTbl(7) = Item_Edit(Me.TextBox7.Text.ToUpper)
DataTbl(8) = Item_Edit(Me.TextBox8.Text.ToUpper)
DataTbl(9) = Item_Edit(Me.TextBox9.Text.ToUpper)
DataTbl(10) = Item_Edit(Me.TextBox10.Text.ToUpper)
DataTbl(11) = Item_Edit(Me.TextBox11.Text)
DataTbl(12) = Item_Edit(Me.TextBox12.Text)
DataTbl(13) = Item_Edit(Me.TextBox13.Text)
DataTbl(14) = Item_Edit(Me.TextBox14.Text)
DataTbl(15) = Item_Edit(Me.TextBox15.Text) 'DX Flag
End Sub
Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.Visible = True Then
update_flag = 1
CheckBox1.ForeColor = Color.Blue
Else
update_flag = 0
CheckBox1.ForeColor = Color.Black
End If
End Sub
Private Sub CheckBox2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox2.CheckedChanged
If CheckBox2.Visible = True Then
append_flag = 1
CheckBox2.ForeColor = Color.Blue
Else
append_flag = 0
CheckBox2.ForeColor = Color.Black
End If
End Sub
End Class