精英俱乐部文章1.docx
《精英俱乐部文章1.docx》由会员分享，可在线阅读，更多相关《精英俱乐部文章1.docx（13页珍藏版）》请在冰点文库上搜索。
精英俱乐部文章1
如何连接有密码的后端数据库例子
今年发现这个网站的人气没有去年旺了,希望斑竹们能多写点好东东让大家学习一下.我的第一个数据库完成,这个网站给了我很多帮助,所以很想这个网站能越来越好.
我从别的网站发现一个好东东,希望能帮到大家.
刷新表链接 '
' '
' '
' '
' 这个程序适用于后台数据库与前台数据库在固定的相对位置。
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
OptionExplicit '要求变量在使用以前明确声明
OptionCompareDatabase '字符串比较使用数据库次序
'=======================================================================
'设定部分：
PrivateConstCheckTableName="基本表"
'"基本表"表是我的实例数据库中的表，你应该改成你自己后台数据库的链接表名。
PrivateConstTablePassword="sssssssss"
'"sssssssss"是我的后台数据库打开的密码，你应该改成你自己后台数据库的打开密码。
PrivateConstconAppTitle="信访管理"
PrivateConstconBackAppTitle="DATA.DB"
'"前台数据库——信访管理"是本数据库的名称，不用加“.MDB”
'"后台数据库——DATA.DB"是链接的后台数据库的名称，必须写其扩展名，我将MDB改成DB，防止别人直接用Access打开
PrivateConstconBackAppRelPath=""
'conBackAppRelPath是默认得后台数据库的相对路径
'如果后台数据库与前台数据库在同一目录，可以设conBackAppRelPath=""
'
'=======================================================================
'
'引用部分在“启动”窗体的Form_Open事件代码中
'
'=======================================================================
'以下不用改
'=======================================================================
DeclareFunctionGetOpenFileNameLib"comdlg32.dll"Alias_
"GetOpenFileNameA"（pOpenfilenameAsOPENFILENAME）AsBoolean
DeclareFunctionGetSaveFileNameLib"comdlg32.dll"Alias_
"GetSaveFileNameA"（pOpenfilenameAsOPENFILENAME）AsBoolean
TypeMSA_OPENFILENAME
'用于打开文件对话框过滤器的过滤字符串。
'使用MSA_CreateFilterString（）来创建它。
'默认（Default）=所有文件,*.*
strFilterAsString
'用于显示的初始过滤器。
'默认（Default）=1
lngFilterIndexAsLong
'对话框所作用的初始目录。
'默认（Default）=当前工作目录。
strInitialDirAsString
'初始文件名。
'默认（Default）=""
strInitialFileAsString
strDialogTitleAsString
'默认的文件扩展名，如果用户没有指定一个的话，将使用它。
'默认（Default）=系统值（打开文件，保存文件）。
strDefaultExtensionAsString
'所使用的标志（参看“常量”（Const）列表）
'默认（Default）=无标志。
lngFlagsAsLong
'所选取文件的完整路径。
在打开文件（OpenFile）时，如果用户点取了
'一个不存在的文件，将只返回"FileName"（文件名）框中的文本。
strFullPathReturnedAsString
'所选取文件的文件名。
strFileNameReturnedAsString
'文件名（strFileNameReturned）开始位置在完整路径中的偏移。
intFileOffsetAsInteger
'文件扩展名开始位置在完整路径（strFullPathReturned）中的偏移。
intFileExtensionAsInteger
EndType
ConstALLFILES="所有文件"
TypeOPENFILENAME
lStructSizeAsLong
hwndOwnerAsLong
hInstanceAsLong
lpstrFilterAsString
lpstrCustomFilterAsLong
nMaxCustrFilterAsLong
nFilterIndexAsLong
lpstrFileAsString
nMaxFileAsLong
lpstrFileTitleAsString
nMaxFileTitleAsLong
lpstrInitialDirAsString
lpstrTitleAsString
FlagsAsLong
nFileOffsetAsInteger
nFileExtensionAsInteger
lpstrDefExtAsString
lCustrDataAsLong
lpfnHookAsLong
lpTemplateNameAsLong
EndType
ConstOFN_ALLOWMULTISELECT=&H200
ConstOFN_CREATEPROMPT=&H2000
ConstOFN_EXPLORER=&H80000
ConstOFN_FILEMUSTEXIST=&H1000
ConstOFN_HIDEREADONLY=&H4
ConstOFN_NOCHANGEDIR=&H8
ConstOFN_NODEREFERENCELINKS=&H100000
ConstOFN_NONETWORKBUTTON=&H20000
ConstOFN_NOREADONLYRETURN=&H8000
ConstOFN_NOVALIDATE=&H100
ConstOFN_OVERWRITEPROMPT=&H2
ConstOFN_PATHMUSTEXIST=&H800
ConstOFN_READONLY=&H1
ConstOFN_SHOWHELP=&H10
FunctionFindFile（strSearchPath,strTitle,strFilterFilename,strFilterExtname）AsString
'显示打开文件对话框让用户定位
'特定的文件。
返回文件的完整路径。
DimmsaofAsMSA_OPENFILENAME
'给对话框设置选项。
msaof.strDialogTitle=strTitle
msaof.strInitialDir=strSearchPath
msaof.strFilter=MSA_CreateFilterString（strFilterFilename,strFilterExtname）
'调用打开文件对话框例程。
MSA_GetOpenFileNamemsaof
'返回路径和文件名。
FindFile=Trim（msaof.strFullPathReturned）
EndFunction
FunctionMSA_CreateFilterString（ParamArrayvarFilt（）AsVariant）AsString
'从所传递的实参中创建一个过滤器字符串。
'如果没有传递进任何实参，将返回""。
'期望传进偶数个实参（过滤字符串、扩展名），但
'如果传进奇数个，将附加*.*。
DimstrFilterAsString
DimintRetAsInteger
DimintNumAsInteger
intNum=UBound（varFilt）
If（intNum<>-1）Then
ForintRet=0TointNum
strFilter=strFilter&varFilt（intRet）&vbNullChar
Next
IfintNumMod2=0Then
strFilter=strFilter&"*.*"&vbNullChar
EndIf
strFilter=strFilter&vbNullChar
Else
strFilter=""
EndIf
MSA_CreateFilterString=strFilter
EndFunction
FunctionMSA_ConvertFilterString（strFilterInAsString）AsString
'从一个竖条分隔的字符串创建一个过滤字符串。
'该字符串应具有（过滤名称|扩展名）对，例如，"Access数据库|*.mdb|所有文件|*.*"
'如果最后一个过滤对没有扩展名，将加上*.*。
'这里代码将忽略任何空字符串，例如，"||"对。
'如果传进的字符串是空的，就返回""。
DimstrFilterAsString
DimintNumAsInteger,intPosAsInteger,intLastPosAsInteger
strFilter=""
intNum=0
intPos=1
intLastPos=1
'一旦我们找到竖条，就加入字符串。
'忽略任何空字符串（不允许空字符串）。
Do
intPos=InStr（intLastPos,strFilterIn,"|"）
If（intPos>intLastPos）Then
strFilter=strFilter&Mid（strFilterIn,intLastPos,intPos-intLastPos）&vbNullChar
intNum=intNum+1
intLastPos=intPos+1
ElseIf（intPos=intLastPos）Then
intLastPos=intPos+1
EndIf
LoopUntil（intPos=0）
'获取最后一个子串（假定串strFilterIn不以竖条|结尾）。
intPos=Len（strFilterIn）
If（intPos>=intLastPos）Then
strFilter=strFilter&Mid（strFilterIn,intLastPos,intPos-intLastPos+1）&vbNullChar
intNum=intNum+1
EndIf
'如果最后一个子串没有扩展名，那么添加*.*。
IfintNumMod2=1Then
strFilter=strFilter&"*.*"&vbNullChar
EndIf
'如果存在任何过滤字符串，添加空结尾字符vbNullChar。
IfstrFilter<>""Then
strFilter=strFilter&vbNullChar
EndIf
MSA_ConvertFilterString=strFilter
EndFunction
PrivateFunctionMSA_GetSaveFileName（msaofAsMSA_OPENFILENAME）AsInteger
'打开保存文件对话框。
DimofAsOPENFILENAME
DimintRetAsInteger
MSAOF_to_OFmsaof,of
of.Flags=of.FlagsOrOFN_HIDEREADONLY
intRet=GetSaveFileName（of）
IfintRetThen
OF_to_MSAOFof,msaof
EndIf
MSA_GetSaveFileName=intRet
EndFunction
FunctionMSA_SimpleGetSaveFileName（）AsString
'用默认值打开保存文件对话框。
DimmsaofAsMSA_OPENFILENAME
DimintRetAsInteger
DimstrRetAsString
intRet=MSA_GetSaveFileName（msaof）
IfintRetThen
strRet=msaof.strFullPathReturned
EndIf
MSA_SimpleGetSaveFileName=strRet
EndFunction
PrivateFunctionMSA_GetOpenFileName（msaofAsMSA_OPENFILENAME）AsInteger
'打开打开文件对话框。
DimofAsOPENFILENAME
DimintRetAsInteger
MSAOF_to_OFmsaof,of
intRet=GetOpenFileName（of）
IfintRetThen
OF_to_MSAOFof,msaof
EndIf
MSA_GetOpenFileName=intRet
EndFunction
FunctionMSA_SimpleGetOpenFileName（）AsString
'用默认值打开打开文件对话框。
DimmsaofAsMSA_OPENFILENAME
DimintRetAsInteger
DimstrRetAsString
intRet=MSA_GetOpenFileName（msaof）
IfintRetThen
strRet=msaof.strFullPathReturned
EndIf
MSA_SimpleGetOpenFileName=strRet
EndFunction
PrivateSubOF_to_MSAOF（ofAsOPENFILENAME,msaofAsMSA_OPENFILENAME）
'这一个子过程将win32结构转换到友好的MSAccess结构。
msaof.strFullPathReturned=Left（of.lpstrFile,InStr（of.lpstrFile,vbNullChar）-1）
msaof.strFileNameReturned=of.lpstrFileTitle
msaof.intFileOffset=of.nFileOffset
msaof.intFileExtension=of.nFileExtension
EndSub
PrivateSubMSAOF_to_OF（msaofAsMSA_OPENFILENAME,ofAsOPENFILENAME）
'这一个子过程将友好的MSAccess结构转换到win32结构。
DimstrFileAsString*512
'初始化该结构的某些部分。
of.hwndOwner=Application.hWndAccessApp
of.hInstance=0
of.lpstrCustomFilter=0
of.nMaxCustrFilter=0
of.lpfnHook=0
of.lpTemplateName=0
of.lCustrData=0
Ifmsaof.strFilter=""Then
of.lpstrFilter=MSA_CreateFilterString（ALLFILES）
Else
of.lpstrFilter=msaof.strFilter
EndIf
of.nFilterIndex=msaof.lngFilterIndex
of.lpstrFile=msaof.strInitialFile_
&String（512-Len（msaof.strInitialFile）,0）
of.nMaxFile=511
of.lpstrFileTitle=String（512,0）
of.nMaxFileTitle=511
of.lpstrTitle=msaof.strDialogTitle
of.lpstrInitialDir=msaof.strInitialDir
of.lpstrDefExt=msaof.strDefaultExtension
of.Flags=msaof.lngFlags
of.lStructSize=Len（of）
EndSub
PublicFunctionCheckLinks（）AsBoolean
'检查到后台数据库的链接；如果链接存在且正确的话，返回True。
DimdbsAsDatabase,rstAsRecordset
Setdbs=CurrentDb
'打开链接表查看表链接信息是否正确。
OnErrorResumeNext
Setrst=dbs.OpenRecordset（CheckTableName）
rst.Close
'如果没有错误，返回True。
IfErr=0Then
CheckLinks=True
Else
CheckLinks=False
EndIf
EndFunction
PrivateFunctionRefreshLinks（strFileNameAsString）AsBoolean
'刷新到提供表的数据库的链接。
如果成功的话返回True。
DimdbsAsDatabase
DimtdfAsTableDef
'循环处理此数据库的所有表。
Setdbs=CurrentDb
ForEachtdfIndbs.TableDefs
'如果表有一个连接串，那么该表是一个链接表。
IfLen（tdf.Connect）>0Then
tdf.Connect=";DATABASE="&strFileName&";PWD="+TablePassword
Err=0
OnErrorResumeNext
tdf.RefreshLink '重新链接该表。
IfErr<>0Then
RefreshLinks=False
ExitFunction
EndIf
EndIf
升级会员 