main.bak

来自「太平洋保险保单统计系统」· BAK 代码 · 共 152 行

WITH _SCREEN
	.VISIBLE = .F.		&&（默认界面不可见）
	.WINDOWSTATE =2		&&（当再次需要显示时最大化，当再次用_Screen.Visible = .T.恢复界面时，这样的效果最理想 ）
ENDWITH
*-------------------------------------------------第一步：清环境
CLEAR
CLEAR ALL
CLOSE ALL
CLEAR MENUS  &&  从内存中释放所有的内存变量和数组以及所有用户自定义菜单栏、菜单和窗口的定义。 还从内存中删除所有用 DECLARE-ALL 注册
&& 的外部 Windows 32 位动态链接库 (.DLLS)。 * 关闭系统菜单 如果在发出 SET SYSMENU SAVE 命令之后修改了菜单系统，可以通过发出 SET  SYSMENU TO DEFAULT 命令来恢复前面的设置。
SET SYSMENU SAVE
SET SYSMENU OFF  	&&* 在程序执行期间废止 Visual FoxPro 主菜单栏。
SET SYSMENU TO
*--------------------------------------------------第二步：定义环境
SET CENTURY ON 		&&显示四位年份  作用域是当前数据工作期
SET DATE TO YMD 	&&年月日显示   在当前数据工作期有效。
SET STATUS BAR OFF	&&*当GRID等控键的ReadOnly=.T.时，如果用户想改变其值，系统会出现“此控件只读！”的提示
SET NOTIFY OFF		&&TEXT的Valid中判断其值不符要求而RETU .F.时，系统也会出现“无效*输入”的提示，除用上面的办法可避免其出现外，用RETU 0来代替RETU .f. 同样可避免。
SET CONFIRM OFF   	&&指定在文本框中不能用键入最后一个字符的方法退出文本框。要退出文本框，可以按 Enter
SET CARRY  OFF		&&添加新数据不复制数据
SET EXACT ON		&&严格比较
SET TALK OFF    	&&关闭对话模式
SET SAFE OFF		&&关闭安全提示
SET STAT OFF
SET DELE ON     	&&不处理已删除的记录
SET ANSI ON     	&&'abc' <> 'ab'
SET ESCAPE  OFF 	&&禁用ESC键
SET FDOW TO 2  		&&指定一周中的第一天 2 星期一
SET HOURS TO 24 	&&24小时制
SET MARK TO '-'		&&指定日期分隔符为  -
*--------------------------------------------------定义屏幕分辨率为
IF  SYSMETRIC(1)<1024 AND SYSMETRIC(2)<768
	=MESSAGEBOX("显示器分辨率需调整为1024×768"+CHR(13)+"或更高才能正常运行本软件！",48,"警告窗口")
	QUIT
ENDIF
*--------------------------------------------------表单状态 主路径
PUBLIC baodan,safetykind,f_netpoint,F_NPrate,Top_main,f_getview,f_Payview,f_getmoney,f_paymoney
PUBLIC mainpath,REG_ok,REG_time
P_agent=''
REG_time=DATETIME()
mainpath=STRTRAN(LEFT(SYS(16),RAT("\",SYS(16))),'PROGS\','')
SET DEFA TO (mainpath)
SET PATH TO FORMS;GRAPHICS;HELP;libs;MENUS;progs;REPORTS;temp;SYSTEM;数据备份
*--------------------------------------------------指向自定义函数
*SET CLASSLIB TO "my_class.vcx"
SET PROCEDURE TO common
*--------------------------------------------------
= SQLSETPROP(0,'displogin',3)			&&永不显示登际框
= SQLSETPROP(0,"ConnectTimeOut",5)		&&连接超时５秒
*--------------------------------------------------如无临时目录则建一个
IF !DIRECTORY(mainpath+'\temp')
	MD 'TEMP'
ENDIF
IF !DIRECTORY(mainpath+'\数据备份')
	MD '数据备份'
ENDIF
*--------------------------------------------------防止主程序第二次打开
TRY
	IF FILE(mainpath+'\temp\errors.txt')
		gnerrfile = FOPEN(mainpath+'\temp\errors.txt',12)
	ELSE
		gnerrfile = FCREATE(mainpath+'\temp\errors.txt')
	ENDIF
	IF gnerrfile < 0
		THROW 'cannot open or create output file'
	ELSE
		=FWRITE(gnerrfile , 'Error information to be written here')
	ENDIF
CATCH TO zgerror WHEN zgerror.ERRORNO=2071
	=MESSAGEBOX(' 本系统正在运行中...',0+48,'警告')
	CLEAR DLLS
	CLOSE ALL
	*CLEAR ALL
	QUIT
ENDTRY
*--------------------------------------------------读取IP
lcBuffer=Read_ini('server.ini','ip','serverip')
Port=','+Read_Ini('server.ini','ip','port')
********************************************
PUBLIC sql_server,SQL_uID,sql_idpass,sql_sqlbase
sql_server	=lcBuffer+Port		&&Server IP
SQL_uID		='sa'				&&SQL ID
sql_idpass	='admin'		    &&SQL PASS
sql_sqlbase	='pacific'			&&SQL DATABASE NAME
*--------------------------------------------------
=SYS(3055 , 2040)			&&允许SQL传递最大字符数量

LOCAL Handle
WAIT '正在和服务器建立连接，请稍等... ... '  WINDOW AT SYSMETRIC(2)/24-6,SYSMETRIC(1)/12-13 NOCLEAR NOWAIT
Handle=SQLSTRINGCONNECT('driver=sql server;server=&sql_server;uid=&sql_uid;pwd=&sql_idpass;database=&sql_sqlbase')
IF Handle<0
	WAIT CLEAR
	=MESSAGEBOX('不能连接服务器，请检查网络，程序将退出！',48,'！！！')
	QUIT
ELSE
	=SQLDISCONNECT(Handle)
ENDIF
WAIT '服务器连接正常 '  WINDOW AT SYSMETRIC(2)/24-6,SYSMETRIC(1)/12-13 NOWAIT TIMEOUT 1
*--------------------------------------------------捕捉错误
ON ERROR errhand(ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( ))
*--------------------------------------------------检查注册码
LOCAL L_PASS,L_HD
L_PASS 	= NVL(reg(2,'Software\TCai','Pass',0),'')
L_PASS 	= STRCONV(L_PASS,14)

L_HD	=STRCONV(ALLTRIM(Read_serial()),13)
IF LEN(L_HD)>30
	L_HD=RIGHT(L_HD,30)
ENDIF

IF LEN(L_HD)<5
	=MESSAGEBOX('系统环境不符合软件要求！软件退出运行，请联系原作者！',0+48,'警告')
	QUIT
ENDIF

*--------------------------------------------------试用时间
IF L_HD<>pass_encode('Thomas Sure Win 500 万',L_PASS)
	REG_ok=0
	Spare_time=reg(2,'Software\TCai','PT',0)
	IF  VARTYPE(Spare_time)=='C'
		Spare_time 	= STRCONV(Spare_time,14)
		Spare_time	= ROUND(VAL(Spare_time),0)
	ELSE
		=reg(0,'Software\TCai',0,0)		&&建立 主键
		=reg(2,'Software\TCai','PT',0)
		=reg(1,'Software\TCai','PT',STRCONV(ALLTRIM(STR(60*10)),13))
		Spare_time	=6000
	ENDIF
	IF Spare_time<=0 OR Spare_time>6000
		=MESSAGEBOX('软件已试用到期！若您想继续使用本软件,请联系作者(QQ:24209057 TEL:[phone])购买正版！',0+48,'警告')
		DO FORM reg
		READ  EVENTS
	ELSE
		DO FORM top_login
		READ  EVENTS
	ENDIF
ELSE
	REG_ok=1
	DO FORM top_login
	READ  EVENTS
ENDIF

CLEAR DLLS
CLEAR ALL
CLOSE ALL
DELETE FILE  *.DBF
*DELETE FILE  *.txt
ON ERROR  && 还原系统错误处理
QUIT