_____________________________________________________
How to Back up a SQL Database Using SQL-DMO
_____________________________________________________
Public Function DB_Backup(ByVal nServer_Name As String, _
ByVal nDB_Name As String, _
ByVal nDB_Login As String, ByVal nDB_Password As String, _
ByVal nBack_Dev As String, ByVal nBack_Set As String, _
ByVal nBack_Desc As String) As Boolean
‘ nServer_Name = SQL server name
' nDB_Name = Database name
' nDB_Login = Login name
' nDB_Password = Password
' nBack_Dev =Backup device name
' nBack_Set = Backup set name
' nBack_Desc = Backup discription
Dim oBackup As SQLDMO.Backup
On Error GoTo ErrorHandler
Set oBackup = CreateObject("SQLDMO.Backup")
If Connect_SQLDB(nServer_Name, nDB_Login, nDB_Password) Then
oBackup.Devices = "[" & nBack_Dev & "]"
oBackup.Database = nDB_Name
oBackup.BackupSetName = nBack_Set
oBackup.BackupSetDescription = nBack_Desc
oBackup.SQLBackup oSQLServer
oSQLServer.DisConnect
DB_Backup = True
End If
Exit Function
ErrorHandler:
DB_Backup = False
End Function
Private Function Connect_SQLDB(ByVal nServer_Name As String, _
ByVal nDB_Login As String, _
ByVal nDB_Password As String) As Boolean
' nServer_Name = SQL server name
' nDB_Login = Login name
' nDB_Password = Password
Set oSQLServer = CreateObject("SQLDMO.SQLServer")
On Error GoTo ErrorHandler
Connect_SQLDB = False
oSQLServer.Connect nServer_Name, nDB_Login, nDB_Password
Connect_SQLDB = True
Exit Function
ErrorHandler:
oSQLServer.DisConnect
Connect_SQLDB = False
End Function
_____________________________________________________
How to Connect to a Secure Access Database Using ADO
_____________________________________________________
'In the place where you want to establish your connection, such
'as the Initialize event of a class module, enter the following:
Dim strConnect As String
Set Cnn = New ADODB.Connection
'Substitute your own User IDs, Password, Data Source, and System
'database in the connection string below
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Password=OpenSesame;User ID=Administrator;" & _
"Data Source=C:\AccessDBs\DB1.mdb;" & _
"Persist Security Info=True;" & _
"Jet OLEDB:System database=C:\AccessDBs\system.mdw"
With Cnn
.CursorLocation = adUseClient
.Open strConnect
End With
Set Rst = New ADODB.Recordset
Rst.ActiveConnection = Cnn
'In the place where you want to establish your connection, such 'as the Initialize event of a class module, enter the following:
Dim strConnect As StringSet Cnn = New ADODB.Connection
'Substitute your own User IDs, Password, Data Source, and System'database in the connection string below strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Password=OpenSesame;User ID=Administrator;" & _ "Data Source=C:\AccessDBs\DB1.mdb;" & _ "Persist Security Info=True;" & _ "Jet OLEDB:System database=C:\AccessDBs\system.mdw"
With Cnn
.CursorLocation = adUseClient
.Open strConnect
End With
Set Rst = New ADODB.Recordset
Rst.ActiveConnection = Cnn
_____________________________________________________
How to Connect Oracle in Visual Basic in Easy Way
_____________________________________________________
ON FORM LOAD EVENT
‘——————-
con.open “driver={Microsoft ODBC for ORACLE};UID=SCOTT;PWD=TIGER”
rs.open “EMP”,con,adopendynamik,adlockoptimistic,adcmdtable
_____________________________________________________
How to Create a blank DB by reading its structure
_____________________________________________________
Public Function CreateDB(dbName As String) As Boolean
Dim rsTable, rsField As dao.Recordset
Dim str1, str2 As String, db1, db2 As dao.Database
Dim int1 As Integer, fld As Field, tdf As dao.TableDef
CreateDB = False
On Error GoTo CreateDB_Error
Set db1 = OpenDatabase(G_RefDB)
Set rsTable = db1.OpenRecordset("Select Distinct TableName from tblTableFields")
If Dir(dbName) <> "" Then Kill dbName
Set db2 = CreateDatabase(dbName, dbLangGeneral)
rsTable.MoveFirst
Do Until rsTable.EOF
On Error Resume Next
db2.TableDefs.Delete rsTable!TableName
On Error GoTo 0
Set tdf = db2.CreateTableDef(rsTable!TableName)
Set rsField = db1.OpenRecordset("Select * from tblTableFields where TableName = '" & rsTable!TableName & "'")
rsField.MoveLast
rsField.MoveFirst
Do Until rsField.EOF
Select Case rsField!Type
Case "dbText"
Set fld = tdf.CreateField(rsField!FieldName, dbText)
Case "dbInteger"
Set fld = tdf.CreateField(rsField!FieldName, dbInteger)
Case "dbLong"
Set fld = tdf.CreateField(rsField!FieldName, dbLong)
Case "dbBoolean"
Set fld = tdf.CreateField(rsField!FieldName, dbBoolean)
Case "dbByte"
Set fld = tdf.CreateField(rsField!FieldName, dbByte)
Case "dbSingle"
Set fld = tdf.CreateField(rsField!FieldName, dbSingle)
Case "dbDate"
Set fld = tdf.CreateField(rsField!FieldName, dbDate)
Case "dbDouble"
Set fld = tdf.CreateField(rsField!FieldName, dbDouble)
Case "dbLongBinary"
Set fld = tdf.CreateField(rsField!FieldName, dbLongBinary)
Case "dbMemo"
Set fld = tdf.CreateField(rsField!FieldName, dbMemo)
End Select
'Set fld = tdf.CreateField(rsField!FieldName, rsField!Type)
If Not IsNull(rsField!Size) Then fld.Size = rsField!Size
If Not IsNull(rsField!DefaultValue) Then fld.DefaultValue = rsField!DefaultValue
If rsField!Type = "dbText" Then fld.AllowZeroLength = rsField!AllowZero
tdf.Fields.Append fld
rsField.MoveNext
Loop
db2.TableDefs.Append tdf
db2.TableDefs.Refresh
rsTable.MoveNext
On Error Resume Next
On Error GoTo 0
Loop
rsTable.Close
rsField.Close
db1.Close
db2.Close
Set rsTable = Nothing
Set rsField = Nothing
Set db1 = Nothing
Set db2 = Nothing
CreateDB = True
Exit Function
CreateDB_Error:
MsgBox "The error: " & Err.Description & "has happened"
End Function
_____________________________________________________
How to Connect Database without DSN Connection or DSNLess
__________________________________________________________________________________________________________
'** opening dsnless connection in Access, SQL Server & Oracle'* 1.
USING ODBC DRIVERSDim con As New ADODB.Connection
con.Open "Driver={Microsoft Access Driver (*.mdb)}; dbq=Biblio.mdb; " & _
"DefaultDir=C:\Program Files\Microsoft Visual Studio\VB98; uid=admin; pwd="
Print "Access connection state=" & con.State
con.Closecon.Open "Driver={Oracle ODBC Driver}; dbq=beq-local.world ;uid=scott; pwd=tiger"
Print "Oracle connection state=" & con.State
con.Close
'Note: This connection is tested on both Personal Oracle 8 and Oracle 8i. Only
change you make while using it with oracle8i client is to use Net 8 service name as value
of dbq parameter.con.Open "Driver={SQL Server}; Server=Server1; Database=pubs; uid=sa; pwd="
Print "SQL Server connection state=" & con.State
con.Close'* 1. USING OLEDB PROVIDERScon.Open "Provider=Microsoft.Jet.Oledb.4.0; " & _
"Data Source=C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb; User Id=admin; Password="
'Note: connectionstring in above example makes use of provider for Access 2000 database.
For earlier version of database use
Provider=Microsoft.Jet.Oledb.3.51con.Open "Provider=MSDAORA.1;Password=tiger;User ID=scott;Data " & _
"Source=beq-local.world"con.Open "Provider=SQLOLEDB.1;User ID=sa;password=;Data Source=(local); Initial Catalog=Northwind"
_____________________________________________________
How to Populate a MSFlexGrid or Sheridan DataGrid
_____________________________________________________
Public Function LoadRecordSetIntoGrid(ctlGrid As MSFlexGrid, _
rs As ADODB.Recordset) As Boolean
Dim sTmp As String
Dim vArr As Variant
Dim i As Integer
On Error GoTo ErrorHandler
'first we have to clear the grid from previous query results
'**** remove existing grid rows
ctlGrid.Rows = 2
ctlGrid.AddItem ""
ctlGrid.RemoveItem 1
If Not rs.EOF And Not rs.BOF Then
'get the recordset into a string delimiting the fields
'with a tab character and the records with a semicolon
'replace nulls with a space
sTmp = rs.GetString(adClipString, , Chr(9), ";", " ")
'split the string into an array of individual records
vArr = Split(sTmp, ";")
'now add the records to the grid
For i = 0 To UBound(vArr) - 1
ctlGrid.AddItem vArr(i)
Next
'set the return value
LoadRecordSetIntoGrid = True
Else
LoadRecordSetIntoGrid = False
Exit Function
End If
'remove empty rows
If ctlGrid.Rows > 2 Then
On Error Resume Next 'get over removing a single record
For i = 1 To ctlGrid.Rows - 1
If ctlGrid.TextMatrix(i, 1) = "" Then
ctlGrid.RemoveItem i
Else
Exit For
End If
Next
End If
Exit Function
ErrorHandler:
LoadRecordSetIntoGrid = False
End Function
_____________________________________________________
How to Search all records
_____________________________________________________
Private Sub Command1_click()
Dim search as variant
sstr = InputBox("Enter Author to Search") ' Display a Input Box Window
data1.recordset.findfirst "Author='" & sstr & "'" ' Look for the record that has a value "sstr"
If trim(sstr) <> "" then
If data1.recordset.nomatch then 'check if the record exist
MsgBox "No record Exist"
Command1.setfocus
else
data1.recordsource = "SELECT * FROM TableName WHERE Author='" & sstr & "'" ' Display all the Records that has a Value of "sstr"
data1.refresh ' refresh the DBGRID or MSFLEXGRID
End if
End if
End Sub
______________________________________________________________________________________
How to User Name and Password Using Stored Procedure
____________________________________________________________________________________________
'-- Make sure that you reference Microsoft ActiveX Data Objects Library--
'******************************
'**** Use this in a Module ****
'******************************
Public DB as New ADODB.Connection
Public RS as New ADODB.Recordset
Public QY as New ADODB.Command
Function Validate(UserName as String, Password as string,RS as ADODB.Recordset)
'-- Open a connection to SQL database
ConnectionString = "Provider= "Microsoft OLE DB Provider for SQL Server";Data Provider = "SQLOLEDB";Driver = " SQL Server" _
;Server=" & "YOUR SERVER NAME" & ";uid="sa";pwd="";Database="YOUR DATABASE"
'-- Open a connection to SQL database.
Set DB = New ADODB.Connection
DB.CursorLocation = adUseClient
DB.ConnectionTimeout = 60
DB.ConnectionString = ConnectionString
DB.Open
Set DB = QY.ActiveConnection
QY.CommandType = adCmdStoredProc
QY.CommandText = "usp_UserSecurity"
QY.Parameters.Refresh
QY.Parameters("@UserName") = UserName
QY.Parameters("@Password") = Password
Set RS = QY.Execute
'*********************************
'--User this code for the form
'--Add two text boxes and a button
'--text1 and text2
'*********************************
Private Sub Command1_Click()
Validate text1.text,text2.text,RS
If Not RS.EOF Then
msgbox "Successfull!!!"
Else
msgbox "Not Successfull"
End IF
End Sub
'***************************************************
'--Here is the code to make the stored procedures!!!
'--Make sure you have a table in SQL named "Security"
'--with Columns "UserName" and "Password"
'--You might want to enter a user name and password
'--in there to test with!!!
'***************************************************
CREATE PROCEDURE dbo.usp_UserSecurity
@UserName as varchar(50),
@Password as varchar(50)
AS
Select * from Security
Where UserName = @UserName and Password = @Password
GO
_____________________________________________________
How to Convert Hex to Dec
_____________________________________________________
Public Function hex2ascii(ByVal hextext As String) As String
For y = 1 To Len(hextext)
num = Mid(hextext, y, 2)
Value = Value & Chr(Val("&h" & num))
y = y + 1
Next y
hex2ascii = Value
End Function
_____________________________________________________
How to Delay or Pause a Program
_____________________________________________________
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
Call Sleep(1000)
End Sub
_____________________________________________________
How to Get Operating System and Version
_____________________________________________________
Private Sub Form_Load()Label1.Caption= "OSVersion = " & SysInfo1.OSVersionLabel2.Caption "OSBuild = " & SysInfo1.OSBuildEnd Sub _____________________________________________________ How to Show Shutdown Dialogue Box _____________________________________________________
Declare Function SHShutDownDialog Lib "shell32" Alias _
"#60" (ByVal lType As Long) As Long
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8
_____________________________________________________
How to Show or Hide Taskbar
_____________________________________________________
Declare Function SetWindowPos Lib "user32" (ByVal hwnd _
As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal _
wFlags As Long) As Long
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Sub Command1_Click()
Dim Thwnd as Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
Private Sub Command2_Click()
Dim Thwnd as Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
_____________________________________________________
How to Shutdown Windows
_____________________________________________________
'Api function and the constants required for ExitWindowsEx
Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags As Long, _ ByVal dwReserved As Long) Public Const EWX_FORCE = 4 Public Const EWX_LOGOFF = 0 Public Const EWX_REBOOT = 2 Public Const EWX_SHUTDOWN = 1 Private Sub cmdShutdown_Click() Dim MsgRes As Long 'Make sure that the user really want to shutdown MsgRes = MsgBox("Are you sure you want to Shut Down Windows 95?", vbYesNo Or vbQuestion) 'If the user selects no, exit this sub If MsgRes = vbNo Then Exit Sub 'else, shutdown windows and unload this form Call ExitWindowsEx(EWX_SHUTDOWN, 0) Unload Me End Sub _____________________________________________________ How to Check if Program is Running _____________________________________________________ Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, ByVal _ lpWindowName As String) As Long Function IsAppRunning() Dim strClassName As String Dim strCaption As String strClassName = "SciCalc" strCaption = "Calculator" Print "Handle = ";FindWindow(strClassName, 0&) Print "Handle = ";FindWindow(0&, strCaption) Print "Handle = ";FindWindow(strClassName,strCaption) End Function _____________________________________________________ How to Read and Write Registry in Visual Basic _____________________________________________________ Dim Text As String 'Gets from the registry Print GetSetting(App.Title, "Startup", "Message", "Hello") 'Saves to the registry Text = "Hello again!!!" SaveSetting App.Title, "Startup", "Message", Text 'Deletes from the registry DeleteSetting App.Title, "Startup", "Message"