档案管理系统源码VB.zip Module1.bas

www.pudn.com > 档案管理系统源码VB.zip > Module1.bas
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