VB开发的ERP系统

VERSION 5.00
Begin VB.Form frm_new_bbmbfromfile 
   AutoRedraw      =   -1  'True
   Caption         =   "文件存为模板"
   ClientHeight    =   2070
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4200
   Icon            =   "新建模板from文件.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2070
   ScaleWidth      =   4200
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Height          =   1515
      Left            =   60
      TabIndex        =   2
      Top             =   90
      Width           =   4065
      Begin VB.TextBox Text3 
         Enabled         =   0   'False
         Height          =   300
         Left            =   1080
         TabIndex        =   5
         Top             =   270
         Width           =   2865
      End
      Begin VB.TextBox Text1 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   "99999"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
         Height          =   300
         Left            =   1080
         MaxLength       =   5
         TabIndex        =   4
         Top             =   690
         Width           =   2865
      End
      Begin VB.TextBox Text2 
         Height          =   300
         Left            =   1080
         MaxLength       =   20
         TabIndex        =   3
         Top             =   1095
         Width           =   2865
      End
      Begin VB.Label Label2 
         Caption         =   "报表编号:"
         Height          =   225
         Left            =   120
         TabIndex        =   8
         Top             =   750
         Width           =   825
      End
      Begin VB.Label Label3 
         Caption         =   "报表名称:"
         Height          =   225
         Left            =   120
         TabIndex        =   7
         Top             =   1140
         Width           =   825
      End
      Begin VB.Label Label1 
         Caption         =   "系统编号:"
         Height          =   210
         Left            =   120
         TabIndex        =   6
         Top             =   315
         Width           =   825
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   1800
      TabIndex        =   1
      Top             =   1695
      Width           =   1120
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   3000
      TabIndex        =   0
      Top             =   1695
      Width           =   1120
   End
End
Attribute VB_Name = "frm_new_bbmbfromfile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'*    模 块 名 称 :新建模板(From文件)
'*    功 能 描 述 :
'*    程序员姓名  :奚俊峰
'*    最后修改人  :奚俊峰
'*    最后修改时间:2002/01/21
'***********************************************

Option Explicit

Private Sub Command1_Click() '检查并保存
    Dim lrst_select As New ADODB.Recordset
    Dim ls_select As String
    If Len(Trim(ls_xtbm)) = 0 Then
        MsgBox "请输入系统编码!", vbOKOnly, "百利/ERP5.0-电子报表"
        ls_xtbm.SetFocus
        Exit Sub
    End If
    If Len(Trim(Text1.Text)) = 0 Then
        MsgBox "请输入报表模板号!", vbOKOnly, "百利/ERP5.0-电子报表"
        Text1.SetFocus
        Exit Sub
    End If
    If Len(Trim(Text2.Text)) = 0 Then
        MsgBox "请输入报表模板名称!", vbOKOnly, "百利/ERP5.0-电子报表"
        Text2.SetFocus
        Exit Sub
    End If
    If Not IsNumeric(Text1) Then
        MsgBox "请输入报表模板号!" & vbCrLf & "模板号必须为数字!", vbOKOnly, "百利/ERP5.0-电子报表"
        Text1.SetFocus
        Exit Sub
    End If
    Text1.Text = Right("000000" & Text1, 5)
    ls_select = "select report_model_id from dzbb_bbmb where system_code='" & Left(ls_xtbm, 2) _
    & "' and report_model_id='" & Text1.Text & "'"
    lrst_select.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
    If lrst_select.RecordCount > 0 Then
        lrst_select.Close
        Set lrst_select = Nothing
        MsgBox "您输入的报表模板号已存在!", vbOKOnly, "百利/ERP5.0-电子报表"
        Text1.SetFocus
        Exit Sub
    End If
    lrst_select.Close
    ls_select = "select report_model_id from dzbb_bbmb where system_code='" & Left(ls_xtbm, 2) _
    & "' and report_model_name='" & Trim(Text2.Text) & "'"
    lrst_select.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
    If lrst_select.RecordCount > 0 Then
        lrst_select.Close
        Set lrst_select = Nothing
        MsgBox "您输入的报表模板名称已存在!", vbOKOnly, "百利/ERP5.0-电子报表"
        Text2.SetFocus
        Exit Sub
    End If
    lrst_select.Close
    '******************************************************************
    '将文件保存为模板
    Dim ls_path As String
    Dim ls_filename As String
    Dim ll_filenumber As Long
    Dim laby_cell() As Byte
    Dim ll_filelen
    Dim i As Integer
    ls_path = App.Path
    If Right(ls_path, 1) <> "\" Then
        ls_path = ls_path & "\"
    End If
    ls_filename = ls_path + "\dzbb_temp.cll"
    If Dir(ls_filename) <> "" Then
        Kill ls_filename
    End If
    If MDI_frame.ActiveForm.Cell1.DoSaveFile(ls_filename) <= 0 Then
        MsgBox "保存到临时文件失败，报表模板保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
        Exit Sub
    End If
    ll_filenumber = FreeFile()
    Open ls_filename For Binary As #ll_filenumber
    ll_filelen = LOF(ll_filenumber)
    ReDim laby_cell(ll_filelen)
    Get #ll_filenumber, 1, laby_cell
    Close #ll_filenumber
    '设置权限
    frm_user_right.Show vbModal, MDI_frame
    
    '保存模板
    ls_select = "select * from dzbb_bbmb where system_code='" & Left(ls_xtbm, 2) & "'"
    lrst_select.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, 8
    With lrst_select
        .AddNew
        .Fields("system_code") = Left(ls_xtbm, 2)
        .Fields("report_model_id") = Text1.Text
        .Fields("report_model_name") = Text2.Text
        .Fields("user_id") = Xtczybm
        .Fields("report_model_nr").AppendChunk laby_cell
        .Fields("canmakdate") = frm_user_right.Combo1.Text
        .Update
    End With
    lrst_select.Close
    ls_select = "select * from dzbb_right"
    lrst_select.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, 8
    With lrst_select
        For i = 0 To frm_user_right.vs1.Rows - 1
            If frm_user_right.vs1.TextMatrix(i, 2) = "√" Or frm_user_right.vs1.TextMatrix(i, 3) = "√" Then
                .AddNew
                .Fields("system_code") = Left(ls_xtbm, 2)
                .Fields("report_model_id") = Text1.Text
                .Fields("user_id") = Xtczybm
                .Fields("bbuser_id") = Trim(frm_user_right.vs1.TextMatrix(i, 0))
                If frm_user_right.vs1.TextMatrix(i, 2) = "√" Then
                    .Fields("editflag") = 1
                Else
                    .Fields("editflag") = 0
                End If
                .Update
            End If
        Next i
    End With
    If Dir(ls_filename) <> "" Then Kill ls_filename
    Unload frm_user_right
    MsgBox "报表模板保存成功!!!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
    Unload Me
    
    
End Sub

Private Sub command2_Click()
    MDI_frame.mb_new_report_model = False
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case vbKeyReturn
        SendKeys "{tab}"
    Case 39           '屏蔽"'"
        KeyAscii = 0
    End Select
End Sub

Private Sub Form_Load() '初始化
    Dim lrst_xtbm As ADODB.Recordset
    Dim ls_select As String
    Set lrst_xtbm = New ADODB.Recordset
    Dim k As Long
    ls_select = "select system_code,report_model_id  from dzbb_bbmb order by system_code , report_model_id"
    lrst_xtbm.Open ls_select, Cw_DataEnvi.dataconnect, adOpenStatic, adLockReadOnly, adCmdText
    
    If lrst_xtbm.RecordCount = 0 Then
        Text1.Text = "00001"
    Else
        k = 1
        With lrst_xtbm
            Do While Not .EOF
                If k <> Val(.Fields("report_model_id")) Then
                    Text1.Text = Right("00000" & Trim(Str(k)), 5)
                    Exit Do
                End If
                k = k + 1
                Text1.Text = Right("00000" & Trim(Str(k)), 5)
                .MoveNext
            Loop
        End With
        lrst_xtbm.Close
    End If
    Set lrst_xtbm = Nothing
    Text3.Text = ls_xtbm
End Sub