Programming Workshop
ここに掲載したプログラムソースは、自由にコピーして使っていただいて結構です。ただし、極単純なソースでこのままではプログラム
として活用は出来ないと考えます。誰かに見せるときは出所を言っていただけると大変うれしいです。
ＶＢではAccsessデータベースにアクセスする時にＪＥＴデータベースエンジンを使います、これはＪＥＴを使ってAccsessデータベースに
アクセスする基本です、かつてＳｗｉｎｇを使っていたような人でＶＢを始めたばかりの人用に解説しました。
フィールドは、ＩＤ、名前、住所、電話。キーはＩＤです。
ＪＥＴは２段階のプロセスを経てデータベースとアクセスします、まずクエリーでデータベースを検索します、修正する該当データを
コピーバッファと呼ばれる専用のメモリに読み込みます、私たちはこのメモリーの上データに対して表示修正登録を行う事が出来ます下記のソースはコマンドボタンの「Command1_Click」イベントプロシージャに書き込むソースとして書きました。Dim DB As Database 'データベースオブジェクト定義 Dim TBL As Recordset 'テーブルのオブジェクトSet DB = OpenDatabase("データベースファイル名.MDB") 'データベースオープン Set TBL = DB.OpenRecordset("テーブル名") 'テーブルオープンTBL.FindFirst "ID = " & ID.Text '該当ＩＤを持つレコードの検索（クエリー）If TBL.NoMatch then '該当レコードのチェック '新規登録（該当なしの時） TBL.AddNew '新規の空レコードを追加 TBL![ID] = ID.Text '登録ＩＤをコピーバッファに代入 ユニークキー TBL![名前] = Namae.Text '登録氏名をコピーバッファに代入 TBL![住所] = Addres.Text '登録住所をコピーバッファに代入 TBL![電話] = TEL.Text '登録電話をコピーバッファに代入 TBL.Update 'コピーバッファを新規の空カレントレコードに書き込む else '既存修正（該当ありの時） TBL.Edit 'カレントレコードをコピーバッファに読み込む TBL![ID] = ID.Text TBL![名前] = Namae.Text TBL![住所] = Addres.Text TBL![電話] = TEL.Text TBL.Update End IfTBL.Close 'オープン中のテーブルのクローズ DB.Close 'オープン中のデータベースのクローズプログラム終了時にＣｌｏｓｅを行わないとせっかく登録したデータが失われるばかりか、レコードがロックされ次回登録も 修正も出来なくなる場合がありますの必ず実行します。又、クエリーはテーブルオープン時に実行する事も出来ますSet TBL = DB.OpenRecordset("Select From 住所録 Where ID =" & ID.Text)とします、そして「TBL.FindFirst "ID = " & ID.Text」は使いません。さらにＩＦ文の条件式は「TBL.EOF」に変わりますしたがってソース全体は少し変わってDim DB As Database 'データベースオブジェクト定義 Dim TBL As Recordset 'テーブルのオブジェクトSet DB = OpenDatabase("データベースファイル名.MDB") 'データベースオープン Set TBL = DB.OpenRecordset("Select From テーブル名 Where ID =" & ID.Text) 'テーブルオープンIf TBL.EOF then '該当レコードのチェック '新規登録（該当なしの時） TBL.AddNew '新規の空レコードを追加 '新規登録（該当なしの時） TBL![ID] = ID.Text '登録ＩＤをコピーバッファに代入 ユニークキー TBL![名前] = Namae.Text '登録氏名をコピーバッファに代入 TBL![住所] = Addres.Text '登録住所をコピーバッファに代入 TBL![電話] = TEL.Text '登録電話をコピーバッファに代入 TBL.Update 'コピーバッファを新規の空カレントレコードに書き込む else '既存修正（該当ありの時） TBL.Edit 'カレントレコードをコピーバッファに読み込む TBL![ID] = ID.Text TBL![名前] = Namae.Text TBL![住所] = Addres.Text TBL![電話] = TEL.Text TBL.Update End IfTBL.Close 'オープン中のテーブルのクローズ DB.Close 'オープン中のデータベースのクローズとなります。ソースのダウンロード jyusyo.lzh
●Accessデータベースのレコード削除
データベースのレコードを削除するＳＱＬです。
Dim DB As Recordset 'データベースオブジェクト定義
Set DB = OpenDatabase("データベースファイル名.MDB") 'データベースオープン
DB.Execute "Delete from テーブル名 Where 削除条件" 'レコード削除
この削除条件にはさまざまな条件式を設定出来ます例としては
金額
0=売掛金
0=当月入金-前月残高-当月売上-当月値引
日付
1998年以前のレコードの削除
登録日<='" & DateValue(01/01/'98) & "'"
データベースを新規作成することはデータマネージャーで可能です。しかしＪｅｔ３．０データデータベースをを作成したつもりでも実際に出来るのは２．５のようです、この場合時としてアクセスを拒否されることが有り平行した経験があります
長さが１０２４バイト以下のデータをポーリングして一度に読み込むプログラムのソースです。
測定データの最後にENDの３文字が送られてきますのでこれを元にデータ送信終了を判定しています。またENDはデータの妥当性チェックにも使っています。
ＭＳＣｏｍｍのプロパティーを以下のような設定にします
CDTimeout = 0
CommPort = 2
CTSTimeout = 0
DSRTimeout = 0
DTREnable = True
Handshaking = 0
InBufferSize = 1024
InputLen = 0
Interval = 1000
NullDiscard = False
OutBufferSize = 512
ParityReplace = "?"
RThreshold = 0
RTSEnable = True
Settings = "9600,n,8,1"
SThreshold = 0Timerコントロールのｉｎｔｅｒｖａｌを１０００（１秒）にします
相手がＰＣやモデムだとDTREnable 、 RTSEnable は未設定でもデータのやり取りは可能ですが産業用測定器はチェックが厳くＰＣ側がデータ受け取り準備ＯＫのシグナルを出してやらないとデータを送ってくれません。
CommPort, Handshaking, Settingsはプログラム中で設定しますのでデフォルトにしておいてください'RS232Cポートオープン
Private Sub Form_Load()
Comm1.CommPort = 2 'COM2 を使います
Comm1.Settings = "9600,N,8,1" ' 通信速度9600bps、ﾊﾟﾘﾃｨなし、8bit データ長、ｽﾄｯﾌﾟﾋﾞｯﾄ１
Comm1.InputLen = 0 ' コントロールに対して、バッファ全体を読み取るように指示
Comm1.PortOpen = True ' ポートを開く
End Sub
'タイマーを使って１秒のインターバルでデータの有無をチェックして
'データがきていればその都度処理します。
Private Sub Timer1_Timer()
Dim prOpenForms
Dim cprDataBuff As String '読み取りバッファー
Dim nprWork As String '空読み用バッファー
Dim nprDelay1 As Single 'ディレイ開始時間
Dim nprDelay2 As Single 'ディレイ終了時間
cprDataBuff = "" '読み取りバッファークリア
Do
prOpenForms = DoEvents() 'ＯＳに制御を渡す
cprDataBuff = cprDataBuff & Comm1.Input 'データ読み込み
Loop Until InStr(cprDataBuff, "END") > 0 '測定データ読み取り終了？
'３秒間ゴミデータ空読み
nprDelay1 = Timer 'ディレイ開始時間設定
Do
nprWork = Comm1.Input 'データ空読み
nprDelay2 = Timer 'ディレイ終了時間設定
Loop Until Abs(nprDelay2 - nprDelay1) > 3 '３秒間ディレイ完了？
'測定データ読み取り終了時処理
If InStr(cprDataBuff, "END") > 0 Then '測定データか？
・
・
ここに読み取りデータ加工ルーチンを書く
・
・
End If
End Sub
Private Sub Form_Unload(CANCEL As Integer)
Comm1.PortOpen = False 'ポートを閉じる
End Sub
ソースのダウンロード rsread.lzh
ＡＶＩ、ＷＡＶなどのマルチメディア関係の再生プログラムのソースです。まず、[カスタムコントロール]の[利用可能なコントロール]のMicrisoft Ｍｕｌｔｉｍｅｄｉａ Ｃｏｎｔｒｏｌを選んでからコーディングにかかります。
ファイルをファイルリストから選べるようにするためにＤｒｉｖｅＬｉｓｔＢｏｘ、ＤｉｒＬｉｓｔＢｏｘ、ＦｉｌｅＬｉｓｔＢｏｘをフォームに貼り付けます。それからそれぞれのコントロールのプロシージャにプログラムソースを書き込んで行きます
'ドライブの設定
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub'パスの設定
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
'演奏するファイルの選択
Private Sub File1_Click()
Dim nprDoubleBackslash As Integer
Dim cprLeftSTR As String
Dim cprRightSTR As String
Label1 = Dir1.Path & "\" & File1.filename
'ルートディレクトリー指定時ダブルバックスラッシュ削除
Do
nprDoubleBackslash = InStr(Label1, "\\")
If nprDoubleBackslash > 0 Then
cprLeftSTR = Left(Label1, nprDoubleBackslash - 1)
cprRightSTR = Right(Label1, Len(Label1) - nprDoubleBackslash - 1)
Label1 = cprLeftSTR & "\" & cprRightSTR
End If
Loop While nprDoubleBackslash > 0
'デバイスタイプ設定
Select Case Right(Label1, 3)
Case "AVI", "avi"
MMControl1.DeviceType = "AVIVideo"
Case "CDA", "cda"
MMControl1.DeviceType = "CDAudio"
Case "MID", "mid"
MMControl1.DeviceType = "Sequencer"
Case "WAV", "wav"
MMControl1.DeviceType = "WaveAudio"
Case Else
MMControl1.DeviceType = "Other"
End Select
'実行するマルチメディアファイル
MMControl1.Command = "close"
MMControl1.filename = Trim(Label1)
'MCI デバイスを開く
MMControl1.Command = "Open"
End Sub'Ｐｌａｙボタン押下時の処理
Private Sub MMControl1_PlayClick(Cancel As Integer)
Label1 = File1.filename & "を再生中"
End Sub'ＭＣＩコントロール実行終了時の処理
Private Sub MMControl1_Done(NotifyCode As Integer)
MMControl1.filename = Label1
End Sub
ソースのダウンロード Multimediaplayer.zip, Multimed.lzh
ﾌｧｲﾙをコピーする時、ＤＯＳのＢＡＳＩＣではコピーしたいﾌｧｲﾙをランダムアクセスファイルとしてオープンし何バイト単位に区切って一旦メモリー上に読み込みコピーしたいディレクトリーに順に書き出していたものでした。
しかし、ＷＩＮＤＯＷＳではＡＰＩを使うのが間違いも少なくコーディングも楽です。
ＡＰＩとゆうとなんだかＣ言語を理解していないと使えないじゃないかｌと危惧を抱いて敬遠される方もおられると思いますが使い方を理解してしまえば至って簡単なものです。
ＡＰＩ関数の宣言
ファイルをコピーするＡＰＩ関数にＣｏｐｙＦｉｌｅが有ります今回はこれを使います。まずＭｏｄｕｌｅファイルで以下のようにコーディングします
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistringFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
この宣言文は、kernel32.DLL中の関数CopyFileAをＶＢでCopyFileとゆう関数名で使用する事を意味します、かっこ内が引数で、それぞれコピー元のファイル名、コピー先のファイル名、オーバーライトするかしないかの指定の三つです。
最後の AS Long は、この関数を実行した結果の戻り値が長整数であることをあらわしています。ちなみにこの関数を実行すると実行結果が成功だったか失敗だったかが戻り値として戻ってきます。
コピーするファイルの指定
コピーするファイルを指定する時に必要は要素はドライブ名、フオルダー名、ファイル名の三つです。この三つを決めるためにＦｏｒｍにＤｒｉｖｅＬｉｓｔＢｏｘ、ＤｉｒＬｉｓｔＢｏｘ、ＦｉｌｅＬｉｓｔＢｏｘの三つのＬｉｓｔＢｏｘを貼り付けます。
コピー先を決めるために必要なのはドライブ名、フオルダー名の二つです、新たに名前の違うＤｒｉｖｅＬｉｓｔＢｏｘ、ＤｉｒＬｉｓｔＢｏｘ、をＦｏｒｍに貼り付けます。
コントロールを貼り付け終わったらコーディングに取り掛かります。
ＤｒｉｖｅＬｉｓｔＢｏｘでドライブを変更した時に、ＤｉｒＬｉｓｔＢｏｘに変更したドライブのフォルダー名が表示されるようにします
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
ＤｉｒＬｉｓｔＢｏｘでフォルダー名を変更した時に、ＦｉｌｅＬｉｓｔＢｏｘに変更したフォルダーのファイル名が表示されるようにします
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
これで、ドライブ名、そのドライブのフォルダー名、そのフォルダーのファイル名と指定する事が出来る用になりました、このような状態の事を「パスが通った」と言います。コピー先を決めるためのＤｒｉｖｅＬｉｓｔＢｏｘも同じようにコーディングします。
コピー実行ボタンのコーディング
Ｆｏｒｍ中央にＣｏｍｍａｎｄＢｕｔｔｏｎを張り付けコーディングします。
ＣｏｐｙＦｉｌｅ関数の1番目の引数にコピー元のファイル名、2番目の引数のコピー先のファイル名指定します。
最後に、3番目の引数でオーバーライトするかしないかを指定します、Ｔｒｕｅを指定するとオーバーライト不可、Ｆａｌｓｅだとオーバーライト可になります。
戻り値はＴｒｕｅがコピー成功、Ｆａｌｓｅが不成功ですので、Ｉｆ文で判定して成功の時にはコピー完了、不成功の時にはコピー失敗とメッセージボックスを出すようにしました。
Private Sub Command1_Click()
Dim cprCopyMoto As String
Dim cprCopySaki As String
Dim bprOverWriteOk As Boolean
'コピー元指定
cprCopyMoto = Dir1.Path & "\" & File1.filename
'コピー先指定
cprCopySaki = Dir2.Path & "\" & File1.filename
'オーバーライト不可指定
bprOverWriteOk = True
If CopyFile(cprCopyMoto, cprCopySaki, bprOverWriteOk) Then
MsgBox "コピー完了"
Label1 = File1.filename & "をコピー完了"
Else
MsgBox "コピー失敗"
Label1 = File1.filename & "をコピー失敗"
End If
End Sub
ソースのダウンロード FileCopy.lzh