*!*下面是测试连接有效否，有效就检测服务器注册及过期情况等
If Empty(pCompany)
cTitle="【 星 级 酒 店 管 理 系 统 】"
Else
cTitle="【 &pCompany. --- 酒店管理系统 】"
Endif
m.LNHWND=FindWindow(0,cTitle)
If m.LNHWND<>0
Wait Window "重 复 提 示 : 程 序 已 经 运 行 !" At Srows()/2-3,(Scol()-34)/2 Timeout 2
BringWindowToTop(m.LNHWND)
ShowWindow(m.LNHWND,3)
Quit
Endif
*!*分变率处理，如果低于800*600就修改为800*600，否则就从配置文件进行相应处理，程序本身有自动适应功能。
OFBLX=Sysmetric(1)
OFBLY=Sysmetric(2)
If OFBLX<800 Or (Upper(ReadIni('SCREEN','SourceXY','&ExePath.LXJ.INI'))='YES' And OFBLX<>800)
CHANGERES(800,600)
OFBLX=800
OFBLY=600
_Screen.ScreenImg.Height=600-50
_Screen.ScreenImg.Width=800
Endif
*!*下面是背景图自动随机调用或是调用用户设定的固定图片处理
If Upper(ReadIni('SCREEN','RandomLoad','&ExePath.LXJ.INI'))='YES'
Set Default To &ExePath.PictureS
FileNo=Adir(PicFile,"*.JPG")
If FileNo>0
FileNo=Int(Rand(Seconds())*FileNo)+1
CurPic =PicFile[FileNo,1]
Else
CurPic=ReadIni('SCREEN','Picture','&ExePath.LXJ.INI')
Endif
Release FileNo,PicFile,LNHWND
Set Default To &ExePath.
CurPic=ExePath+'PictureS\'+CurPic
Else
CurPic=ReadIni('SCREEN','Picture','&ExePath.LXJ.INI')
Endif
If !File(CurPic)
CurPic='DeskTopr.jpg'
Endif
_Screen.ScreenImg.Picture=CurPic
_Screen.Caption=cTitle
_Screen.Refresh
Do Form Login.SCX &&运行登录用密码校验界面
Read Events
=VFP_INIT()
Return
Function VFP_INIT
With _Screen
.ZOOMBOX=.T.
.MinButton=.T.
.MaxButton=.T.
.BorderStyle=2
.Closable=.T.
.Movable=.T.
.Icon=""
.Caption=Chr(49653)+Chr(53673)+Chr(48889)
Endwith
Close Databases All
Close Tables All
Release Windows
Set Sysmenu To Default
Set Sysmenu On
Set Deleted Off
Set Procedure To
Set Exclusive On
Set Multilocks Off
Set Library To
Set Talk On
Set Escap On
Set Safe On
Set Exact Off
Close All
Clear Dlls
Clear All
Clear
On Key
On Error
On Escap
Return
Endfunc
*!*判断连接是否存在或断线,如不通并重新连接
Function IsConn
If nConn<=0
SQLDIsConnECT(0)
nConn=Sqlstringconnect(sConn)
Endif
Try
SQLEXEC(nConn,'')
Catch
nConn=-1
Finally
If nConn<=0
nConn=Sqlstringconnect(sConn)
Endif
Endtry
If nConn>0
SQLEXEC(nConn,"Select GetDate() AS SysTime ,CONVERT(VARCHAR(10),GetDate(),111) AS SysDate ",'ServerDate')
Return(.T.)
Else
Return(.F.)
Endif
Endfunc
*!*设定当前系统的时间为服务器的时间
Function GetServerTime
If IsConn()
Select ServerDate
SystemTime = WTOS(Year(ServerDate.SysTime)) + ;
WTOS(Month(ServerDate.SysTime)) + ;
WTOS(Dow(ServerDate.SysTime) - 1) + ;
WTOS(Day(ServerDate.SysTime))+ ;
WTOS(Hour(ServerDate.SysTime)) + ;
WTOS(Minut(ServerDate.SysTime)) + ;
WTOS(Sec(ServerDate.SysTime))+;
WTOS(Sec(ServerDate.SysTime))
= SETLOCALTIME(SystemTime)
Else
Messagebox('后台数据库连接失败,时间同步无效！',16,'Information',3000)
Endif
Endfunc
Function WTOS
Parameters WORDVAL
Private IDNAME, RETSTR
RETSTR = ""
For IDNAME = 8 To 0 Step -8
RETSTR = Chr(Int(WORDVAL/(2^IDNAME))) + RETSTR
WORDVAL = Mod(WORDVAL, (2^IDNAME))
Next
Retu RETSTR
Endfunc
*!* SQL 错误登记显示自定义函数
Function ShowSqlError
NERRLINE=Aerror(SQLERROR)
If SqlError[5]<60000
Set Textmerge Delimiters To
Set Textmerge On
Set Textmerge To &ExePath.ERRORS\SQLERRLOG.TXT Noshow
\<> <> 错误记录
For I=1 To NERRLINE
\错误编号：<>
\错误信息：<>
\ODBC 信息：<>
\ODBC 状态：<>
\ODBC 数据源错误编号：<>
\ODBC 连接句柄：<>
Endfor
Set Safety Off
Set Textmerge To
Local LCERRORLOG,LCUSER
If !Directory("&ExePath.Errors")
Md &ExePath.Errors
Endif
LCERRORLOG = Filetostr('&ExePath.ERRORS\SQLERRLOG.txt')
LCUSER=pUserId-'/'-pUserName
If IsConn()
SQLEXEC(nConn,'INSERT INTO SYSERROR (WORKSTATION,USERNAME,ERRORDATE,ERRORLOG) valueS (?SYS(0),?lcUSER,GETDATE(),?lcERRORLOG)')
Endif
Messagebox(SQLERROR[2],16,'SQL Error '+Transform(SQLERROR[1]))
Else
Messagebox(Right(SQLERROR[2],54),64,'SQL Error '+Transform(SQLERROR[1]))
Endif
Endfunc
*!* 程序快捷方式自定义函数
Function SetShortCut
Parameters MyProcName
wshshell = Createobject("Wscript.shell")
StrDesktop = wshshell.specialfolders("Desktop")
oMyShortcut = wshshell.createshortcut(strdesktop + "\&MyProcName..lnk")
oMyShortcut.windowstyle = 4 &&Maximized 7=Minimized 4=Normal
oMyShortcut.iconlocation = "&ExePath.Loader.EXE"
oMyShortcut.targetpath = "&ExePath.Loader.EXE"
oMyShortcut.workingdirectory = ExePath
oMyShortcut.Save
Release wshshell
Endfunc
责任编辑：小草
