'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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。