Source code Server.doc

Source code Server

Source code Server

Sub connectserver(ddriver As String, sserver As String, uuid As String, ppw As String, ddb As String)

On Error GoTo loi

If UCase$(ddriver) = "ORACLE ODBC DRIVER" Then

If oracleconn.State = 0 Then

showstatus "Connectting to Oracle server ", True

oracleconn.ConnectionString = "Driver=" & ddriver & ";Server="

& sserver & ";UID=" & uuid & ";PWD=" & ppw & ";DBQ=" & ddb &

";"""

oracleconn.ConnectionTimeout = 20

oracleconn.Open

Else

MsgBox "This server connected", vbInformation, "Connected" showstatus "Server not ready", False

Exit Sub

End If

Else

If sqlconn.State = 0 Then

showstatus "Connectting to SQL server ", True

sqlconn.ConnectionString = "Driver=" & ddriver & ";Server=" & sserver & ";UID=" & uuid & ";PWD=" & ppw & ";Database=" & ddb &

""

sqlconn.ConnectionTimeout = 20

sqlconn.Open

Else

MsgBox "This server connected", vbInformation, "Connected" showstatus "Server not ready", False

Exit Sub

End If

End If

'Neu da ket noi duoc toi 2 server thi vao che do auto test

If oracleconn.State = 1 And sqlconn.State = 1 Then

frmmain.mnuconnect.Enabled = False

frmmain.tool.Buttons("connect").Enabled = False

frmmain.mnudisconnect.Enabled = True

frmmain.tool.Buttons("disconnect").Enabled = True

frmmain.autotime.Interval = 1000

showstatus "Ready", False

frmmain.autotime.Enabled = True

Else

showstatus "Connectting success, but server not ready", False

End If

Exit Sub

loi:

MsgBox Err.Description, vbInformation, "Can't connect"

frmmain.mnuconnect.Enabled = True

frmmain.tool.Buttons("connect").Enabled = True

showstatus "Connectting fail, server not ready", False

If oracleconn.State = 1 Then oracleconn.Close

If sqlconn.State = 1 Then sqlconn.Close

End Sub

Private Sub MDIForm_Load()

Dim makeable As Boolean

Dim autotimes As Integer

Dim autoconn As Integer

On Error GoTo loi

showstatus "Server startting ", False

makeable = False

connected = False

'Lay lai vi tri luc tat chuong trinh

Me.Top = getreg("top")

Me.Left = getreg("left")

'Hien thi Ip cua Middleware

status.Panels("ip").Text = status.Panels("ip").Text & socket(0).LocalIP makeable = True

'Khoi tao 2 duong truyen co dinh toi 2 server

Set oracleconn = New ADODB.Connection

Set sqlconn = New ADODB.Connection

'Lay thong tin khoi dong

re:

Set sysdb = OpenDatabase(App.Path & "\sysserver.mdb")

Set connectre = sysdb.OpenRecordset("connect")

Set settingre = sysdb.OpenRecordset("setting")

If connectre.RecordCount > 0 And settingre.RecordCount > 0 Then autoconn = settingre.Fields("AutoConnect").value

'Neu autoconnect = true thi sau 3 giay se connect

If autoconn = -1 Then

autotimes = settingre.Fields("TestTime").value

autotime.Interval = 3000

autotime.Enabled = True

Exit Sub

End If

ElseIf settingre.RecordCount = 0 Then

'Set default values

settingre.AddNew

settingre.Fields("TestTime") = 20000

settingre.Fields("QueryTimeout") = 5000

settingre.Fields("AutoConnect") = 0

settingre.Update

End If

showstatus "No auto connect, server not ready", False

mnuconnect.Enabled = True

tool.Buttons("connect").Enabled = True

Exit Sub

loi:

If makeable Then

'Tao database luu thong tin he thong

makeable = False

makesysdb

Resume re

Else

MsgBox Err.Description, vbInformation, "Can't start"

Unload Me

End If

End Sub

Private Sub autotime_Timer()

Dim drv As String

Dim ser As String

Dim uid As String

Dim pw As String

Dim cdb As String

Dim i As Integer

On Error GoTo loi

autotime.Enabled = False

If Not connected Then

connected = True

re:

drv = connectre.Fields("Driver")

ser = connectre.Fields("HostName")

uid = connectre.Fields("UserID")

pw = connectre.Fields("Password")

cdb = connectre.Fields("Database")

'Connect toi Oracle

connectserver drv, ser, uid, pw, cdb

If oracleconn.State = 0 And sqlconn.State = 0 Then Exit Sub 'Tiep tuc connect toi Sql server

If oracleconn.State = 1 Then

connectre.MoveNext

GoTo re

End If

Set orauserre = New ADODB.Recordset

Set oradbre = New ADODB.Recordset

Set sqluserre = New ADODB.Recordset

Set sqldbre = New ADODB.Recordset

oracleconn.CommandTimeout =

settingre.Fields("QueryTimeout").value

sqlconn.CommandTimeout =

settingre.Fields("QueryTimeout").value

End If

showstatus "Testting query executing ", True

'Thuc hien cac cau query cap nhat va tham do server down

If orauserre.State = 1 Then orauserre.Close

If oradbre.State = 1 Then oradbre.Close

If sqluserre.State = 1 Then sqluserre.Close

If sqldbre.State = 1 Then sqldbre.Close

orauserre.Open "Select username,user_id,created From all_users", oracleconn, adOpenStatic, adLockBatchOptimistic, adCmdText

'oradbre.Open "Select From", oracleconn, adOpenStatic,

adLockBatchOptimistic, adCmdText

sqluserre.Open "Select name,suid,password,accdate From syslogins", sqlconn, adOpenStatic, adLockBatchOptimistic, adCmdText

sqldbre.Open "Select name,dbid,crdate From sysdatabases", sqlconn, adOpenStatic, adLockBatchOptimistic, adCmdText

Exit Sub

loi:

autotime.Enabled = False

If Err.Number = 94 Or Err.Number = -2147217865 Then

MsgBox "Can't auto connect", vbInformation, "Can't connect"

mnudisconnect_Click

End If

' if err.Number = then

' If oracleconn.State = 0 Then MsgBox "Oracle server died", vbInformation, "Server died"

' If sqlconn.State = 0 Then MsgBox "SQL server died", vbInformation, "Server died"

'close all socket

' End If

MsgBox Err.Description & Err.Number

mnuconnect.Enabled = True

tool.Buttons("connect").Enabled = True

mnudisconnect.Enabled = False

tool.Buttons("disconnect").Enabled = False

showstatus "Server not ready", False

End Sub