This is quite a simple program that fetches all the Char data for any char you specify.
For this Project add the reference.. (Menu.. Project..Reference)
Microsoft ActiveX Data Objects 2.8 Library
Create a Form with the following controls
11 Labels in a Control Array
lblAccCharInfo(0) to lblAccCharInfo(10)
4 Text Boxes..
txtSQLIP
txtSQLUserID
txtSQLPass
txtInfo
txtCharName
1 Command Button
cmdAccGetCharData
Various Labels so you know what each one means..
(Screeny)
Paste in this code..
-----------------------------------------------------------------------
E D I T
-----------------------------------------------------------------------
Updated - with Title Additions..
Download the exe here.. www.sting3g.com/idaBigA/BasicSQLConnection.rar
or attached here > > View attachment 9780
If you would like something else attached to this Program, just shout up and I will add it and post the new exe..
Here is the new code..
For this Project add the reference.. (Menu.. Project..Reference)
Microsoft ActiveX Data Objects 2.8 Library
Create a Form with the following controls
11 Labels in a Control Array
lblAccCharInfo(0) to lblAccCharInfo(10)
4 Text Boxes..
txtSQLIP
txtSQLUserID
txtSQLPass
txtInfo
txtCharName
1 Command Button
cmdAccGetCharData
Various Labels so you know what each one means..
(Screeny)
Paste in this code..
Code:
Public Cn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Private Sub cmdAccGetCharData_Click()
Dim strTableName As String 'Name of the Table being accessed
Dim Servername As String 'IP Address of SQL
Dim UserID As String 'UserID to the SQL
Dim Password As String 'Password to the SQL
Dim DB As String 'Database Name
On Error GoTo errHandler
Call TerminateConnection
Servername = txtSQLIP
UserID = txtSQLUserID
Password = txtSQLPass
DB = "Game3G"
For bytCounter = lblAccCharInfo.LBound To lblAccCharInfo.UBound
lblAccCharInfo(bytCounter).Caption = ""
Next
Call InitConnectionSQL(Servername, UserID, Password, DB)
strTableName = "TBL_CHARACTER"
Set Rs.ActiveConnection = Cn
Rs.LockType = adLockOptimistic
Rs.Source = "Select * From " & strTableName & " Where FLD_CHARACTER = '" & txtCharName & "'"
Rs.Open
If Rs.RecordCount = 0 Then
txtInfo = "Char Does not Exist"
Exit Sub
End If
lblAccCharInfo(0).Caption = (ReadDataRecord("FLD_LEVEL"))
lblAccCharInfo(1).Caption = (ReadDataRecord("FLD_GOLD"))
bytStore = (ReadDataRecord("FLD_JOB"))
If bytStore = 0 Then
lblAccCharInfo(2).Caption = ("War")
ElseIf bytStore = 1 Then
lblAccCharInfo(2).Caption = ("Wiz")
Else
lblAccCharInfo(2).Caption = ("Tao")
End If
bytStore = (ReadDataRecord("FLD_SEX"))
If bytStore = 0 Then
lblAccCharInfo(3).Caption = ("Male")
Else
lblAccCharInfo(3).Caption = ("Female")
End If
lblAccCharInfo(4).Caption = (ReadDataRecord("FLD_DELETED"))
lblAccCharInfo(5).Caption = (ReadDataRecord("FLD_MAKEDATE"))
lblAccCharInfo(6).Caption = (ReadDataRecord("FLD_UPDATEDATETIME"))
lblAccCharInfo(7).Caption = (ReadDataRecord("FLD_MAPNAME"))
lblAccCharInfo(8).Caption = (ReadDataRecord("FLD_STORAGEPASSWD"))
lblAccCharInfo(9).Caption = (ReadDataRecord("FLD_BODYLUCK"))
lblAccCharInfo(10).Caption = (ReadDataRecord("FLD_CHARACTER"))
If Rs.State = 1 Then
Rs.Close
End If
Call TerminateConnection
Exit Sub
errHandler:
txtInfo = "Char Does not Exist"
End Sub
Public Function ReadDataRecord(fldName) As Variant
If Not IsNull(Rs.Fields(fldName).Value) Then
ReadDataRecord = Rs.Fields(fldName).Value
End If
End Function
Public Sub TerminateConnection()
If Cn.State = adStateOpen Then
Cn.Close
Set Cn = Nothing
txtInfo = "Connection Closed"
End If
End Sub
Public Sub InitConnectionSQL(Servername As String, UserID As String, _
Password As String, DB As String)
Cn.Provider = "SQLOLEDB.1"
Cn.ConnectionString = "Data Source=" & Servername & _
";User ID=" & UserID & ";Password=" & Password & _
";Initial Catalog=" & DB
Cn.Open
End Sub
-----------------------------------------------------------------------
E D I T
-----------------------------------------------------------------------
Updated - with Title Additions..
Download the exe here.. www.sting3g.com/idaBigA/BasicSQLConnection.rar
or attached here > > View attachment 9780
If you would like something else attached to this Program, just shout up and I will add it and post the new exe..
Here is the new code..
Code:
Option Explicit
Public Cn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Private Sub cmdAccGetCharData_Click()
Dim bytCounter As Byte
Dim strTableName As String 'Name of the Table being accessed
Dim Servername As String 'IP Address of SQL
Dim UserID As String 'UserID to the SQL
Dim Password As String 'Password to the SQL
Dim DB As String 'Database Name
Dim bytStore As Byte
On Error GoTo errhandler
Call TerminateConnection
Servername = txtSQLIP
UserID = txtSQLUserID
Password = txtSQLPass
DB = "Game3G"
For bytCounter = 0 To 10
lblAccCharInfo(bytCounter).Caption = ""
Next
Call InitConnectionSQL(Servername, UserID, Password, DB)
strTableName = "TBL_CHARACTER"
Set Rs.ActiveConnection = Cn
Rs.LockType = adLockOptimistic
Rs.Source = "Select * From " & strTableName & " Where FLD_CHARACTER = '" & txtCharName & "'"
Rs.Open
If Rs.RecordCount = 0 Then
txtInfo = "Char Does not Exist"
Exit Sub
End If
lblAccCharInfo(0).Caption = (ReadDataRecord("FLD_LEVEL"))
lblAccCharInfo(1).Caption = (ReadDataRecord("FLD_GOLD"))
bytStore = (ReadDataRecord("FLD_JOB"))
If bytStore = 0 Then
lblAccCharInfo(2).Caption = ("War")
ElseIf bytStore = 1 Then
lblAccCharInfo(2).Caption = ("Wiz")
Else
lblAccCharInfo(2).Caption = ("Tao")
End If
bytStore = (ReadDataRecord("FLD_SEX"))
If bytStore = 0 Then
lblAccCharInfo(3).Caption = ("Male")
Else
lblAccCharInfo(3).Caption = ("Female")
End If
lblAccCharInfo(4).Caption = (ReadDataRecord("FLD_DELETED"))
lblAccCharInfo(5).Caption = (ReadDataRecord("FLD_MAKEDATE"))
lblAccCharInfo(6).Caption = (ReadDataRecord("FLD_UPDATEDATETIME"))
lblAccCharInfo(7).Caption = (ReadDataRecord("FLD_MAPNAME"))
lblAccCharInfo(8).Caption = (ReadDataRecord("FLD_STORAGEPASSWD"))
lblAccCharInfo(9).Caption = (ReadDataRecord("FLD_BODYLUCK"))
lblAccCharInfo(10).Caption = (ReadDataRecord("FLD_CHARACTER"))
If Rs.State = 1 Then
Rs.Close
End If
Call TerminateConnection
Exit Sub
errhandler:
txtInfo = "Char Does not Exist"
End Sub
Public Function ReadDataRecord(fldName) As Variant
If Not IsNull(Rs.Fields(fldName).Value) Then
ReadDataRecord = Rs.Fields(fldName).Value
End If
End Function
Public Sub TerminateConnection()
If Cn.State = adStateOpen Then
Cn.Close
Set Cn = Nothing
txtInfo = "Connection Closed"
End If
End Sub
Public Sub InitConnectionSQL(Servername As String, UserID As String, _
Password As String, DB As String)
Cn.Provider = "SQLOLEDB.1"
Cn.ConnectionString = "Data Source=" & Servername & _
";User ID=" & UserID & ";Password=" & Password & _
";Initial Catalog=" & DB
Cn.Open
End Sub
Private Sub cmdTitleFetch_Click()
Dim strTableName As String
Dim Servername As String
Dim UserID As String
Dim Password As String
Dim DB As String
On Error GoTo errhandler
Call TerminateConnection
Servername = txtSQLIP
UserID = txtSQLUserID
Password = txtSQLPass
DB = "CruelDragon3GBaseData"
Call InitConnectionSQL(Servername, UserID, Password, DB)
strTableName = "HL_HumPlus"
Set Rs.ActiveConnection = Cn
Rs.LockType = adLockOptimistic
Rs.Source = "Select FLD_CHARACTER, ST_FLAG, ST_Name From " & strTableName & " WHERE FLD_CHARACTER = '" & txtTitleChar & "'"
Rs.Open
txtTitleTitle = (ReadDataRecord("ST_Name"))
txtTitleFlag = (ReadDataRecord("ST_FLAG"))
If Rs.State = 1 Then
Rs.Close
End If
Call TerminateConnection
Exit Sub
errhandler:
MsgBox ("Error Reading Data")
Call TerminateConnection
End Sub
Private Sub cmdTitleUpdate_Click()
Dim strTableName As String
Dim Servername As String
Dim UserID As String
Dim Password As String
Dim DB As String
Dim bytResult As Byte
On Error GoTo errhandler
Call TerminateConnection
Servername = txtSQLIP
UserID = txtSQLUserID
Password = txtSQLPass
DB = "CruelDragon3GBaseData"
Call InitConnectionSQL(Servername, UserID, Password, DB)
strTableName = "HL_HumPlus"
bytResult = (MsgBox("Are you Sure you want to save that info?" & vbCrLf, vbYesNo))
If bytResult = 7 Then Exit Sub
Set Rs.ActiveConnection = Cn
Rs.LockType = adLockOptimistic
Rs.Source = "Select FLD_CHARACTER, ST_FLAG, ST_Name From " & strTableName & " WHERE FLD_CHARACTER = '" & txtTitleChar & "'"
Rs.Open
If Rs.EOF = True And Rs.BOF = True Then MsgBox ("Not Found"): Exit Sub
Rs!ST_Name = Trim(txtTitleTitle)
Rs!ST_FLAG = Val(txtTitleFlag)
Rs.Update
If Rs.State = 1 Then
Rs.Close
End If
Call TerminateConnection
Exit Sub
errhandler:
MsgBox ("Error Occured")
Call TerminateConnection
End Sub
Last edited: