modmain.bas

星级酒店管理系统（附带系统自写控件源码）

Attribute VB_Name = "modMain"
Public Type SHFILEOPSTRUCT
   hwnd As Long
   wFunc As Long
   pFrom As String
   pTo As String
   fFlags As Integer
   fAnyOperationsAborted As Long
   hNameMappings As Long
   lpszProgressTitle As Long
End Type

Public Type BROWSEINFO
    
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long

End Type

Public Const DI_MASK& = 1
Public Const DI_IMAGE& = 2
Public Const DI_NORMAL& = 3
Public Const DI_DEFAULTSIZE& = 8
Public Const DI_COMPAT& = 4
Public Const FILE_ATTRIBUTE_ARCHIVE& = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED& = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY& = &H10
Public Const FILE_ATTRIBUTE_HIDDEN& = &H2
Public Const FILE_ATTRIBUTE_NORMAL& = &H80
Public Const FILE_ATTRIBUTE_READONLY& = &H1
Public Const FILE_ATTRIBUTE_SYSTEM& = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY& = &H100
Public Const MAX_PATH& = 260
Public Const SHGFI_LARGEICON& = &H0
Public Const SHGFI_SMALLICON& = &H1
Public Const SHGFI_OPENICON& = &H2
Public Const SHGFI_SHELLICONSIZE& = &H4
Public Const SHGFI_PIDL& = &H8
Public Const SHGFI_USEFILEATTRIBUTES& = &H10
Public Const SHGFI_DISPLAYNAME& = &H200
Public Const SHGFI_ICON& = &H100
Public Const SHGFI_TYPENAME& = &H400
Public Const SHGFI_ATTRIBUTES& = &H800
Public Const SHGFI_ICONLOCATION& = &H1000
Public Const SHGFI_EXETYPE& = &H2000
Public Const SHGFI_SYSICONINDEX& = &H4000
Public Const SHGFI_LINKOVERLAY& = &H8000&
Public Const SHGFI_SELECTED& = &H10000
Public Const NOERROR& = 0
Public Const CSIDL_DESKTOP = &H0
Public Const CSIDL_PROGRAMS = &H2
Public Const CSIDL_CONTROLS = &H3
Public Const CSIDL_PRINTERS = &H4
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_STARTUP = &H7
Public Const CSIDL_RECENT = &H8
Public Const CSIDL_SENDTO = &H9
Public Const CSIDL_BITBUCKET = &HA
Public Const CSIDL_STARTMENU = &HB
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const CSIDL_DRIVES = &H11
Public Const CSIDL_NETWORK = &H12
Public Const CSIDL_NETHOOD = &H13
Public Const CSIDL_FONTS = &H14
Public Const CSIDL_TEMPLATES = &H15
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const m_wCurOptIdx = 0

Public Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Type SHITEMID
    cb As Long
    abID() As Byte
End Type

Type ITEMIDLIST
    mkid As SHITEMID
End Type
Public Declare Function DrawIcon& Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long)
Public Declare Function DrawIconEx& Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long)
Public Declare Function SHGetFileInfo& Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long)
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pIdl As ITEMIDLIST) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Declare Function SHFileOperation Lib "shell32.dll" Alias _
   "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long


Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
Public Const FO_COPY& = &H2
Public Const FOF_SIMPLEPROGRESS& = &H100

Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2

Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2

Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long

Public bCancel As Long

Public Function CopyProgressRoutine(ByVal TotalFileSize As Currency, ByVal TotalBytesTransferred As Currency, ByVal StreamSize As Currency, ByVal StreamBytesTransferred As Currency, ByVal dwStreamNumber As Long, ByVal dwCallbackReason As Long, ByVal hSourceFile As Long, ByVal hDestinationFile As Long, ByVal lpData As Long) As Long
   
   '返回状态,通过移动Lbstatus来显示进度
    DataBackup.lbStatus.Left = CLng((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100) * picStatus.Width
    DoEvents
   '继续拷贝
    CopyProgressRoutine = PROGRESS_CONTINUE
    
End Function

'返回目中的文件名,路径删除
Public Function GetFileName(sSource As String) As String

  If Len(sSource) < 4 Then
     GetFileName = ""
     Exit Function
  End If
  
  Dim X As Integer, N As Integer
  Dim sTmp As String
  
  N = Len(sSource)
  For X = N To 1 Step -1
      sTmp = Mid(sSource, X, 1)
      If sTmp = "\" Then
         GetFileName = Mid(sSource, X)
         Exit For
      End If
  Next
    
End Function