walid_8281500
03-20-2009, 12:27 AM
داله لمستخدمى اداة ado
Public dbCon As ADODB.Connection
Public dSource As String
Private Const PROVIDER As String = "Microsoft.Jet.OLEDB.4.0;"
Public Function dbConnection()
Dim conString As String
On Error GoTo errhandler:
If Dir(App.Path & "\Data****\tqnea.mdb") <> "" Then
dSource = App.Path & "\Data****\tqnea.mdb;Jet OLEDB:Data**** Password=tqnea;"
Else
MsgBox "قاعدة البيانات غير موجوده" _
, vbCritical + vbOKOnly + vbMsgBoxRight _
+ vbMsgBoxRtlReading, "حدد المكان الجديد"
With frmMain.cdData****
.Filter = "MDB Data****|*.mdb"
.DialogTitle = "حدد مكان قاعده البيانات"
.ShowOpen
If .FileName <> "" Then
dSource = .FileName & ";Jet OLEDB:Data**** Password=xteamX;"
End If
End With
End If
Set dbCon = New ADODB.Connection
conString = "Provider=" & PROVIDER & "" _
& "Data Source=" & dSource & ""
dbCon.CursorLocation = adUseClient
dbCon.Open conString
Exit Function
errhandler:
If Err.Number = -2147217843 Then
MsgBox "لم يتم تحديد قاعدة البيانات وسيتم اغلاق البرنامج", vbCritical, "قاعدة البيانات غير موجوده"
End
Else
MsgBox Err.Number, vbCritical, App.Title
End If
End Function
دالة لمستخدمى DAO
Public Dbs As DAO.Data****
Public Sub Init_Data****()
If LoadInI(App.Path & "\setting.ini") = True Then
Set Dbs = OpenData****(DataPath & "\tqnea.mdb", False, False, "MS ACCESS;PWD=" & "tqnea")
Cnnction = "Provider=MSDASQL.1;Password=tqnea;Persist Security Info=True;User ID=admin;Extended Properties=DSN=MS Access Data****;DBQ=" & DataPath & "\tqnea.mdb" & ";DefaultDir=" & DataPath & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;PWD=tqnea; UID=admin;"
Else
Exit Sub
End If
ChkSt = False
End Sub
Public dbCon As ADODB.Connection
Public dSource As String
Private Const PROVIDER As String = "Microsoft.Jet.OLEDB.4.0;"
Public Function dbConnection()
Dim conString As String
On Error GoTo errhandler:
If Dir(App.Path & "\Data****\tqnea.mdb") <> "" Then
dSource = App.Path & "\Data****\tqnea.mdb;Jet OLEDB:Data**** Password=tqnea;"
Else
MsgBox "قاعدة البيانات غير موجوده" _
, vbCritical + vbOKOnly + vbMsgBoxRight _
+ vbMsgBoxRtlReading, "حدد المكان الجديد"
With frmMain.cdData****
.Filter = "MDB Data****|*.mdb"
.DialogTitle = "حدد مكان قاعده البيانات"
.ShowOpen
If .FileName <> "" Then
dSource = .FileName & ";Jet OLEDB:Data**** Password=xteamX;"
End If
End With
End If
Set dbCon = New ADODB.Connection
conString = "Provider=" & PROVIDER & "" _
& "Data Source=" & dSource & ""
dbCon.CursorLocation = adUseClient
dbCon.Open conString
Exit Function
errhandler:
If Err.Number = -2147217843 Then
MsgBox "لم يتم تحديد قاعدة البيانات وسيتم اغلاق البرنامج", vbCritical, "قاعدة البيانات غير موجوده"
End
Else
MsgBox Err.Number, vbCritical, App.Title
End If
End Function
دالة لمستخدمى DAO
Public Dbs As DAO.Data****
Public Sub Init_Data****()
If LoadInI(App.Path & "\setting.ini") = True Then
Set Dbs = OpenData****(DataPath & "\tqnea.mdb", False, False, "MS ACCESS;PWD=" & "tqnea")
Cnnction = "Provider=MSDASQL.1;Password=tqnea;Persist Security Info=True;User ID=admin;Extended Properties=DSN=MS Access Data****;DBQ=" & DataPath & "\tqnea.mdb" & ";DefaultDir=" & DataPath & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;PWD=tqnea; UID=admin;"
Else
Exit Sub
End If
ChkSt = False
End Sub