module1.bas

档案管理系统源码VB档案管理系统源码VB

Attribute VB_Name = "Module1"
  Option Explicit
  
  Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom 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 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 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 SW_RESTORE As Long = 9&
Public Const GW_CHILD As Long = 5&
Public Const GW_HWNDNEXT As Long = 2&
Public Declare Function GetDesktopWindow& Lib "user32" ()
Public Declare Function GetWindow& Lib "user32" (ByVal hwnd&, ByVal wCmd&)
Public Declare Function GetWindowText& Lib "user32" Alias "GetWindowTextA" _
                                    (ByVal hwnd&, ByVal lpString$, ByVal cch&)
Public Declare Function ShowWindow& Lib "user32" (ByVal hwnd&, ByVal nCmdShow&)
Public Declare Function GetWindowRect& Lib "user32" (ByVal hwnd&, lpRect As RECT)
Public Declare Function MoveWindow& Lib "user32" (ByVal hwnd&, ByVal X&, _
                          ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&)
Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hwnd&)
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
                                         (ByVal lpClassName$, ByVal lpWindowName$)
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 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

Global ConData As String
Global Browser As String
Global UserText As String, PurView As String
Global strSearchString As String
Global strFileType As String, strFileID As String
Global CompanyName As String
Global ConStr As String, IT As Boolean
Global TempArray(5) As String
Global ScanFileName As String

Public Sub GetStatus(StatusString As String)

    frmMain.StatusBar.Panels.Item(2).Text = StatusString
    
End Sub

Public Sub checkPath(strCorrect As String)

Dim FS As String, Fn As Long
 If strCorrect = "" Then
    FS = GetSetting(App.EXEName, "Data", "Path")
   Else
    FS = strCorrect
 End If
    Fn = FreeFile
On Error GoTo Exist_Err
Open FS For Input As #Fn
Close #Fn
  ConData = FS
  SaveSetting App.EXEName, "Data", "Path", ConData
Exit Sub

Exist_Err:

  MsgBox vbCrLf & "网 络 路 径 错 误 , 现 在 启 用 本 地 数 据 库 。        " + vbCrLf + vbCrLf + "如 果 需 要 , 请 重 新 定 义 网 络 数 据 库 的 路 径  ！    ", vbOKOnly + vbExclamation, "网络路径错误"
    
  ConData = App.Path + "\Data\File.Mdb"
  SaveSetting App.EXEName, "Data", "Path", ConData
   
End Sub


Private Sub Main()

  Const sBaseCaption As String = "登录窗口"
  Const sBaseCaption1 As String = "FileManager"
  
  If App.PrevInstance = True Then
      
      Dim hAppWindow&, sTemp$
      hAppWindow = GetWindow(GetDesktopWindow(), GW_CHILD)
      
      Do
        sTemp = String$(180, False)
        Call GetWindowText(hAppWindow, sTemp, 179)
  
        If InStr(sTemp, sBaseCaption) Then
           ActivatePrevInstance (hAppWindow) '使以前的窗口活动
          Exit Do
        End If
        
        If InStr(sTemp, sBaseCaption1) Then
           ActivatePrevInstance (hAppWindow) '使以前的窗口活动
          Exit Do
        End If
  
        ' 获得下一个子窗体
        hAppWindow = GetWindow(hAppWindow, GW_HWNDNEXT)
      Loop
  Else
    ConStr = ";UID=;PWD=filemanager"

    '第一次运行时
    frmLogin.Show
  End If

End Sub

Private Sub ActivatePrevInstance(ByVal hAppWindow&)

  Call ShowWindow(hAppWindow, SW_RESTORE)

  '使窗口活动
  Call SetForegroundWindow(hAppWindow)
  
  
End Sub