Attribute VB_Name = "base"
'****************************************************************************
'人人為我，我為人人
'枕善居收藏整理
'發布日期：2008/05/11
'描    述：天宏鋼構倉庫管理系統 Ver 2.96
'網    站：http://www.Mndsoft.com/  (VB6源碼博客)
'網    站：http://www.VbDnet.com/   (VB.NET源碼博客,主要基于.NET2005)
'e-mail  ：Mndsoft@163.com
'e-mail  ：Mndsoft@126.com
'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