accesscnn.bas

一套简单的销售管理系统

Attribute VB_Name = "conn"
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public cnn As New ADODB.Connection
Public qy1 As New ADODB.Recordset '数据专用
Public qy1save As New ADODB.Recordset '数据专用
Public s1 As New ADODB.Recordset '商品资料专用
Public s2 As New ADODB.Recordset '商品名称专用
Public s3 As New ADODB.Recordset '商品型号专用
Public qy3 As New ADODB.Recordset '商品单位专用
Public qy2 As New ADODB.Recordset '单位专用
Private backFile As String
Private qs As String
Private buff As String

Sub Main()
tkOpenAccessDB App.Path & "\base.mdb"
addtrans App.Path & "\base.mdb"
If qy1.State = adStateOpen Then '表状态
qy1.Close
End If
qy1.Open "select * from 用户", cnn, adOpenStatic, adLockReadOnly, adCmdText
If qy1.RecordCount = 0 Then
Set qy1 = cnn.Execute("insert into 用户 values('admin','admin','管理员')")
End If
Form5.Show
End Sub
Public Sub addtrans(tkFileName As String)
buff = String(255, 0)
backFile = Date + 5
Dim backfila As String
backfila = Date
Dim backfilb As Date
ret = GetPrivateProfileString("OK", "yesno", "", buff, 256, "c:\temp.ini")
If ret <> 0 Then
ret1 = GetPrivateProfileString("Bak", "qs", "", buff, 256, "c:\temp.ini")
form1.Label13.Caption = buff
If form1.Label13.Caption = "NO" Then
  ret1 = GetPrivateProfileString("Bak", "yy", "", buff, 256, "c:\temp.ini")
 form1.Label13.Caption = buff
 MsgBox form1.Label13.Caption
 End
ElseIf form1.Label13.Caption <= Date Then
 ret1 = GetPrivateProfileString("Bak", "yy", "", buff, 256, "c:\temp.ini")
 form1.Label13.Caption = buff
 MsgBox form1.Label13.Caption
 success1 = WritePrivateProfileString("Bak", "qs", "NO", "c:\temp.ini")
 End
End If
Else
success = WritePrivateProfileString("OK", "yesno", "yes", "c:\temp.ini")
success1 = WritePrivateProfileString("Bak", "qs", backFile, "c:\temp.ini")
success2 = WritePrivateProfileString("Bak", "yy", form1.Label12.Caption, "c:\temp.ini")
End If
End Sub

Private Sub tkOpenAccessDB( _
        tkFileName As String, _
        Optional tkUserID As String, _
        Optional tkPassword As String _
    )
    
    On Error GoTo tkFinish
    
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & tkFileName & ";" & _
        "Mode=Share Deny None;" & _
        "Extended Properties=;" & _
        "Jet OLEDB:System database=;" & _
        "Jet OLEDB:Registry Path=;" & _
        "Jet OLEDB:Database Password=;" & _
        "Jet OLEDB:Engine Type=5;" & _
        "Jet OLEDB:Database Locking Mode=1;" & _
        "Jet OLEDB:Global Partial Bulk Ops=2;" & _
        "Jet OLEDB:Global Bulk Transactions=1;" & _
        "Jet OLEDB:New Database Password=;" & _
        "Jet OLEDB:Create System Database=False;" & _
        "Jet OLEDB:Encrypt Database=False;" & _
        "Jet OLEDB:Don't Copy Locale on Compact=False;" & _
        "Jet OLEDB:Compact Without Replica Repair=False;" & _
        "Jet OLEDB:SFP=False;" & _
        tkUserID, _
        tkPassword
    
    Exit Sub
tkFinish:
    MsgBox Err.Description
    End
    
End Sub

Public Sub nconn()
If nnumber > 4 Then
MsgBox form1.Label12.Caption
nnumber = 0
End If
End Sub