公用对话框.bas

新魔剑压缩机。采用新的压缩算法对文件压缩。

Attribute VB_Name = "公用对话框"
Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long '打开
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long  '保存
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidl As Long, pszPath As String) As Long
Private Type BROWSEINFO
        hOwner   As Long
        pidlRoot   As Long
        pszDisplayName   As String
        lpszTitle   As String
        ulFlage   As Long
        lpfn   As Long
        lparam   As Long
        iImage   As Long
End Type

Private 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

Public Function ShowOpen(File As String) As String  '打开
    Dim Ofn As OPENFILENAME
    Dim t As Long
    With Ofn
      .lStructSize = Len(Ofn)
      .lpstrFile = Space$(254)
      .nMaxFile = 255
      .lpstrFilter = File
      .lpstrTitle = "打开文件"
    End With
    t = GetOpenFileName(Ofn)
    If t Then
      Ofn.lpstrFile = Trim(Replace(Ofn.lpstrFile, Chr$(0), ""))
      ShowOpen = Ofn.lpstrFile
    End If
End Function

Public Function ShowSave(File As String) As String '保存
    Dim Ofn As OPENFILENAME
    Dim Last As String
    Dim t As Long
    With Ofn
      .lStructSize = Len(Ofn)
      .lpstrFile = Space$(254)
      .nMaxFile = 255
      .lpstrFilter = File
      .lpstrTitle = "保存文件"
    End With
    t = GetSaveFileName(Ofn)
    If t Then
      Ofn.lpstrFile = Trim(Replace(Ofn.lpstrFile, Chr$(0), ""))
      Last = Mid$(Split(File, Chr$(0))(2 * Ofn.nFilterIndex - 1), 2)
      ShowSave = IIf(UCase(Right$(Ofn.lpstrFile, 4)) = Last, Ofn.lpstrFile, Ofn.lpstrFile & Last)
    End If
End Function

Public Function ShowDir(MehWnd As Long, Optional Title As String) As String
Dim BI As BROWSEINFO
Dim TempID As Long
Dim TempStr As String
        
TempStr = String$(255, Chr$(0))
With BI
  .hOwner = MehWnd
  .pidlRoot = 0
  .lpszTitle = Title + Chr$(0)
  .ulFlage = &H1
End With
        
TempID = SHBrowseForFolder(BI)
        
If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then ShowDir = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
End Function