📄 form1.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form Form1
Caption = "流程任务短信催派"
ClientHeight = 5190
ClientLeft = 165
ClientTop = 450
ClientWidth = 7200
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5190
ScaleWidth = 7200
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "退出"
BeginProperty Font
Name = "SimSun"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 7
Top = 1680
Width = 1335
End
Begin VB.Timer Timer2
Interval = 500
Left = 120
Top = 960
End
Begin VB.CommandButton Command1
Caption = "开始发送"
BeginProperty Font
Name = "SimSun"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 6
Top = 720
Width = 1335
End
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 1440
Top = 960
Visible = 0 'False
Width = 1455
_ExtentX = 2566
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=10.74.168.108"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "10.74.168.108"
OtherAttributes = ""
UserName = "sa"
Password = "jiushisa123"
RecordSource = "select * from LIVEFLOW_DUANXIN_CUIPAI_MID"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "SimSun"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame1
Caption = "日志信息"
Height = 1935
Left = 0
TabIndex = 4
Top = 3120
Width = 7095
Begin VB.ListBox List1
Height = 1500
Left = 120
TabIndex = 5
Top = 240
Width = 6855
End
End
Begin VB.TextBox Text2
BackColor = &H00FFFF00&
DataField = "USER_PHS"
DataSource = "Adodc1"
ForeColor = &H00FF0000&
Height = 495
Left = 3120
TabIndex = 1
Top = 1440
Width = 2175
End
Begin MSWinsockLib.Winsock wsck1
Left = 1200
Top = 1320
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 300
Left = 480
Top = 1440
End
Begin VB.TextBox Text1
BackColor = &H00FFFF00&
DataField = "content"
DataSource = "Adodc1"
ForeColor = &H00FF0000&
Height = 975
Left = 3120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 240
Width = 3615
End
Begin VB.Label Label2
Caption = "发送号码:"
BeginProperty Font
Name = "SimSun"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 3
Top = 1680
Width = 1095
End
Begin VB.Label Label1
Caption = "发送内容:"
BeginProperty Font
Name = "SimSun"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 2
Top = 600
Width = 1095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public if_back As Integer
Public gstr_SendNumber As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim cn As ADODB.Connection
Dim cn1 As ADODB.Connection
Dim rt As ADODB.Recordset
Dim rt1 As ADODB.Recordset
Private Function init_sock()
On Error Resume Next
wsck1.Close
DoEvents
Sleep (100)
wsck1.RemoteHost = "134.32.1.181"
wsck1.RemotePort = 8851
wsck1.Protocol = sckTCPProtocol
wsck1.Connect
DoEvents
Sleep (100)
While wsck1.State <> sckConnected
Select Case wsck1.State
Case 0
wsck1.Connect
Sleep (200)
Case 1
Sleep (200)
Case 2
Sleep (200)
Case 3
Sleep (200)
Case 4
Sleep (200)
Case 5
Sleep (200)
Case 6
Sleep (200)
Case 8
Sleep (200)
wsck1.Connect
Case 9
wsck1.Close
Sleep (200)
wsck1.Connect
End Select
DoEvents
Wend
DoEvents
Timer1.Enabled = True
End Function
Private Sub Command1_Click()
Dim strDt As String
strDt = Format(Now, "yyyy-mm-dd HH:MM:SS")
List1.AddItem (strDt + "开始发送！")
init_sock
If Command1.Enabled Then
Command1.Enabled = False
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Timer2_Timer()
Adodc1.Refresh
End Sub
Private Sub wsck1_Connect()
List1.AddItem (Format(Now, "yyyy-mm-dd HH:MM:SS") + "连接成功,开始发送短信")
End Sub
Private Sub wsck1_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim str As String
Dim rst As New ADODB.Recordset
On Error Resume Next
wsck1.GetData data
If LCase(Left(data, 5)) = "st_ok" Then
str = gstr_SendNumber + "发送成功"
Set cn = New ADODB.Connection
cn.ConnectionString = "DSN=10.74.168.108;UID=sa;PWD=jiushisa123;"
cn.CommandTimeout = 30
cn.Open
Set rt = New ADODB.Recordset
Set rt.ActiveConnection = cn
rt.LockType = adLockOptimistic
rt.Source = "select * from LIVEFLOW_DUANXIN_CUIPAI_MID where 1=2"
rt.Open
' rt.AddNew
'rt.Fields("user_name") = Trim(Adodc1.Recordset.Fields("user_name"))
'rt.Fields("insert_time") = Format(Now, "yyyy-mm-dd HH:MM:SS")
'rt.Fields("telephone") = Trim(Adodc1.Recordset.Fields("telephone"))
'rt.Fields("content") = Trim(Adodc1.Recordset.Fields("content"))
'rt.Fields("phone") = Trim(Adodc1.Recordset.Fields("phone"))
'rt.Update
List1.AddItem str
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Delete
Else: Exit Sub
End If
Else
str = gstr_SendNumber + "发送失败！" + data
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Delete
Else: Exit Sub
End If
List1.AddItem str
List1.AddItem gstr_SendNumber
End If
DoEvents
End Sub
Private Sub wsck1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
List1.AddItem (Format(Now, "yyyy-mm-dd HH:MM:SS") + "发送错误，发送终止")
End Sub
Private Sub Timer1_Timer()
Dim strContent As String
Dim strMsg As String
Dim strFrom
Dim strTo
Dim cTime As Integer
Dim tele As String
Dim strLine As String
Dim fromm
'8:00-22:00之间才能发送
'If Not (Hour(Now) >= 8 And Hour(Now) <= 22) Then
' Exit Sub
' End If
Timer1.Enabled = False
strContent = Text1.Text
tele = Trim(Text2.Text)
fromm = "108"
strFrom = "<FROM:" & fromm & ">"
If Text2.Text <> "" Then
init_sock
gstr_SendNumber = Text1.Text
strTo = "<TO:" & "0635" & tele & ">"
strMsg = strFrom & strTo & "<MSG:BZ " & strContent & ">" & Chr(10) & Chr(13)
if_back = 0
List1.AddItem ("正在发送") + gstr_SendNumber
If wsck1.State <> sckConnected Then
Sleep (200)
DoEvents
init_sock
Exit Sub
End If
wsck1.SendData strMsg
cTime = 0
While if_back = 0 And cTime < 15
Sleep (100)
cTime = cTime + 1
DoEvents
Wend
wsck1.Close
End If
Timer1.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -