private declare function ADDR(byref A as long) as long
function ADDR(A as long) as long
'print "test=";hex$(varadr(A))
ADDR=A
end function
declare function _PBGETDCBNO alias "_$PbGetDCBNo@4" (byval FILENO as long) as long
declare function _PBGETDCB alias "_$PbGetDCB@4" (byval FBDCBNO as long) as long
declare function FB63_GETFILEHANDLE bdecl (byval FILENO as integer) as long
function FB63_GETFILEHANDLE (byval FILENO as integer) as long
var FBDCBNO as long, FBDCBDATA as long
FB63_GETFILEHANDLE= INVALID_HANDLE_VALUE
select case FILENO
case 1 to 255
FBDCBNO= -1
FBDCBNO= _PBGETDCBNO(clng(FILENO))
if FBDCBNO = -1 then error 57:exit function
FBDCBDATA=0
FBDCBDATA=_PBGETDCB(FBDCBNO)
if FBDCBDATA = 0 then error 60:exit function
FB63_GETFILEHANDLE=FBDCBDATA
FBDCBDATA=FBDCBDATA+&H108 'オフセット
FB63_GETFILEHANDLE=ADDR(byval FBDCBDATA)
case else
error 50
end select
end function
declare sub TEST2_SETSTATE(byval FILENO%)
sub TEST2_SETSTATE(byval FILENO%)
var RES as long
var DCB as T_DCB, HFILE as long
var F as long, M as long
HFILE= FB63_GETFILEHANDLE(FILENO%)
if HFILE=0 or HFILE=-1 then HFILE=INVALID_HANDLE_VALUE
if HFILE= INVALID_HANDLE_VALUE then print "Error:open":exit sub
RES=GetCommState(hfile, DCB) 'ポートの設定取得
if res=0 then
print "Error:GetCommState"
else
if DCB.DCBLENGTH<>len(T_DCB) then print "!!DCBlength(hex)=";DCB.DCBLENGTH
print "fBitFields(16進数)変更前=";hex$(DCB.FBITFIELDS)
'＊＊ここで設定を変更する＊＊
F=DCB.FBITFIELDS '＊bit毎設定必要
'----fRtsControl----
F=F and (not FRTSCONTROL) 'ビット消去
M=FRTSCONTROL :M=M and (M \ 2) '※下位ビットを残す
M=M * RTS_CONTROL_TOGGLE '設定値
F=F or M 'ビット設定
print "fRtsControl書換";RTS_CONTROL_TOGGLE ;" (RTS フロー制御:0..3)"
'--------
DCB.FBITFIELDS=F '設定
'＊＊＊＊
print "fBitFields(16進数)変更後=";hex$(DCB.FBITFIELDS)
'設定を強制更新する
RES=SetCommState(hfile, DCB)
if res=0 then
print "Error:SetCommState"
endif
endif
end sub
'－－－－－－－－
var CM$, R$(4-1)
baud 0,9600
CM$="COM0:(S7N2N7NNN)"
open CM$ for output as #2 : open CM$ for input as #1
TEST2_SETSTATE 2 '←ファイル番号のCOM設定を強制変更する
WAIT 100
if not eof(1) then print "!!受信バッファが空でない！"
print"!!送信始!!"
print#2,"D";chr$(13);
wait 50
while eof(1) :print"*"; :wend ' 受信開始までループ
print:print"!!受信始!!"
wait 5
while lof(1) < 14*4 :print"."; :wait 5 :wend ' 全フレーム受信までループ
print:print"!!受信終!!"
line input#1,R$(0) :print "!!Frame-1入力"
line input#1,R$(1) :print "!!Frame-2入力"
line input#1,R$(2) :print "!!Frame-3入力"
line input#1,R$(3) :print "!!Frame-4入力"
close
stop:end
