下面的代碼是我上次給一個上公司
做管理信息系統時用來實現來電顯示的源代碼。
發到這里時只刪了一些沒有用的東西
大家就湊合著看吧
有興趣的話可以發信到[email protected]和我交流
我是菜鳥
option explicit
const debflg = 1
public comx, beepno, hangup, pnloc as integer
public combuf, comlin as string
dim h
private sub command1_click()
frmwelcome.visible = false
end sub
private sub option1_click(index as integer)
comx = index + 1
call init_modem
end sub
private sub form_load()
'電話號碼置空
phonenumber = "" '用來存放從貓中的電話號碼
getnumber = "" '存放去掉區號后的號碼
with mscomm1
.inbuffersize = 1024
.inputlen = 0
.inputmode = 0
.rthreshold = 1
.rtsenable = true
.settings = "9600,n,8,1"
.sthreshold = 0
end with
'檢測串行口
dim i, c as integer
comx = 0
combuf = ""
comlin = ""
beepno = 0
hangup = 0
on error goto error_form_load
'檢測可用串口
for c = 1 to 4
if mscomm1.portopen then mscomm1.portopen = false
mscomm1.commport = c
if not mscomm1.portopen then
mscomm1.portopen = true
end if
if mscomm1.portopen then mscomm1.portopen = false
if comx = 0 then comx = c
form_load_1:
next c
if comx = 0 then end
on error goto 0
option1(comx - 1).value = true
exit sub
error_form_load:
option1(c - 1).enabled = false
resume form_load_1
exit sub
exit sub
why:
msgbox err.description
end sub
'檢測串行口
'檢查modem命令是否完成
private sub chk_modem()
on error goto why
dim t as single
dim l as integer
t = timer
do
combuf = combuf + mscomm1.input
l = instr(1, combuf, "ok")
loop until l <> 0 or timer - t > 1
if l = 0 then
msgbox "端口" & comx & "上沒有發現modem,請選擇別的端口試試.", vbokonly + vbcritical, "測試modem"
else
msgbox "來電顯示已經啟動,確定此按鈕后,如果返回ok,說明計算機與modem能正常通信,否則,請重試其它端口"
end if
exit sub
why: msgbox err.description
end sub
'串行口接收事件處理
private sub mscomm1_oncomm()
dim a
dim b
on error goto why
dim instrdata as string, tm as string
dim ipos as integer
instrdata = mscomm1.input & mscomm1.input
ipos = instr(instrdata, "nmbr=")
'記錄程序是否第一次打開,不是話下次就不顯示貓的返回信息
if timeopen = 0 then
msgbox instrdata
timeopen = 54 '寫成什么都可以,但0不可以,
msgbox "恭喜!來電顯示和modem都已經成功設置." '成功了,哈哈,我有錢可以賺了
frmwelcome.visible = false
command2.visible = false
end if
a = instr(1, instrdata, "nmbr = ", vbtextcompare)
if a <> 0 then
b = instr(a, instrdata, vbcr, vbtextcompare)
phonenumber = mid(instrdata, a + 7, b - a - 7)
frmreg.show
else:
end if
exit sub
why:
msgbox err.description
end sub
private sub init_modem()
on error goto why
if mscomm1.portopen then mscomm1.portopen = false
mscomm1.commport = comx
if not mscomm1.portopen then mscomm1.portopen = true
mscomm1.output = "at+vcid=1" + vbcr
'檢查modem命令是否完成
call chk_modem
mscomm1.output = "ats0=0" + vbcr
exit sub
why:
msgbox err.description
end sub
新聞熱點
疑難解答