mainform.frm

中日邮件短信网关

      Begin VB.Menu data_turnover 
         Caption         =   "流水表统计"
      End
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Pop3server As String     'pop3服务器地址
Public Pop3name As String       'pop3用户名帐户
Public Pop3password As String   'pop3密码
Public Smtpserver As String     'stmp服务器地址
Public Smtpname As String
Public Smtppassword As String
Public Pop3Account As String    '帐务交换邮件地址
Public MailoutAddress As String

Public DSN As DsnConstants
Public EightBitMime As Integer
Public SizeMethod As Integer
Public Pipelining As Integer
Public EnhancedStatus As Integer
Dim BadStatusMessage As String

'定义数据库连接ado
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim WithEvents RS As Recordset
Attribute RS.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

'定义数据库连接
Dim db As Connection
Dim sql As String

Private Sub Command1_Click()
Frame2.Visible = False
End Sub

Private Sub Command2_Click()
Text2.Text = GB2ShiftJIS(Text1.Text)
Text3.Text = GB2ShiftJIS(Text1.Text)
End Sub

Private Sub Command3_Click()
Text2.Text = ShiftJIS2GB(Text1.Text)
Text3.Text = ShiftJIS2GB(Text1.Text)
End Sub

Private Sub Command4_Click()
Text2.Text = pinyin(Text1.Text)
End Sub

Private Sub Form_Load()

'停止所有子进程
Timermain.Enabled = False
stopserver.Enabled = False
   
SpecifyIni (App.Path + "\config.ini")     '定义系统配置文件的路径名称
        
'定义数据库连接
Set db = New Connection
db.CursorLocation = adUseClient

'---------------------------------------------------------------
'accesss数据库
'db.Open "FILE NAME=" & App.Path & "\MailSmc.dsn"
'sql2000数据库
db.Open "PROVIDER=MSDASQL;dsn=mailsmcsql;uid=sa;pwd=as23vv79;"
'----------------------------------------------------------------
Set adoPrimaryRS = New Recordset
Set RS = New Recordset

   
'===================初始化pop3服务接收部分内容,读取ini文件内容======================
 
  Pop3server = ReadString("mailserver", "Pop3server", 20)
  Pop3name = ReadString("mailserver", "Pop3name", 20)
  Pop3password = ReadString("mailserver", "Pop3password", 20)
  price = Val(ReadString("commom set", "price", 5))
   
'===================初始化短信服务接收部分内容========================




'===================初始化邮件发送内容=================================
  Smtpserver = ReadString("mailserver", "smtpserver", 20)
  Smtpname = ReadString("mailserver", "smtpname", 20)
  Smtppassword = ReadString("mailserver", "smtppassword", 20)
  MailoutAddress = ReadString("mailserver", "MailoutAddress", 20)


'===================初始化短信发送部分内容=============================
   
   
   

'===================初始化用户服务开账及余额查询部分内容=============================
  Euserserver = ReadString("mailserver", "euserserver", 20)
  Eusername = ReadString("mailserver", "euserName", 20)
  Euserpass = ReadString("mailserver", "euserpass", 20)



'LoadLanguage

End Sub
Private Sub Form_Unload(Cancel As Integer)
Set adoPrimaryRS = Nothing
Set RS = Nothing
'关闭GSM Modem
  alasunsms1.CloseComm
   
  
End Sub



' _________________________________________________________________________________
'|
'|
'|                              主进程--测试通过---需要进一步调试
'|
'|
'|_________________________________________________________________________________
'

Private Sub startserver_Click()      '启动服务
 

 '连接短信猫，打开设备
    alasunsms1.SetSN "JPCN", "4639b12966915c10"
    alasunsms1.CommPort = Val(ReadString("Device", "CommPort1", 20))
    If alasunsms1.OpenComm() = 0 Then
       alasunsms1.SetMsgCenterNo ReadString("Device", "MsgCenter1", 20)
        StatusBar.Panels(2).Text = "设备:Modem已连接"
    Else
        MsgBox "设备打开失败"
    End If
    
    
'打开主进程时间进度
Timermain.Enabled = True
startserver.Enabled = False
stopserver.Enabled = True
End Sub

Private Sub stopserver_Click()            '停止服务

Timermain.Enabled = False
startserver.Enabled = True
stopserver.Enabled = False
'关闭GSM Modem

alasunsms1.CloseComm
StatusBar.Panels(2).Text = "设备:Modem已关闭"
End Sub

Private Sub Timermain_Timer()
Static tim As Integer
tim = tim + 1
Debug.Print tim
Select Case tim
    '进程的启动顺序为  邮件接收-处理下账-短信发送-短信接收-邮件发送-帐务交换
  Case 1
    StatusBar.Panels(1).Text = "邮件接收进程"
    MailIn
  Case 2
    StatusBar.Panels(1).Text = "处理下账"
    TurnOver
  Case 3
    StatusBar.Panels(1).Text = "短信发送"
    SMS_Sent
  Case 4
    StatusBar.Panels(1).Text = "短信接收 "
    SMS_in
  Case 5
   StatusBar.Panels(1).Text = "用户服务 "
   User_line
  Case 6
   StatusBar.Panels(1).Text = "帐务交换"
   Account_In
  Case 7
   StatusBar.Panels(1).Text = "邮件发送进程 "
   Mail_sent
  Case 8
   StatusBar.Panels(1).Text = "预留进程1 "
  
  tim = 0
End Select
End Sub
' _________________________________________________________________________________
'|
'|
'|                                   收邮件进程ok2005-11-24
'|
'|
'|_________________________________________________________________________________
'
Private Sub MailIn()
On Error GoTo OnError
Pop1.Messages.Clear
Pop1.Timeout = 10000
Pop1.Login Pop3server, Pop3name, Pop3password

If Pop1.Count = 0 Then      '如果邮件服务器上没有邮件，则退出进程，等待下一次触发
   Pop1.Logout

Else                          '如果邮件服务器上有邮件，则收取邮件并写入邮件队列
   Pop1.Get
   StatusBar.Panels(1).Text = "待收邮件:" & Pop1.Count
   Labmailin.Caption = Val(Labmailin.Caption) + Pop1.Count
   Dim Msg As Message
   Dim n As Long
   Dim lvi As ListItem
 
   For n = 1 To Pop1.Messages.Count
          Set Msg = Pop1.Messages.Item(n)
           sql = "select * from Mailin"
           adoPrimaryRS.Open sql, db, 3, 3
               adoPrimaryRS.AddNew
               adoPrimaryRS.Fields("mfrom").Value = Trim(FromAddress(Msg.From))              '发信地址，作为帐号
               adoPrimaryRS.Fields("mto").Value = Trim(Toaddress(Msg.Content))            '目标地址，提取手机号码
               adoPrimaryRS.Fields("mtext").Value = Trim(Msg.Text)                           '信件内容
               adoPrimaryRS.Fields("addtime").Value = str(Now())         '发信时间
               adoPrimaryRS.Fields("actlabel").Value = "0"                                   '操作标志，0还没有处理
               adoPrimaryRS.Update
               adoPrimaryRS.Close
           '调试期间，删除服务器上的邮件
           Pop1.Delete (n)
   Next
   
   Pop1.Logout
End If

OnError:
   If BadStatusMessage <> "" Then
      StatusBar.Panels(1).Text = "ERROR:邮件接收错误 "
      Label5.Caption = BadStatusMessage
       Z = App.Path & "\web\errorlog.txt"
       Open Z For Append As #2
       Print #2, "邮件接收错误:" & Now() & BadStatusMessage
        Close #2
       BadStatusMessage = ""
    Resume Next
    End If

End Sub
' _________________________________________________________________________________
'|                                                                                 |
'|                                                                                 |
'|                                   邮件处理及下账进程ok
'|
'|
'|_________________________________________________________________________________
'
Private Sub TurnOver()
Dim Pricess
On Error GoTo OnError
'打开mailin表，取得为处理的邮件队列
sql = "select * from Mailin where actlabel like '0'"
adoPrimaryRS.Open sql, db, adOpenStatic, adLockOptimistic

Dim Mailtext As String

'判断邮件队列是否为空
If adoPrimaryRS.RecordCount = 0 Then
   adoPrimaryRS.Close
   Exit Sub

Else

'格式化邮件完毕 进行下账处理


 Dim MBaddress As String
 For n = 1 To adoPrimaryRS.RecordCount
   '先将邮件接收表的处理标志改为1
    adoPrimaryRS.Fields("actlabel").Value = "1"
 
   '判断目标邮件地址（to）的@前面的字符是否为手机号码
   
    MBaddress = adoPrimaryRS.Fields("mto").Value
    MBaddress = Left(MBaddress, InStr(1, MBaddress, "@") - 1)
    
    '去除手机号码中的中国区号
    If InStr(1, MBaddress, "086") = 1 Then
        MBaddress = Mid(MBaddress, 4)
    Else
        If InStr(1, MBaddress, "86") = 1 Then
           MBaddress = Mid(MBaddress, 3)
        End If
    End If


    If Val(MBaddress) > 0 Then
      '开始判断帐户是否有效
      Pricess = (Len(adoPrimaryRS.Fields("mtext").Value) \ 70 + 1) * price
       sql = "select Account_id,Amount from Account where Account_id like '" & adoPrimaryRS.Fields("mfrom").Value & "'"
       RS.Open sql, db, adOpenStatic, adLockOptimistic
    
       If RS.RecordCount > 0 Then
            '帐号存在，判断余额
            
            If RS.Fields("Amount").Value >= Pricess Or RS.Fields("Amount").Value = "1" Then
               '余额足够本次操作，数据库中扣除1次金额，
               
               RS.Fields("Amount").Value = RS.Fields("Amount").Value - price
               RS.Update
               RS.Close
               
               '同时将操作写入流水表
               
               sql = "select * from Turnover"
               RS.Open sql, db, adOpenStatic, adLockOptimistic
               RS.AddNew
               
               RS.Fields("Account_id").Value = adoPrimaryRS.Fields("mfrom").Value
               RS.Fields("ToMB").Value = MBaddress
               RS.Fields("Mail_text").Value = adoPrimaryRS.Fields("mtext").Value
               RS.Fields("turnover_amount").Value = Pricess
               RS.Fields("Action_lable").Value = "0"
               RS.Fields("Action_date").Value = str(Now())
               RS.Update
               RS.Close
               
               
            Else
               '余额不足，反馈余额不足邮件
               
               
             
               RS.Close
            End If
 
       Else
               '帐号不存在，反馈邮件，通知开通帐户