VB编写的GPIB控制设备和串口控制产品的测试系统程序

'在电脑上使用时要安装NI488.2 GPIB驱动，在VB模块中加入niglobal.bas和vbib-32.bas
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '延时控件调用


'运行载入
Private Sub Form_Load()
Textsend.Text = "pd 1" '发送栏赋初始命令
' 串口初始化
mPort = 1 ' 设置通信端口号为COM1
MSComm1.Settings = "9600,n,8,1" ' 设置串口1参数
MSComm1.InputMode = 0 ' 接收文本型数据


End Sub


'PD1校准
Private Sub Pd1cal_Click()
Textcal.Text = ""
Dim Dev_ATT As Integer 'ATT地址
Dim Dev_OPM As Integer 'OPM地址
Const ARRAYSIZE = 1024 '读缓存区字节数
Dim PowerVal As String * ARRAYSIZE '光功率读值功率
Dim Tpower As String '光源总功率
Const Initial_ATT = 13 'ATT初始衰减量
Dim ATT As String 'ATT衰减量
Const Sleep_ATT = 3000 'ATT衰减延时后OPM才读值
Const Sleep_Comm = 100 '串口通信延时
Const Sleep_Cal = 6000 'PD校准延时
'Const Offset_Pd = 0.5 'PD补偿值

Dev_ATT% = ildev(0, 28, 0, T3s, 1, 0)
Dev_OPM% = ildev(0, 20, 0, T3s, 1, 0)
ilclr Dev_ATT%
ilclr Dev_OPM%
ilwrt Dev_ATT%, ":INP:ATT " & Initial_ATT, Len(":INP:ATT " & Initial_ATT) '发送衰减值给ATT
ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
MsgBox ("请将光源接光功率探头1")
ilwrt Dev_ATT%, ":OUTP 1", Len(":OUTP 1") '打开ATT
Sleep Sleep_ATT '延时
ilwrt Dev_OPM%, ":read1:chan1:power?", Len(":read1:chan1:power?") '发送读取光功率指令
ilrd Dev_OPM%, PowerVal$, Len(PowerVal$) '读取光功率返回值
Tpower$ = PowerVal$ + Initial_ATT '计算光源总功率
ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
MsgBox ("请将光源接1A")
ilwrt Dev_ATT%, ":OUTP 1", Len(":OUTP 1") '打开ATT
MsgBox ("确认连接插损最小")
'Shell "D:\study\VB\shiyan\GPIB.exe"
MSComm1.PortOpen = True '打开通信端口1
Sleep Sleep_ATT '延时

'校准PD1
ATT$ = Tpower$ - (0) '- Offset_Pd '计算光源输出-10dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT '延时
MSComm1.Output = "pdc 1 0 3 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then

' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-10) '计算光源输出-10dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT '延时
MSComm1.Output = "pdc 1 -1000 2 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-20) '计算光源输出-20dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 1 -2000 1 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-30) '计算光源输出-30dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 1 -3000 0 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

'验证PD1
ATT$ = Tpower$ - (5) '计算光源输出5dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 1 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-5) '计算光源输出-5dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 1 " & Ch

r(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-15) '计算光源输出-15dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 1 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-25) '计算光源输出-25dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 1 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-35) '计算光源输出-35dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 1 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
Textpd.SelStart = Len(Textpd.Text) '自动滚屏
ilclr Dev%
illoc Dev%
ilonl Dev%, 0 '释放GPIB
MSComm1.PortOpen = False
MsgBox (" 完成")
End Sub



'PD3校准
Private Sub Pd3cal_Click()
Textcal.Text = ""
Dim Dev_ATT As Integer 'ATT地址
Dim Dev_OPM As Integer 'OPM地址
Const ARRAYSIZE = 1024 '读缓存区字节数
Dim PowerVal As String * ARRAYSIZE '光功率读值功率
Dim Tpower As String '光源总功率
Const Initial_ATT = 13

'ATT初始衰减量
Dim ATT As String 'ATT衰减量
Const Sleep_ATT = 3000 'ATT衰减延时后OPM才读值
Const Sleep_Comm = 100 '串口通信延时
Const Sleep_Cal = 6000 'PD校准延时


Dev_ATT% = ildev(0, 28, 0, T3s, 1, 0)
Dev_OPM% = ildev(0, 20, 0, T3s, 1, 0)
ilclr Dev_ATT%
ilclr Dev_OPM%
ilwrt Dev_ATT%, ":INP:ATT " & Initial_ATT, Len(":INP:ATT " & Initial_ATT) '发送衰减值给ATT
ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
MsgBox ("请将光源接光功率探头1")
ilwrt Dev_ATT%, ":OUTP 1", Len(":OUTP 1") '打开ATT
Sleep Sleep_ATT '延时
ilwrt Dev_OPM%, ":read1:chan1:power?", Len(":read1:chan1:power?") '发送读取光功率指令
ilrd Dev_OPM%, PowerVal$, Len(PowerVal$) '读取光功率返回值
Tpower$ = PowerVal$ + Initial_ATT '计算光源总功率

ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
MsgBox ("请将光源接2A")
ilwrt Dev_ATT%, ":OUTP 1", Len(":OUTP 1") '打开ATT
MsgBox ("确认连接插损最小")
'Shell "D:\study\VB\shiyan\GPIB.exe"
Sleep Sleep_ATT '延时
MSComm1.PortOpen = True '打开通信端口1

'校准PD3
ATT$ = Tpower$ - (8) '计算光源输出8dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 3 800 3 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-2) '计算光源输出-2dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 3 -200 2 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-12) '计算光源输出-12dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 3 -1200 1 " & Chr(13)

'发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-22) '计算光源输出-22dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pdc 3 -2200 0 " & Chr(13) '发送校准指令
Sleep Sleep_Cal '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

'验证PD3
ATT$ = Tpower$ - (9) '计算光源输出9dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (5) '计算光源输出5dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-5) '计算光源输出-5dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-15) '计算光源

输出-15dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-25) '计算光源输出-25dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ATT$ = Tpower$ - (-30) '计算光源输出-30dBm时的ATT值
ilwrt Dev_ATT%, ":INP:ATT " & ATT$, Len(":INP:ATT " & ATT$) ''发送衰减值给ATT
Sleep Sleep_ATT
MSComm1.Output = "pd 3 " & Chr(13) '发送校准指令
Sleep Sleep_Comm '等待校准完成
buf = Trim(MSComm1.Input) '读取校准还回信息
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textcal.Text = Textcal.Text + Chr(13) + Chr(10) + buf '//回车换行
End If

ilwrt Dev_ATT%, ":OUTP 0", Len(":OUTP 0") '关闭ATT
Textpd.SelStart = Len(Textpd.Text) '自动滚屏
ilclr Dev%
illoc Dev%
ilonl Dev%, 0 '释放GPIB
MSComm1.PortOpen = False
MsgBox (" 完成")
End Sub





'读取PD值
Private Sub RdPD_Click()
MSComm1.PortOpen = True '打开通信端口1
Dim buf$
For j = 1 To 6
MSComm1.Output = "pd " & j & Chr(13) '把字符通过串口发送出去,ch(13):换行
Sleep 100 '延时
'For i = 1 To 20000000
'ext i
buf = Trim(MSComm1.Input)
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
Textpd.Text = Textpd.Text + Chr(13) + Chr(10) + buf '//回车换行
End If
Next j
Textpd.SelStart = Len(Textpd.Text) '自动滚屏
MSComm1.PortOpen = False '关闭通信端口1
End Sub
' 超级终端（点击发送按键）
Private Sub CommandSend_Click()
MSComm1.PortOpen = True ' 打开通

信端口1
Dim buf$
If Textsend.Text = "" Then
pp = MsgBox("发送的数据不能为空！", 16)
MSComm1.PortOpen = False
Exit Sub
End If
MSComm1.Output = Trim(Textsend.Text) & Chr(13) 'Trim删除字串符的空格
For I = 1 To 20000000
Next I
buf = Trim(MSComm1.Input) ' 将缓冲区内的数据读入buf变量中
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
TextReceiver.Text = TextReceiver.Text + Chr(13) + Chr(10) + buf '//回车换行
End If
TextReceiver.SelStart = Len(TextReceiver) '自动滚屏
MSComm1.PortOpen = False
End Sub

Private Sub SSTab1_DblClick()

End Sub

' 超级终端（回车发送）
Private Sub Textsend_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
MSComm1.PortOpen = True ' 打开通信端口1
Dim buf$
If Textsend.Text = "" Then
pp = MsgBox("发送的数据不能为空！", 16)
MSComm1.PortOpen = False
Exit Sub
End If
MSComm1.Output = Trim(Textsend.Text) & Chr(13) 'Trim删除字串符的空格
For I = 1 To 20000000
Next I
buf = Trim(MSComm1.Input) ' 将缓冲区内的数据读入buf变量中
If Len(buf) <> 0 Then ' 判断缓冲区内是否存在数据
TextReceiver.Text = TextReceiver.Text + Chr(13) + Chr(10) + buf '//回车换行
End If
TextReceiver.SelStart = Len(TextReceiver) '自动滚屏
MSComm1.PortOpen = False
Textsend.Text = ""
End If
End Sub

'清屏
Private Sub CLS_Click()
Textpd.Text = ""
TextReceiver.Text = ""
Textcal.Text = ""
End Sub

' 退出程序运行
Private Sub Quit_Click()
Unload Me
End Sub