亲，您未登录哦！ 登录 | 注册
首页  |  社区  |  工具箱  |  代码库  |  博客  |  招聘  |  文章  |  新闻  |  下载  |  读书
回 帖 发 新 帖 刷新版面

主题：一个CS的主程序，望有高人给我解释一下！万分感谢

fyren [专家分：230] 发布于 2010-05-24 14:41:00

* * 2003/11/21 《星级酒店管理》系统 主程序
* * 作者：刘雪均
* * 版权所有 (C) 2003 宝明城大酒店
* * 广东深圳市公明镇长春花园
* * 深圳, 广东 518106
* * 中国
* * 说明: 版权所有，严禁非法复制，违者必穷
Clear
Clear All
Clear Dlls
Clear Macros
Close All
Set Talk Off
Set Safe Off
Set Escape Off
Set Debug Off
Set Exact Off
Set Sysmenu Save
Set Sysmenu To
Set Sysmenu Off
Set NullDisplay To ''
Set Null Off
Set Dohistory Off
Set Notify Cursor Off
Release Windows
Close Databases
Set Date To YMD
Set Hour To 24
Set Seconds Off
Set Century On
Set Deleted On
Set Resource On
Set Help On
On Shutdown Quit
Set Clock Off
With _Screen
.WindowState=2
.ZOOMBOX=.F.
.Movable=.F.
.MinButton=.F.
.MaxButton=.F.
.Closable=.F.
.Icon="Ball.ICO"
.Caption='《星级酒店管理》系统－－均维软件工作室'
.LockScreen=.T.
.AddObject('ScreenImg','Image')
.ScreenImg.Stretch=2
.ScreenImg.Visible=.T.
.ScreenImg.Height=Sysmetric(2)-50
.ScreenImg.Width=Sysmetric(1)
.ScreenImg.Picture='DeskTopr.jpg'
.LockScreen=.F.
Endwith
=Capslock(.T.)
=Numlock(.T.)
Public TempFile,ExePath,CurWinDir,CurPic,pCompany,ReportFile,pTeamId,pUserGroup,pUserId,pUserName,sConn,gcUpdateId,;
m.Date_From,m.Date_To,nConn,OFBLX,OFBLY,Times
Store 0 To nConn,OFBLX,OFBLY,Times
Store Date() To m.Date_From,m.Date_To
Store '' To TempFile,ExePath,CurWinDir,CurPic,pCompany,ReportFile,sConn,pTeamId,pUserGroup,pUserId,pUserName
TempFile='T'+Right(Sys(2015),7)
CurWinDir=Getenv('WinDir')
ExePath=Left(Sys(16,1),Rat("\",Sys(16,1)))
Set Default To (ExePath)
Set Resource To &ExePath.FoxUser.Dbf
Set Path To &ExePath.;&ExePath.HelpS
If !Directory("&ExePath.Temp")
Md &ExePath.Temp
Endif
Tmpfiles="&ExePath.Temp" &&设定当前VFP使用的临时文件目录
=DelTmpFile() &&删除当前用户系统目录和VFP目录的过时的临时文件
*!* SET HELP TO &ExePath.HelpS\Hotel.CHM
If !File('MYDLL.DLL')
Messagebox('MYDLL.DLL丢失,程序不能正常运行!',48,'系统提示')
Quit
Endif
Declare String getserial In "MyDll.dll" Integer &&获得硬盘厂商物理永久性的ID
Declare String num2txt_c In "MyDll.dll" As RMBZH Double &&小写金额转换成大写金额
Declare String topy In "MyDll.dll" String &&汉字转拼音首字母
Declare Integer changeres In "MyDll.dll" Integer, Integer &&分变率设定
Declare Integer WinExec In "kernel32" String,Integer
Declare Integer FindWindow In Win32api String, String
Declare Long BringWindowToTop In Win32API Long
Declare Long ShowWindow In Win32API Long, Long
Declare Integer SendMessage In user32 Integer,Integer,Integer,Integer
Declare Integer ShellExecute In SHELL32.Dll Integer, String, String, String, String, Integer
Declare Integer GetPrivateProfileString In Win32API As GetPrivStr String, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Win32API As WritePrivStr String, String, String, String
Declare SHORT SetLocalTime In win32api String SystemTime
*!* Declare integer ShowWindowAsync in user32 integer hwnd, integer nCmdShow
*!* htaskbar = FindWindow("Shell_TrayWnd",0)
*!* ShowWindowAsync(htaskbar,0) &&0为隐藏任务栏，1为显示任务栏
Set Class To MyLibs Additive &&使用自已的类库
On Error Do Err_Fix With Error( ),Message( ),Message(1), Program( ),Lineno( ) &&错误跟踪处理
If !File("&ExePath.LXJ.INI") &&判断配置文件存在否，不存在就创建。
=WriteIni('REGISTRY','Local_Id',Str(DiskSpace(Sys(5),1)),'&ExePath.LXJ.INI')
=WriteIni('REGISTRY','Reg_Date',Ttoc(Datetime()),'&ExePath.LXJ.INI')
=WriteIni('REGISTRY',' ','======================','&ExePath.LXJ.INI')

=WriteIni('AUTHOR','Contact','刘 雪 均','&ExePath.LXJ.INI')
=WriteIni('AUTHOR','Title','电脑工程师','&ExePath.LXJ.INI')
=WriteIni('AUTHOR','Telephone','13613026728','&ExePath.LXJ.INI')
=WriteIni('AUTHOR',' ','======================','&ExePath.LXJ.INI')

=WriteIni('SCREEN','RandomLoad','Yes','&ExePath.LXJ.INI')
=WriteIni('SCREEN','SourceXY','Yes','&ExePath.LXJ.INI')
=WriteIni('SCREEN','Picture ','Picture.JPG','&ExePath.LXJ.INI')
=WriteIni('SCREEN','StatusBar ','On','&ExePath.LXJ.INI')
=WriteIni('SCREEN','','======================','&ExePath.LXJ.INI')

=WriteIni('CONNECT','DRIVER','SQL SERVER','&ExePath.LXJ.INI')
=WriteIni('CONNECT','SERVER',GETENV("COMPUTERNAME"),'&ExePath.LXJ.INI')
=WriteIni('CONNECT','PORTNO','1433','&ExePath.LXJ.INI')
=WriteIni('CONNECT','UID','SA','&ExePath.LXJ.INI')
=WriteIni('CONNECT','PWD','DBA','&ExePath.LXJ.INI')
=WriteIni('CONNECT','DATABASE','HOTEL','&ExePath.LXJ.INI')
=WriteIni('CONNECT',' ','======================','&ExePath.LXJ.INI')

=WriteIni('USER','LastUser','Guest','&ExePath.LXJ.INI')
=WriteIni('USER',' ','======================','&ExePath.LXJ.INI')

=WriteIni('UPDATE','NewExe','&ExePath.Main.EXE','&ExePath.LXJ.INI') &&工作站自动升级的共享目录
=WriteIni('UPDATE','NewInfo','欢迎使用本系统！','&ExePath.LXJ.INI') &&提示的信息
=WriteIni('UPDATE',' ','======================','&ExePath.LXJ.INI')
=WriteIni('OCXDLLREG',GETENV("COMPUTERNAME"),'NO','&ExePath.LXJ.INI')
Endif
If Upper(ReadIni('SCREEN','StatusBar','&ExePath.LXJ.INI'))='ON'
Set Status Bar On
_vfp.StatusBar=' 欢 迎 您 使 用 本 系 统 . . . '
Else
Set Status Bar Off
Endif
=OleRegister() &&根据INI文件判断是否注册OCX，DLL文件
=SetShortCut('酒店管理') &&在屏幕上创建快捷方式
*!*工作站是否注册判断
If ReadIni('REGISTRY','Local_Id','&ExePath.LXJ.INI')!=WorkJm(Iif(Empty(GetSerial(0)),Str(Diskspace(Sys(5),1)),Allt(GetSerial(0))),'HTL')
Do Form RegWork.SCX &&调用本工作站使用注册表单
Endif
Wait Window "正在连接 SQL SERVER 数据库 ，请稍候 ...... " At Srows()/2-10,(Scol()-45)/2 Nowait Noclear
SQLSETPROP(0,"DispLogin" ,3) &&连接不成功时不显示ODBC登录对话窗口
SQLSETPROP(0,"ConnectTimeOut",20) &&连接超时等待秒数设置，可取值0至600
SQLSETPROP(0,"IdleTimeout",0) &&空闲超时间隔秒数，取0为无限期等待
SQLSETPROP(0,"QueryTimeOut",20) &&超时错误之前等待的时间
SQLSETPROP(0,"Asynchronous",.F.) &&指定结果集合是同步返回
SQLSETPROP(0,"DispWarnings",.F.) &&不显示一个错误信息
*!*从配置文件中获得SQL SERVER的加密连接串
sConn='DRIVER=SQL SERVER'
sConn=sConn+'; SERVER='+Iif(Empty(ReadIni('CONNECT','SERVER','&ExePath.LXJ.INI')),GETENV("COMPUTERNAME"),ReadIni('CONNECT','SERVER','&ExePath.LXJ.INI'))
sConn=sConn+','+Iif(Empty(ReadIni('CONNECT','PORTNO','&ExePath.LXJ.INI')),'1433',ReadIni('CONNECT','PORTNO','&ExePath.LXJ.INI'))
sConn=sConn+';UID='+ReadIni('CONNECT','UID','&ExePath.LXJ.INI')
sConn=sConn+';PWD='+Iif(Empty(ReadIni('CONNECT','PWD','&ExePath.LXJ.INI')),'',JmWd(ReadIni('CONNECT','PWD','&ExePath.LXJ.INI')))
sConn=sConn+';DATABASE='+Iif(Empty(ReadIni('CONNECT','DATABASE','&ExePath.LXJ.INI')),'NoDatabase',ReadIni('CONNECT','DATABASE','&ExePath.LXJ.INI'))
sConn=sConn+';NetWork=DBMSSOCN'
nConn=Sqlstringconnect(sConn)
Wait Clear
Do While nConn<=0
Local YN
YN=Messagebox('SQL Server 数据库连接失败,请选择 ！'+Chr(13)+Chr(13)+"Y ->重试 , N ->设定 , 取消 ->退出 ！",67 ,'SQL Connect Info.')
_Screen.Refresh
Do Case
Case YN=6
Wait Window "正在连接 SQL SERVER 数据库 ，请稍候 ...... " At Srows()/2-10,(Scol()-45)/2 Nowait Noclear
nConn=Sqlstringconnect(sConn)
Wait Clear
Case YN=7
Do Form SetServer.SCX &&SQL SERVER服务器连接配置
Otherwise
Quit
Endcase
Enddo

*!*下面是测试连接有效否，有效就检测服务器注册及过期情况等
If IsConn()
=GetServerTime() &&设定当前机器时间为服务器的时间
If SQLEXEC(nConn,'Select * From Registry','MyCursor')>0
Select MyCursor
pCompany=Alltrim(MyCursor.Corp)
If Alltrim(MyCursor.RegKey)!=Alltrim(ServerJm(Dtoc(Ttod(MyCursor.EndTime))-TOPY(pCompany)-Dtoc(Ttod(MyCursor.BeginTime)),'HTL'))
Do Form RegServer.SCX &&调用注册SQL SERVER服务器使用权表单
Endif
If MyCursor.BeginTime>Date()
Messagebox('系统时间小于注册时间，程序不可运行！',16,'Information',3000)
Quit
Endif
If MyCursor.EndTime<DATE()
Messagebox('系统使用期限已到，请重新注册！',16,'Information',3000)
Do Form RegServer.SCX
Endif
If MyCursor.EndTime<=Date()+7
Messagebox('1、使用期限快到，程序将在 '+Alltrim(MyCursor.EndTime)+' 后终止运行，切记！'+Chr(13)+Chr(13)+'2、请尽快同 刘雪均 联系(E-MAIL:CQTony@tom.com),谢谢！',64 ,'系统提示')
Endif
Else
Messagebox('注册信息查询失败，请等会重试！',16,'Information',3000)
=SQLDisConnect(0)
Quit
Endif
Else
Messagebox('后台数据库连接失败，请等会重试！',16,'Information',3000)
=SQLDIsConnect(0)
Quit
Endif

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

本帖地址：  http://bbs.pfan.cn/post/322498.html

回复列表 （共9个回复）

沙发

fyren [专家分：230] 发布于 2010-05-24 14:43:00

* * 2003/11/21 《星级酒店管理》系统 主程序
* * 作者：刘雪均
* * 版权所有 (C) 2003 宝明城大酒店
* * 广东深圳市公明镇长春花园
* * 深圳, 广东 518106
* * 中国
* * 说明: 版权所有，严禁非法复制，违者必穷
Clear
Clear All
Clear Dlls
Clear Macros
Close All
Set Talk Off
Set Safe Off
Set Escape Off
Set Debug Off
Set Exact Off
Set Sysmenu Save
Set Sysmenu To
Set Sysmenu Off
Set NullDisplay To ''
Set Null Off
Set Dohistory Off
Set Notify Cursor Off
Release Windows
Close Databases
Set Date To YMD
Set Hour To 24
Set Seconds Off
Set Century On
Set Deleted On
Set Resource On
Set Help On
On Shutdown Quit
Set Clock Off
With _Screen
.WindowState=2
.ZOOMBOX=.F.
.Movable=.F.
.MinButton=.F.
.MaxButton=.F.
.Closable=.F.
.Icon="Ball.ICO"
.Caption='《星级酒店管理》系统－－均维软件工作室'
.LockScreen=.T.
.AddObject('ScreenImg','Image')
.ScreenImg.Stretch=2
.ScreenImg.Visible=.T.
.ScreenImg.Height=Sysmetric(2)-50
.ScreenImg.Width=Sysmetric(1)
.ScreenImg.Picture='DeskTopr.jpg'
.LockScreen=.F.
Endwith
=Capslock(.T.)
=Numlock(.T.)
Public TempFile,ExePath,CurWinDir,CurPic,pCompany,ReportFile,pTeamId,pUserGroup,pUserId,pUserName,sConn,gcUpdateId,;
m.Date_From,m.Date_To,nConn,OFBLX,OFBLY,Times
Store 0 To nConn,OFBLX,OFBLY,Times
Store Date() To m.Date_From,m.Date_To
Store '' To TempFile,ExePath,CurWinDir,CurPic,pCompany,ReportFile,sConn,pTeamId,pUserGroup,pUserId,pUserName
TempFile='T'+Right(Sys(2015),7)
CurWinDir=Getenv('WinDir')
ExePath=Left(Sys(16,1),Rat("\",Sys(16,1)))
Set Default To (ExePath)
Set Resource To &ExePath.FoxUser.Dbf
Set Path To &ExePath.;&ExePath.HelpS
If !Directory("&ExePath.Temp")
Md &ExePath.Temp
Endif
Tmpfiles="&ExePath.Temp" &&设定当前VFP使用的临时文件目录
=DelTmpFile() &&删除当前用户系统目录和VFP目录的过时的临时文件
*!* SET HELP TO &ExePath.HelpS\Hotel.CHM
If !File('MYDLL.DLL')
Messagebox('MYDLL.DLL丢失,程序不能正常运行!',48,'系统提示')
Quit
Endif
Declare String getserial In "MyDll.dll" Integer &&获得硬盘厂商物理永久性的ID
Declare String num2txt_c In "MyDll.dll" As RMBZH Double &&小写金额转换成大写金额
Declare String topy In "MyDll.dll" String &&汉字转拼音首字母
Declare Integer changeres In "MyDll.dll" Integer, Integer &&分变率设定
Declare Integer WinExec In "kernel32" String,Integer
Declare Integer FindWindow In Win32api String, String
Declare Long BringWindowToTop In Win32API Long
Declare Long ShowWindow In Win32API Long, Long
Declare Integer SendMessage In user32 Integer,Integer,Integer,Integer
Declare Integer ShellExecute In SHELL32.Dll Integer, String, String, String, String, Integer
Declare Integer GetPrivateProfileString In Win32API As GetPrivStr String, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Win32API As WritePrivStr String, String, String, String
Declare SHORT SetLocalTime In win32api String SystemTime
*!* Declare integer ShowWindowAsync in user32 integer hwnd, integer nCmdShow
*!* htaskbar = FindWindow("Shell_TrayWnd",0)
*!* ShowWindowAsync(htaskbar,0) &&0为隐藏任务栏，1为显示任务栏
Set Class To MyLibs Additive &&使用自已的类库
On Error Do Err_Fix With Error( ),Message( ),Message(1), Program( ),Lineno( ) &&错误跟踪处理
If !File("&ExePath.LXJ.INI") &&判断配置文件存在否，不存在就创建。
=WriteIni('REGISTRY','Local_Id',Str(DiskSpace(Sys(5),1)),'&ExePath.LXJ.INI')
=WriteIni('REGISTRY','Reg_Date',Ttoc(Datetime()),'&ExePath.LXJ.INI')
=WriteIni('REGISTRY',' ','======================','&ExePath.LXJ.INI')

=WriteIni('AUTHOR','Contact','刘 雪 均','&ExePath.LXJ.INI')
=WriteIni('AUTHOR','Title','电脑工程师','&ExePath.LXJ.INI')
=WriteIni('AUTHOR','Telephone','13613026728','&ExePath.LXJ.INI')
=WriteIni('AUTHOR',' ','======================','&ExePath.LXJ.INI')

=WriteIni('SCREEN','RandomLoad','Yes','&ExePath.LXJ.INI')
=WriteIni('SCREEN','SourceXY','Yes','&ExePath.LXJ.INI')
=WriteIni('SCREEN','Picture ','Picture.JPG','&ExePath.LXJ.INI')
=WriteIni('SCREEN','StatusBar ','On','&ExePath.LXJ.INI')
=WriteIni('SCREEN','','======================','&ExePath.LXJ.INI')

=WriteIni('CONNECT','DRIVER','SQL SERVER','&ExePath.LXJ.INI')
=WriteIni('CONNECT','SERVER',GETENV("COMPUTERNAME"),'&ExePath.LXJ.INI')
=WriteIni('CONNECT','PORTNO','1433','&ExePath.LXJ.INI')
=WriteIni('CONNECT','UID','SA','&ExePath.LXJ.INI')
=WriteIni('CONNECT','PWD','DBA','&ExePath.LXJ.INI')
=WriteIni('CONNECT','DATABASE','HOTEL','&ExePath.LXJ.INI')
=WriteIni('CONNECT',' ','======================','&ExePath.LXJ.INI')

=WriteIni('USER','LastUser','Guest','&ExePath.LXJ.INI')
=WriteIni('USER',' ','======================','&ExePath.LXJ.INI')

=WriteIni('UPDATE','NewExe','&ExePath.Main.EXE','&ExePath.LXJ.INI') &&工作站自动升级的共享目录

板凳

fyren [专家分：230] 发布于 2010-05-24 14:43:00

=WriteIni('UPDATE','NewInfo','欢迎使用本系统！','&ExePath.LXJ.INI') &&提示的信息
=WriteIni('UPDATE',' ','======================','&ExePath.LXJ.INI')
=WriteIni('OCXDLLREG',GETENV("COMPUTERNAME"),'NO','&ExePath.LXJ.INI')
Endif
If Upper(ReadIni('SCREEN','StatusBar','&ExePath.LXJ.INI'))='ON'
Set Status Bar On
_vfp.StatusBar=' 欢 迎 您 使 用 本 系 统 . . . '
Else
Set Status Bar Off
Endif
=OleRegister() &&根据INI文件判断是否注册OCX，DLL文件
=SetShortCut('酒店管理') &&在屏幕上创建快捷方式
*!*工作站是否注册判断
If ReadIni('REGISTRY','Local_Id','&ExePath.LXJ.INI')!=WorkJm(Iif(Empty(GetSerial(0)),Str(Diskspace(Sys(5),1)),Allt(GetSerial(0))),'HTL')
Do Form RegWork.SCX &&调用本工作站使用注册表单
Endif
Wait Window "正在连接 SQL SERVER 数据库 ，请稍候 ...... " At Srows()/2-10,(Scol()-45)/2 Nowait Noclear
SQLSETPROP(0,"DispLogin" ,3) &&连接不成功时不显示ODBC登录对话窗口
SQLSETPROP(0,"ConnectTimeOut",20) &&连接超时等待秒数设置，可取值0至600
SQLSETPROP(0,"IdleTimeout",0) &&空闲超时间隔秒数，取0为无限期等待
SQLSETPROP(0,"QueryTimeOut",20) &&超时错误之前等待的时间
SQLSETPROP(0,"Asynchronous",.F.) &&指定结果集合是同步返回
SQLSETPROP(0,"DispWarnings",.F.) &&不显示一个错误信息
*!*从配置文件中获得SQL SERVER的加密连接串
sConn='DRIVER=SQL SERVER'
sConn=sConn+'; SERVER='+Iif(Empty(ReadIni('CONNECT','SERVER','&ExePath.LXJ.INI')),GETENV("COMPUTERNAME"),ReadIni('CONNECT','SERVER','&ExePath.LXJ.INI'))
sConn=sConn+','+Iif(Empty(ReadIni('CONNECT','PORTNO','&ExePath.LXJ.INI')),'1433',ReadIni('CONNECT','PORTNO','&ExePath.LXJ.INI'))
sConn=sConn+';UID='+ReadIni('CONNECT','UID','&ExePath.LXJ.INI')
sConn=sConn+';PWD='+Iif(Empty(ReadIni('CONNECT','PWD','&ExePath.LXJ.INI')),'',JmWd(ReadIni('CONNECT','PWD','&ExePath.LXJ.INI')))
sConn=sConn+';DATABASE='+Iif(Empty(ReadIni('CONNECT','DATABASE','&ExePath.LXJ.INI')),'NoDatabase',ReadIni('CONNECT','DATABASE','&ExePath.LXJ.INI'))
sConn=sConn+';NetWork=DBMSSOCN'
nConn=Sqlstringconnect(sConn)
Wait Clear
Do While nConn<=0
Local YN
YN=Messagebox('SQL Server 数据库连接失败,请选择 ！'+Chr(13)+Chr(13)+"Y ->重试 , N ->设定 , 取消 ->退出 ！",67 ,'SQL Connect Info.')
_Screen.Refresh
Do Case
Case YN=6
Wait Window "正在连接 SQL SERVER 数据库 ，请稍候 ...... " At Srows()/2-10,(Scol()-45)/2 Nowait Noclear
nConn=Sqlstringconnect(sConn)
Wait Clear
Case YN=7
Do Form SetServer.SCX &&SQL SERVER服务器连接配置
Otherwise
Quit
Endcase
Enddo

*!*下面是测试连接有效否，有效就检测服务器注册及过期情况等
If IsConn()
=GetServerTime() &&设定当前机器时间为服务器的时间
If SQLEXEC(nConn,'Select * From Registry','MyCursor')>0
Select MyCursor
pCompany=Alltrim(MyCursor.Corp)
If Alltrim(MyCursor.RegKey)!=Alltrim(ServerJm(Dtoc(Ttod(MyCursor.EndTime))-TOPY(pCompany)-Dtoc(Ttod(MyCursor.BeginTime)),'HTL'))
Do Form RegServer.SCX &&调用注册SQL SERVER服务器使用权表单
Endif
If MyCursor.BeginTime>Date()
Messagebox('系统时间小于注册时间，程序不可运行！',16,'Information',3000)
Quit
Endif
If MyCursor.EndTime<DATE()
Messagebox('系统使用期限已到，请重新注册！',16,'Information',3000)
Do Form RegServer.SCX
Endif
If MyCursor.EndTime<=Date()+7
Messagebox('1、使用期限快到，程序将在 '+Alltrim(MyCursor.EndTime)+' 后终止运行，切记！'+Chr(13)+Chr(13)+'2、请尽快同 刘雪均 联系(E-MAIL:CQTony@tom.com),谢谢！',64 ,'系统提示')
Endif
Else
Messagebox('注册信息查询失败，请等会重试！',16,'Information',3000)
=SQLDisConnect(0)
Quit
Endif
Else
Messagebox('后台数据库连接失败，请等会重试！',16,'Information',3000)
=SQLDIsConnect(0)
Quit
Endif

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

3 楼

fyren [专家分：230] 发布于 2010-05-24 14:49:00

基本看不懂，就不知道到底是怎么回事！
望有高人给我这程序好好解释一下！
越明白越好！！先谢谢了！

4 楼

fyren [专家分：230] 发布于 2010-05-24 14:52:00

*!*判断连接是否存在或断线,如不通并重新连接
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

*!* 动态SQL 查询条件中的特殊符号‘和“的处理函数
Function DelStr
Parameters lsCurStr
lsCurStr=Strtran(lsCurStr, "'", '')
lsCurStr=Alltrim(Strtran(lsCurStr, '"', ''))
Return(lsCurStr)
Endfunc

*!* 更新站点唯一ID获得函数,以当前用户的机器名+系统登录名+系统日期时间到毫秒+本程序的用户编号

5 楼

fyren [专家分：230] 发布于 2010-05-24 14:52:00

Function GetUserId
Local gcUpdateId
Set Seconds On
gcUpdateId=Strtran(Sys(0)+'|'+Right(Strtran(Ttoc(Datetime()),'/',''),15)+'|'+Alltrim(pUserId),' ','')
If Len(gcUpdateID)>46
gcUpdateID=Right(gcUpdateID,46)
Endif
Set Seconds Off
Return(gcUpdateId)
Endfunc

*!* 日期或字符串转换为日期型或者NULL，目的是为了适应后台SQL SERVER的格式，方便处理
Function DC2D
Parameters lsCDStr
Do Case
Case Vartype(lsCDStr)='C'
lsCDStr=Alltrim(lsCDStr)
lsCDStr=Ctod(lsCDStr)
If Empty(lsCDStr)
Return(.Null.)
Else
Return(lsCDStr)
Endif
Case Vartype(lsCDStr)='D'
If Empty(lsCDStr)
Return(.Null.)
Else
Return(lsCDStr)
Endif
Otherwise
Return(.Null.)
Endcase
Endfunc

*!* 日期或字符串转换为字符或NULL,目的是为了适应前台的格式，方便处理SQL SERVER调的数据

Function DC2C
Parameters lsDCStr
Do Case
Case Vartype(lsDCStr)='C'
lsDCStr=Alltrim(lsDCStr)
If Empty(lsDCStr)
Return(.Null.)
Else
Return(lsDCStr)
Endif
Case Vartype(lsDCStr)='D'
lsDCStr=Dtoc(lsDCStr)
If Empty(lsDCStr)
Return(.Null.)
Else
Return(lsDCStr)
Endif
Otherwise
Return(.Null.)
Endcase
Endfunc

*!* 删除当前系统用户临时目录过时的临时文件,因为系统有些临时文件是不会自动删除的
Function DelTmpFile
*!*Windows系统临时目录
gNo = Adir(gFile, GETENV("TEMP")+'\*.TMP')
For I=1 To gNo
nHand=Fopen(GETENV("TEMP")+'\'+gFile(I,1),12)
If nHand!=-1 And FDATE(GETENV("TEMP")+'\'+gFile(I,1))!=Date()
=Fclose(nHand)
Delete File GETENV("TEMP")+'\'+gFile(I,1)
Endif
Endfor
*!*当前程序临时目录
gNo = Adir(gFile, '&ExePath.Temp\*.*')
For I=1 To gNo
nHand=Fopen('&ExePath.Temp\'+gFile(I,1),12)
If nHand!=-1 And FDATE('&ExePath.Temp\'+gFile(I,1))!=Date()
=Fclose(nHand)
Delete File '&ExePath.Temp\'+gFile(I,1)
Endif
Endfor
Release gFile,nHand,gNo
Endfunc

*!* 工作站第一次运行的时候注册本程序目录下的控件
Function OleRegister
If ALLTRIM(Upper(ReadIni('OCXDLLREG',GETENV("COMPUTERNAME"),'&ExePath.LXJ.INI')))!='YES'
IF FILE("&EXEPATH.MSCOMCTL.OCX")
WINEXEC("REGSVR32 &EXEPATH.MSCOMCTL.OCX /S",0)
ENDIF
IF FILE("&EXEPATH.MSCOMCT2.OCX")
WINEXEC("REGSVR32 &EXEPATH.MSCOMCT2.OCX /S",0)
ENDIF

IF FILE("&EXEPATH.MSMAPI32.OCX")
WINEXEC("REGSVR32 &EXEPATH.MSMAPI32.OCX /S",0)
ENDIF
IF FILE("&EXEPATH.RICHTX32.OCX")
WINEXEC("REGSVR32 &EXEPATH.RICHTX32.OCX /S",0)
ENDIF

IF FILE("&EXEPATH.MSWINSCK.OCX")
WINEXEC("REGSVR32 &EXEPATH.MSWINSCK.OCX /S",0)
ENDIF
IF FILE("&EXEPATH.MSCOMM32.OCX")
WINEXEC("REGSVR32 &EXEPATH.MSCOMM32.OCX /S",0)
ENDIF
=WriteIni('OCXDLLREG',GETENV("COMPUTERNAME") ,'YES','&ExePath.LXJ.INI')
Endif
Endfunc

*********因本程序所有的字符串加密目前采用MD5校验，故把原有的加密函数也贴出来贡献给大家参考。

*!* ***工作站安装加密
Function WorkJm
Para YourId,JmStr
YourId=JmStr-Upper(Alltrim(YourId))
Local CurrentId
CurrentId=''
For IdName=1 To Len(YourId) Step 2
CurrentId=CurrentId+Subst(YourId,Len(YourId)-IdName,1)
Endfor
For IdName=0 To Len(YourId) Step 2
CurrentId=CurrentId+Subst(YourId,Len(YourId)-IdName,1)
Endfor
YourId=CurrentId
CurrentId=''
For IdName=1 To Len(YourId)
CurrentId=CurrentId+Chr(Bitxor(Asc(Subst(YourId,IdName,1)),IdName))
Endfor
Return(CurrentId)
Endfunc

***系统使用期限加密
Function ServerJm
Para GetSd,JmStr
GetSd=JmStr-Upper(Allt(GetSd))
Local CurSd
CurSd=''
For IdName=0 To Len(GetSd) Step 2
CurSd=CurSd+Subst(GetSd,Len(GetSd)-IdName,1)
Endfor
For IdName=1 To Len(GetSd) Step 2
CurSd=CurSd+Subst(GetSd,Len(GetSd)-IdName,1)
Endfor
GetSd=CurSd
CurSd=''
For IdName=1 To Len(GetSd)
CurSd=CurSd+Chr(Bitxor(Asc(Subst(GetSd,IdName,1)),IdName))
Endfor
Return(CurSd)
Endfunc

有人找我关于程序中的读写INI的函数，其实以前早发过了，为了方便大家，就一起贴出来吧！API的定义在前面。
Function ReadIni
PARAMETERS lcHeader, lcCentry,lcFile
Private lcBuffer
lnBufferSize = 128
lcBuffer = Space(lnBufferSize)+Chr(0)
=GETPRIVSTR(lcHeader, lcCentry, "", @lcBuffer, Len(lcBuffer),lcFile)
lcBuffer = Alltrim(Left(lcBuffer, lnBufferSize))
Return Left(lcBuffer, Len(lcBuffer)-1)
Endfunc

Procedure WriteIni
PARAMETERS lcHeader, lcCentry, LCvalue,lcFile
=WRITEPRIVSTR(lcHeader, lcCentry, LCvalue, lcFile)
Return
Endproc

6 楼

agt澳 [专家分：840] 发布于 2010-05-25 15:58:00

[color=0000FF][color=FF0000]
[size=3]* * 2003/11/21 《星级酒店管理》系统 主程序
* * 作者：刘雪均
* * 版权所有 (C) 2003 宝明城大酒店
既然人家有名有姓，有版权你应该问他啊，而且你把人家的程序原封不动的贴出来，是否要人家同意，
另外你想学，完全可以去买本带光盘的书，边做边学，就事论事的提点问题[/size][/color][/color]

7 楼

CQTONY [专家分：20] 发布于 2010-05-29 08:10:00

基本看不懂的话说明你的基础没打好，多看看书，具体哪不明白的可以问我，这是我03年发梅子论谈上的程序，目前还在用呢，只是更完善了，有需要酒店管理软件的可以找我，客房、餐饮、桑拿沐足、娱乐KTV点歌、会员管理等星级酒店管理程序全套，联系电话还是主程序中的13613026728，QQ:3858646.

8 楼

fyren [专家分：230] 发布于 2010-05-29 13:09:00

[quote]基本看不懂的话说明你的基础没打好，多看看书，具体哪不明白的可以问我，这是我03年发梅子论谈上的程序，目前还在用呢，只是更完善了，有需要酒店管理软件的可以找我，客房、餐饮、桑拿沐足、娱乐KTV点歌、会员管理等星级酒店管理程序全套，联系电话还是主程序中的13613026728，QQ:3858646.[/quote]

不好意思啊！大水冲到龙王庙了！！作者在这儿还贴正不好意思啊！！！
主要我是不清楚CS中远程视图生成的那块！
主机和客户机有什么要求，生成远程的基本条件要那些！
谢谢了啊！

9 楼

homayzh [专家分：7040] 发布于 2010-06-11 18:58:00

对作者的MYfll有兴趣，呵

我来回复

您尚未登录，请登录后再回复。点此登录或注册

程序员工具箱 new

  • 编程网站导航
  • 数据规范检测
  • 网页字体测试
  • HTML在线测试
  • useragent工具
  • 数字进制转换
  • PHP手册
  • TCP/IP端口号
  • 图片转Base64编码
  • 中文填字游戏
  • 更多工具

    • 代码片段

  • 模拟键盘（不可按）
  • 碰撞的唐三
  • 精彩奥运热点赛事的实时采集
  • 获取天气动态信息
  • 文件查找
  • python大数据抓取京东电脑销量数据
  • 爬虫技术不仅仅支持数据采集
  • 抓取脉脉APP上的职业信息
  • 爬虫中多线程的运用
  • 四则运算以及一元二次方程
  • 欢迎来共享你的NB代码

    • 本版新帖

  • 在VFP中模拟动画
  • VF7.0学习网站~~~微软的杀手锏呀--VF7.0
  • 如何在VFP程序中读出本机的IP地址？
  • 标题栏上显示年月日，能不能把它移植到窗体上？
  • 打印问题，请教mgm
  • 如何读取Access数据库（*.MDB）的系统表内容？
  • 急！VFP可以控制EXCEL的文件存盘，但一定要点击确认？能否去掉点击确认！！
  • 为什么老是出现文件在使用？
  • 为什么没有人回答?
  • 在VFP中，如何使用磁卡写卡器
  • 这算不算一个疑难问题？？？高手请进
  • VFP开发数据库软件中的几个小技巧
  • 求教关于encrypt()函数的详细情况!
  • 如何即时滚动显示表记录
  • 急! 快捷菜单在表格中不显示??