PublicuserdwnameAsString
PublicusernameAsString
PublicuserrightAsString
PublicconnAsString
PrivateSubCommand1_Click()
DimpasswordAsString
DimrespondAsString
username=Text1.Text
password=Text2.Text
GoToerr1
Adodc1.ConnectionString=conn
Adodc1.RecordSource="select*fromusertabwhere用户名="&"'"&username&"'"&"and"&"密码="&"'"&password&"'"
Adodc1.Refresh
IfAdodc1.Recordset.AbsolutePosition=adPosUnknownThen
respond=MsgBox("用户名或密码错误,请重新输入!",vbOKOnly,"警告")
Ifrespond<>vbOKOnlyThen
Text1.SetFocus
Text1.Text=""
Text2.Text=""
username=""
password=""
EndIf
Else
userright=Adodc1.Recordset.Fields("权限")
Unloadfrmlogin
frmmain.Show
EndIf
ExitSub
err1:
MsgBox"系统配置错误!无法与服务器连接!"
userright="0"
UnloadMe
frmsysset.Show
EndSub
PrivateSubCommand2_Click()
End
EndSub
PrivateSubForm_Load()
Text1.Text=""
Text2.Text=""
'conn=Frmstart.pconn
conn="Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&App.Path&"\his.mdb;PersistSecurityInfo=False"
EndSub
2.用户修改密码界面设计:
代码设计:
PrivateSubCommand1_Click()
GoToerr1
username=frmlogin.username
IfText1.Text<>""AndText2.Text<>""Then
Adodc1.RecordSource="select*fromusertabwhere用户名='"&username&"'and密码="&"'"&Text1.Text&"'"
Adodc1.Refresh
IfAdodc1.Recordset.AbsolutePosition=adPosUnknownThen
MsgBox"旧密码错误!"
Text1.Text=""
Text2.Text=""
Text1.SetFocus
Else
Adodc1.Recordset.Fields("密码")=Text2.Text
Adodc1.Recordset.Update
MsgBox"密码修改成功!"
Text1.Text=""
Text2.Text=""
EndIf
Else
MsgBox"新旧密码均不得为空!"
Text1.SetFocus
EndIf
ExitSub
err1:
MsgBox"远程服务器连接失败!"
EndSub
PrivateSubCommand2_Click()
Text1.Text=""
Text2.Text=""
Text1.SetFocus
EndSub
PrivateSubCommand3_Click()
UnloadMe
EndSub
PrivateSubForm_Load()
GoToerr2
chpwd.Top=(frmmain.Height-chpwd.Height)/2-500
chpwd.Left=(frmmain.Width-chpwd.Width)/2
Adodc1.ConnectionString=frmlogin.conn
Text1.Text=""
Text2.Text=""
ExitSub
err2:
MsgBox"远程服务器连接失败!"
EndSub
PrivateSubForm_Unload(CancelAsInteger)
frmmain.StatusBar1.Panels(2)="目前没有窗口被激活"
EndSub
PrivateSubForm_Activate()
frmmain.StatusBar1.Panels(2)="活动窗口:"&chpwd.Caption
EndSub
3,关于界面设计:
代码设计:
PrivateSubcmdOK_Click()
UnloadMe
EndSub
PrivateSubForm_Load()
frmAbout.Top=(frmmain.Height-frmAbout.Height)/2-500
frmAbout.Left=(frmmain.Width-frmAbout.Width)/2
Me.Caption="关于"&App.Title
lblTitle.Caption=App.Title
EndSub
PublicSubStartSysInfo()
GoToSysInfoErr
DimrcAsLong
DimSysInfoPathAsString
'试图从注册表中获得系统信息程序的路径及名称...
IfGetKeyValue(HKEY_LOCAL_MACHINE,gREGKEYSYSINFO,gREGVALSYSINFO,SysInfoPath)Then
'试图仅从注册表中获得系统信息程序的路径...
ElseIfGetKeyValue(HKEY_LOCAL_MACHINE,gREGKEYSYSINFOLOC,gREGVALSYSINFOLOC,SysInfoPath)Then
'已知32位文件版本的有效位置
If(Dir(SysInfoPath&"\MSINFO32.EXE")<>"")Then
SysInfoPath=SysInfoPath&"\MSINFO32.EXE"
'错误-文件不能被找到...
Else
GoToSysInfoErr
EndIf
'错误-注册表相应条目不能被找到...
Else
GoToSysInfoErr
EndIf
CallShell(SysInfoPath,vbNormalFocus)
ExitSub
SysInfoErr:
MsgBox"此时系统信息不可用",vbOKOnly
EndSub
PublicFunctionGetKeyValue(KeyRootAsLong,KeyNameAsString,SubKeyRefAsString,ByRefKeyValAsString)AsBoolean
DimiAsLong'循环计数器
DimrcAsLong'返回代码
DimhKeyAsLong'打开的注册表关键字句柄
DimhDepthAsLong'
DimKeyValTypeAsLong'注册表关键字数据类型
DimtmpValAsString'注册表关键字值的临时存储器
DimKeyValSizeAsLong'注册表关键自变量的尺寸
'------------------------------------------------------------
'打开{HKEY_LOCAL_MACHINE...}下的RegKey
'------------------------------------------------------------
rc=RegOpenKeyEx(KeyRoot,KeyName,0,KEY_ALL_ACCESS,hKey)'打开注册表关键字
If(rc<>ERROR_SUCCESS)ThenGoToGetKeyError'处理错误...
tmpVal=String$(1024,0)'分配变量空间
KeyValSize=1024'标记变量尺寸
'------------------------------------------------------------
'检索注册表关键字的值...
'------------------------------------------------------------
rc=RegQueryValueEx(hKey,SubKeyRef,0,_
KeyValType,tmpVal,KeyValSize)'获得/创建关键字值
If(rc<>ERROR_SUCCESS)ThenGoToGetKeyError'处理错误
If(Asc(Mid(tmpVal,KeyValSize,1))=0)Then'Win95外接程序空终结字符串...
tmpVal=Left(tmpVal,KeyValSize-1)'Null被找到,从字符串中分离出来
Else'WinNT没有空终结字符串...
tmpVal=Left(tmpVal,KeyValSize)'Null没有被找到,分离字符串
EndIf
'------------------------------------------------------------
'决定转换的关键字的值类型...
'------------------------------------------------------------
SelectCaseKeyValType'搜索数据类型...
CaseREG_SZ'字符串注册关键字数据类型
KeyVal=tmpVal'复制字符串的值
CaseREG_DWORD'四字节的注册表关键字数据类型
Fori=Len(tmpVal)To1Step-1'将每位进行转换
KeyVal=KeyVal+Hex(Asc(Mid(tmpVal,i,1)))'生成值字符。ByChar。
Next
KeyVal=Format$("&h"+KeyVal)'转换四字节的字符为字符串
EndSelect
GetKeyValue=True'返回成功
rc=RegCloseKey(hKey)'关闭注册表关键字
ExitFunction'退出
GetKeyError:'错误发生后将其清除...
KeyVal=""'设置返回值到空字符串
GetKeyValue=False'返回失败
rc=RegCloseKey(hKey)'关闭注册表关键字
EndFunction
PrivateSubForm_Unload(CancelAsInteger)
frmmain.StatusBar1.Panels(2)="目前没有窗口被激活"
EndSub
PrivateSubForm_Activate()
frmmain.StatusBar1.Panels(2)="活动窗口:"&frmAbout.Caption
EndSub
4:库存登记界面设计:
代码设计:
PublicSubGuolu()
WithAdodc1
.RecordSource="select*from"&frmmain.datas&"where失效标记=false"
.Refresh
Fori=0To.Recordset.RecordCount
IfNot.Recordset.EOFThen
If.Recordset.Fields("失效期")<=DateThen
.Recordset.Fields("失效标记")=True
.Recordset.Update
Else
.Recordset.Fields("失效标记")=False
.Recordset.Update
EndIf
.Recordset.MoveNext
EndIf
Next
EndWith
EndSub
PrivateSubcombo2_Change()
IfCombo2.Text<>"西药中成药库"AndCombo2.Text<>"中草药库"AndCombo2.Text<>"器械材料库"Then
Text1.Enabled=False
Text18.Enabled=False
EndIf
EndSub
PrivateSubCombo2_Click()
SelectCaseCombo2.Text
Case"西药中成药库"
frmmain.datas="kcyp"
frminput.Caption="西药和中成药入库登记"
frmmain.kcode="ypcode"
CallGuolu
Text1.Enabled=True
Text18.Enabled=True
C
上一篇:
VB药品公司进销售存管理系统VC(论文和程序)
下一篇:
白三烯的研究进展与临床意义