th_pub1.bas

WAP新闻系统,使用感觉还可以,比较合适改写

Attribute VB_Name = "th_pub1"
Public xxzx As String '短信服务中心号码
Public ucs2 As String '要发送的信息的ｕｃｓ２编码
Public len_ucs2 As String  '要发送的信息的ｕｃｓ２编码的长度的十六进制表示
Public sjhma_ys As String '原始手机号码
Public sjhma_bh As String  '变换后的手机号码
Public geshi1 As String '固定格式１
Public geshi2 As String '固定格式２
Public super_admin As Boolean
Public user_num As Long '用户数
Public font_num As Integer '字库汉字个数
Public fenlei As Integer '用户分类　１－主要领导　２－中层　３－教职工　４－学生
Public num_ok As Long '发送成功总数
Public num_error As Integer   '失败总数

'---------------------------数据库
Public sCon As String
Public adoCn As New ADODB.Connection
Public adoRs As New ADODB.Recordset
Public adocm As New ADODB.Command
Public sql As String
'========= 类型定义 ========================================
Type user
  bh       As Long
  name       As String
  father_name      As String
  gsm_num     As String
  jb As String
  num_all As Integer
  num_error As Integer
  
End Type
Type ucs2_font
chinese As String
ucs2 As String
End Type

Public myuser(1 To 5000) As user   ''全部用户信息
Public today_user(1 To 2000) As user '当前要发布信息的用户信息

Public myfont(1 To 7411) As ucs2_font ''字库信息

Private Sub Main()
Dim adoDsn As String
If App.PrevInstance = True Then
    End
End If
adoDsn = "data Source=" & App.Path & "\TeleSystem.mdb;"
''On Error GoTo cnError
Set adoCn = New ADODB.Connection
adoCn.Provider = "Microsoft.Jet.OLEDB.4.0"
'RecPath = App.Path & "\voice\"
adoCn.CursorLocation = adUseClient
adoCn.ConnectionTimeout = 30  '单位:秒
adoCn.Open adoDsn
Set adoRs = New ADODB.Recordset
adoRs.CacheSize = 900
adoRs.CursorLocation = adUseClient

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & adoDsn & ";Persist Security Info=False"
form1.Show

'frmtele.Show
End Sub


Public Sub SystemClose()
'On Error Resume Next
'Call CloseTele
If Voice_tele = True Then EndCard
Unload frmtele
DoEvents
adoRs.Close
Set adoRs = Nothing
adoCn.Close
Set adoCn = Nothing
End
End Sub
Public Sub CloseSystem()
On Error Resume Next
DoEvents
adoRs.Close
Set adoRs = Nothing
adoCn.Close
Set adoCn = Nothing
  
End
End Sub
Public Sub init_user()
Dim i As Integer
sql = "select  编号学号,姓名,家长姓名,联系手机号,级别,总次数,故障次数 from user_info order by 编号学号"
adoRs.Open sql, adoCn, adOpenForwardOnly, adLockReadOnly, adCmdText
user_num = adoRs.RecordCount
adoRs.MoveFirst
For i = 1 To user_num
    myuser(i).bh = adoRs(0)
    myuser(i).name = adoRs(1)
    myuser(i).father_name = adoRs(2) & ""
    myuser(i).gsm_num = adoRs(3)
    myuser(i).jb = adoRs(4)
    myuser(i).num_all = adoRs(5)
    myuser(i).num_error = adoRs(6)
    adoRs.MoveNext
Next i

adoRs.Close
End Sub
Public Sub init_font()
Dim i As Integer
sql = "select  编号,字库,编码 from 字库 "
adoRs.Open sql, adoCn, adOpenForwardOnly, adLockReadOnly, adCmdText
i = 1
While Not adoRs.EOF
'Debug.Print adoRs(0)
    myfont(i).chinese = adoRs(1)
    myfont(i).ucs2 = adoRs(2)
    
    adoRs.MoveNext
    i = i + 1
Wend
font_num = i - 1
adoRs.Close

End Sub