VB_纯API 打开保存对话框源码
发布时间:2020-12-17 07:48:40 所属栏目:百科 来源:网络整理
导读:'VB_纯API打开保存对话框源码'MyBloghttp://www.arvinhk.com'By:ArvinQQ:348619517OptionExplicitPublicTypeOPENFILENAMElStructSizeAsLonghwndOwnerAsLonghInstanceAsLonglpstrFilterAsStringlpstrCustomFilterAsStringnMaxCustFilterAsLongnFilterIndexAsL
'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 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |