usersynchro.asp

动易的系统

<% @ Language="VBScript" Codepage="936" %>
<%
'###############################################################
'File:      UserSynchro.asp
'Name:      统一接口专用用户数据同步工具
'Code By:   小李刀刀(Eric Wu) http://www.oophome.net
'Copyright: 广东佛山动易网络科技有限公司 http://www.powereasy.net
'Version:   v2.0
'###############################################################
Option Explicit
Response.Buffer = True 
Response.ExpiresAbsolute = Now() - 1 
Response.Expires = 0 
Response.CacheControl = "no-cache" 
Response.AddHeader "Pragma", "No-Cache"
Server.ScriptTimeout = 999999

Rem 全局变量
Dim Action
Dim SysType_Source,DbType_Source,AcFile_Source,SqlServer_Source,SqlDbName_Source,SqlUser_Source,SqlPass_Source
Dim SysType_Remote,DbType_Remote,AcFile_Remote,SqlServer_Remote,SqlDbName_Remote,SqlUser_Remote,SqlPass_Remote
Dim NeedOverwrite,NeedBatch,BatchNum
Dim TotalRecord,SkipRecord,OverwriteRecord,SuccessRecord,FailedRecord
Dim Conn_Source,Conn_Remote,ConnStr
Dim ServerMsg,SQL_Source
Dim oblogConfig,user_dir,user_group,isOblog4

Action = Trim(Request.QueryString("action"))
Select Case Action
    Case "TestConn"
        TestConn
    Case "start"
        Main
End Select

Sub TestConn()
    Dim TestType
    TestType = Trim(Request.form("testtype"))
    If TestType = "source" Then
        GetSourceInfo
        TestSource
        ServerMsg = "{0}源数据库连接测试成功。"
        WriteMsg
    Else
        GetRemoteInfo
        TestRemote
        ServerMsg = "{0}目标数据库连接测试成功。"
        WriteMsg
    End If
End Sub

Sub Main()
    GetSourceInfo
    GetRemoteInfo
    GetOptionInfo
    InitHTML
    CheckParam
    TestSource
    Dim tempRs
    Set tempRs = Conn_Source.Execute(GetSqlString)
    If tempRs.Eof And tempRs.Bof Then
        Set TempRs = Nothing
        ServerMsg = "源数据库中没有记录，不需要同步！"
        WriteMsg
    Else
        SQL_Source = tempRs.GetRows()
        Set TempRs = Nothing
    End If
    TotalRecord = UBound(SQL_Source,2)
    SuccessRecord = Trim(Request.Form("SucNum"))
    SkipRecord = Trim(Request.Form("SkipNum"))
    OverwriteRecord = Trim(Request.Form("OverNum"))
    FailedRecord = Trim(Request.Form("FailNum"))
    If IsNull(TotalRecord) Then TotalRecord = 0
    If SuccessRecord = "" Then SuccessRecord = 0
    If SkipRecord = "" Then SkipRecord = 0
    If OverwriteRecord = "" Then OverwriteRecord = 0
    If FailedRecord = "" Then FailedRecord = 0

    Dim StartID,EndID
    Dim Batch,Batchs
    If NeedBatch Then
        Batch = Request.QueryString("batch")
        If Batch = "" or IsNumeric(Batch) = False Then Batch = 1
        Batchs = Clng(TotalRecord \ BatchNum) + 1
        If CLng(Batch)-Clng(Batchs) > 0 Then Batch = 1
        StartID = (Batch-1) * BatchNum
        EndID = Batch * BatchNum - 1
    Else
        Batch = 1
        Batchs = 1
        StartID = 0
        BatchNum = TotalRecord
        EndID = TotalRecord
    End If

    If EndID > TotalRecord Then EndID = TotalRecord

    RefreshHTMLStart TotalRecord+1, Batchs, Batch, StartID+1, EndID+1
    If CLng(StartID - TotalRecord) <= 0 Then
        TestRemote
		If SysType_Remote = "oblog" Then
			Set oblogConfig = Conn_Remote.Execute("SELECT userdir FROM oblog_userdir WHERE is_default=1")
        	user_dir = oblogConfig(0)
			If isOblog4 Then
				Set oblogConfig = Conn_Remote.Execute("SELECT TOP 1 groupid FROM oblog_groups")
				user_group = oblogConfig(0)
			End If
			oblogConfig.Close
        	Set oblogConfig = Nothing
		End If
        Dim i
        For i = StartID To EndID
            AddNewUser SQL_Source(0,i),SQL_Source(1,i),SQL_Source(2,i),SQL_Source(3,i),SQL_Source(4,i),SysType_Remote,DbType_Remote
        Next
    End If
	If SysType_Remote = "oblog" Then
		If isOblog4 Then
			Conn_Remote.execute ("update oblog_groups set g_members=g_members+" & successRecord & " WHERE groupid = " &user_group)
		End If
		Conn_Remote.execute("UPDATE oblog_setup SET user_count=user_count+" & successRecord)
	End If
    If EndID = TotalRecord Then
        OutputSubmit True, Batch
    Else
        OutputSubmit False, Batch
    End If
End Sub

Function TestSource()
    If DbType_Source = "" Or ((DbType_Source = "access") And (AcFile_Source = "")) Or ((DbType_Source = "sql") And (SqlServer_Source = "" Or SqlDbName_Source = "" Or SqlUser_Source = "")) Then
        ServerMsg = "缺少连接源数据库的必须参数！"
        WriteMsg
    End If
    OpenDatabase "Source"
    Dim strSql_Test
    Select Case SysType_Source
        Case "powereasy"
            strSql_Test = "SELECT TOP 1 * FROM PE_User"
        Case "dvbbs"
            strSql_Test = "SELECT TOP 1 * FROM Dv_User"
        Case "oblog"
            strSql_Test = "SELECT TOP 1 * FROM oblog_User"
    End Select
    MyExecute "Source", strSql_Test, "所选程序类型与数据库结构不匹配！"
End Function

Function TestRemote
    If DbType_Remote = "" Or ((DbType_Remote = "access") And (AcFile_Remote = "")) Or ((DbType_Remote = "sql") And (SqlServer_Remote = "" Or SqlDbName_Remote = "" Or SqlUser_Remote = "")) Then
        ServerMsg = "缺少连接目标数据库的必须参数！"
        WriteMsg
    End If
    OpenDatabase "Remote"
    Dim strSql_Test
    Select Case SysType_Remote
        Case "powereasy"
            strSql_Test = "SELECT TOP 1 * FROM PE_User"
        Case "dvbbs"
            strSql_Test = "SELECT TOP 1 * FROM Dv_User"
        Case "oblog"
            strSql_Test = "SELECT TOP 1 * FROM oblog_User"
    End Select
    MyExecute "Remote",strSql_Test,"所选程序类型与数据库结构不匹配！"
End Function

Sub AddNewUser(UserName,UserPassword,UserEmail,UserQuestion,UserAnswer,SysType,DbType)
    Dim TempSql
    Set TempSql = Conn_Remote.Execute("SELECT * FROM " & GetUserTable(SysType) & " WHERE UserName='" & UserName & "'")
    If TempSql.Eof And TempSql.Bof Then
        If AddUser(UserName,UserPassword,UserEmail,UserQuestion,UserAnswer,SysType,DbType) Then
            SuccessRecord = SuccessRecord + 1
        Else
            FailedRecord = FailedRecord + 1
        End If
    Else
        If NeedOverwrite Then
            If UpdateUser(UserName,UserPassword,UserEmail,UserQuestion,UserAnswer,SysType,DbType) Then
                OverwriteRecord = OverWriteRecord + 1
            Else
                FailedRecord = FailedRecord + 1
            End If
        Else
            SkipRecord = SkipRecord + 1
        End If
    End If
    Set TempSql = Nothing
    RefreshHTMLEnd SuccessRecord, SkipRecord, OverwriteRecord, FailedRecord
End Sub

Function AddUser(UserName,UserPassword,UserEmail,UserQuestion,UserAnswer,SysType,DbType)
    On Error Resume Next
    Dim Trs
    Select Case SysType
        Case "powereasy"
            Dim rsConfig,PresentExp,PresentMoney,PresentPoint,PresentValidNum,PresentValidUnit
            Set rsConfig = Conn_Remote.Execute("select top 1 * from PE_Config")
            If rsConfig.BOF And rsConfig.EOF Then
                PresentExp = 0
                PresentMoney = 0
                PresentPoint = 0
                PresentValidNum = 0
                PresentValidNum = 1
            Else
                PresentExp = rsConfig("PresentExp")
                PresentMoney = rsConfig("PresentMoney")
                PresentPoint = rsConfig("PresentPoint")
                PresentValidNum = rsConfig("PresentValidNum")
                PresentValidUnit = rsConfig("PresentValidUnit")
            End If
            rsConfig.Close
            Set rsConfig = Nothing
            Dim UserID
            UserID = Conn_Remote.Execute("SELECT MAX(UserID) FROM PE_User")(0)
            If IsNull(UserID) Then
                UserID = 1
            Else
                UserID = UserID + 1
            End If
            Dim GroupID, GroupSetting
            Set Trs = Conn_Remote.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=2")
            GroupID = Trs(0)
            GroupSetting = Split(trs(1), ",")
            Trs.Close
            Set Trs = Nothing
            Set Trs = Server.CreateObject("ADODB.RecordSet")
            Trs.Open "SELECT * FROM PE_User WHERE UserID=0",Conn_Remote,1,3
            Trs.AddNew
                    Trs("UserID") = UserID
                    Trs("ClientID") = 0
                    Trs("ContacterID") = 0
                    Trs("UserType") = 0
                    Trs("UserName") = UserName
                    Trs("UserPassword") = UserPassword
                    Trs("LastPassword") = UserPassword
                    Trs("Question") = UserQuestion
                    Trs("Answer") = UserAnswer
                    Trs("Email") = UserEmail
                    Trs("RegTime") = Now()
                    Trs("LoginTimes") = 0
                    Trs("IsLocked") = False
                    Trs("Balance") = PresentMoney
                    Trs("UserExp") = PresentExp
                    Trs("PostItems") = 0
                    Trs("PassedItems") = 0
                    Trs("DelItems") = 0
                    Trs("UnsignedItems") = ""
                    Trs("UnreadMsg") = 0
                    Trs("arrClass_Browse") = ""
                    Trs("arrClass_View") = ""
                    Trs("arrClass_Input") = ""
                    Trs("UserSetting") = ""
                    Trs("UserFriendGroup") = "黑名单$我的好友"
                    Trs("LoginTimes") = 1
                    Trs("LastLoginIP") = ""
                    Trs("LastLoginTime") = Now()
                    Trs("LastPresentTime") = Now()
                    Trs("GroupID") = GroupID
                    Trs("UserPoint") = PresentPoint
                    Trs("BeginTime") = FormatDateTime(Now(), 2)
                    Trs("ValidNum") = PresentValidNum
                    Trs("ValidUnit") = PresentValidUnit
                    Trs("CheckNum") = 9999
                    Trs("SpecialPermission") = False
                    Trs("Blog") = False
             Trs.Update
             Trs.Close
             Set Trs = Nothing
        Case "dvbbs"
            Set Trs = Server.CreateObject("ADODB.RecordSet")
            Trs.Open "SELECT * FROM Dv_User WHERE UserID=0",Conn_Remote,1,3
			Trs.Addnew
                Trs("Username") = UserName
                Trs("Userpassword") = UserPassword
                Trs("UserQuesion") = UserQuestion
                Trs("UserAnswer") = UserAnswer
                Trs("Userclass") = "新手上路"
                Trs("UserGroupID") = 4
                Trs("Titlepic") = "level0.gif"
                Trs("UserWealth") = 100
                Trs("Userep") = 30
                Trs("Usercp") = 30
                Trs("Userisbest") = 0
                Trs("Userdel") = 0
                Trs("Userpower") = 0
                Trs("Lockuser") = 0
                Trs("Usersex") = 1
                Trs("UserEmail") = UserEmail
                Trs("UserFace") = "Images/userface/image1.gif"
                Trs("UserWidth") = 32
                Trs("UserHeight") = 32
                Trs("UserIM") = "||||||||||||||||||"
                Trs("UserFav") = "陌生人,我的好友,黑名单"
                Trs("LastLogin") = Now()
                Trs("JoinDate") = Now()
                Trs("Userpost") = 0
                Trs("Usertopic") = 0
			Trs.Update
            Trs.Close
            Set Trs = Nothing
        Case "oblog"
            Set Trs = Server.CreateObject("ADODB.RecordSet")
            Trs.Open "SELECT * FROM oblog_User WHERE UserID=0",Conn_Remote,1,3
			Trs.Addnew
            	Trs("UserName")=UserName
                Trs("PassWord")=UserPassword
                Trs("Question")=UserQuestion
                Trs("Answer")=UserAnswer
                Trs("userEMail")=UserEmail
                Trs("user_level")=7
                Trs("user_isbest")=0
                Trs("province")=""
                Trs("city")=""
                Trs("Nickname")=UserName
                Trs("adddate")=Now()
                Trs("lastloginip")="0.0.0.0"
                Trs("lastlogintime")=Now()
                Trs("user_dir")=user_dir
				If isOblog4 Then
					Trs("user_group") = user_group
					Trs("newbie") = 1
				End If
		    Trs.update
            Trs.Close
            Set Trs = Nothing
			Conn_Remote.execute("UPDATE oblog_user SET user_folder=userid where UserName='" & UserName & "'")
    End Select
    If Err Then
        Err.Clear
        AddUser = False
    Else