dcsimg
Results 1 to 1 of 1

Thread: [VB6] Function to get a valid file name from a string

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,223

    [VB6] Function to get a valid file name from a string

    Code:
    Private Declare Function PathGetCharType Lib "shlwapi.dll" Alias "PathGetCharTypeW" (ByVal ch As Long) As Long
    
    Private Const GCT_LFNCHAR = &H1
    Private Const GCT_SHORTCHAR = &H2
    
    '*****************************************
    ' ValidFileName: returns a valid file name String
    
    ' The cases where an invalid file name can be returned are:
    ' 1) The DefaultFileName parameter is a null String ("") and ProposedFileName was completely invalid or also a null string.
    ' 2) The DefaultFileName parameter is a null String ("") and ProposedFileName was only an extension (".something").
    ' In both above cases it will return a null string (""). So if you set DefaultFileName to "" you should check that the returned value is not "". In all other cases some valid file name will be returned.
    ' Also consider that this function only returns a valid filename but it doesn't check if the name is available, because it doesn't deal with paths but just filenames, so you still need to check if the files already exists and do something to handle that.
    
    ' Parameters
    ' ProposedFileName: the String that is proposed to use as file name
    ' ReplacementChar (Optional): a character to be used as a replacement for invalid characters, the default is nothing (a null string)
    ' DefaultFileName (Optional): the file name that will be used when the is not file name
    ' ForOldFileFormat_8Dot3 (Optional): set it to True in the case that you need to support the old file format convention that was used in the D.O.S. or if for some reason you want to restrict the file name to that format
    ' AllowExtension (Optional): specifies if the string can supply not only the file name but also the file extension. The default is True.
    ' [out] HasExtension (Optional): It is a return value. It is passed ByRef, it returns if the file name included an Extension.
    '*****************************************
    Public Function ValidFileName(ByVal ProposedFileName As String, Optional ByVal ReplacementChar As String = "", Optional DefaultFileName As String = "Untitled", Optional ForOldFileFormat_8Dot3 As Boolean = False, Optional AllowExtension As Boolean = True, Optional ByRef HasExtension As Boolean) As String
        Dim iChar As String
        Dim c  As Long
        Dim iFlag As Long
        Dim iName As String
        Dim iExt As String
        Dim iDotPos As Long
        Dim iNameLen As Long
        Dim iExtLen As Long
        Dim iFileName As String
        
        If ForOldFileFormat_8Dot3 Then
            iFlag = GCT_SHORTCHAR
        Else
            iFlag = GCT_LFNCHAR
        End If
         
         ' validate the replacement char (thanks Lavolpe)
        If ReplacementChar <> "" Then
            If Not ((PathGetCharType(AscW(ReplacementChar)) And iFlag) = iFlag) Then
                Err.Raise 2069, App.Title & "ValidFileName", "ReplacementChar is not valid."
                Exit Function
            End If
        End If
       
        ProposedFileName = Trim$(ProposedFileName)
        If InStr(ProposedFileName, "/") Then ProposedFileName = Replace(ProposedFileName, "/", "-")  ' to preserve a date formatting
        If InStr(ProposedFileName, """") Then ProposedFileName = Replace(ProposedFileName, """", "'") ' convert double quotes to single quotes to preserve quotation
        
        ' strip out not allowed characters in all the file name:
        iFileName = ""
        For c = 1 To Len(ProposedFileName)
            iChar = Mid$(ProposedFileName, c, 1)
            If (PathGetCharType(AscW(iChar)) And iFlag) = iFlag Then
                iFileName = iFileName & iChar
            Else
                iFileName = iFileName & ReplacementChar
            End If
        Next c
        
        ' strip out illegal characters at the end:
        Do
            iChar = Right$(iFileName, 1)
            Select Case iChar
                Case " ", "."
                    iFileName = Left(iFileName, Len(iFileName) - 1)
                Case Else
                    Exit Do
            End Select
        Loop
        
        ' separate name and (optional) extension
        iDotPos = InStrRev(iFileName, ".")
        If iDotPos > 0 Then
            iName = Left(iFileName, iDotPos - 1)
            iExt = Mid(iFileName, iDotPos + 1)
        Else
            iName = iFileName
            iExt = ""
        End If
        
        ' strip out illegal characters at the beginning of the name
        For c = 1 To Len(iName)
            iChar = Left(iName, 1)
            Select Case iChar
                Case " ", "."
                    iName = Mid(iName, 2)
                Case Else
                    Exit For
            End Select
        Next c
        
        ' don't permit too long file names (or estensions in the case of ForOldFileFormat_8Dot3)
        iNameLen = Len(iName)
        iExtLen = Len(iExt)
        If ForOldFileFormat_8Dot3 Then
            If iNameLen > 8 Then
                iName = Left(iName, 8)
            End If
            If iExtLen > 3 Then
                iExt = Left(iExt, 3)
            End If
        Else
            If iExtLen > 0 Then
                If iNameLen > 258 Then
                    iName = Left(iName, 258)
                    iNameLen = 258
                End If
            End If
            If (iNameLen + iExtLen + 1) > 260 Then
                iExt = Left(iExt, 260 - iNameLen - 1)
            End If
        End If
        
        ' don't permit forbidden file names
        Select Case UCase(iName)
            Case "CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"
                If ReplacementChar <> "" Then
                    iName = iName & ReplacementChar
                Else
                    iName = iName & "_"
                End If
        End Select
        If iName = "" Then
            'if there is not a valid file name, then use the default
            iName = DefaultFileName
        End If
        
        ' compose file name again
        ValidFileName = iName
        If iDotPos > 0 Then
            If AllowExtension Then
                If ValidFileName <> "" Then
                    ValidFileName = ValidFileName & "." & iExt
                    HasExtension = True
                End If
            End If
        End If
    
    End Function
    Thanks to Lavolpe and AAraya.
    Last edited by Eduardo-; Jul 31st, 2018 at 06:36 PM.
    vbExtra: Print preview for VB6, print FlexGrids and more.
    MSDN online for VB6, Language reference.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width