Source code Server.doc

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