Connecting to the Database using VB6

idaBigA · Dec 11, 2008

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..

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

idaBigA · Dec 23, 2008

Quick Note

This post will be updated with the new exe's as I release them, and I will just put a note on the bottom that its updated.

Also, ALL PLEASE NOTE.. THIS PROGRAM WILL CHANGE YOUR SQL DATA, only change things if you understand what you are pressing and updating!

Files are location Here >> > >

www.sting3g.com/idaBigA/BasicSQLConnection.rar

If you get an error saying that a component or dll or something is missing download these and extract to your windows\system32 folder (don't overwrite any that are already there).
www.sting3g.com/idaBigA/BasicSQLConnectionFiles.rar

There are 2 files in the rar..

BasicSQLConnection.exe
Settings.ini

Edit the Settings.ini with your settings making sure there are no spaces between the = and the settings.

This will fill in automatically from the Settings.ini file.

Click the Check SQL Connection button to make sure the settings are correct, if you need to change them, just click the Save Settings to "Settings.ini" button

This page has various Character and Account Admin options..

"Char Information"
Type in the Chars name then click Fetch Char Data

This will tell you all about the char, and you can then click any of the button to change that piece of information.

"Account Info"
Type in the char and click Find User ID to find what account it is registered to.. You can then click Find Acc Info to get all the info for that account and also to change any of that info.

If you manually set up the account by entering info into the Account table without making a like entry into the AccountAdd table, you will get an error, it just means there isn't an entry in the AccountAdd table.

"IP Search"
Type in the User ID (not sure what it is.. use the "Account Info" section to find it) then click Search for IP

This will search the logs and return every IP and date that account has been accessed from. It will also sort out every Unique IP address. Click any of the Unique IP address to find out every Account and Char that that IP address has accessed (to successfully ban cheaters

)

"Title Info & Update"
Type in the Char and it will tell you its Title (if you use this option). If it doesn't have a title the "Flag" will return as a 0, to set a title, put the "Flag" as 2 and give it a title then Update Title Data

Pretty Self explanatory, just 1 note.. do NOT Update Mon or Add Mon without first Loading the current Mon Info. To edit any of the Monsters just click on it, then edit the Text boxes at the bottom. To add a new mob, you need to fill in ALL the boxes (on the 3 pages).

This is the same as the Mon info but instead for Items

Firstly.. click the Fetch All Items button to grab all the up to date Item and idx data.

Then select which tables you want to search, the click Find Dupes. This program does NOT remove the Dupes, its up to you to investigate the logs and find which ones you want to remove.

This is my drop file editor I am slowly incorporating into this Tool, you can at least view any of your drop files by simply clicking on the mob on the left hand side.

As before post any updates you want to see here and I will get it sorted.

Edit > Added Info Boxes for the Mon and Item tabs so users can see whats happening

Edit >

Coly · Dec 23, 2008

A good idea is to write a link to needed Runtime things for none Pro in VB ;-) so you have this Question done in your first Post.

Geordiehc · Dec 23, 2008

Dropfile tool looks brilliant il definately use that as it doesnt look to hard for my tiny mind to understand :P

idaBigA · Dec 23, 2008

Files required for Visual Basic and the Tab component needed for this app are all here..

www.sting3g.com/idaBigA/BasicSQLConnectionFiles.rar

(Is that what you were saying Coly?)

Geordie, the drop file editor is already released on lomcn as a stand alone application.. I am only adding it to this app so that all the Mir 3 tools I have done are all on one app.

Coly · Dec 23, 2008

I have Test your Software and see, you don't refrash the system and Read the xxxxx Mobs from the db and the System Hangs in this time. A good Idea is to get a Sleep on some Interation, to give the System a littel Air for own work ;-) .
Next is, give more Infos to most of the things for None Pro to understand He/She write things to the Database with this tool.
At last ^^ your tool is very good and helps for none SQL Pros.

PS: yes this files I mean, good work ;-)

idaBigA · Dec 23, 2008

I have updated the exe with some info while its loading the mobs and items.

It already has a "DoEvents" command in while its loading so it shouldn't lock up, not sure what else you mean.

Coly · Dec 23, 2008

I mean, if you read the Monster DB, then I believe you put line by line to your Interface over a Loop and made it without Pause. If you have more then 1000 Monster in your DB
in your Loop to stop all other Applications. I have test it on a DualCore Server.
This I mean is :

Loop begin

Read Line from DB
Put it to the Interface
say Sleep(1ms); <-- this givs Windows the power to work on other Win-Messages

Loop end

I hope you understand it.

DjDarkBoyZ · Dec 23, 2008

Use doevents, with sleep only pauses the app and not refresh the form, with doevents inside the loop refresh the form and give resources to windows.

idaBigA · Dec 24, 2008

I have DoEvents in there already.

You reckon it might be better to snatch all of the info into an array then add the array to a control afterwards?

/Mick

Coly · Dec 24, 2008

On my Server the DoEvent brings nothing, no Free Room for other Apps.
If I load the Monster DB I can't open Minimize Window and so one, all hangs.
For this I mean better say sleep to avoid this problem.

For my to understand your code (atm not see) you made this ? :

For I = 0 To DBRecordSet.Count
Read DB things
DoEvent;
Next

or like this :

For I = 0 To DBRecordSet.Count
Read DB things
Next

if last, your Loop give no Free Room for other things...

idaBigA · Dec 24, 2008

This is the data for adding the info to the list boxes.

Code:

    Do While Not Rs.EOF
        lblMonInfo = "Mobs Loaded - " & intCounter
        DoEvents
        lstMobInfo(0).AddItem (ReadDataRecord("Name"))
        lstMobInfo(1).AddItem (ReadDataRecord("Race"))
        lstMobInfo(2).AddItem (ReadDataRecord("RaceImg"))
        lstMobInfo(3).AddItem (ReadDataRecord("Appr"))
        lstMobInfo(4).AddItem (ReadDataRecord("Lvl"))
        lstMobInfo(5).AddItem (ReadDataRecord("Undead"))
        lstMobInfo(6).AddItem (ReadDataRecord("Tameble"))
        lstMobInfo(7).AddItem (ReadDataRecord("Wz1"))
        lstMobInfo(8).AddItem (ReadDataRecord("CoolEye"))
        lstMobInfo(9).AddItem (ReadDataRecord("VenomDc"))
        lstMobInfo(10).AddItem (ReadDataRecord("Exp"))
        lstMobInfo(11).AddItem (ReadDataRecord("HP"))
        lstMobInfo(12).AddItem (ReadDataRecord("MP"))
        lstMobInfo(13).AddItem (ReadDataRecord("Wz2"))
        lstMobInfo(14).AddItem (ReadDataRecord("Wz3"))
        lstMobInfo(15).AddItem (ReadDataRecord("Ac"))
        lstMobInfo(16).AddItem (ReadDataRecord("FireMAC"))
        lstMobInfo(17).AddItem (ReadDataRecord("IceMAC"))
        lstMobInfo(18).AddItem (ReadDataRecord("LightMAC"))
        lstMobInfo(19).AddItem (ReadDataRecord("WindMAC"))
        lstMobInfo(20).AddItem (ReadDataRecord("HolyMAC"))
        lstMobInfo(21).AddItem (ReadDataRecord("DarkMAC"))
        lstMobInfo(22).AddItem (ReadDataRecord("PhantomMAC"))
        lstMobInfo(23).AddItem (ReadDataRecord("Dc"))
        lstMobInfo(24).AddItem (ReadDataRecord("DcMax"))
        lstMobInfo(25).AddItem (ReadDataRecord("McType"))
        lstMobInfo(26).AddItem (ReadDataRecord("Mc"))
        lstMobInfo(27).AddItem (ReadDataRecord("McMax"))
        lstMobInfo(28).AddItem (ReadDataRecord("Speed"))
        lstMobInfo(29).AddItem (ReadDataRecord("Hit"))
        lstMobInfo(30).AddItem (ReadDataRecord("WALK_SPD"))
        lstMobInfo(31).AddItem (ReadDataRecord("WalkWait"))
        lstMobInfo(32).AddItem (ReadDataRecord("WalkStep"))
        lstMobInfo(33).AddItem (ReadDataRecord("ATTACK_SPD"))
        lstMobInfo(34).AddItem (ReadDataRecord("Wz4"))
        lstMobInfo(35).AddItem (ReadDataRecord("Wz5"))
        lstMobInfo(36).AddItem (ReadDataRecord("UnKnow"))
        lstMobInfo(37).AddItem (ReadDataRecord("OrgName"))
        intCounter = intCounter + 1
        Rs.MoveNext
    Loop

dilina · Jan 2, 2009

would be great if u can add a delete button @ duplicated items , as i just search for them and i have 200 duplicated , will take me a while to look for them in the sql table with no search working in there (at least i duno how to

)

mapadale · Jan 2, 2009

dilina said:
would be great if u can add a delete button @ duplicated items , as i just search for them and i have 200 duplicated , will take me a while to look for them in the sql table with no search working in there (at least i duno how to )

There is a guide on how to search for dupped items.

CheekyVimto · Jan 3, 2009

great work on this application mick I think it will be useful for all.

budyniowski · Jan 7, 2009

gr8 idea but i have problems in this program. I have connection:

But i can't read items and monsters info (soft load only first mob and first item) i have this error:

And when i click on this item or monster i have this:

and program goes down. I have patched my system32 with dll's from BasicConnectionFiles.
What can I do to put it working?
THX.

idaBigA · Jan 7, 2009

1st Screeny is Good
2nd Screeny is problem - see below
3rd Screeny is because of problem on 2nd Screeny, you can't look at an item if it isn't fully loaded.

2nd Screeny.

You will notice that the info hasn't all loaded (OrgName is blank), do you have a field called OrgName in your HL_StdItems? If not.. why not, and can you add one? There doesn't need to be anything in the field, but the program uses a standard set of files and needs the standard setup for each Table.

/Mick

Edit > > > >> > >

NEW EXE's HERE > >> > www.sting3g.com/idaBigA/BasicSQLConnection.rar

OK.. I have added some Error Checking into every Sub Routine so it should never crash out now. Doesn't help your error as it still won't work until you fix the table, but at least it won't crash

Added -

(just because I can :P)

Also, done some more work on the Drop File Editor..

Single Edit Mode -
Click on Any file on the left hand side.
This Loads up the Drop File

Edit Drop Rate

Double Click the Ratio to Edit the Drop Rate of that particular item

Remove Drop
Double Click the Ratio to and type a 0 when asked for a New Ratio, this will remove the Drop

Add New Drop
To add a new drop, find the item on the right hand side (the "All Item" List), select it, then drag and drop it into one of the list in the middle.. Give it a Ratio (and a Qty if you want to add one).

Note : Nothing gets changed in the Drop File UNLESS you press "Save Selected Drop File"

Multiple Edit Mode -
Select Which Drop Files you want to Multiple Edit

Remove Item from Multiple Files
Select the Item in the "All Items" list on the right then drop it into the Big X on the left.... Are you Sure? :P

Add an Item to Multiple Files
Give the New Item a Ratio in the Ratio Box next to the Big TICK
Select the Item in the "All Items" list on the right then drop it into the Big TICK on the left.... Are you Sure?

----------------------------------------------------

I have also added 2 new options.. "Preload Mons From SQL" and "Preload Items From SQL"

If you are happy they work normally, then you can preload them every time so save you pressing the manual load later on.. its up to you.

Just Edit the Setting and Press Save Settings.ini

budyniowski · Jan 7, 2009

OK all work briliant ;d thx for this helpfull app.

edit:

You can add "search by name" box in items and monsters window, if it possible.

idaBigA · Jan 7, 2009

Hmm... I will have a look.. for now.. Updated with Map Info editor..

2 Buttons at the bottom, the right hand one will fix your Merchant.txt and MapInfo.txt so this program can use them. Click this first!

Merchant.txt -
It will replace all TABS with a Single Space
It will replace all Double Spaces with a Single Space

MapInfo.txt -
It will replace all "[ " with "["
It will replace all " ]" with "]"
It will replace all TABS with a Single Space
It will replace all Double Spaces with a Single Space

This saves me having lots of extra lines in the code to find out how many spaces and tabs you have etc.. I know I could loop and stuff, but its easier and quicker if I don't have to.

The Left hand button will now populate the Lists with the maps that are currently on your server..

Click on a Map to show its Doors, Flags and NPC's.

(Mouse Over any of the Flag Check Boxes to show what each Flag means)

Double click any of the NPC's to load up that NPC.

Oh.. and this is only a Viewer at the moment, I will turn it into an Editor very shortly

budyniowski · Jan 7, 2009

Is possible to add remote acces to mapinfo, merchant and drop files in this soft?

Connecting to the Database using VB6

Holley Mir 3!!

Holley Mir 3!!

LOMCN Developer

Mad Dog Geo

Holley Mir 3!!

LOMCN Developer

Holley Mir 3!!

LOMCN Developer

Dev

Holley Mir 3!!

LOMCN Developer

Holley Mir 3!!

Dedicated Member

mapadale

Guest

It's my Precious!

Dedicated Member

Holley Mir 3!!

Dedicated Member

Holley Mir 3!!

Dedicated Member