form1.frm

会员信息管理系统基于vb开发

         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   330
         Left            =   360
         TabIndex        =   9
         Top             =   2040
         Width           =   1470
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         BackColor       =   &H00E0E0E0&
         Caption         =   "类别:"
         Height          =   240
         Left            =   240
         TabIndex        =   8
         Top             =   1320
         Width           =   660
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         BackColor       =   &H00E0E0E0&
         Caption         =   "姓名:"
         Height          =   240
         Left            =   3480
         TabIndex        =   7
         Top             =   600
         Width           =   660
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackColor       =   &H00E0E0E0&
         Caption         =   "卡号:"
         Height          =   240
         Index           =   0
         Left            =   240
         TabIndex        =   6
         Top             =   480
         Width           =   660
      End
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackColor       =   &H00E0E0E0&
      Caption         =   "卡号:"
      Height          =   240
      Index           =   1
      Left            =   120
      TabIndex        =   23
      Top             =   1080
      Width           =   660
   End
   Begin VB.Label Label4 
      BackColor       =   &H00E0E0E0&
      Caption         =   "进入人数 "
      Height          =   255
      Index           =   0
      Left            =   6240
      TabIndex        =   4
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label Label39 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   7560
      TabIndex        =   3
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004080&
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   1080
      Width           =   1695
   End
   Begin VB.Label Label2 
      BackColor       =   &H00E0E0E0&
      Caption         =   "当前时间"
      Height          =   375
      Index           =   1
      Left            =   3000
      TabIndex        =   1
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackColor       =   &H00E0E0E0&
      Caption         =   "海角嬉水乐园会员卡管理系统入口"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   360
      TabIndex        =   0
      Top             =   120
      Width           =   8295
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim row_num As Integer               '表格的总行数
Dim col_num As Integer               '表格的总列数
Dim gridrow As Integer
Dim mycmd As New ADODB.Command
Dim temp As String
Dim rs5 As New ADODB.Recordset
Private Sub command1_Click()
Dim sql As String
Dim rs4 As New ADODB.Recordset

sql = "delete * from 临时表"
Set rs4 = conn.Execute(sql)
Unload Me
End Sub

Private Sub command3_Click()
Form3.Show
End Sub

Private Sub Form_Activate()
Text1.SetFocus
End Sub

Private Sub Form_Load()

If username = "guest" Then
command3.Enabled = False

End If


End Sub



Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then



Dim sql As String

Dim cmd As New ADODB.Command
select_row = Text1.Text
select_row1 = Text6.Text

On Error GoTo displaybasicerror
Set cmd.ActiveConnection = conn
sql = "select * from 基本档案 where 基本档案.卡号=" & "'" & select_row & "'"
cmd.CommandText = sql
Set rs2 = cmd.Execute

If rs2.EOF = True Then
 MsgBox "无此卡", vbOKOnly + vbExclamation, ""
Else

Text2.Text = rs2.Fields(0)
Text3.Text = rs2.Fields(1)
Text4.Text = rs2.Fields(9)
Text5.Text = rs2.Fields(7)
Text6.Text = rs2.Fields(8)

 If rs2.Fields(13) = "是" Then
 MsgBox "此卡已到期", vbOKOnly + vbExclamation, ""
Else
 Picture1.Picture = LoadPicture(ReadImage(rs2.Fields("照片")))
     
 sql = " insert into 临时表 (卡号,注册时间) values ('" & Text2.Text & "','" & Now & "')"
  conn.Execute sql
  
End If
End If
  
  
displaybasicerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
Text1.Text = ""
Text1.SetFocus
End If
temp = 0
sql = "select * from 临时表"
Set rs3 = conn.Execute(sql)
Do While Not rs3.EOF
temp = temp + 1
rs3.MoveNext
Loop
Label39.Caption = temp

End Sub
Private Sub Timer1_Timer()
Label3.Caption = Time
End Sub
Private Function ReadImage(blobColumn As ADODB.Field) As String
    '取得一个临时性文件
    Dim strFileName As String
    strFileName = "ImageTmp"

    Dim FileNumber      As Integer      '文件号
    Dim DataLen             As Long         '文件长度
    Dim Chunks              As Long         '数据块数
    Dim ChunkAry()      As Byte         '数据块数组
    Dim ChunkSize       As Long         '数据块大小
    Dim Fragment        As Long         '零碎数据大小
    Dim lngI                As Long '计数器
    
    On Error GoTo errHander
    
    ChunkSize = 20480                    '定义块大小为 20K
    If IsNull(blobColumn) Then Exit Function

    DataLen = blobColumn.ActualSize         '获得图像大小
    If DataLen < 8 Then Exit Function   '图像大小小于8字节时认为不是图像信息
        FileNumber = FreeFile               '产生随机的文件号
    Open strFileName For Binary Access Write As FileNumber     '打开存放图像数据文件
    Chunks = DataLen \ ChunkSize        '数据块数
    Fragment = DataLen Mod ChunkSize    '零碎数据
    If Fragment > 0 Then            '有零碎数据，则先读该数据
            ReDim ChunkAry(Fragment - 1)
            ChunkAry = blobColumn.GetChunk(Fragment)
            Put FileNumber, , ChunkAry      '写入文件
    End If

    ReDim ChunkAry(ChunkSize - 1)             '为数据块重新开辟空间
    For lngI = 1 To Chunks                              '循环读出所有块
            ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
            Put FileNumber, , ChunkAry()    '将数据块写入文件中
    Next lngI
    Close FileNumber            '关闭文件
    
    ReadImage = strFileName
    
    Exit Function
    
errHander:
    ReadImage = ""
End Function