mobini.bas

BREW平台上实现的一个聊天系统

Attribute VB_Name = "mobIni"
Option Explicit

'配置常量
Public Const C_INI_FILE = "SendMail.ini"
Private Const C_BUFFER_MAX_LENGTH = 255
Private Const C_FAIL_DEAFULT = "not found"
Private Const C_SECTION_DATABASE = "DataBase"

Public m_SendMaxNumberPerPackage As Variant
Public m_Timeout4Connect As Long
Public m_Timeout4Recv As Long
Public m_PauseTime4Recv As Long
Public m_PauseTime4Terminate As Long
Public m_SendIntervalTime As Long
Public m_Timeout4Response As Long
Public m_AgentFeeFlag As Integer
Public m_SExpireTime As String
Public m_SFeeMobileID As String
Public m_SFeeType As Integer
Public m_SFeeValue As String
Public m_SGivenValue As String
Public m_SMsgMsg As Integer
Public m_SMsgType As Integer
Public m_MobileIDFix As String
Public m_SMoreLateToMTFlag As Integer
Public m_SPriority As Integer
Public m_SReserve As String
Public m_SScheduleTime As String
Public m_SSeviceType As String
Public m_RegDeliveryFlag As Integer
Public m_SSPID As String
Public m_SSPNumber As String
Public m_STPpid As Integer
Public m_STPudhi As Integer
Public m_SVersion As Integer

Public Type TDATABASE
   BusiServerName        As String     '服务器名称
   BusiDatabaseName      As String     '数据库名称
   BusiLoginName         As String     '数据库登录名
   BusiPassword          As String     '数据库密码
   ip                    As String     '网关IP
   port                  As String     '端口
   name                  As String     '登录名
   password              As String     '密码
   spnumber              As String     '网关接入号
End Type

Public Type TINI
   DataBase As TDATABASE
End Type

Public g_Ini As TINI
Private m_ini_Init As TINI

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Sub InitIni()
'***************************************************
'目    的： 给INI配置属性名称赋值
'输    入： 无
'输出/返回：无
'作    者： 张龙
'完成日期： 2004/01/07
'修 正 人：
'修正日期：
'****************************************************

   m_ini_Init.DataBase.BusiServerName = "BusiServerName"
   m_ini_Init.DataBase.BusiDatabaseName = "BusiDatabaseName"
   m_ini_Init.DataBase.BusiLoginName = "BusiLoginName"
   m_ini_Init.DataBase.BusiPassword = "BusiPassword"
   m_ini_Init.DataBase.ip = "ip"
   m_ini_Init.DataBase.port = "port"
   m_ini_Init.DataBase.name = "name"
   m_ini_Init.DataBase.password = "password"
   m_ini_Init.DataBase.spnumber = "spnumber"
End Sub

Public Function GetConfigMsg() As Boolean
'***************************************************
'目    的： 读ini文件
'输    入： 无
'输出/返回：True 读成功 False 读失败
'作    者： 张龙
'完成日期： 2004/01/07
'修 正 人：
'修正日期：
'****************************************************
   Dim lError As Long
   Dim strTemp As String * 255
   GetConfigMsg = False
   InitIni
   
   '数据库信息
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiServerName, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.BusiServerName = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiDatabaseName, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.BusiDatabaseName = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiLoginName, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.BusiLoginName = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiPassword, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.BusiPassword = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.ip, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.ip = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.port, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.port = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.name, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.name = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.password, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.password = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   
   strTemp = Space(255)
   lError = GetPrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.spnumber, C_FAIL_DEAFULT, strTemp, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
   If lError >= C_BUFFER_MAX_LENGTH - 2 Or Left(strTemp, 9) = C_FAIL_DEAFULT Then Exit Function
   g_Ini.DataBase.spnumber = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
   m_SSPNumber = g_Ini.DataBase.spnumber
   
   GetConfigMsg = True
End Function

Public Function WriteConfigMsg() As Boolean
'***************************************************
'目    的： 写ini文件
'输    入： 无
'输出/返回：True 写成功 False 写失败
'作    者： 张龙
'完成日期： 2004/01/07
'修 正 人：
'修正日期：
'****************************************************
   Dim lResult As Long
   InitIni
   WriteConfigMsg = False
   
   '数据库信息
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiServerName, g_Ini.DataBase.BusiServerName, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiDatabaseName, g_Ini.DataBase.BusiDatabaseName, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiLoginName, g_Ini.DataBase.BusiLoginName, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.BusiPassword, g_Ini.DataBase.BusiPassword, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.ip, g_Ini.DataBase.ip, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.port, g_Ini.DataBase.port, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.name, g_Ini.DataBase.name, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.password, g_Ini.DataBase.password, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   lResult = WritePrivateProfileString(C_SECTION_DATABASE, m_ini_Init.DataBase.spnumber, g_Ini.DataBase.spnumber, App.Path & "\" & C_INI_FILE)
   If lResult = 0 Then Exit Function
   
   WriteConfigMsg = True
End Function

Public Sub GetParamValue()
   m_SendMaxNumberPerPackage = CInt(FrmParam.MaxUserTxt.Text)
   m_Timeout4Connect = CLng(FrmParam.ConTOutTxt.Item(1).Text)
   m_Timeout4Recv = CLng(FrmParam.RecvTOutTxt.Item(3).Text)
   m_PauseTime4Recv = CLng(FrmParam.RecvSpaceTxt.Item(2).Text)
   m_PauseTime4Terminate = CLng(FrmParam.DisconDelayTxt.Item(5).Text)
   m_SendIntervalTime = CLng(FrmParam.SendSpaceTxt.Item(4).Text)
   m_Timeout4Response = CLng(FrmParam.ReqTOutTxt.Item(0).Text)
   m_AgentFeeFlag = CInt(FrmParam.FeeFlagCom.Text)
   m_SExpireTime = FrmParam.ReserveTxt.Text
   m_SFeeMobileID = FrmParam.FeeMobileTxt.Text
   m_SFeeType = CInt(FrmParam.FeeTypeCom.Text)
   m_SFeeValue = FrmParam.FeeValueTxt.Text
   m_SGivenValue = FrmParam.FeeGiveTxt.Text
   m_SMsgMsg = CInt(FrmParam.InfoFormatCom.Text)
   m_SMsgType = CInt(FrmParam.InfoTypeCom.Text)
   m_MobileIDFix = "86"
   m_SMoreLateToMTFlag = CInt(FrmParam.InfoMtCom.Text)
   m_SPriority = CInt(FrmParam.InfoPriorityCom.Text)
   m_SReserve = "0"
   m_SScheduleTime = FrmParam.ScheduleTxt.Text
   m_SSeviceType = FrmParam.ServerIDCom.Text
   m_RegDeliveryFlag = CInt(FrmParam.InfoReportCom.Text)
   m_SSPID = FrmParam.SPIDCom.Text
'   m_SSPNumber
   m_STPpid = 0
   m_STPudhi = 0
   m_SVersion = 12
End Sub

'Public Property Let Para(ByVal eInParaType As FTMGCMPPLib.tagParaType, ByVal vNewValue As Long)
'      m_Sgip.
'
'End Property