发信人: hunter__fox(雁回西楼)
整理人: foxzz(2003-04-04 08:42:36), 站内信件
|
&& 系统主程序
&& 进行下面几项操作:
&& 显示一个启动表单;
&& 进行系统环境设置;
&& 检查一下数据库一否存在;
&& 进行登录界面并开始响应用户事件.
&& hunter 2000-10-22
&&--------------------------------------------------
&& 显示启动表单
Do Form ShortForm
&& 系统设置
On Error Do ForError.prg With Error(),Message(),Message(1),Program(),LineNo() && 集中错误处理
Set Procedure To Main.prg,ExclFuns.prg,FreeFuns.prg Additive && 函数库--主程序中有一个QuitSys()函数
Set ClassLib To PartLib.vcx && 类库--------各系统使用的类库可能不同
On ShutDown QuitSys() && 退出的代码
Do SetSys.prg && 系统设置
&& 数据库
Local lcDatabaseName
lcDatabaseName = RedReg("DatabaseName")
If lcDatabaseName == "" Or Not(File(lcDatabaseName))
&& 注册表中无此信息,或无相应的数据库文件
If SetDataBase(@lcDatabaseName) = .F.
MessageBox("无法打开数据库"+Upper(AllTrim(lcDatabaseName))+",不能继续.")
QuitSys()
Else
&& 重新指定了数据库!
&& 重新指定的数据库默认的有效期为此次进程内.
&& 将此数据库做为默认数据库,须通过其它代码完成.
&& 这样可使数据脱机使用易于控制.
EndIf
EndIf
Public pcDatabase && 定义一个全局变量,存放数据库名.
pcDatabase = lcDatabaseName
Open Database &pcDatabase
Set Database To (pcDatabase)
_Screen.Visible = .T.
Set SysMenu Off
&& 进入用户登录表单
Do Form GetUser
Read Events && 开始事件处理.
QuitSys()
&&--------------------------------------------------
&& 退出系统
&& Hunter 2000-10-22
&&--------------------------------------------------
Function QuitSys
On Error Quit
&& 取消当前事务
Do While TxnLevel() > 0
Rollback
EndDo
Close All
Clear All
Release All
Quit
EndFunc
----
在代码天地里
我要做一个
猎狐者 |
|