module1.bas

一个企业生产管理系统

Attribute VB_Name = "Module1"
Public fMainForm As frmMain
Public cn As ADODB.Connection ' 我们仅仅使用一个活动的连接。
Public sConnect As String
Public rs As ADODB.Recordset
Public frmheader_flag As Integer '置标志,在出或入颤单中定位FILTER条仟

Public strtable As String
Public strleft As String
Public strright As String
Public strcomplete
Public i As Integer
Public iseek As Integer
Public strcomsource As String
Public strcomdes As String
Public iflag As Integer '设置标志，如增加为1，编辑为0，删除为2
Public strwarename As String
Public sconi As String
Public tvwdb_show As Integer
'Public trvdb_key As String
'Public trvdb_text As String

Public gs_userid As String
Public gs_warehouse As String
Public gs_rights As String
Public gs_warehouse_id As String

Public w_employee1__wareid As String 'w_employee1窗体中的数据源中的imployee_id字段

'出入单全局变量
Public gs_exp_ware_id As String
Public gs_exp_warename As String
Public gs_exp_unit As Double


Public gs_imp_ware_id As String
Public gs_imp_warename As String
Public gs_imp_unit As Double


Sub Main()
    Dim fLogin As New w_login_dw
    fLogin.Show vbModal
'    If Not fLogin.OK Then
'        '登录失败，退出应用程序
'        End
'    End If
    Unload fLogin


    frmSplash.Show
    frmSplash.Refresh
'    Set fMainForm = New frmMain
'    Load fMainForm
    Unload frmSplash


'    fMainForm.Show
End Sub

Function find_item(fstr As String, ficount As Integer, fquantity As Long) As Boolean '用递归方法技算共有多少零件
Dim strtemp As String
Dim strtemp1 As String
Dim strtemp0 As String
Dim rstemp As New ADODB.Recordset
i = i + 1
Set cn = New ADODB.Connection
 cn.Open "PROVIDER=MSDASQL;driver={SQL Server};server=ht;uid=sa;pwd=;database=warehouse;"
strtemp = "temp" & CStr(i)
strtemp1 = strtemp
strtemp0 = "temp" & CStr(i - 1)
cn.Execute "if exists (select * from sysobjects where id = object_id(N'[dbo].[" & strtemp & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[" & strtemp & "]"
strtemp = "CREATE TABLE [dbo].[" & strtemp & "] (  [war_ware_id] [varchar] (50) NOT NULL ,    [ware_id] [varchar] (20) NOT NULL ,    [ware_layer_id] [varchar] (50) NOT NULL ,  [quantity] [numeric](7, 2) NOT NULL ,   [blong_to] [varchar] (10) NOT NULL ,[warename] [varchar] (25) not null) ON [PRIMARY]"

cn.Execute strtemp

strtemp = " SELECT WAR_ware_id,ware_id,ware_layer_id,quantity,blong_to,warename FROM WARE_PRODUCT where "
strtemp = strtemp & fstr
strtemp = strtemp1 & strtemp
strtemp = "insert into " & strtemp
cn.Execute strtemp
rstemp.Open "temp" & CStr(i), cn, adOpenStatic, adLockBatchOptimistic
If rstemp.RecordCount < 1 Then
ware_compose_information1.Show
Exit Function
End If
strtemp = "UPDATE " & strtemp1 & " SET " & strtemp1 & ".quantity = " & strtemp0 & ".quantity*" & strtemp1 & ".quantity from " & strtemp0 & "," & strtemp1 & " where " & strtemp0 & ".ware_layer_id = " & strtemp1 & ".war_ware_id"

cn.Execute strtemp
strtemp1 = "ware_id not like '%' "
With rstemp
.MoveFirst
Do While Not .EOF
 strtemp1 = strtemp1 & " or war_ware_id ='" & .Fields("ware_layer_id") & "'"
 .MoveNext
Loop
End With

find_item strtemp1, 0, 0
'MsgBox "", vbOKOnly, ""

End Function
Function seek_item(fstr As String, ficount As Integer, fquantity As Long) As Boolean '判断是否零件重复
Dim strtemp As String
Dim strtemp1 As String
Dim strtemp0 As String
Dim rstemp As New ADODB.Recordset
Dim ii As Integer

Set cn = New ADODB.Connection
 cn.Open "PROVIDER=MSDASQL;driver={SQL Server};server=ht;uid=sa;pwd=;database=warehouse;"
strtemp = "test" & CStr(iseek)
strtemp1 = strtemp

'strtemp0 = "test" & CStr(iseek - 1)
''cn.Execute "sp_dbcmptlevel('warehouse',70)"
cn.Execute "if exists (select * from sysobjects where id = object_id(N'[dbo].[" & strtemp & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[" & strtemp & "]"
strtemp = "CREATE TABLE [dbo].[" & strtemp & "] (  [war_ware_id] [varchar] (50) NOT NULL ,    [ware_id] [varchar] (20) NOT NULL ,    [ware_layer_id] [varchar] (50) NOT NULL ,  [quantity] [numeric](7, 2) NOT NULL ,   [blong_to] [varchar] (10) NOT NULL ) ON [PRIMARY]"
'strtemp = "CREATE TABLE [dbo].[" & strtemp & "] (  [war_ware_id] [varchar] (50)  NULL ,    [ware_id] [varchar] (20)  NULL ,    [ware_layer_id] [varchar] (50)  NULL ,  [quantity] [numeric](7, 2)  NULL ,   [blong_to] [varchar] (10)  NULL ) ON [PRIMARY]"
'strtemp = "CREATE TABLE [dbo].[" & strtemp & "] (  [war_ware_id] [varchar] (50) NOT NULL ,    [ware_id] [varchar] (20) NOT NULL ,    [ware_layer_id] [varchar] (50) NOT NULL ,  [quantity] [numeric](7, 2) NOT NULL ,   [blong_to] [varchar] (10) NOT NULL ) "

cn.Execute strtemp
strtemp = " SELECT WAR_ware_id,ware_id,ware_layer_id,quantity,blong_to FROM WARE_PRODUCT "
strtemp = strtemp & fstr
strtemp = strtemp1 & strtemp
strtemp = "insert into " & strtemp
'On Error Resume Next
cn.Execute strtemp


rstemp.Open "test" & CStr(iseek), cn, adOpenStatic, adLockBatchOptimistic
If rstemp.RecordCount = 0 Then Exit Function
Select Case rstemp.RecordCount

'cn.Execute strtemp
Case 1
strtemp1 = "where war_ware_id like '" & rstemp.Fields("ware_layer_id") & "%'"
Case Else
 strtemp1 = "where ware_id not like '%' "
With rstemp
.MoveFirst
Do While Not .EOF
 strtemp1 = strtemp1 & " or war_ware_id like'" & .Fields("ware_layer_id") & "%'"
 .MoveNext
Loop
End With
End Select


iseek = iseek + 1
seek_item strtemp1, 0, 0
MsgBox "dfdfdfdfdf", vbOKOnly, ""

End Function

Function compare_wareid(str1 As String, str2 As String) As Boolean
Dim strs As String
Dim vreturn As Variant
strs = Trim(str2)
vreturn = InStr(Trim(str1), strs)
If vreturn = 0 Or IsNull(vreturn) Or vreturn = "start" Then
compare_wareid = True
End If
End Function


Function auto_expant()

End Function