📄 form1.frm
字号:
TabIndex = 23
Top = 90
Width = 1700
WordWrap = -1 'True
End
Begin VB.Image Image1
Height = 315
Left = 0
Picture = "Form1.frx":126B
Top = 0
Width = 5160
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "欢迎您的咨询:renyanning@sohu.com"
ForeColor = &H00404040&
Height = 255
Left = 12120
TabIndex = 22
Top = 480
Width = 3000
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "※移动和联通短消息中心号码均可自由转换※"
ForeColor = &H00404040&
Height = 255
Left = 1230
TabIndex = 10
Top = 480
Width = 3735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const SND_ASYNC = &H1
Private Const SND_MEMORY = &H4
Private Declare Function PlaySoundMemory Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal pMemory As Long, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Dim bytWavData() As Byte
Dim start As Long
Dim pause As Long
Dim strData As String
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Label3.Caption = "最快最优的解卡服务请联系 业务QQ:34505205（读你）" '擦除字符，还原初始化
Label3.ForeColor = &H0&
Text1.SetFocus
End Sub
Private Sub Command3_Click()
On Error GoTo err_line1
If Len(Text4.Text) > 19 Then
Dim l, m, n, o, p, q, r, s, t, u, v, w, X, Y, z, ab, ac, ad, ae, af As Byte
l = Mid(Text4.Text, 2, 1)
m = Mid(Text4.Text, 1, 1)
n = Mid(Text4.Text, 4, 1)
o = Mid(Text4.Text, 3, 1)
p = Mid(Text4.Text, 6, 1)
q = Mid(Text4.Text, 5, 1) '字符互换
r = Mid(Text4.Text, 8, 1)
s = Mid(Text4.Text, 7, 1)
t = Mid(Text4.Text, 10, 1)
u = Mid(Text4.Text, 9, 1)
v = Mid(Text4.Text, 12, 1)
w = Mid(Text4.Text, 11, 1)
X = Mid(Text4.Text, 14, 1)
Y = Mid(Text4.Text, 13, 1)
z = Mid(Text4.Text, 16, 1)
ab = Mid(Text4.Text, 15, 1)
ac = Mid(Text4.Text, 18, 1)
ad = Mid(Text4.Text, 17, 1)
ae = Mid(Text4.Text, 20, 1)
af = Mid(Text4.Text, 19, 1)
Text3.Text = "" & l & m & n & o & p & q & r & s & t & u & v & w & X & Y & z & ab & ac & ad & ae & af
Label8.Caption = "转换成功！请将蓝色数据复制到DatMiner相应选项中"
Label8.ForeColor = &HFF&
Else
err_line1:
MsgBox " " & Chr(13) & "对不起，您输入的ICCID号有误！" & Chr(13) & "请您核对后重新输入！", vbExclamation, "错误提示！":
Text4.SetFocus
End If
End Sub
Private Sub Command4_Click()
Text3.Text = ""
Text4.Text = ""
Label8.Caption = "最快最优的解卡服务请联系 业务QQ:34505205（读你） "
Label8.ForeColor = &H0&
Text4.SetFocus
End Sub
Private Sub Command5_Click()
Unload Me
End
End Sub
Private Sub Command6_Click()
Unload Me
End
End Sub
Private Sub Command7_Click()
On Error GoTo err
start = Timer
pause = 1
While Timer < start + pause
DoEvents
Wend
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
MSComm1.CommPort = Mid(Combo1.Text, 4)
MSComm1.PortOpen = True
If MSComm1.PortOpen = True Then
Text5.Text = "连接成功..."
Text5.ForeColor = &H80000008
Combo1.Enabled = False
Command7.Enabled = False
Command8.Enabled = True
Command9.Enabled = True
Command8.SetFocus
MSComm1.InputMode = comInputModeBinary
MSComm1.InBufferCount = 0
MSComm1.InputLen = 0
MSComm1.Settings = "19200,N,8,1"
MSComm1.RThreshold = 1
MSComm1.OutBufferCount = 0
Text5.Text = ""
MSComm1.Output = "reset" + Chr$(13) + vbCr '读取或者识别SIM卡的IMSI AT+CIMI=
Else
err:
If Text5.Text = "端口打开错误..." Then
Text5.Text = "端口打开错误,请再次确认..."
Else
Text5.Text = "端口打开错误..."
End If
End If
End Sub
Private Sub Command8_Click()
On Error GoTo err
Dim reco As String
Dim count As Integer
Command8.Enabled = False
'MSComm1.Output = "ATS0=1E1Q0M0" + Chr$(13) '设置参数
'MSComm1.Output = "AT+CMGF=1" + vbCr '以TEXT模式发送短信
start = Timer
pause = 1
While Timer < start + pause
DoEvents
Wend
'MSComm1.Output = "ATR" + Chr$(13) + vbCr '读取或者识别SIM卡的IMSI AT+CIMI=
start = Timer
pause = 2
While Timer < start + pause
DoEvents
Wend
'MSComm1.Output = "AT+STGI=" + vbCr '返回一个
'MSComm1.Output = "AT+CCID=1" + vbCr '读取SIM卡上的EF-CCID文件
'MSComm1.Output = "AT+CSCA=1" + vbCr '短信服务中心地址
'MSComm1.Output = "AT+CPLMN=1" + vbCr '在PLMN上的信息
'MSComm1.Output = "AT+CNMI = 2, 2, , 1" '来了新信息直接显示到串口，不作存储
'reco = MSComm1.Input
'Text5.Text = Text5.Text & vbCrLf & "ATR=" & Hex(Asc(reco))
count = MSComm1.InBufferCount
If count = "0" Then
Text5.Text = Text5.Text & vbCrLf & "读取成功..."
Else
err:
Text5.Text = "SIM卡读取失败..."
Command9.Enabled = False
Command8.Enabled = False
Command7.Enabled = True
Combo1.Enabled = True
End If
End Sub
Private Sub Command9_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False ' 关闭串行端口
Command9.Enabled = False
Command8.Enabled = False
Command7.Enabled = True
Combo1.Enabled = True
Text5.Text = "连接已断开..."
End Sub
Private Sub Form_Load()
Me.Width = 350 * 15
Me.Height = 241 * 15
Combo1.Text = "COM1"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Label12_Click() '窗体移动效果
Label12.Height = 220
Label12.Enabled = False
If Label13.Enabled = False Then
Label13.Enabled = True
Label13.Height = 190
Do While (1)
Frame1.Left = Frame1.Left + 25
Frame2.Left = Frame2.Left + 25
Frame3.Left = Frame3.Left + 25
Label4.Left = Label4.Left + 25
Label16.Left = Label16.Left + 25
Label11.Left = Label11.Left + 25
If Frame1.Left >= 250 Then Exit Do
DoEvents
Loop
Else
If Label14.Enabled = False Then
Label14.Enabled = True
Label14.Height = 190
Do While (1)
Frame1.Left = Frame1.Left + 50
Frame2.Left = Frame2.Left + 50
Frame3.Left = Frame3.Left + 50
Label4.Left = Label4.Left + 50
Label16.Left = Label16.Left + 50
Label11.Left = Label11.Left + 50
If Frame1.Left >= 250 Then Exit Do
DoEvents
Loop
End If
End If
bytWavData = LoadResData(101, "CUSTOM")
PlaySoundMemory VarPtr(bytWavData(0)), ByVal 0&, SND_MEMORY Or SND_ASYNC
Text1.SetFocus
End Sub
Private Sub Label13_Click() '窗体移动效果
Label13.Height = 220
Label13.Enabled = False
If Label12.Enabled = False Then
Label12.Enabled = True
Label12.Height = 190
Do While (1)
Frame1.Left = Frame1.Left - 25
Frame2.Left = Frame2.Left - 25
Frame3.Left = Frame3.Left - 25
Label4.Left = Label4.Left - 25
Label16.Left = Label16.Left - 25
Label11.Left = Label11.Left - 25
If Frame2.Left <= 250 Then Exit Do
DoEvents
Loop
Else
If Label14.Enabled = False Then
Label14.Enabled = True
Label14.Height = 190
Do While (1)
Frame1.Left = Frame1.Left + 25
Frame2.Left = Frame2.Left + 25
Frame3.Left = Frame3.Left + 25
Label4.Left = Label4.Left + 25
Label16.Left = Label16.Left + 25
Label11.Left = Label11.Left + 25
If Frame2.Left >= 250 Then Exit Do
DoEvents
Loop
End If
End If
bytWavData = LoadResData(101, "CUSTOM")
PlaySoundMemory VarPtr(bytWavData(0)), ByVal 0&, SND_MEMORY Or SND_ASYNC
Command7.Default = True
End Sub
Private Sub Label14_Click() '窗体移动效果
Label14.Height = 220
Label14.Enabled = False
If Label12.Enabled = False Then
Label12.Enabled = True
Label12.Height = 190
Do While (1)
Frame1.Left = Frame1.Left - 50
Frame2.Left = Frame2.Left - 50
Frame3.Left = Frame3.Left - 50
Label4.Left = Label4.Left - 50
Label16.Left = Label16.Left - 50
Label11.Left = Label11.Left - 50
If Frame3.Left <= 250 Then Exit Do
DoEvents
Loop
Else
If Label13.Enabled = False Then
Label13.Enabled = True
Label13.Height = 190
Do While (1)
Frame1.Left = Frame1.Left - 25
Frame2.Left = Frame2.Left - 25
Frame3.Left = Frame3.Left - 25
Label4.Left = Label4.Left - 25
Label16.Left = Label16.Left - 25
Label11.Left = Label11.Left - 25
If Frame3.Left <= 250 Then Exit Do
DoEvents
Loop
End If
End If
bytWavData = LoadResData(101, "CUSTOM")
PlaySoundMemory VarPtr(bytWavData(0)), ByVal 0&, SND_MEMORY Or SND_ASYNC
Text4.SetFocus
End Sub
Private Sub Text1_Change()
If Len(Text1.Text) > 10 Then
Command1.Default = True '激活回车执行命令
Command3.Default = False
Else
Command1.Default = False
Command3.Default = False
End If
End Sub
Private Sub Text4_Change()
If Len(Text4.Text) > 19 Then
Command3.Default = True '激活回车执行命令
Command1.Default = False
Else
Command1.Default = False
Command3.Default = False
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
KeyAscii = 0 '判断如果不是数字键和backspace键的话，就认为是没有按键盘，意思是只能输入上述键！
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
KeyAscii = 0 '判断如果不是数字键和backspace键的话，就认为是没有按键盘，意思是只能输入上述键！
End If
End Sub
Private Sub Command1_Click()
On Error GoTo err_line2
If Text1.Text > "13010100499" And Text1.Text < "13010999501" Or Text1.Text > "13800100499" And Text1.Text < "13800999501" And Len(Text1.Text) > 10 Then
Dim a, b, c, d, e, F, g, H, i As Byte
a = Mid(Text1.Text, 4, 1)
b = Mid(Text1.Text, 3, 1)
c = Mid(Text1.Text, 6, 1)
d = Mid(Text1.Text, 5, 1)
e = Mid(Text1.Text, 8, 1)
F = Mid(Text1.Text, 7, 1) '字符互换
g = Mid(Text1.Text, 10, 1)
H = Mid(Text1.Text, 9, 1)
i = Mid(Text1.Text, 11, 1)
Text2.Text = "FFFFFFFFFFFFFFFFFFFFFFFFEDFFFFFFFFFFFFFFFFFFFFFFFF08916831" & a & b & c & d & e & F & g & H & "F" & i & "E00FFFFFF"
Label3.Caption = "转换成功！请将蓝色数据复制到DatMiner相应选项中"
Label3.ForeColor = &HFF&
Else
err_line2:
MsgBox " " & Chr(13) & "对不起，您输入的短信息中心号码有误！" & Chr(10) & "移动请按“13800993500”的格式输入" & Chr(13) & "联通请按“13010993500”的格式输入", vbExclamation, "错误提示！":
Text1.SetFocus
End If
End Sub
Private Sub MSComm1_OnComm()
On Error Resume Next
Dim strBuff As String
Dim BytReceived() As Byte
Dim i As Integer
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
BytReceived() = strBuff
For i = 0 To UBound(BytReceived) '转16进制
If Len(Hex(BytReceived(i))) = 1 Then
strData = strData & "0" & Hex(BytReceived(i))
Else
strData = strData & Hex(BytReceived(i))
End If
Next
Text5.Text = ""
Text5.Text = "ATR=" & strData '显示接收数据
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -