main.bas

一个完整的仓库管理系统

Attribute VB_Name = "base"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function BackupData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long
Public Declare Function ResumeData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long
Public Declare Function GetBit Lib "storage.dll" (ByVal bit As Long, ByVal index As Integer) As Integer
Public Declare Function GetBits Lib "storage.dll" (ByVal bit As String, ByVal l As Integer) As Long
Public Declare Function ShowHelp Lib "storage.dll" (ByVal hwnd As Long, ByVal chmname As String, ByVal htmlname As String) As Long
Public Declare Function AddWndMsg Lib "storage.dll" (ByVal hwnd As Long, ByVal msg As Long, ByVal procaddress As Long) As Long

Public Declare Function ClearPrintData Lib "FxPrint.dll" () As Integer
Public Declare Function SetPrintDataWidth Lib "FxPrint.dll" (ByVal width As Integer) As Integer
Public Declare Function AddPrintData Lib "FxPrint.dll" (ByVal data As String) As Integer
Public Declare Function ShowPrint Lib "FxPrint.dll" (ByVal title As String) As Integer
Public Declare Function SaveToFile Lib "FxPrint.dll" () As Integer

Public fMainForm As frmMain '主窗口句柄
Public DataPath As String '数据库路径
Public DataConnectString As String '数据库连接源字符串
Public UserName As String '用户名
Public UserPas As String '用户密码
Public Purview As Long  '操作权限
Public 权限类别(16) As Integer '17种权限类别


Public Function ShowPrintDlg(ByVal ado As Adodc, ByVal title As String)
    
    '清除以前的打印数据
    ClearPrintData
    
    Dim count As Integer
    On Error GoTo quit:
    count = ado.Recordset.Fields.count
    
    If count <= 0 Then
        MsgBox "没有需打印的数据", vbInformation
        Exit Function
    End If
    
    
    '设置打印列宽度
    SetPrintDataWidth count
    
    '保存当前位置的状态pos
    Dim pos As Long
    pos = ado.Recordset.AbsolutePosition
    
    '移到记录最前面
    ado.Recordset.MoveFirst
    
    Dim i As Integer
    
    '写入眉头
    For i = 0 To count - 1

        AddPrintData ado.Recordset.Fields(i).name
          
    Next
    
    '写入数据
    While ado.Recordset.EOF = False
        
        For i = 0 To count - 1
            
            If ado.Recordset.Fields(i).ActualSize > 0 Then
                AddPrintData ado.Recordset.Fields(i).Value
            Else
                AddPrintData ""
            End If
        Next
        
        ado.Recordset.MoveNext
        
    Wend
    
    '恢复以前的记录
    ado.Recordset.MoveFirst
    If pos > 1 Then ado.Recordset.Move pos - 1

    ShowPrint title
    
    Exit Function
quit:
    MsgBox "没有打印数据或打印数据未初始化!", vbInformation
    
End Function

Public Function ShowHelpWnd(index As Long)
    
    If index = 0 Then
        ShowHelp fMainForm.hwnd, App.HelpFile, ""
    Else
        Dim htmlname As String
        htmlname = "仓库管理系统.htm/#"
        
        Dim v As String
        v = LTrim(Str(index))
        
        Dim i As Integer
        For i = 1 To Len(v)
            htmlname = htmlname + Mid(v, i, 1)
            If i <> Len(v) Then htmlname = htmlname + "_"
        Next
    
        ShowHelp fMainForm.hwnd, App.HelpFile, htmlname
    End If
    
End Function

'屏蔽flash右键弹出菜单
Public Function FlashNoRButton(ByVal hwnd As Long, ByVal msg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long
        
        FlashNoRButton = 1
    
End Function

'删除记录中的所有数据
Public Function DeleteRecordData(Re As Recordset)
    
    If Re.RecordCount <= 0 Then Exit Function
    
    Re.MoveFirst
    While Re.EOF = False
        Re.Delete
        Re.MoveFirst
    Wend
    
End Function


Sub Main()
    
    '检测是否已运行
    If App.PrevInstance Then
        MsgBox App.title + " 已运行!"
        End
    End If

    '初始化数据库文件路径
    DataPath = App.Path + "\storage.mdb"
    DataConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password=prowind"
    
    '启动起始屏
    frmSplash.Show vbModal

    '启动登陆对话框
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    
    If Not fLogin.OK Then
       '登录失败，退出应用程序
        End
    End If
    Unload fLogin

    '启动主窗口
    Set fMainForm = New frmMain
    fMainForm.Show
    
End Sub



'此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
'╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
'╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
',︶︶︶︶,''︶~~ ,''~︶︶　 ,''
'╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
'╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
'╬　　　　　　　http://www.5ivb.net ╬
'╬　 ╭○╮●　                   　╬
'╬　　/■\/■\　　                  ╬
'╬　　 <|　||　   有希望,就有成功！ ╬
'╬　　　　　　　　　　　　　　　　　╬
'╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
'
'说明：
'专业提供VB、．NET、Delphi、ASP、PB源码下载
'包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档