home *** CD-ROM | disk | FTP | other *** search
Attribute VB_Name = "modFileCommonDialogs" Attribute VB_HelpID = 3208 '--------------------------------------' ' Ariad Development Library ' ' Version 3.0 ' '--------------------------------------' ' File Common Dialogs ' ' Version 2.0 ' '--------------------------------------' 'Copyright ⌐ 1999 by Ariad Software. All Rights Reserved. 'Created : 21/09/1999 'Completed : 'Last Updated : Option Explicit DefInt A-Z Public Declare Function CommDlgExtendedError Lib "COMDLG32.DLL" () As Long Public Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Public Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Public 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 Enum CDFileModes cdfmOpenFile cdfmOpenFileOrPrompt cdfmSaveFile cdfmSaveFileNoConfirm End Enum Public Enum CDFileFlags OFN_ALLOWMULTISELECT = &H200 OFN_CREATEPROMPT = &H2000 OFN_ENABLEHOOK = &H20 OFN_ENABLETEMPLATE = &H40 OFN_ENABLETEMPLATEHANDLE = &H80 OFN_EXPLORER = &H80000 OFN_EXTENSIONDIFFERENT = &H400 OFN_FILEMUSTEXIST = &H1000 OFN_HIDEREADONLY = &H4 OFN_LONGNAMES = &H200000 OFN_NOCHANGEDIR = &H8 OFN_NODEREFERENCELINKS = &H100000 OFN_NOLONGNAMES = &H40000 OFN_NONETWORKBUTTON = &H20000 OFN_NOREADONLYRETURN = &H8000 OFN_NOTESTFILECREATE = &H10000 OFN_NOVALIDATE = &H100 OFN_OVERWRITEPROMPT = &H2 OFN_PATHMUSTEXIST = &H800 OFN_READONLY = &H1 OFN_SHAREAWARE = &H4000 OFN_SHAREFALLTHROUGH = 2 OFN_SHAREWARN = 0 OFN_SHARENOWARN = 1 OFN_SHOWHELP = &H10 OFS_MAXPATHNAME = 128 End Enum Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_NODEREFERENCELINKS Or OFN_HIDEREADONLY Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Public OFN As OPENFILENAME Attribute OFN.VB_VarHelpID = 3211 '------------------------------------------------------- 'Name : CreatePath 'Created : 07/02/2000 16:06 '------------------------------------------------------- 'Author : Richard Moss 'Organisation: Ariad Software '------------------------------------------------------- 'Description : Creates a new path. '------------------------------------------------------- 'Returns : Returns True on Success, otherwise False '------------------------------------------------------- 'Updates : ' '------------------------------------------------------- ' Ariad Procedure Builder Add-In 1.00.0035 Public Function CreatePath(ByVal DestPath$) As Boolean Attribute CreatePath.VB_HelpID = 3212 Dim Temp$, DP$ Dim BackPos, ForePos Dim P DP$ = DestPath$ P = Screen.MousePointer Screen.MousePointer = 11 If Right$(DP$, 1) <> "\" Then DP$ = DP$ + "\" On Error Resume Next 'Change to root directory of dest drive ChDrive DP$ If Err <> 0 Then GoTo ErrorOut ChDir "\" 'Make directory BackPos = 3 ForePos = InStr(4, DP$, "\") Do While ForePos <> 0 Temp$ = Mid$(DP$, BackPos + 1, ForePos - BackPos - 1) Err = 0 MkDir Temp$ If Err <> 0 And Err <> 75 Then GoTo ErrorOut Err = 0 ChDir Temp$ If Err <> 0 Then GoTo ErrorOut BackPos = ForePos ForePos = InStr(BackPos + 1, DP$, "\") Loop CreatePath = -1 On Error GoTo 0 Screen.MousePointer = P Exit Function ErrorOut: MsgBox "Invalid path entered." + vbCr + vbCr + DP$, vbCritical CreatePath = 0 Screen.MousePointer = P End Function '(Public) Function CreatePath () As Boolean '---------------------------------------------------------------------- 'Name : SelectFile 'Created : 21/09/1999 08:02 '---------------------------------------------------------------------- 'Author : Richard Moss 'Organisation: Ariad Software '---------------------------------------------------------------------- 'Description : Displays an API created file common dialog and returns ' the name of the selected file. '---------------------------------------------------------------------- 'Returns : Returns a String Variable '---------------------------------------------------------------------- 'Updates : ' '---------------------------------------------------------------------- ' Ariad Procedure Builder Add-In 1.00.0027 Public Function SelectFile$(ByVal hWndOwner As Long, Optional ByVal Filter$ = "All Files (*.*)|*.*", Optional ByVal DefaultExtension$ = "", Optional ByVal FileMode As CDFileModes = cdfmOpenFile, Optional ByVal DialogCaption$ = "", Optional ByVal DefaultFilename$ = "", Optional ByVal DefaultPath$ = "", Optional ByVal FilterIDX As Long = 0, Optional ByVal MoreFlags As CDFileFlags) Attribute SelectFile.VB_HelpID = 3213 Dim R As Long, SP As Long, ShortSize As Long, Z As Long 'determine defaults If InStr(DefaultFilename, "\") Then DefaultPath = GetPath$(DefaultFilename) DefaultFilename = GetFile$(DefaultFilename) End If If Len(DefaultPath$) = 0 Then DefaultPath$ = CurDir$ 'fill structure With OFN .lStructSize = Len(OFN) .hWndOwner = hWndOwner .hInstance = App.hInstance .lpStrFilter = Replace$(Filter$, "|", Chr$(0)) & Chr$(0) .nFilterIndex = FilterIDX .lpStrFile = DefaultFilename$ & String$(257 - Len(DefaultFilename$), 0) .nMaxFile = Len(.lpStrFile) - 1 .lpStrFileTitle = .lpStrFile .nMaxFileTitle = .nMaxFile .lpStrDefExt = DefaultExtension$ & Chr$(0) .lpStrInitialDir = DefaultPath$ & Chr$(0) .lpStrTitle = DialogCaption$ & Chr$(0) If FileMode = cdfmSaveFile Or FileMode = cdfmSaveFileNoConfirm Then 'Flags for save dialog .Flags = .Flags Or OFS_FILE_SAVE_FLAGS If FileMode <> cdfmSaveFileNoConfirm Then .Flags = .Flags Or OFN_OVERWRITEPROMPT R = GetSaveFileName(OFN) ElseIf FileMode = cdfmOpenFile Or FileMode = cdfmOpenFileOrPrompt Then 'Flags for open dialog .Flags = .Flags Or OFS_FILE_OPEN_FLAGS If FileMode = cdfmOpenFileOrPrompt Then .Flags = .Flags Or OFN_CREATEPROMPT R = GetOpenFileName(OFN) End If 'returnfilename If R Then SP = InStr(.lpStrFile, Chr$(0)) If SP Then .lpStrFile = Left$(.lpStrFile, SP - 1) SelectFile$ = Trim$(Replace$(.lpStrFile, Chr$(0), "")) Else Z = CommDlgExtendedError() If Z Then MsgBox "Unable to get filename(s)." & vbCr & vbCr & "CommDlgExtendedError returned " & Z, vbCritical End If End With End Function '(Public) Function SelectFile () As String '---------------------------------------------------------------------- 'Name : GetFile 'Created : 06/07/1999 12:36 'Modified : '---------------------------------------------------------------------- 'Author : Richard Moss 'Organisation: Ariad Software '---------------------------------------------------------------------- 'Description : Extracts the filename from a path '---------------------------------------------------------------------- 'Returns : Returns the extracted filename, or the original string if no path exists '---------------------------------------------------------------------- Private Function GetFile(ByVal PathAndFile$) As String Attribute GetFile.VB_HelpID = 3214 Dim R$() If Len(PathAndFile$) Then R$() = Split(PathAndFile$, "\") GetFile$ = R$(UBound(R$)) End If End Function '(Public) Function GetFile () As String '---------------------------------------------------------------------- 'Name : GetPath 'Created : 08/08/1999 09:07 'Modified : 'Modified By : '---------------------------------------------------------------------- 'Author : Richard James Moss 'Organisation: Ariad Software '---------------------------------------------------------------------- 'Description : Removes the filename from path '---------------------------------------------------------------------- 'Returns : Returns the path minus it's filename '---------------------------------------------------------------------- Private Function GetPath(ByVal Filename$) As String Attribute GetPath.VB_HelpID = 3215 Dim R$(), P$ Dim I If InStr(Filename$, "\") Then R$() = Split(Filename$, "\") For I = 0 To UBound(R$) - 1 P$ = P$ + R$(I) + "\" Next End If GetPath$ = P$ End Function '(Public) Function GetPath () As String 
