'VB_纯API打开保存对话框源码
'MyBloghttp://www.arvinhk.com
'By:ArvinQQ:348619517
OptionExplicit
PublicTypeOPENFILENAME
lStructSizeAsLong
hwndOwnerAsLong
hInstanceAsLong
lpstrFilterAsString
lpstrCustomFilterAsString
nMaxCustFilterAsLong
nFilterIndexAsLong
lpstrFileAsString
nMaxFileAsLong
lpstrFileTitleAsString
nMaxFileTitleAsLong
lpstrInitialDirAsString
lpstrTitleAsString
flagsAsLong
nFileOffsetAsInteger
nFileExtensionAsInteger
lpstrDefExtAsString
lCustDataAsLong
lpfnHookAsLong
lpTemplateNameAsString
EndType
PublicTypeBrowseInfo
hwndOwnerAsLong
pIDLRootAsLong
pszDisplayNameAsLong
lpszTitleAsLong
ulFlagsAsLong
lpfnCallbackAsLong
lParamAsLong
iImageAsLong
EndType
PublicConstOFN_READONLYAsLong=&H1
PublicConstOFN_OVERWRITEPROMPTAsLong=&H2
PublicConstOFN_HIDEREADONLYAsLong=&H4
PublicConstOFN_NOCHANGEDIRAsLong=&H8
PublicConstOFN_SHOWHELPAsLong=&H10
PublicConstOFN_ENABLEHOOKAsLong=&H20
PublicConstOFN_ENABLETEMPLATEAsLong=&H40
PublicConstOFN_ENABLETEMPLATEHANDLEAsLong=&H80
PublicConstOFN_NOVALIDATEAsLong=&H100
PublicConstOFN_ALLOWMULTISELECTAsLong=&H200
PublicConstOFN_EXTENSIONDIFFERENTAsLong=&H400
PublicConstOFN_PATHMUSTEXISTAsLong=&H800
PublicConstOFN_FILEMUSTEXISTAsLong=&H1000
PublicConstOFN_CREATEPROMPTAsLong=&H2000
PublicConstOFN_SHAREAWAREAsLong=&H4000
PublicConstOFN_NOREADONLYRETURNAsLong=&H8000
PublicConstOFN_NOTESTFILECREATEAsLong=&H10000
PublicConstOFN_NONETWORKBUTTONAsLong=&H20000
PublicConstOFN_NOLONGNAMESAsLong=&H40000
PublicConstOFN_EXPLORERAsLong=&H80000
PublicConstOFN_NODEREFERENCELINKSAsLong=&H100000
PublicConstOFN_LONGNAMESAsLong=&H200000
PublicConstOFN_SHAREFALLTHROUGHAsLong=2
PublicConstOFN_SHARENOWARNAsLong=1
PublicConstOFN_SHAREWARNAsLong=0
PublicConstBrowseForFoldersAsLong=&H1
PublicConstBrowseForComputersAsLong=&H1000
PublicConstBrowseForPrintersAsLong=&H2000
PublicConstBrowseForEverythingAsLong=&H4000
PublicConstCSIDL_BITBUCKETAsLong=10
PublicConstCSIDL_CONTROLSAsLong=3
PublicConstCSIDL_DESKTOPAsLong=0
PublicConstCSIDL_DRIVESAsLong=17
PublicConstCSIDL_FONTSAsLong=20
PublicConstCSIDL_NETHOODAsLong=18
PublicConstCSIDL_NETWORKAsLong=19
PublicConstCSIDL_PERSONALAsLong=5
PublicConstCSIDL_PRINTERSAsLong=4
PublicConstCSIDL_PROGRAMSAsLong=2
PublicConstCSIDL_RECENTAsLong=8
PublicConstCSIDL_SENDTOAsLong=9
PublicConstCSIDL_STARTMENUAsLong=11
PublicConstMAX_PATHAsLong=260
PublicDeclareFunctionGetOpenFileNameLib"comdlg32.dll"Alias"GetOpenFileNameA"(pOpenfilenameAsOPENFILENAME)AsLong
PublicDeclareFunctionGetSaveFileNameLib"comdlg32.dll"Alias"GetSaveFileNameA"(pOpenfilenameAsOPENFILENAME)AsLong
PublicDeclareSubCoTaskMemFreeLib"ole32.dll"(ByValhMemAsLong)
PublicDeclareFunctionlstrcatLib"kernel32"Alias"lstrcatA"(ByVallpString1AsString,ByVallpString2AsString)AsLong
PublicDeclareFunctionSHBrowseForFolderLib"shell32"(lpBIAsBrowseInfo)AsLong
PublicDeclareFunctionSHGetPathFromIDListLib"shell32"(ByValpidListAsLong,ByVallpBufferAsString)AsLong
PublicDeclareFunctionSHGetSpecialFolderLocationLib"shell32"(ByValhwndOwnerAsLong,ByValnFolderAsLong,ListIdAsLong)AsLong
PublicDeclareFunctionGetWindowsDirectoryLib"kernel32"Alias"GetWindowsDirectoryA"(ByVallpBufferAsString,ByValnSizeAsLong)AsLong
PublicDeclareFunctionGetSystemDirectoryLib"kernel32"Alias"GetSystemDirectoryA"(ByVallpBufferAsString,ByValnSizeAsLong)AsLong
PublicDeclareFunctionGetTempPathLib"kernel32"Alias"GetTempPathA"(ByValnBufferLengthAsLong,ByVallpBufferAsString)AsLong
PublicDeclareFunctionGetTempFileNameLib"kernel32"Alias"GetTempFileNameA"(ByVallpszPathAsString,ByVallpPrefixStringAsString,ByValwUniqueAsLong,ByVallpTempFileNameAsString)AsLong
PublicDeclareFunctionGetModuleHandleLib"kernel32"Alias"GetModuleHandleA"(ByVallpModuleNameAsString)AsLong
PublicDeclareFunctionGetModuleFileNameLib"kernel32"Alias"GetModuleFileNameA"(ByValhModuleAsLong,ByVallpFileNameAsString,ByValnSizeAsLong)AsLong
PublicDeclareFunctionGetShortPathNameLib"kernel32"Alias"GetShortPathNameA"(ByVallpszLongPathAsString,ByVallpszShortPathAsString,ByValcchBufferAsLong)AsLong
PublicDeclareFunctionGetTickCountLib"kernel32"()AsLong
PublicFunctionFileDialog(FormObjectAsForm,SaveDialogAsBoolean,ByValTitleAsString,ByValFilterAsString,OptionalByValFileNameAsString,OptionalByValExtentionAsString,OptionalByValInitDirAsString)AsString
DimOFNAsOPENFILENAME
DimrAsLong
IfLen(FileName)>MAX_PATHThenCallMsgBox("FilenameLengthOverflow",vbExclamation,App.Title+"-FileDialogFunction"):ExitFunction
FileName=FileName+String(MAX_PATH-Len(FileName),0)
WithOFN
.lStructSize=Len(OFN)
.hwndOwner=0
.hInstance=App.hInstance
.lpstrFilter=Replace(Filter,"|",vbNullChar)
.lpstrFile=FileName
.nMaxFile=MAX_PATH
.lpstrFileTitle=Space$(MAX_PATH-1)
.nMaxFileTitle=MAX_PATH
.lpstrInitialDir=InitDir
.lpstrTitle=Title
.flags=OFN_HIDEREADONLYOrOFN_OVERWRITEPROMPTOrOFN_CREATEPROMPT
.lpstrDefExt=Extention
EndWith
DimLAsLong
L=GetTickCount
IfSaveDialogThenr=GetSaveFileName(OFN)Elser=GetOpenFileName(OFN)
IfGetTickCount-L<20Then
OFN.lpstrFile=""
IfSaveDialogThenr=GetSaveFileName(OFN)Elser=GetOpenFileName(OFN)
EndIf
Ifr=1ThenFileDialog=Left$(OFN.lpstrFile,InStr(1,OFN.lpstrFile+vbNullChar,vbNullChar)-1)
EndFunction
PublicFunctionBrowseFolders(FormObjectAsForm,sMessageAsString)AsString
DimBAsBrowseInfo
DimrAsLong
DimLAsLong
DimfAsString
FormObject.Enabled=False
WithB
.hwndOwner=FormObject.hWnd
.lpszTitle=lstrcat(sMessage,"")
.ulFlags=BrowseForFolders
EndWith
SHGetSpecialFolderLocationFormObject.hWnd,CSIDL_DRIVES,B.pIDLRoot
r=SHBrowseForFolder(B)
Ifr<>0Then
f=String(MAX_PATH,vbNullChar)
SHGetPathFromIDListr,f
CoTaskMemFreer
L=InStr(1,f,vbNullChar)-1
IfL<0ThenL=0
f=Left(f,L)
AddSlashf
EndIf
BrowseFolders=f
FormObject.Enabled=True
EndFunction
PublicPropertyGetWindowsDirectory()AsString
StaticrAsString
IfLen(r)=0Then
DimLAsLong
L=MAX_PATH
r=String(L,0)
L=GetWindowsDirectory(r,L)
IfL>0Then
r=Left$(r,L)
AddSlashr
Else
r=""
EndIf
EndIf
WindowsDirectory=r
EndProperty
PublicPropertyGetWindowsTempDirectory()AsString
Staticm_WindowsTempDirectoryAsString
IfLen(m_WindowsTempDirectory)=0Then
DimBufferAsString
DimLengthAsLong
Buffer=String(MAX_PATH,0)
Length=GetTempPath(MAX_PATH,Buffer)
IfLength>0Then
m_WindowsTempDirectory=Left$(Buffer,Length)
AddSlashm_WindowsTempDirectory
EndIf
EndIf
WindowsTempDirectory=m_WindowsTempDirectory
EndProperty
PublicPropertyGetWindowsSystemDirectory()AsString
Staticm_WindowsSystemDirectoryAsString
IfLen(m_WindowsSystemDirectory)=0Then
DimBufferAsString
DimLengthAsLong
Buffer=String(MAX_PATH,0)
Length=GetSystemDirectory(Buffer,MAX_PATH)
IfLength>0Then
m_WindowsSystemDirectory=Left$(Buffer,Length)
AddSlashm_WindowsSystemDirectory
EndIf
EndIf
WindowsSystemDirectory=m_WindowsSystemDirectory
EndProperty
PublicPropertyGetAppPath()AsString
Staticm_AppPathAsString'ReturnsProgramEXEFileName
IfLen(m_AppPath)=0Then
DimretAsLong
DimLengthAsLong
DimFilePathAsString
DimFileHandleAsLong
FilePath=String(MAX_PATH,0)
FileHandle=GetModuleHandle(App.EXEName)
ret=GetModuleFileName(FileHandle,FilePath,MAX_PATH)
Length=InStr(1,vbNullChar)-1
IfLength>0Thenm_AppPath=Left$(FilePath,Length)
EndIf
AppPath=m_AppPath
EndProperty
PublicPropertyGetDefaultSettingsFile()AsString
Staticm_DefaultSettingsFileAsString
IfLen(m_DefaultSettingsFile)=0Thenm_DefaultSettingsFile=FileTitleOnly(AppPath,True)&"Settings.Dat"
DefaultSettingsFile=m_DefaultSettingsFile
EndProperty
PublicPropertyGetDefaultLegendFile()AsString
Staticm_DefaultLegendFileAsString
IfLen(m_DefaultLegendFile)=0Thenm_DefaultLegendFile=FileTitleOnly(AppPath,True)&"Legends.Txt"
DefaultLegendFile=m_DefaultLegendFile
EndProperty
PublicFunctionFileExists(FileNameAsString)AsBoolean
IfLen(FileName)>0ThenFileExists=(Len(Dir(FileName,vbNormalOrvbReadOnlyOrvbHiddenOrvbSystemOrvbArchive))>0)
EndFunction
PublicFunctionDirectoryExists(ByValDirectoryAsString)AsBoolean
AddSlashDirectory
DirectoryExists=Len(Directory)>0AndLen(Dir(Directory+"*.*",vbDirectory))>0
EndFunction
PublicFunctionFileTitleOnly(FileNameAsString,OptionalReturnDirectoryAsBoolean)AsString
IfReturnDirectoryThen
FileTitleOnly=Left$(FileName,InStrRev(FileName,"\"))
Else
FileTitleOnly=Right$(FileName,Len(FileName)-InStrRev(FileName,"\"))
EndIf
EndFunction
PublicSubAddSlash(DirectoryAsString)
IfInStrRev(Directory,"\")<>Len(Directory)ThenDirectory=Directory+"\"
EndSub
PublicSubRemoveSlash(DirectoryAsString)
IfLen(Directory)>3AndInStrRev(Directory,"\")=Len(Directory)ThenDirectory=Left$(Directory,Len(Directory)-1)
EndSub
PublicSubRidFile(FileNameAsString)
IfFileExists(FileName)Then
SetAttrFileName,vbNormal
KillFileName
EndIf
EndSub
PublicFunctionGetShortName(ByValFileNameAsString)AsString
DimBufferAsString
DimLengthAsLong
Buffer=String(MAX_PATH,0)
Length=GetShortPathName(FileName,Buffer,MAX_PATH)
IfLength>0ThenGetShortName=Left$(Buffer,Length)
EndFunction
PublicFunctionCreateTempFile(OptionalByValPrefixAsString,OptionalDirectoryAsString)AsString
DimBufferAsString
DimLengthAsLong
Buffer=String(MAX_PATH,0)
IfLen(Prefix)=0ThenPrefix=Left$(App.Title+"TMP",3)
IfNotDirectoryExists(Directory)ThenDirectory=WindowsTempDirectory
IfGetTempFileName(Directory,Prefix,0&,Buffer)=0ThenExitFunction
Length=InStr(1,vbNullChar)-1
IfLength>0ThenCreateTempFile=Left$(Buffer,Length)
EndFunction
PublicFunctionCreatePath(ByValPathAsString)AsBoolean
OnErrorGoToFail
DimiAsInteger
DimsAsString
AddSlashPath
Do
i=InStr(i+1,Path,"\")
Ifi=0ThenExitDo
s=Left$(Path,i-1)
IfNotDirectoryExists(s)ThenMkDirs
LoopUntili=Len(Path)
IfDirectoryExists(Path)Then
CreatePath=True
ExitFunction
EndIf
Fail:
CallMsgBox(IIf(Err.Number=0,"","Error"+CStr(Err.Number)+":"+Err.Description+vbCrLf)+"CouldNotCreate/AccessDirectory:"+vbCrLf+vbCrLf+Chr$(34)+Path+Chr$(34),App.Title+"-CreatePathFunction")
EndFunction

文章出自:http://www.arvinhk.com/?id=48