Occasional Save As Dialog crash ? (GetSaveFileNameW)

Hello people,

I got this code to a Unicode aware Save As Dialog. It all works fine, but occasionally it would result the APP to crash if I SAVE on the 2nd or 3rd time etc.. I can't figure out what's wrong... Any ideas/suggestions?

Code:

---

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameW" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
  lStructSize          As Long    'Length of structure, in bytes
  hWndOwner            As Long    'Window that owns the dialog, or NULL
  hInstance            As Long    'Handle of mem object containing template (not used)
  lpstrFilter          As Long    'File types/descriptions, delimited with vbnullchar, ends with 2xvbnullchar
  lpstrCustomFilter    As Long    'Filters typed in by user
  nMaxCustFilter      As Long    'Length of CustomFilter, min 40x chars
  nFilterIndex        As Long    'Filter Index to use (1,2,etc) or 0 for custom
  lpstrFile            As Long    'Initial file/returned file(s), delimited with vbnullchar for multi files
  nMaxFile            As Long    'Size of Initial File long  , min 256
  lpstrFileTitle      As Long    'File.ext excluding path
  nMaxFileTitle        As Long    'Length of FileTitle
  lpstrInitialDir      As Long    'Initial file dir, null for current dir
  lpstrTitle          As Long    'Title bar of dialog
  flags                As Long    'See OFN_Flags
  nFileOffset          As Integer  'Offset to file name in full path, 0-based
  nFileExtension      As Integer  'Offset to file ext in full path, 0-based (excl '.')
  lpstrDefExt          As Long    'Default ext appended, excl '.', max 3 chars
  lCustData            As Long    'Appl defined data for lpfnHook
  lpfnHook            As Long    'Pointer to hook procedure
  lpTemplateName      As Long    'Template Name (not used)
  pvReserved          As Long    'new Win2000 / WinXP members
  dwReserved          As Long    'new Win2000 / WinXP members
  FlagsEx              As Long    'new Win2000 / WinXP members
End Type

'//------------------
Public Function cDlgShowSave(ByVal InitialDir As String, _
                            ByVal DialogTitle As String, ByVal frmHwnd As Long, _
                            Optional Filter As String = "Text File(*.txt)|*.txt", _
                            Optional FileTitle As String = vbNullString, _
                            Optional ByRef rtnFilter As Long = 1) As String
On Error GoTo ErrFound

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim FileFilter As String
Dim strFile As String


    strFile = String$(512, 0)
    If Not FileTitle = vbNullString Then
      strFile = FileTitle & strFile
    End If

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hWndOwner = frmHwnd
OpenFile.hInstance = App.hInstance

          FileFilter = Replace$(Filter, "|", vbNullChar)
          If AscW(Right$(FileFilter, 1)) <> 0& Then FileFilter = FileFilter & vbNullChar
         
OpenFile.lpstrFilter = StrPtr(FileFilter)
OpenFile.nFilterIndex = 1

OpenFile.lpstrFile = StrPtr(strFile)
OpenFile.nMaxFile = Len(strFile) - 1

OpenFile.lpstrFileTitle = StrPtr(OpenFile.lpstrFile)
OpenFile.nMaxFileTitle = StrPtr(OpenFile.nMaxFile)
OpenFile.lpstrInitialDir = StrPtr(InitialDir)
OpenFile.lpstrTitle = StrPtr(DialogTitle)
OpenFile.flags = 0
lReturn = GetSaveFileName(OpenFile)

If lReturn = 0 Then
'Cancel Button Pressed
Else
    cDlgShowSave = Left$(strFile, InStr(strFile, vbNullChar) - 1)
    rtnFilter = OpenFile.nFilterIndex
End If

Exit Function
ErrFound:
MsgBox Err.Description, vbCritical, "File Save"

cDlgShowSave = ""
End Function

---

I don't understand what you try to do with strFile.
First you reserve space for 512 characters, then you append the filetitle.

Quote:

---

Originally Posted by some1uk03

I can't figure out what's wrong...

---

I think the problem is here:

Code:

---

OpenFile.lpstrFileTitle = StrPtr(OpenFile.lpstrFile)    'lpstrFile is coerced to a temporary string. By the time GetSaveFileName is called, the temporary string is probably gone.
OpenFile.nMaxFileTitle = StrPtr(OpenFile.nMaxFile)      'A pointer to a temporary string is assigned to nMaxFileTitle instead of the size of the buffer pointed to by lpstrFileTitle.

---

Try this instead:

Code:

---

Option Explicit

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

Private Declare Function GetSaveFileNameW Lib "comdlg32.dll" (ByVal lpofn As Long) As Long
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long

'FileName          [In,Out] On entry, specifies the filename to save. On return, contains the user's selected file if successful, empty string otherwise.
'FileTitle        [  Out] Optionally returns the filename without the path if successful, empty string otherwise.
'FilterIndex      [In,Out] Optional. On entry, specifies the initially selected filter. On return, contains the user's selected filter if successful, zero otherwise.
'Filter            [In    ] Optionally specifies the file types filter.
'DefaultExt        [In    ] Optionally specifies the default file extension appended to the filename should the user fail to provide one.
'hWnd              [In    ] Optionally specifies the owner window of the dialog box.
'InitialDir        [In    ] Optionally specifies the initial directory. See MSDN for further details.
'DialogTitle      [In    ] Optionally specifies the title of the dialog box. The default is "Save As" (for English locales).
'NoOverWritePrompt [In    ] Optionally specifies whether to stop prompting the user when they select an existing file. The default is to warn overwriting.
'
'ShowSave returns True if the user has selected a filename; False if the user cancelled or a dialog box error occurred.

Public Function ShowSave(ByRef FileName As String, Optional ByRef FileTitle As String, _
                                                  Optional ByRef FilterIndex As Long, _
                                                  Optional ByRef Filter As String = "Text Files (*.txt)|*.txt", _
                                                  Optional ByRef DefaultExt As String = "txt", _
                                                  Optional ByVal hWnd As Long, _
                                                  Optional ByRef InitialDir As String, _
                                                  Optional ByRef DialogTitle As String, _
                                                  Optional ByVal NoOverWritePrompt As Boolean) As Boolean
    Dim OFN As OPENFILENAME
    Const MAX_PATH = 260&, OFN_PATHMUSTEXIST = &H800&, OFN_EXTENSIONDIFFERENT = &H400&, OFN_NOCHANGEDIR = &H8&, OFN_OVERWRITEPROMPT = &H2&

    With OFN
        .lStructSize = LenB(OFN)
        .hWndOwner = hWnd
        .lpstrFilter = Replace(Filter, "|", vbNullChar) & vbNullChar
        .nFilterIndex = FilterIndex
        .lpstrFileTitle = String$(MAX_PATH - 1&, 0)
        .nMaxFileTitle = MAX_PATH
        .lpstrFile = .lpstrFileTitle
        .nMaxFile = MAX_PATH
        If 0& < Len(FileName) And Len(FileName) < MAX_PATH Then Mid$(.lpstrFile, 1&) = FileName
        .lpstrInitialDir = InitialDir
        .lpstrTitle = DialogTitle
        .Flags = OFN_PATHMUSTEXIST Or OFN_EXTENSIONDIFFERENT Or OFN_NOCHANGEDIR Or OFN_OVERWRITEPROMPT And Not NoOverWritePrompt
        .lpstrDefExt = DefaultExt

        ShowSave = GetSaveFileNameW(VarPtr(OFN))

        If ShowSave Then
            FileName = Left$(.lpstrFile, lstrlenW(StrPtr(.lpstrFile)))
            FileTitle = Left$(.lpstrFileTitle, lstrlenW(StrPtr(.lpstrFileTitle)))
            FilterIndex = .nFilterIndex
        Else
            FileName = vbNullString
            FileTitle = vbNullString
            FilterIndex = 0&
        End If
    End With
End Function

---

Code:

---

Option Explicit    'In a blank Form

Private Sub Form_Click()
    Const FILTERS = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
    Dim FN$, FT$, FI&

    FN = Name
    FI = 2&

    Caption = "ShowSave = " & ShowSave(FN, FT, FI, FILTERS, , hWnd, CurDir$, App.Title)
    Print FI, FT, FN
End Sub

---

BTW, VB6's error handling mechanism can't catch errors thrown by APIs so there's no use trying to (it can, however, retrieve their last error via Err.LastDllError). VB6 also can't catch illegal memory accesses due to invalid pointers, so again, On Error * is ineffective here. API errors are best handled by checking the return value of API functions and/or Err.LastDllError.