|
投稿者：yanyan
投稿日：2015年 6月 1日(月)14時41分13秒
|
|
|
|
下記のようなサンプルでデバイスの動作確認したところ、1度目は正常動作するが、2度目はデバイスをリセットしないと、EXTYPE7101エラーが発生し、正常動作しない。またKernel32で直接DLL動作確認したところ正常でした。CLOSEで正常にクローズ(解放)していないようですが、何か回避方法がありますでしょうか?また64ビット機固有の問題でしょうか?
環境)
Win7 64ビット 7601
サンプル)
OPEN #1:NAME "COM4:"
PRINT #1:"AAAA"
LINE input #1:a$
PRINT a$
CLOSE #1
END
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 1日(月)17時53分46秒
|
|
|
|
以前はWindows機2台をRS-232Cケーブルで接続してテストしていたのですが，
最近はCOMポート自体が省かれていることが多くてテストできません。
関係しそうな部分のソースコードを貼っておきます。
手続きやメソッドはDelphiのものとWin32APIのものとが混在しています。
TCommfile=class(TTextDevice1)
FHandle:THandle;
Limit:TDateTime;
constructor create;
destructor destroy;override;
procedure open(FName:FNameStr; am:AccessMode; og:OrganizationType; len:integer );override;
procedure close;override;
procedure erase(rs:tpRecordSetter; insideofwhen:boolean);override;
procedure initInput(LineNumb:integer;const prom:AnsiString; TimeLimit:double);override;
procedure CharacterInput(var s:AnsiString; option:IOoptions);override;
procedure flush;override;
function DataFoundForRead:boolean;override;
function DataFoundForWrite:boolean;override;
function choose(i1,i2,i3,i4:integer):integer;override;
function askpointer:Ansistring;override;
function TrueFile:boolean;override;
function AskCharacterPending:integer;override;
function AskTypeAhead:boolean;override;
private
function readline:boolean;override;
procedure PortOpen(const FName:string);
procedure readchar(var c:char);
procedure transstring(s:string);
function GetReceiveLength: Integer;
procedure ClearReceiveBuf;
procedure PortClose;
function ReadByte:char;override;
end;
resourceString
s_FailedOpen= 'をオープンできませんでした';
procedure TCommFile.PortOpen(const FName:string);
var
lpCC:TCOMMCONFIG;
size:dWord;
LPCommProp:TCommProp;
LPCOMMTIMEOUTs:TCOMMTIMEOUTs;
SubName:string;
begin
if (FHandle <> INVALID_HANDLE_VALUE) or (FName='') then begin
raise ECommError.Create('');
end;
subName:=ExtractPortName(FName);
if (Length(subName)>=5) and (uppercase(copy(subName,1,3))='COM')
and (subName[4] in ['1'..'9']) and (subName[5] in ['0'..'9'])
and ((Length(subName)=5) or (subName[6] in ['0'..'9'])) then
subName:='\\.\' + subName;
FHandle := CreateFile(Pchar(SubName),
GENERIC_READ or GENERIC_WRITE,// 読み書きアクセス
0, // 共有の対象としない
Nil, // セキュリティ属性なし
OPEN_EXISTING, // 通信では必ずこの設定
FILE_FLAG_OVERLAPPED, // オーバーラップ入出力を行う
0); // テンプレートファイルアクセスなし
if FHandle = INVALID_HANDLE_VALUE then begin
raise ECommError.Create(FName+s_FailedOpen);
end;
//SetBufferLength; // 送受信バッファ長の設定
GetCommState(FHandle,lpCC.DCB);
size:=sizeOf(lpCC);
if GetDefaultCommConfig(PChar(ExtractPortName(FName)),lpCC,size)
and ((pos(':',Fname)=0) or BuildCommDCB(PChar(FName),lpCC.DCB))
and SetCommState(FHandle,lpCC.DCB) then
else
begin
PortClose;
raise ECommError.Create(FName + s_FailedOpen);
end;
GetCommTimeOuts(FHandle,LPCOMMTIMEOUTs);
LPCOMMTIMEOUTS.ReadIntervalTimeout:=0;
LPCOMMTIMEOUTS.ReadTotalTimeoutConstant:=0;
SetCommTimeOuts(FHandle,LPCOMMTIMEOUTs);
end;
procedure TCommFile.PortClose;
var
Msg : TMsg;
Handle : THandle;
begin
if FHandle <> INVALID_HANDLE_VALUE then
begin
CloseHandle(FHandle); // 通信ポートをクローズ
FHandle := INVALID_HANDLE_VALUE;
end;
end;
procedure TCommFile.open(FName:FNameStr; am:AccessMode; og:OrganizationType; len:integer);
var
ermess:ansistring;
s:string;
begin
if FName='' then setexception(7101);
if isOpen then setexception(7003);
if (rectype=rcDISPLAY) and (og=orgSTREAM) then setexception(7101);
if len<=0 then setexception(7051);
name:=uppercase(FName);
leng:=len;
margin:=len;
AMode:=am;
OrgType:=og;
try
portopen(name);
except
on E:exception do
setexceptionWith(E.Message,7101);
end;
isOpen:=true;
currentChar:='';
end;
BASICAccでも同様でしょうか？
BASICAccでも上とほぼ同じコードを使っているので，
Lazarusをインストールすることで，実機でのデバッグが可能になるかもしれません。
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 2日(火)21時53分59秒
|
|
|
|
CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
受信バッファが空でないときにCloseHandleを実行するのが原因だとしたら、
DO
ASK CHARACTER PENDING #1:n
IF n=0 THEN EXIT DO
CHARACTER INPUT #1:s$
LOOP
みたいなコードをCLOSE文の直前に追加すれば改善されるはずです。
|
|
|
|
投稿者：yanyan
投稿日：2015年 6月 3日(水)13時59分5秒
|
|
|
|
白石 和夫さんへのお返事です。
齋藤です。
申し訳ありませんが、BASICACCでは確認しておりません。
下記の件について、残データがあるかどうか ASK #1: CHARACTER PENDING nで、確認しましたが、なにも残っていません
でした。また、LINE INPUTにSKIP RESTをオプション追加してみましたが変化ありませんでした。
対応として、Kernel32によるシリアルポート手順を組み込むことは無理でしょうか?なお、使用しているデバイスは、TriState社
のデジタル気圧計(USBで疑似RS-232C動作)です。32ビット環境なら、いろいろなアプリケーションで動いているようです。
> CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
>
> 受信バッファが空でないときにCloseHandleを実行するのが原因だとしたら、
> DO
> ASK CHARACTER PENDING #1:n
> IF n=0 THEN EXIT DO
> CHARACTER INPUT #1:s$
> LOOP
> みたいなコードをCLOSE文の直前に追加すれば改善されるはずです。
>
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 3日(水)21時00分24秒
|
|
|
|
> No.3732[元記事へ]
６４ビットWindowsであっても３２ビットのWindows APIを利用することが可能ですので、
Win32 APIとDLLの利用
を参照してください。
|
|
|
|
投稿者：yanyan
投稿日：2015年 6月 3日(水)21時49分55秒
|
|
|
|
> No.3733[元記事へ]
お世話になります。
当初のNO3729で報告しましたが、WinAPI(Kenel32.DLL)で直接記述したCOM通信では正常にクローズ
(CloseHandleで)しているようです。使い勝手から、マニュアル仕様のOPEN #~/CLOSE #~で
実現することができませんでしょうか? それともデバイス固有の問題とあきらめるべきでしょうか?
なお、64ビット環境で本デバイスの動作を確認しているアプリは、teraterm-4.86(コンソールタイプ)と
Kenel32.DLLを使用したものです。(Mscomm32.ocx を使用したものはNG)
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 4日(木)07時49分11秒
|
|
|
|
> No.3734[元記事へ]
正常にクローズしない原因がわかれば対応可能と思われます。
たとえば、共有フラッグの無指定が原因であるとかです。
お知らせください。
|
|
|
|
投稿者：山中和義
投稿日：2015年 6月 4日(木)10時56分31秒
|
|
|
|
> No.3734[元記事へ]
yanyanさんへのお返事です。
> WinAPI(Kenel32.DLL)で直接記述したCOM通信では正常にクローズ(CloseHandleで)しているようです。
Win32 APIで記述してみました。このプログラムは正しく動作しますか。
実機がありませんので、お手数ですが確認をお願いします。
OPTION CHARACTER BYTE
DECLARE EXTERNAL FUNCTION CloseHandle
DECLARE EXTERNAL FUNCTION CreateFile
DECLARE EXTERNAL FUNCTION ReadFile
DECLARE EXTERNAL FUNCTION WriteFile
DECLARE EXTERNAL FUNCTION BuildCommDCB
DECLARE EXTERNAL FUNCTION GetCommState
DECLARE EXTERNAL FUNCTION GetCommTimeouts
DECLARE EXTERNAL FUNCTION SetCommState
DECLARE EXTERNAL FUNCTION SetCommTimeouts
LET CONST_GENERIC_READ=BVAL("80000000",16)
LET CONST_GENERIC_WRITE=BVAL("40000000",16)
LET CONST_OPEN_EXISTING=3
LET hComm=CreateFile("COM1",CONST_GENERIC_READ+CONST_GENERIC_WRITE,0,0,CONST_OPEN_EXISTING,0,0) !ハンドルを得る
PRINT hComm
IF hComm<0 THEN
PRINT "オープンできません。"
ELSE
LET DCB$=REPEAT$("#",3*4+4*2+8*1)
LET DCB$(1:2)=DWORD$(LEN(DCB$)) !サイズを設定する
LET rc=GetCommState(hComm, DCB$) !既存の状態を得る
PRINT rc
LET rc=BuildCommDCB("9600,n,8,1,p", DCB$) !通信速度などの変更
PRINT rc
LET rc=SetCommState(hComm, DCB$) !設定する
PRINT rc
!コマンド・レスポンス（計測データを取得する）
LET wData$="BARH"&CHR$(13)&CHR$(10) !データを送信する
LET wLen$=REPEAT$("#",4)
LET rc=WriteFile(hComm, wData$, LEN(wData$), wLen$, 0)
PRINT rc; int32(wLen$,0) !結果と実際に送信した文字数
LET rData$=REPEAT$("#",100) !データを受信する
LET rLen$=REPEAT$("#",4)
LET rc=ReadFile(hComm, rData$, LEN(rData$), rLen$, 0)
PRINT rc; int32(rLen$,0) !結果と実際に受信した文字数
FOR i=0 TO int32(rLen$,0)-1
PRINT rData$(i:i); !1234.5hPa
NEXT i
LET rc=CloseHandle(hComm) !閉じる
PRINT rc
END IF
END
!Win32 API シリアル伝送用（RS-232C）
EXTERNAL FUNCTION BuildCommDCB(lpDef$, lpDCB$)
ASSIGN "kernel32.dll","BuildCommDCBA"
END FUNCTION
EXTERNAL FUNCTION GetCommState(nCid, lpDCB$)
ASSIGN "kernel32.dll","GetCommState"
END FUNCTION
EXTERNAL FUNCTION GetCommTimeouts(hFile, lpCommTimeouts$)
ASSIGN "kernel32.dll","GetCommTimeouts"
END FUNCTION
EXTERNAL FUNCTION SetCommState(hCommDev, lpDCB$)
ASSIGN "kernel32.dll","SetCommState"
END FUNCTION
EXTERNAL FUNCTION SetCommTimeouts(hFile, lpCommTimeouts$)
ASSIGN "kernel32.dll","SetCommTimeouts"
END FUNCTION
!Win32 API ファイルI/O
EXTERNAL FUNCTION CloseHandle(hObject)
ASSIGN "kernel32.dll","CloseHandle"
END FUNCTION
EXTERNAL FUNCTION CreateFile(lpFileName$, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
ASSIGN "kernel32.dll","CreateFileA"
END FUNCTION
EXTERNAL FUNCTION ReadFile(hFile, lpBuffer$, nNumberOfBytesToRead, lpNumberOfBytesRead$, lpOverlapped)
ASSIGN "kernel32.dll","ReadFile"
END FUNCTION
EXTERNAL FUNCTION WriteFile(hFile, lpBuffer$, nNumberOfBytesToWrite, lpNumberOfBytesWritten$, lpOverlapped)
ASSIGN "kernel32.dll","WriteFile"
END FUNCTION
!補助ルーチン
EXTERNAL FUNCTION int32(s$,p)
OPTION CHARACTER byte
LET n=0
FOR i=1 TO 4
LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32
END FUNCTION
|
|
|
|
投稿者：yanyan
投稿日：2015年 6月 4日(木)12時49分18秒
|
|
|
|
> No.3736[元記事へ]
山中和義さんへのお返事です。
お疲れさまです。
頂いたプログラムで、ポート番号は当方の環境に変更しましたが、下記の出力が得られ、何度か繰り返し
実行してもエラーとなりませんでした。
原因がわかりましたら、OPEN #~/CLOSE #~に反映して頂くことが可能でしょうか?
出力結果)
904
1
1
0
1 6
1 12
1002.0hPa
1
> yanyanさんへのお返事です。
>
> > WinAPI(Kenel32.DLL)で直接記述したCOM通信では正常にクローズ(CloseHandleで)しているようです。
>
>
> Win32 APIで記述してみました。このプログラムは正しく動作しますか。
> 実機がありませんので、お手数ですが確認をお願いします。
>
|
|
|
|
投稿者：山中和義
投稿日：2015年 6月 4日(木)15時13分6秒
|
|
|
|
> No.3731[元記事へ]
白石 和夫さんへのお返事です。
> CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
非同期でOpenする場合、
受信がないとき、Readのスレッドの開放が必要とありますが、、、
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 4日(木)21時20分24秒
|
|
|
|
> No.3738[元記事へ]
山中和義さんへのお返事です。
> 白石 和夫さんへのお返事です。
>
> > CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
>
>
> 非同期でOpenする場合、
> 受信がないとき、Readのスレッドの開放が必要とありますが、、、
>
>
送信は同期で行っていますが、受信は非同期です。
そのあたりが関係しているかも知れません。
|
|
|
|
投稿者：山中和義
投稿日：2015年 6月 5日(金)11時15分35秒
|
|
|
|
> No.3737[元記事へ]
yanyanさんへのお返事です。
> 原因がわかりましたら、OPEN #~/CLOSE #~に反映して頂くことが可能でしょうか?
>
> 出力結果)
> 904
> 1
> 1
> 0
> 1 6
> 1 12
> 1002.0hPa
> 1
BASICの命令(OPEN#,CLOSE#文)に反映するには、BASIC本体を改修しないといけません。
現時点では、明確な原因は分かりません。
当面、Win32 APIでのプログラムを利用するといいでしょう。
デバッグするとき、途中で中断すると、Closeされていないので、続けて実行すると、Openできません。
そのときは、BASIC本体を再起動することになります、
または、1つ前の実行時のハンドル(最初に表示される値)でCloseしてください。(青色の文字)
BASICの命令との対応を書いておきます。
!テストプログラム
!!LET rc=CloseHandle(1234) !1つ前のハンドルを閉じる
!!PRINT rc
!-- OPEN #1:NAME "COM1:"
LET CONST_GENERIC_READ=BVAL("80000000",16)
LET CONST_GENERIC_WRITE=BVAL("40000000",16)
LET CONST_OPEN_EXISTING=3
LET FILE_ATTRIBUTE_NORMAL=BVAL("80",16)
!LET FILE_FLAG_OVERLAPPED=BVAL("40000000",16)
LET hComm=CreateFile("COM1",CONST_GENERIC_READ+CONST_GENERIC_WRITE,0,0,CONST_OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0) !ハンドルを得る
PRINT hComm
IF hComm<0 THEN
PRINT "オープンできません。"
STOP
END IF
!コマンド・レスポンス（計測データを取得する）
!-- PRINT #1:"BARH" !"BARH"+CR+LF
LET wData$="BARH"&CHR$(13)&CHR$(10) !データを送信する
LET wLen$=REPEAT$("#",4)
LET rc=WriteFile(hComm, wData$, LEN(wData$), wLen$, 0)
PRINT rc; int32(wLen$,0) !結果と実際に送信した文字数
!-- LINE INPUT #1: a$ !1234.5hPa (CR+LF)
LET rData$=REPEAT$("#",100) !データを受信する
LET rLen$=REPEAT$("#",4)
LET rc=ReadFile(hComm, rData$, LEN(rData$), rLen$, 0)
PRINT rc; int32(rLen$,0) !結果と実際に受信した文字数
LET a$=rData$(1:POS(rData$,CHR$(13))-1)
!-- PRINT a$
PRINT a$
!-- CLOSE #1
LET rc=CloseHandle(hComm) !閉じる
PRINT rc
END
※サブルーチン部分は省略する
|
|
|
|
投稿者：yanyan
投稿日：2015年 6月 5日(金)12時54分15秒
|
|
|
|
> No.3740[元記事へ]
山中和義さんへのお返事です。
> BASICの命令(OPEN#,CLOSE#文)に反映するには、BASIC本体を改修しないといけません。
> 現時点では、明確な原因は分かりません。
>
ご確認と調査をありがとうこざいました。
要望としては、 BASICの命令(OPEN#,CLOSE#文)に反映して頂くことでした。Win32 APIでの動作は、
当方でも確認、完成しておりますが、使い勝手(他のデバイス等の併用、グラフ表示など計画)から、
BASIC命令でシンプルになることを期待しておりました。改修の優先順もあるかと思います。
しばらくWin32 APIのままでとのこと、よりDLLを扱いやすい他ツールで実現したいと思います。
お忙しい中、ご対応ありがとうございました。
|
|
|
|
投稿者：白石 和夫
投稿日：2015年 6月 8日(月)10時47分50秒
|
|
|
|
山中和義さんへのお返事です。
> 白石 和夫さんへのお返事です。
>
> > CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
>
>
> 非同期でOpenする場合、
> 受信がないとき、Readのスレッドの開放が必要とありますが、、、
>
>
受信のためのスレッドを起こしていないので無関係のようです。
Closeの前にPurgeComm(handle,PURGE_RXCLEAR)でバッファをクリアすべきことは関係があるかも知れませんが，報告されたテスト結果からは無関係のように思えます。
なお，Delphi版十進BASICのCOMポート対応部分は，
BASICAccのsourceフォルダにあるtextfile.pasのTCOMMFileとほぼ同じものです。
|
|
|
戻る