i have been sending this request for some time now but i've really not got any reply.
i use access for my vb right from time and i need some one to bring me up on using mysql and microsoft sql/
the most difficult part has been the connection with vb6 and making it work on networking
pls help me i am counting on u guys.
a simple application as an illustration will be very alright.
thanks.

tolubonnke:

i have been sending this request for some time now but i've really not got any reply.
i use access for my vb right from time and i need some one to bring me up on using mysql and microsoft sql/
the most difficult part has been the connection with vb6 and making it work on networking
pls help me i am counting on u guys.
a simple application as an illustration will be very alright.
thanks.

Am sorry for replying late. I didnt see your thread.
Please google for connection string for SQLserver and follow the same pattern below.



dim ConnectionString as string

'ConnectionString = ConnString(<server name>,<database name>

Eg.


ConnectionString = ConnString("Locahost","Studentdatabase"



Use below to make the connection as you like


private sub ShowConnection
Dim rs As New ADODB.Recordset
ConnectionString = ConnString("Locahost","Studentdatabase"
set rs=OpenDatabase(ConnectionString ,"Select Studentname,Age,Sex from StudentTable"

Dim Studentname as string
dim Age as integer
dim Sex as string


Do While Not rs.EOF ' since rs.recordcount doesnt work in MySQL but work in SQLSevre

Studentname =rs.Fields("Studentname"
Age =val(rs.Fields("Age")
Sex =rs.Fields("Sex"


'Or this is faster because index is better in number than text

' Studentname =rs.Fields(0)
' Age =val(rs.Fields(1))
' Sex =rs.Fields(2)

Exit Do
rsd.MoveNext
Loop

end sub


Function OpenDatabase(DbPath As String, CommandText As String) As ADODB.Recordset

Dim db As New ADODB.Recordset
db.ActiveConnection = DbPath
db.Source = CommandText
db.CursorType = adOpenKeyset
db.LockType = adLockOptimistic
db.Open
Set OpenDatabase= db
End Function


Function ConnString(Dbname As String, Servername As String)
OBTNAM = "DRIVER={MySQL ODBC 3.51 Driver};" _
& "SERVER=" & Servername & ";" _
& "DATABASE=" & Dbname & ";" _
& "UID=<user name>;" _
& "PWD=<password>" _
& "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 163841
End Function

Hope that helps you.

No more questions?

Pls, put me through on how to use vb sysinfo component to get my computer information.


thanks

hi tolubonnke

Though I join the forum today, You can use this connection string with ado recordset

"Driver={MySQL Odbc 3.51 Driver};Sever=localhost;DataBase=Census;UID=root;PWD=root;option=16427"

you can download mysql odbc driver from mysql server web site. This driver must be installed on all the client machine the connection to work.

this connection string will work on single computer but to work on net work just change the word locahost to the ip address of the server computer.

Hope this will work well for Mysql server.
the work with MsSql server use adodc control to build connection string for the ms sql server copied it and paste as you connection string in you code it will work.

Plz i need a step by step procedure on how 2 connect mysql wit vb 6. Im sick of ms access. I aw8 ur rply. God bles

Hey nlanderz! I realy nid ur help, a step by by procedure n wher 2 place d codez. Cuz it kipin telin me database nt found. Plz help! Stay bles.

The step by step code of luckco will work fine, have you try it, tell us you findings.

Its sayin ms odbc driver manager, dsn not found and no device driver not specified. Help O!

thanks guys i'll see how it works and get back to u. thank u very much.

cant view my first input in the datagrid, however the other data i entered is there, and also 'bookmark is invalid appear' when i save the data to the database,

what is the problem

help me please,

im using ms sql server,, tnx

ashiya:

cant view my first input in the datagrid, however the other data i entered is there, and also 'bookmark is invalid appear' when i save the data to the database,

what is the problem

help me please,

im using ms sql server,, tnx

Dont like using datagrid in my code because it is not giving me the flexibility I need.
The repeated same problem with dotnet 2001,2003 but was corrected in 2005,2008,2010.you
I wish you change your grid for better.
maybe some1 in the forum can help you who is expert in datagrid. Thanks.

Stan Iyke:

Its sayin ms odbc driver manager, dsn not found and no device driver not specified. Help O!

Make sure you downloaded MySQL connector 3.5 from mysql site installed successfully working in your system.
I dont recommen that people should use dsn in their code because of dynamic functionality across different syste without having to begin to create dsn on them.

make sure that the dsn created it name you are using in the connetionstring;
eg;

ConnectionString = "DNS=studentdata"
Private Sub Command1_Click()
Dim ConnectionString As String
ConnectionString = "DNS=studentdata"
Set rs = OpenDatabase(ConnectionString, "Select Studentname,Age,Sex from StudentTable"

Dim Studentname As String
Dim Age As Integer
Dim Sex As String


Do While Not rs.EOF ' since rs.recordcount doesnt work in MySQL but work in SQLSevre

Studentname = rs.Fields("Studentname"
Age = Val(rs.Fields("Age")
Sex = rs.Fields("Sex"


'Or this is faster because index is better in number than text

' Studentname =rs.Fields(0)
' Age =val(rs.Fields(1))
' Sex =rs.Fields(2)

Exit Do
rsd.MoveNext
Loop

End Sub


Function OpenDatabase(DbPath As String, CommandText As String) As ADODB.Recordset

Dim db As New ADODB.Recordset
db.ActiveConnection = DbPath
db.Source = CommandText
db.CursorType = adOpenKeyset
db.LockType = adLockOptimistic
db.Open
Set OpenDatabase = db
End Function


But If you dont want to use dsn already created in your datasource then use the recommended;

Private Sub Command1_Click()
Dim ConnectionString As String

'ConnectionString = ConnString(<server name>,<database name>

'Eg.


ConnectionString = ConnString("Locahost", "Studentdatabase"



'Use below to make the connection as you like

Dim rs As New ADODB.Recordset
ConnectionString = ConnString("Locahost", "Studentdatabase"
Set rs = OpenDatabase(ConnectionString, "Select Studentname,Age,Sex from StudentTable"

Dim Studentname As String
Dim Age As Integer
Dim Sex As String


Do While Not rs.EOF ' since rs.recordcount doesnt work in MySQL but work in SQLSevre

Studentname = rs.Fields("Studentname"
Age = Val(rs.Fields("Age")
Sex = rs.Fields("Sex"


'Or this is faster because index is better in number than text

' Studentname =rs.Fields(0)
' Age =val(rs.Fields(1))
' Sex =rs.Fields(2)

Exit Do
rsd.MoveNext
Loop

End Sub


Function OpenDatabase(DbPath As String, CommandText As String) As ADODB.Recordset

Dim db As New ADODB.Recordset
db.ActiveConnection = DbPath
db.Source = CommandText
db.CursorType = adOpenKeyset
db.LockType = adLockOptimistic
db.Open
Set OpenDatabase = db
End Function


Function ConnString(Dbname As String, Servername As String)
OBTNAM = "DRIVER={MySQL ODBC 3.51 Driver};" _
& "SERVER=" & Servername & ";" _
& "DATABASE=" & Dbname & ";" _
& "UID=<user name>;" _
& "PWD=<password>" _
& "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 163841
End Function

Function OpenDatabase(DbPath As String, CommandText As String) As ADODB.Recordset

Dim db As New ADODB.Recordset
db.ActiveConnection = DbPath
db.Source = CommandText
db.CursorType = adOpenKeyset
db.LockType = adLockOptimistic
db.Open
Set OpenDatabase = db
End Function


If this doesn't work check your system, otherwise send me your samples project to my mail then I will correct it and send you back.

Stan Iyke:

Hey nlanderz! I realy nid your help, a step by by procedure n wher 2 place d codez. Cuz it kipin telin me database nt found. Plz help! Stay bles.

You have to create a database, give it a name say 'studentdata'.
After which you create table inside that will make you experience what am teaching you.
Make sure the name you use exist, dont use studentdata because I used it here as example.
Please use the one you created.

Nrlandr,
i have seen many application that if user view any data by clicking a button it will bring the report without been link the report to that particular table.
e.g

Search for those that have paid for 2009 salary, immediately the query search for the criterial it will bring a report maybe in crystal report form or data-evironment link automatically.
pls how can i do this for the current project i have at hand now

@Lukyco
pls Respond

bigafees:

Pls, put me through on how to use vb sysinfo component to get my computer information.


thanks

For connection to MySQL, you can check this link

http://www.connectionstrings.com/mysql

usually you use something like this

          Dim strConnection as string           'To hold the connection string
          
          strConnection = Provider=SQLOLEDB.1;Persist Security Info=False;User ID=;Password=;Initial Catalog=;Data Source=

          'You then declare a connection object
          Dim myConnection as adodb.connection
          
          set myconnection = new adodb.connection
          'Open it after that.
          myconnection.open (strconnection)

          'NOTE - There are some other options given with the open method for the connection object.
          .
          .
          .

This is the basic for connecting to any database.

Provider (in the string above) is represents the database engine you are connecting to (SQLOLEDB.1 - for MSSQL)

i just want to ask, is it possible to make a system that will manipulate the other pc and also get the list of applications that the user use with that pc and also the files he created using vb 6.0??

Option Explicit

' Reg Key Security Options,
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types,
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long


Public Sub StartSysInfo()
On Error GoTo SysInfoErr

Dim rc As Long
Dim SysInfoPath As String

' Try To Get System Info Program Path\Name From Registry,
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry,
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE" <> "" Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' Error - File Can Not Be Found,
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found,
Else
GoTo SysInfoErr
End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE, }
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error,

tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size

'------------------------------------------------------------
' Retrieve Registry Key Value,
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String,
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String,
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion,
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types,
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
End Select

GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit

GetKeyError: ' Cleanup After An Error Has Occured,
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function

Private Sub Command1_Click()
Call StartSysInfo
End Sub

The above can display system information.

Create Command button named command1, on its click event
enter Call StartSysInfo as above.

If you dont want to stress yourself, copy the code to your form and drop a command button. Hit it to open system information.

Option Explicit

' Reg Key Security Options,
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types,
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long


Public Sub StartSysInfo()
On Error GoTo SysInfoErr

Dim rc As Long
Dim SysInfoPath As String

' Try To Get System Info Program Path\Name From Registry,
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry,
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE" <> "" Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' Error - File Can Not Be Found,
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found,
Else
GoTo SysInfoErr
End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE, }
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error,

tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size

'------------------------------------------------------------
' Retrieve Registry Key Value,
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String,
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String,
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion,
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types,
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
End Select

GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit

GetKeyError: ' Cleanup After An Error Has Occured,
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function

Private Sub Command1_Click()
Call StartSysInfo
End Sub

The above can display system information.

Create Command button named command1, on its click event
enter Call StartSysInfo as above.

If you dont want to stress yourself, copy the code to your form and drop a command button. Hit it to open system information.

bigafees:

@Lukyco
pls Respond

Option Explicit

' Reg Key Security Options,
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types,
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long


Private Sub Command1_Click()
Call StartSysInfo
End Sub


Public Sub StartSysInfo()
On Error GoTo SysInfoErr

Dim rc As Long
Dim SysInfoPath As String

' Try To Get System Info Program Path\Name From Registry,
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry,
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE" <> "" Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' Error - File Can Not Be Found,
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found,
Else
GoTo SysInfoErr
End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE, }
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error,

tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size

'------------------------------------------------------------
' Retrieve Registry Key Value,
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String,
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String,
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion,
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types,
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
End Select

GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit

GetKeyError: ' Cleanup After An Error Has Occured,
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function

You guys are just too wonderful.

Pls advice on how to well to get started in programmig: Polytechnic,Degree etc

Pls how can one?

Pls advice on how to well to get started in programmig: Polytechnic,Degree etc

Pls how can one?

It does not take any degree to program. Hear this:
Success if a function of Sincerety, Determination and Luck.

1. Be ready to burn candles like never b4;
2. What drives you to programming (love of money, creativity, or both, or lack of something better to do);
3. What kind of programming do you want to involve yourslef in (system, driver, application - windows, web or both);
4. How long are you willing to go (top top, or just to feed urself and possibly some family members);
5. Are you ready to learn mathematics (not the theory u did in school);
6. Above all, are you ready to make Google (and recently, Bing) your friend;

HAPPY NEW YEAR.

Smart K.

i have this error whenever i add a new record in the database,  'operation is not allowed when the object is open'
pls help me,  i need a lot,  tnx to those who will reply, 


con.Open "Description=laboratory;DRIVER=SQL Server;SERVER=(local);APP=Visual Basic;WSID=HELICON-CRIS;DATABASE=laboratory;Trusted_Connection=Yes"


here's the connection string that i uses, many tnx

i have a new problem regarding with the system that im working right now,

i have 2 column and i will add a new record , my input is not same with the 1st column which is the 'day' but in the second column which is the 'time' it says that it has the same record but if in the 'day column' my input are not same it should not have any problem with the 'time column',

.Find "Day='" & cboday.Text & "'", 0, adSearchForward, 1

.Find "Start_Time='" & cbostart.Text & "'", 0, adSearchForward, 1

what can the solution to this

tnx in advance,

i have this new problem in the system im creating, 
at first i can add records but now i cant add record,

here is the code,


Dim flag As Integer
Dim day, stime, tempday As String

Private Sub cmdAdd_Click()
enabletextTime
cleartextTime
flag = 0
txtroomno.SetFocus
End Sub

Private Sub cmddelete_Click()
If rsRoom_Schedule.RecordCount = 0 Then
MsgBox "Database Empty", vbInformation, "Delete Record"
cmddelete.Enabled = False
Exit Sub
End If
If MsgBox("Are you sure you want to delete this record?", vbQuestion + vbYesNo, "Delete Record" = vbYes Then
rsRoom_Schedule.Delete
MsgBox "Record deleted", vbInformation + vbOKOnly, "Delete Record"
cleartextTime
End If
End Sub

Private Sub cmdEdit_Click()
enabletextTime
flag = 1
End Sub

Private Sub cmdsave_Click()
If txtroomno.Text = "" Then
MsgBox "Enter a Room No. before proceeding.", vbInformation + vbOKOnly, "Incomplete Information"
txtroomno.SetFocus
Exit Sub
End If
If txtcode.Text = "" Then
MsgBox "Enter a Class Code before proceeding.", vbInformation + vbOKOnly, "Incomplete Information"
txtcode.SetFocus
Exit Sub
End If
If txtfacultycode.Text = "" Then
MsgBox "Enter a Faculty Code before you continue.", vbInformation + vbOKOnly, "Incomplete Information"
txtfacultycode.SetFocus
Exit Sub
End If
If txtsubject.Text = "" Then
MsgBox "Enter a Subject Code before you proceed.", vbInformation + vbOKOnly, "Incomplete Information"
txtsubject.SetFocus
Exit Sub
End If
If txtsy.Text = "" Then
MsgBox "Enter a School Year before you proceed.", vbInformation + vbOKOnly, "Incomplete Information"
txtsy.SetFocus
Exit Sub
End If
If cboSem.Text = "" Then
MsgBox "Choose a Semester before you continue.", vbInformation + vbOKOnly, "Incomplete Information"
cboSem.SetFocus
Exit Sub
End If
If cboday.Text = "" Then
MsgBox "Choose a Schedule Day before you continue.", vbInformation + vbOKOnly, "Incomplete Information"
cboday.SetFocus
Exit Sub
End If
If cbostart.Text = "" Then
MsgBox "Choose a Start Time before you proceed.", vbInformation + vbOKOnly, "Incomplete Information"
cbostart.SetFocus
Exit Sub
End If
If cboend.Text = "" Then
MsgBox "Choose an End Time before you proceed.", vbInformation + vbOKOnly, "Incomplete Information"
cboend.SetFocus
Exit Sub
End If

If flag = 1 Then
With Room_Schedule
    .Fields(0) = txrtroomno.Text
    .Fields(1) = txtcode.Text
    .Fields(2) = txtfacultycode.Text
    .Fields(3) = txtsubject.Text
    .Fields(4) = txtsy.Text
    .Fields(5) = cboSem.Text
    .Fields(6) = cboday.Text
    .Fields(7) = txtstart.Text
    .Fields( = txtend.Text
    .Update
    MsgBox "Room Schedule Updated!", vbInformation, "Save Record"
    cmdsave.Caption = "Save"
End With
ElseIf flag = 0 Then
    With rsRoom_Schedule
    .Find "Room_No='" & txtroomno.Text & "'", 0, adSearchForward, 1
        If .EOF = False Then
        .Find "School_Year='" & txtsy.Text & "'", 0, adSearchForward, 1
            If .EOF = False Then
            .Find "Semester='" & cboSem.Text & "'", 0, adSearchForward, 1
                If .EOF = False Then
                .Find "Day='" & cboday.Text & "'", 0, adSearchForward, 1
                        tempday = cboday.Text
                        If .EOF = False Then
                        day = .Fields(6)
                        If cboday.Text = day Then
                        .Find "Start_Time='" & cbostart.Text & "'", 0, adSearchForward, 1
                        If .EOF = False Then '1
                        stime = .Fields(7)
                        If day = cboday.Text And stime = cbostart.Text Then
                        MsgBox "Schedule Time already exist!", vbInformation, "Save Record"
                        cbostart.SetFocus
                        cbostart.Text = ""
                        Exit Sub
                        ElseIf day = cboday And stime <> cbostart.Text Then 'If .EOF = True Then 'same day different time
                        .AddNew
                        .Fields(0) = txtroomno.Text
                        .Fields(1) = txtcode.Text
                        .Fields(2) = txtfacultycode.Text
                        .Fields(3) = txtsubject.Text
                        .Fields(4) = txtsy.Text
                        .Fields(5) = cboSem.Text
                        .Fields(6) = cboday.Text
                        .Fields(7) = cbostart.Text
                        .Fields( = cboend.Text
                        .Update
                        MsgBox "New Room Schedule Save!", vbInformation, "Save Record"
                        End If
                        ElseIf day <> cboday And stime <> cbostart.Text Then
                        .AddNew
                    .Fields(0) = txtroomno.Text
                    .Fields(1) = txtcode.Text
                    .Fields(2) = txtfacultycode.Text
                    .Fields(3) = txtsubject.Text
                    .Fields(4) = txtsy.Text
                    .Fields(5) = cboSem.Text
                    .Fields(6) = cboday.Text
                    .Fields(7) = cbostart.Text
                    .Fields( = cboend.Text
                    .Update
                    MsgBox "New Room Schedule Save!", vbInformation, "Save Record"
                        End If
                        End If
                        End If
                    Else ' Then 'different day
                    day = cboday.Text
                    .Find "Start_Time='" & cbostart.Text & "'", 0, adSearchForward, 1
                    stime = .Fields(7)
                    If .EOF = False Then
                    MsgBox "Schedule already exist!", vbInformation, "Save Record"
                    cbostart.SetFocus
                    cbostart.Text = ""
                    Exit Sub
                    Else 'If stime <> cbostart.Text Then 'different time
                    .AddNew
                    .Fields(0) = txtroomno.Text
                    .Fields(1) = txtcode.Text
                    .Fields(2) = txtfacultycode.Text
                    .Fields(3) = txtsubject.Text
                    .Fields(4) = txtsy.Text
                    .Fields(5) = cboSem.Text
                    .Fields(6) = cboday.Text
                    .Fields(7) = cbostart.Text
                    .Fields( = cboend.Text
                    .Update
                    MsgBox "New Room Schedule Save!", vbInformation, "Save Record"
                 
                    End If
                    End If
                    End If
                 
        'elseIf .EOF = True Then 'different sem
        '.Find "Day='" & cboday.Text & "'", 0, adSearchForward, 1
        'If .EOF = False Then
        '.Find "Start_Time='" & txtstart.Text & "'", 0, adSearchForward, 1
        'If .EOF = False Then
        '    MsgBox "Schedule already exist!", vbInformation, "Save Record"
        '    txtstart.SetFocus
        '    txtstart.Text = ""
        '    Exit Sub
        'Else 'same day different time
        '    .AddNew
        '    .Fields(0) = txrtroomno.Text
        '    .Fields(1) = txtcode.Text
        '    .Fields(2) = txtfacultycode.Text
        '    .Fields(3) = txtsubject.Text
        '    .Fields(4) = txtsy.Text
        '    .Fields(5) = cboSem.Text
        '    .Fields(6) = cboday.Text
        '    .Fields(7) = txtstart.Text
        '    .Fields( = txtend.Text
        '    .Update
        '    MsgBox "New Room Schedule Save!", vbInformation, "Save Record"
        End If
       
       
    End With
End If
disabletextTime
cleartextTime
End Sub

Private Sub dtgSchedule_Click()
With rsRoom_Schedule
            txtroomno.Text = .Fields(0)
            txtcode.Text = .Fields(1)
            txtfacultycode.Text = .Fields(2)
            txtsubject.Text = .Fields(3)
            txtsy.Text = .Fields(4)
            cboSem.Text = .Fields(5)
            cboday.Text = .Fields(6)
            txtstart.Text = .Fields(7)
            txtend.Text = .Fields(
End With
End Sub

Private Sub Form_Load()
Call OpenConnection
disabletextTime
For i = 1 To rsRoom_Schedule.RecordCount
rsRoom_Schedule.MoveNext
Next i
Set dtgSchedule.DataSource = rsRoom_Schedule
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call CloseConnection
End Sub

I prefer you use SQl statement to add record instead of following data controls up and down.
Learn how to use sql it is faster and easier.

Lucky Co and Nlaider

Please i'm using Access as my vb6 database b4, now i want to upgrade to SQL server 2000 as my database, pls i need simple and clear xplanation on the connect it to my VB6. It is very urgent because of one project i'm writting that required it. thanx

I salute your courage, make sure you upgrade to vb.net & C# because windows Vista & 7 is rejecting almost everything in vb6.0, in fact they plan to face it out.

Use the following connection string instead;

provider=sqloledb.1;Persist Security Info=False;Data Source=MyServer;Initial
Catalog=MyDatabase;User ID=MyUsername;Password=MyPassword;

hi, i'm making PAP ( final year project ), and i need help, my program is to control electrical appliances (such as lights and sensors) of a house across the vb 6 and parallel port , and I am not able to send and receive signals from more than 8 devices , and I need to send and receive 32 signals , very grateful any help,

I guess there is no more questions?

i have making a question, but ok, n'one answer,

rosworms:

i have making a question, but ok, n'one answer,

U may repost your question please