数据库源代码

四、VB程序源码：

1、allmassage:

Dim txtsql As String

Dim mrc As ADODB.Recordset

Dim MsgText As String

Private Sub Command1_Click()

store.Show 1

End Sub

Private Sub Command10_Click() ' 确定'

MsgBox "韩焕、郭士强制作", vbExclamation, "关于我们"

End Sub

Private Sub Command11_Click()

Dim n As Integer, m As Single, X As Single

n = Text1.Text

m = Text2.Text

X = n * m

Text3.Text = X

Print

End Sub

Private Sub Command12_Click() '增加

Dim txtmsg As String

txtsql = "select * from 服饰入库表"

Set mrc = ExecuteSQL(txtsql, txtmsg)

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text4.Text

mrc.Fields(1) = Text5.Text

mrc.Fields(2) = Text6.Text

mrc.Fields(3) = Text7.Text

mrc.Fields(4) = Text15.Text

mrc.Fields(5) = Text8.Text

mrc.Fields(6) = Text16.Text

mrc.Fields(7) = Text17.Text

mrc.Update

MsgBox ("提交成功")

End Sub

Private Sub Command13_Click()

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text8.Text = ""

Text15.Text = ""

Text16.Text = ""

Text17.Text = ""

SetFocus

End Sub

Private Sub Command14_Click() '增加

Dim txtmsg As String

txtsql = "select * from 会员信息表"

Set mrc = ExecuteSQL(txtsql, txtmsg)

mrc.AddNew '在数据库表中添加数据行mrc.Fields(0) = Text9.Text

mrc.Fields(1) = Text10.Text

mrc.Fields(2) = Text11.Text

mrc.Fields(3) = Text12.Text

mrc.Fields(4) = Text13.Text

mrc.Fields(5) = Text14.Text

mrc.Update

MsgBox ("会员注册成功")

End Sub

Private Sub Command15_Click()

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text8.Text = ""

Text15.Text = ""

Text16.Text = ""

Text17.Text = ""

SetFocus

End Sub

Private Sub Command2_Click()

finance.Show 1

End Sub

Private Sub Command3_Click()

clothing.Show 1

End Sub

Private Sub Command4_Click()

client.Show 1

End Sub

Private Sub Command5_Click() ' 确定'

menber.Show 1

MsgBox "欢迎下次登陆，谢谢您的支持"

End Sub

Private Sub Command6_Click()

sell.Show 1

End Sub

Private Sub Command7_Click() '进入

staff.Show 1

End Sub

Private Sub Command8_Click()

clientsay.Show 1

End Sub

Private Sub Command9_Click() ' 确定'

MsgBox "系统有问题请电话联系程序管理部门：021-********", vbExclamation, "信息提示"

End Sub

2、client:

Dim txtsql As String

Dim mrc As ADODB.Recordset

Dim MsgText As String

Private Sub Command1_Click()

MSHFlexGrid1.Clear

txtsql = "select * from 顾客回馈表"

Set mrc = ExecuteSQL(txtsql, MsgText)

MSHFlexGrid1.Rows = 1

Do While Not mrc.EOF

With MSHFlexGrid1 '将查询内容显示在表格控件中

.Rows = .Rows + 1 '初始设定MSHFlexGrid1属性为1行2列，0固定行0固定列

.TextMatrix(.Rows - 1, 0) = mrc.Fields(0) & ""

.TextMatrix(.Rows - 1, 1) = mrc.Fields(1) & ""

.TextMatrix(.Rows - 1, 2) = mrc.Fields(2) & ""

.TextMatrix(.Rows - 1, 3) = mrc.Fields(3) & ""

.TextMatrix(.Rows - 1, 4) = mrc.Fields(4) & ""

.TextMatrix(0, 0) = "月份"

.TextMatrix(0, 1) = "顾客满意度"

.TextMatrix(0, 2) = "顾客光顾度"

.TextMatrix(0, 3) = "顾客消费度"

.TextMatrix(0, 4) = "顾客建议度"

End With

mrc.MoveNext

Loop

End Sub

Private Sub Command2_Click() '删除

txtsql = "delete from 顾客回馈表where 月份= '" + MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 1) + "'"

Set mrc = ExecuteSQL(txtsql, MsgText)

MSHFlexGrid1.RemoveItem MSHFlexGrid1.RowSel

End Sub

Private Sub Command3_Click() '增加

With MSHFlexGrid1 '增加一行并显示

.AddItem "", mrc.RecordCount + 1

.TextMatrix(mrc.RecordCount + 1, 0) = Text1.Text

.TextMatrix(mrc.RecordCount + 1, 1) = Text2.Text

.TextMatrix(mrc.RecordCount + 1, 2) = Text3.Text

.TextMatrix(mrc.RecordCount + 1, 3) = Text4.Text

.TextMatrix(mrc.RecordCount + 1, 4) = Text5.Text

End With

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Fields(4) = Text5.Text

mrc.Update

End Sub

Private Sub Command4_Click() '修改

'修改显示表

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0) = Text1.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 1) = Text2.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 2) = Text3.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 3) = Text4.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 4) = Text5.Text '修改数据库表

'Text4.Text = MSHFlexGrid1.RowSel

mrc.AbsolutePosition = MSHFlexGrid1.RowSel

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Fields(4) = Text5.Text

mrc.Update

End Sub

Private Sub Text1_Change()

End Sub

3、clientsay:

Dim rs As New ADODB.Recordset

Dim txtsql As String

Dim txtmsg As String

Dim username As String

Dim opt1 As Integer '店员服务态度

Dim opt2 As Integer '服装款式质量

Dim opt3 As Integer '店面装横情况

Private Sub Command1_Click()

Select Case True

Case Option1.Value

opt1 = 4

Case Option2.Value

opt1 = 3

Case Option3.Value

opt1 = 2

Case Option4.Value

opt1 = 1

End Select

Select Case True

Case Option5.Value

opt2 = 4

Case Option6.Value

opt2 = 3

Case Option7.Value

opt2 = 2

Case Option8.Value

opt2 = 1

End Select

Select Case True

Case Option9.Value

opt3 = 4

Case Option10.Value

opt3 = 3

Case Option11.Value

opt3 = 2

Case Option12.Value

opt3 = 1

End Select

Dim txtmsg As String

txtsql = "select * from 顾客评价表"

Set mrc = ExecuteSQL(txtsql, txtmsg)

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = opt1

mrc.Fields(2) = opt2

mrc.Fields(3) = opt3

mrc.Update

MsgBox ("您的评价已成功提交！")

End Sub

Private Sub Command2_Click()

Unload clientsay

End Sub

4、clothing:

Dim txtsql As String

Dim mrc As ADODB.Recordset

Dim MsgText As String

'Private Sub Command1_Click()

' txtSQL = "select * from 服装分类表"

' Set mrc = ExecuteSQL(txtSQL, MsgText)

' mrc.MoveFirst

' mrc.Move (3)

'' mrc.AbsolutePosition = 4

' Text1.Text = MsgText

' mrc.Delete

' mrc.Update

'End Sub

Private Sub Command1_Click()

MSHFlexGrid1.Clear

txtsql = "select * from 服装分类表"

Set mrc = ExecuteSQL(txtsql, MsgText)

MSHFlexGrid1.Rows = 1

Do While Not mrc.EOF

With MSHFlexGrid1 '将查询内容显示在表格控件中

.Rows = .Rows + 1 '初始设定MSHFlexGrid1属性为1行2列，0固定行0固定列

.TextMatrix(.Rows - 1, 0) = mrc.Fields(0) & ""

.TextMatrix(.Rows - 1, 1) = mrc.Fields(1) & ""

.TextMatrix(.Rows - 1, 2) = mrc.Fields(2) & ""

.TextMatrix(.Rows - 1, 3) = mrc.Fields(3) & ""

.TextMatrix(0, 0) = "服装类别"

.TextMatrix(0, 1) = "适合人群"

.TextMatrix(0, 2) = "主色调"

.TextMatrix(0, 3) = "面料"

End With

mrc.MoveNext

Loop

End Sub

Private Sub Form_Load()

'Picture1.Picture = LoadPicture("d:\服装专卖店管理系统\picture\夹

克.jpg")

With MSHFlexGrid1

.Rows = 1

.CellAlignment = 2

.ColWidth(0) = 1000

.ColWidth(1) = 1000

End With

End Sub

''

Private Sub MSHFlexGrid1_Click()

If MSHFlexGrid1.RowSel <> 0 Then

mrc.AbsolutePosition = MSHFlexGrid1.RowSel

Picture1.Picture = LoadPicture(mrc.Fields(4))

End If

'Picture1.Picture = LoadPicture(mrc.Fields(1))

'Picture1.Picture = LoadPicture(mrc.Fields(2))

'Picture1.Picture = LoadPicture(mrc.Fields(3))

End Sub

5、finance:

Private Sub Command3_Click() '增加

With MSHFlexGrid1 '增加一行并显示

.AddItem "", mrc.RecordCount + 1

.TextMatrix(mrc.RecordCount + 1, 0) = Text1.Text

.TextMatrix(mrc.RecordCount + 1, 1) = Text2.Text

.TextMatrix(mrc.RecordCount + 1, 2) = Text3.Text

.TextMatrix(mrc.RecordCount + 1, 3) = Text4.Text

End With

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Update

End Sub

Private Sub Command4_Click() '修改

'修改显示表

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0) = Text1.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 1) = Text2.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 2) = Text3.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 3) = Text4.Text

'修改数据库表

'Text4.Text = MSHFlexGrid1.RowSel

mrc.AbsolutePosition = MSHFlexGrid1.RowSel

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Update

End Sub

6、login:

Public m As String

Public i As String

Dim txtsql As String

Dim conn As New ADODB.Connection

Dim mrc As New ADODB.Recordset

Public n As Integer

Private Sub Command2_Click()

tbname.Text = ""

tbpas.Text = ""

tbname.SetFocus

End Sub

Private Sub Command1_Click()

If tbname.Text = "123" Then

OK = True

Me.Hide

allmassage.Show 1

Else

MsgBox "用户名有误, 请重新输入!", , "错误提示"

tbname.SetFocus

tbpas.SelStart = 123

tbpas.SelLength = Len(tbpas.Text)

End If

End Sub

Private Sub Command3_Click()

Unload login

End Sub

Private Sub Command4_Click() '进入

allmassage.Show 1

End Sub

Private Sub tbPas_Change()

tbpas.PasswordChar = "*"

End Sub

7、menber:

Private Sub Command1_Click()

MsgBox "数据更新中，给您带来了不便，请谅解！", vbExclamation, "信息提示"

End Sub

8、sell：

Dim txtsql As String

Dim mrc As ADODB.Recordset

Dim MsgText As String

Private Sub Command1_Click()

MSHFlexGrid1.Clear

txtsql = "select * from 销售库存表"

Set mrc = ExecuteSQL(txtsql, MsgText)

MSHFlexGrid1.Rows = 1

Do While Not mrc.EOF

With MSHFlexGrid1 '将查询内容显示在表格控件中

.Rows = .Rows + 1 '初始设定MSHFlexGrid1属性为1行2列，0固定行0固定列

.TextMatrix(.Rows - 1, 0) = mrc.Fields(0) & ""

.TextMatrix(.Rows - 1, 1) = mrc.Fields(1) & ""

.TextMatrix(.Rows - 1, 2) = mrc.Fields(2) & ""

.TextMatrix(.Rows - 1, 3) = mrc.Fields(3) & ""

.TextMatrix(0, 0) = "服饰样式"

.TextMatrix(0, 1) = "库存量"

.TextMatrix(0, 2) = "近七天卖出"

.TextMatrix(0, 3) = "近七天进货"

End With

mrc.MoveNext

Loop

End Sub

Private Sub Command3_Click() '增加

With MSHFlexGrid1 '增加一行并显示

.AddItem "", mrc.RecordCount + 1

.TextMatrix(mrc.RecordCount + 1, 0) = Text1.Text

.TextMatrix(mrc.RecordCount + 1, 1) = Text2.Text

.TextMatrix(mrc.RecordCount + 1, 2) = Text3.Text

.TextMatrix(mrc.RecordCount + 1, 3) = Text4.Text

End With

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Update

End Sub

Private Sub Command4_Click() '修改

'修改显示表

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0) = Text1.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 1) = Text2.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 2) = Text3.Text

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 3) = Text4.Text

'修改数据库表

'Text4.Text = MSHFlexGrid1.RowSel

mrc.AbsolutePosition = MSHFlexGrid1.RowSel

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Update

End Sub

9、staff:

Private Sub Command3_Click() '增加

With MSHFlexGrid1 '增加一行并显示

.AddItem "", mrc.RecordCount + 1

.TextMatrix(mrc.RecordCount + 1, 0) = Text1.Text

.TextMatrix(mrc.RecordCount + 1, 1) = Text2.Text

.TextMatrix(mrc.RecordCount + 1, 2) = Text3.Text

.TextMatrix(mrc.RecordCount + 1, 3) = Text4.Text

End With

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

End Sub

Private Sub Command4_Click() '显示

MSHFlexGrid1.Clear

txtsql = "select * from 员工基本表"

Set mrc = ExecuteSQL(txtsql, MsgText)

MSHFlexGrid1.Rows = 1

Do While Not mrc.EOF

With MSHFlexGrid1 '将查询内容显示在表格控件中

.Rows = .Rows + 1 '初始设定MSHFlexGrid1属性为1行3列，0固定行0固定列

.TextMatrix(.Rows - 1, 0) = mrc.Fields(0) & ""

.TextMatrix(.Rows - 1, 1) = mrc.Fields(1) & ""

.TextMatrix(.Rows - 1, 2) = mrc.Fields(2) & ""

.TextMatrix(.Rows - 1, 3) = mrc.Fields(3) & ""

.TextMatrix(0, 0) = "员工编号"

.TextMatrix(0, 1) = "员工姓名"

.TextMatrix(0, 2) = "目前职务"

.TextMatrix(0, 3) = "基本工资"

End With

mrc.MoveNext

Loop

End Sub

10、store:

Private Sub Command3_Click() '增加

With MSHFlexGrid1 '增加一行并显示

.AddItem "", mrc.RecordCount + 1

.TextMatrix(mrc.RecordCount + 1, 0) = Text1.Text

.TextMatrix(mrc.RecordCount + 1, 1) = Text2.Text

.TextMatrix(mrc.RecordCount + 1, 2) = Text3.Text

.TextMatrix(mrc.RecordCount + 1, 3) = Text4.Text

End With

mrc.AddNew '在数据库表中添加数据行

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

End Sub

Private Sub Command4_Click() '修改

'修改显示表

MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0) = Text1.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 1) = Text2.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 2) = Text3.Text MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 3) = Text4.Text '修改数据库表

'Text4.Text = MSHFlexGrid1.RowSel

mrc.AbsolutePosition = MSHFlexGrid1.RowSel

mrc.Fields(0) = Text1.Text

mrc.Fields(1) = Text2.Text

mrc.Fields(2) = Text3.Text

mrc.Fields(3) = Text4.Text

mrc.Update

End Sub