论坛: 编程破解 标题: VB调用打开和保存对话框 复制本贴地址    
作者: hongliubo1 [hongliubo1]    论坛用户   登录



Private Sub Form_Load()

End Sub

Private Sub mnuFileExitApp_Click()

    On Error GoTo mnuFileExitApp_Click_Error
   
    Unload Me
    End
   
mnuFileExitApp_Click_Exit:
    Exit Sub
   
mnuFileExitApp_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileExitApp_Click"
    Resume mnuFileExitApp_Click_Exit
   
End Sub


Private Sub mnuFileOpenDialog_Click()

    On Error GoTo mnuFileOpenDialog_Click_Error
    Dim file As OPENFILENAME, sFile As String, sFileTitle As String, lResult As Long, iDelim As Integer
   
    file.lStructSize = Len(file)
    file.hwndOwner = Me.hWnd
    file.flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
    'wildcard to display, returns with selected path\file
    file.lpstrFile = "*.exe" & String$(250, 0)
    file.nMaxFile = 255
    'returns with just file name
    file.lpstrFileTitle = String$(255, 0)
    file.nMaxFileTitle = 255
    'set the initial directory, otherwise uses current
    file.lpstrInitialDir = Environ$("WinDir")
    'file type filter
    file.lpstrFilter = "Programs" & Chr$(0) & "*.EXE;*.COM;*.BAT" & Chr$(0) & "MS Word Documents" & Chr$(0) & "*.DOC" & Chr$(0) & Chr$(0)
    file.nFilterIndex = 1
    'dialog title
    file.lpstrTitle = "Open"

    lResult = GetOpenFileName(file)
    If lResult <> 0 Then
        iDelim = InStr(file.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            sFileTitle = Left$(file.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(file.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            sFile = Left$(file.lpstrFile, iDelim - 1)
        End If
        'file.nFileOffset is the number of characters from the beginning of the
        '  full path to the start of the file name
        'file.nFileExtension is the number of characters from the beginning of the
        '  full path to the file's extention, including the (.)
        MsgBox "File Name is " & sFileTitle & Chr$(13) & Chr$(10) & "Full path and file is " & sFile, , "Open"
    End If

mnuFileOpenDialog_Click_Exit:
    Exit Sub
   
mnuFileOpenDialog_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileOpenDialog_Click"
    Resume mnuFileOpenDialog_Click_Exit
   
End Sub


Private Sub mnuFileSaveAsDialog_Click()

    On Error GoTo mnuFileSaveAsDialog_Click_Error
        Dim file As OPENFILENAME, sFile As String, sFileTitle As String, lResult As Long, iDelim As Integer
   
    file.lStructSize = Len(file)
    file.hwndOwner = Me.hWnd
    file.flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT
    'If you have a starting file name, put it here, padded with Chr$(0) to make
    'a buffer large enough for return
    file.lpstrFile = String$(255, 0)
    file.nMaxFile = 255
    'returns with just file name
    file.lpstrFileTitle = String$(255, 0)
    file.nMaxFileTitle = 255
    'set the initial directory, otherwise uses current
    file.lpstrInitialDir = Environ$("WinDir")
    'file type filter
    file.lpstrFilter = "Text Files" & Chr$(0) & "*.TXT" & Chr$(0) & Chr$(0)
    file.nFilterIndex = 1
    'dialog title
    file.lpstrTitle = "Save As…"
    'you can provide a default extension; appended if user types none
    file.lpstrDefExt = "TXT"
   
    lResult = GetSaveFileName(file)
    If lResult <> 0 Then
        'file.nFileOffset is the number of characters from the beginning of the
        '  full path to the start of the file name
        'file.nFileExtension is the number of characters from the beginning of the
        '  full path to the file's extention, including the (.)
        iDelim = InStr(file.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            sFileTitle = Left$(file.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(file.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            sFile = Left$(file.lpstrFile, iDelim - 1)
        End If
        MsgBox "File Name is " & sFileTitle & Chr$(13) & Chr$(10) & "Full path and file is " & sFile, , "Save As…"
    End If

mnuFileSaveAsDialog_Click_Exit:
    Exit Sub
   
mnuFileSaveAsDialog_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileSaveAsDialog_Click"
    Resume mnuFileSaveAsDialog_Click_Exit
   
End Sub




Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000                        '  new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000                      '  force long names for 3.x modules

Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

地主 发表时间: 05-01-14 21:30

论坛: 编程破解

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon

粤ICP备05087286号