main.bas

引用枕善居的天宏钢构仓库管理系统 Ver 2.96

Attribute VB_Name = "base"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/05/11
'描    述：天宏钢构仓库管理系统 Ver 2.96
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
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.MoveLast
    
    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.MoveLast
    If pos > 1 Then ado.Recordset.Move pos - 1

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

Public Function ShowHelpWnd(Index As Long)
      On Error Resume Next

    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)
      On Error Resume Next

    If Re.RecordCount <= 0 Then Exit Function
    
    Re.MoveFirst
    While Re.EOF = False
        Re.Delete
        Re.MoveFirst
    Wend
    
End Function


Sub main()
  On Error Resume Next
    '检测是否已运行
    If App.PrevInstance Then
        MsgBox App.title + " 已运行!"
        End
    End If

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

adoCon.Open (DataConnectString)
    '启动起始屏
   frmSplash.Show

   
    
End Sub