cktk.frm

网吧库存管理系统 主要对商品网费等费用和数量管理

         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin 工程1.xpcmdbutton xpcmdbutton3 
         Height          =   240
         Index           =   1
         Left            =   3795
         TabIndex        =   28
         Top             =   435
         Visible         =   0   'False
         Width           =   540
         _ExtentX        =   953
         _ExtentY        =   423
         Caption         =   "本月"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Height          =   900
         Left            =   3195
         TabIndex        =   30
         Top             =   660
         Width           =   1230
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "出库纪录号："
         Height          =   240
         Left            =   45
         TabIndex        =   29
         Top             =   270
         Width           =   1125
      End
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "出库退库"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   135
      TabIndex        =   32
      Top             =   720
      Width           =   4635
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Height          =   285
      Left            =   1140
      TabIndex        =   31
      Top             =   990
      Width           =   2310
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      Height          =   3165
      Left            =   135
      Shape           =   4  'Rounded Rectangle
      Top             =   675
      Width           =   4605
   End
End
Attribute VB_Name = "cktk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim oldx As Long
Dim oldy As Long
Dim mov As Boolean
Dim rkspid As Long
Dim xzkcs As Double
Dim dat As Date
Dim dad As Date
Dim xgsl As Double
Dim xgjg As Double
Dim ckspid As Long
Dim spnm As String
Public ckdzt As Integer
Dim ckid As Integer

Private Sub Combo1_Click()
Label3.Caption = ""
Label5.Caption = ""
xzkcs = 0
xpcmdbutton1.Enabled = True
If Trim(Combo1.Text) = "" Then Exit Sub
Adodc1.RecordSource = "select * from ck where ckdh ='" & Trim(Combo1.Text) & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
spnm = Adodc1.Recordset.Fields("spname")
Label3.Caption = "商品名称：" & spnm
Label3.Caption = Label3.Caption & vbCrLf & "领用数量：" & Adodc1.Recordset.Fields("cksl")
Label3.Caption = Label3.Caption & vbCrLf & "出库人：" & Adodc1.Recordset.Fields("ckname")
Label3.Caption = Label3.Caption & vbCrLf & "出库时间：" & Adodc1.Recordset.Fields("ckdate")
xzkcs = Adodc1.Recordset.Fields("cksl")
ckid = Adodc1.Recordset.Fields("id")
Adodc1.RecordSource = "select spsl,id from spkc where spname ='" & spnm & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Label5.Caption = "库存量：" & Adodc1.Recordset.Fields("spsl")
ckspid = Adodc1.Recordset.Fields("id")
Else
Label5.Caption = "现无库存！"
xpcmdbutton1.Enabled = False
End If
End If


End Sub

Private Sub Combo2_Click()

xpcmdbutton5.Enabled = True
spnm = Trim(Combo2.Text)
If spnm = "" Then Exit Sub
Adodc1.RecordSource = "select spsl,id from spkc where spname ='" & spnm & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Label8.Caption = "库存量：" & Adodc1.Recordset.Fields("spsl")
Text1 = Adodc1.Recordset.Fields("spsl")
ckspid = Adodc1.Recordset.Fields("id")
Else
Label8.Caption = "现无库存！"
xpcmdbutton5.Enabled = False
Text1 = 0
End If
End Sub

Private Sub Combo3_Click()
xzkcs = 0
xpcmdbutton7.Enabled = True
If Trim(Combo3.Text) = "" Then Exit Sub
Adodc1.RecordSource = "select * from ck where ckdh ='" & Trim(Combo3.Text) & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
spnm = Adodc1.Recordset.Fields("spname")
Label9.Caption = "商品名称：" & spnm
Text3.Text = Adodc1.Recordset.Fields("cksl")
xgsl = Val(Adodc1.Recordset.Fields("cksl"))
ckid = Adodc1.Recordset.Fields("id")
Adodc1.RecordSource = "select spsl,id from spkc where spname ='" & spnm & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Label10.Caption = "库存量：" & Adodc1.Recordset.Fields("spsl")
ckspid = Adodc1.Recordset.Fields("id")
Else
Label10.Caption = "现无库存！"
xpcmdbutton7.Enabled = False
End If
End If

End Sub

Private Sub Form_Load()
Me.Left = Screen.Width - Me.Width
Me.Top = 400
Adodc1.ConnectionString = connstr
Adodc1.CommandType = adCmdText
Adodc2.ConnectionString = connstr
Adodc2.CommandType = adCmdText
dat = CDate(Year(Date) & "-" & Month(Date) & "- 1")
dad = Date
loadspdh
If username = "" Then loginfrm.Show
For i = 0 To 2
Frame1(i).Visible = False
Next
Frame1(ckdzt).Visible = True
If ckdzt = 0 Then Label1.Caption = "删除出库单"
If ckdzt = 1 Then Label1.Caption = "出库退库单"
If ckdzt = 2 Then Label1.Caption = "修改出库单"

Adodc1.RecordSource = "select DISTINCT spname from spkc WHERE DWS='" & gsname & "'"
Adodc1.Refresh
Combo2.Clear
Do While Not Adodc1.Recordset.EOF
Combo2.AddItem Adodc1.Recordset.Fields("spname")
Adodc1.Recordset.MoveNext
Loop

tim = 0
If username = "" Then loginfrm.Show


End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
oldx = X
oldy = Y
mov = True
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mov Then
Me.Move Me.Left + (X - oldx), Me.Top + (Y - oldy)
End If
tim = 0
If username = "" Then loginfrm.Show
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mov = False
End Sub

Public Sub loadspdh()
tim = 0
If username = "" Then loginfrm.Show
Dim slk As String
slk = Format(dat, "yyyymm")
Adodc1.RecordSource = "select ckdh from ck where left(ckdh,6)='" & slk & "' and ckxz='商品领用' and DWS='" & gsname & "'"
Adodc1.Refresh
Combo1.Clear
Combo3.Clear
Do While Not Adodc1.Recordset.EOF
Combo1.AddItem Trim(Adodc1.Recordset.Fields(0).Value)
Combo3.AddItem Trim(Adodc1.Recordset.Fields(0).Value)
Adodc1.Recordset.MoveNext
Loop
Combo1.Text = ""
Combo3.Text = ""
Label3.Caption = ""
Label10.Caption = ""
Label5.Caption = ""
If slk <> Format(Date, "yyyymm") Then
xpcmdbutton3(1).Visible = True
xpcmdbutton3(3).Visible = True
Else
xpcmdbutton3(1).Visible = False
xpcmdbutton3(3).Visible = False
End If
End Sub

Private Sub xpcmdbutton1_Click()
On Error GoTo nxt
If spnm = "" Then Exit Sub
Adodc2.RecordSource = "select * from spkc where DWS='" & gsname & "' and id=" & ckspid
Adodc2.Refresh
If Not Adodc2.Recordset.EOF Then
Adodc2.Recordset.Fields("spsl") = Adodc2.Recordset.Fields("spsl") + xzkcs
Adodc2.Recordset.Update
If rs.State Then rs.Close
rs.Open "delete  ck where DWS='" & gsname & "' and id=" & ckid, cn, 3, 3
Combo1.RemoveItem Combo1.ListIndex
If rs.State Then rs.Close
Else
MsgBox "没有找到库存记录，可能的原因是商品名称错误！", vbOKOnly + vbInformation, "错误"
Exit Sub
End If
xzkcs = 0
spnm = ""
spdh = Trim(Combo1.Text)
Call loadspdh
Label5.Caption = "删除：" & spdh & "完成"
Exit Sub
nxt:

End Sub

Private Sub xpcmdbutton2_Click()
Unload Me
End Sub

Private Sub xpcmdbutton3_Click(Index As Integer)
tim = 0
If username = "" Then loginfrm.Show
If Index = 1 Or Index = 3 Then
dat = CDate(Year(Date) & "-" & Month(Date) & "- 1")
dad = Date
Else
If Month(dat) = 1 Then
dat = CDate(Year(dat) - 1 & "-12-1")
dad = CDate(Year(dat) - 1 & "-12-31")
Else
dat = CDate(Year(dat) & "-" & Month(dat) - 1 & "-1")
dad = CDate(Year(dat) & "-" & Month(dat) & "-1") - 1
End If
End If
Call loadspdh

End Sub

Private Sub xpcmdbutton4_Click()

Unload Me
tim = 0
If username = "" Then loginfrm.Show
End Sub

Private Sub xpcmdbutton5_Click()
tim = 0
If username = "" Then loginfrm.Show
Dim sl As Double
ckdh = Format(Now, "yyyymmddhhmmss") & "-" & userid
Adodc2.RecordSource = "select * from spkc where DWS='" & gsname & "' and id=" & ckspid
Adodc2.Refresh
If Not Adodc2.Recordset.EOF Then
Adodc2.Recordset.Fields("spsl") = Adodc2.Recordset.Fields("spsl") + Val(Text1.Text)
Adodc2.Recordset.Update
Else
MsgBox "仓库中没有此商品", vbExclamation + vbOKOnly, "错误"
Exit Sub
End If
Adodc2.RecordSource = "select * from rk where DWS='" & gsname & "' and rkdh='" & ckdh & "'"
Adodc2.Refresh
With Adodc2.Recordset
.addnew
.Fields("rkdh") = ckdh
.Fields("spname") = Trim(Combo1.Text)
.Fields("rksl") = Val(Text1.Text)
.Fields("rkxz") = "商品退库"
.Fields("rkname") = username
.Fields("rkdate") = Now
.Fields("beizhu") = Trim(Text2) & " "
.Fields("dws") = gsname
.Update
End With
Text1 = ""
Text2 = ""
Adodc1.RecordSource = "select DISTINCT spname from spkc WHERE DWS='" & gsname & "'"
Adodc1.Refresh
Combo2.Clear
Do While Not Adodc1.Recordset.EOF
Combo2.AddItem Adodc1.Recordset.Fields("spname")
Adodc1.Recordset.MoveNext
Loop

End Sub

Private Sub xpcmdbutton6_Click()
Unload Me
End Sub

Private Sub xpcmdbutton7_Click()
tim = 0
If username = "" Then loginfrm.Show
If spnm = "" Then Exit Sub
xgsl = xgsl - Val(Text3.Text)
Adodc2.RecordSource = "select * from spkc  where DWS='" & gsname & "' and id=" & ckspid
Adodc2.Refresh
If Not Adodc2.Recordset.EOF Then
Adodc2.Recordset.Fields("spsl") = Adodc2.Recordset.Fields("spsl") + (xgsl)
Adodc2.Recordset.Update
Adodc1.RecordSource = "select * from ck where DWS='" & gsname & "' and id=" & ckid
Adodc1.Refresh
Adodc1.Recordset.Fields("cksl") = Val(Text3.Text)
Adodc1.Recordset.Update
Else
MsgBox "没有找到库存记录，可能的原因是商品名称错误！", vbOKOnly + vbInformation, "错误"
Exit Sub
End If
xgsl = 0
spnm = ""
spdh = Trim(Combo3.Text)
Call loadspdh
Label10.Caption = "修改：" & spdh & "完成"
Text3 = ""
Text4 = ""
Text5 = ""
End Sub

Public Function fRestoreDatabase_a(ByVal sBackUpfileName$, ByVal sDataBaseName$, Optional ByVal sDataBasePath$ = "", Optional ByVal sBackupNumber& = 1, Optional ByVal sReplaceExist As Boolean = False) As String

Dim iDb As ADODB.Connection, iRe As ADODB.Recordset
Dim iConcStr$, iSql$, iReturn$, iI&

On Error GoTo lbErr

'创建对象
Set iDb = New ADODB.Connection
Set iRe = New ADODB.Recordset

'连接数据库服务器,根据你的情况修改连接字符串
iConcStr = cnstr
iDb.Open iConcStr

'得到还原后的数据库存放目录,如果没有指定,存放到SQL SERVER的DATA目录
If sDataBasePath = "" Then
iSql = "select filename from master..sysfiles"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
iSql = iRe(0)
iRe.Close
sDataBasePath = Left(iSql, InStrRev(iSql, "\"))
End If


If sReplaceExist = False Then
iSql = "select 1 from master.sysdatabases where name='" & sDataBaseName & "'"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
If iRe.EOF = False Then
iReturn = "数据库已经存在!"
iRe.Close
GoTo lbExit
End If
iRe.Close
End If

'关闭用户进程,防止其它用户正在使用数据库,导致数据恢复失败
iSql = "select spid from master..sysprocesses where dbid=db_id('" & sDataBaseName & "')"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
While iRe.EOF = False
iSql = "kill " & iRe(0)
iDb.Execute iSql
iRe.MoveNext
Wend
iRe.Close

'获取数据库恢复信息
iSql = "restore filelistonly from disk='" & sBackUpfileName & "'" & vbCrLf & _
"with file=" & sBackupNumber
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly

'生成数据库恢复语句
iSql = "restore database [" & sDataBaseName & "]" & vbCrLf & _
"from disk='" & sBackUpfileName & "'" & vbCrLf & _
"with file=" & sBackupNumber & vbCrLf
With iRe
While Not .EOF
iReturn = iRe("PhysicalName")
iI = InStrRev(iReturn, ".")
iReturn = IIf(iI = 0, "", Mid(iReturn, iI)) & "'"
iSql = iSql & ",move '" & iRe("LogicalName") & _
"' to '" & sDataBasePath & sDataBaseName & iReturn & vbCrLf
.MoveNext
Wend
.Close
End With
iSql = iSql & IIf(sReplaceExist, ",replace", "")

iDb.Execute iSql
iReturn = ""
GoTo lbExit

lbErr:
iReturn = Error
lbExit:
fRestoreDatabase_a = iReturn
End Function