例1：在程序开始时设置系统环境
*-- 设置工作目录
cCurrentProcedure = SYS(16,1)
nPathStart = AT("：",cCurrentProcedure) - 1
nLenOfPath = RAT("\", cCurrentProcedure,2) - (nPathStart)
SET DEFAULT TO (SUBSTR(cCurrentProcedure, nPathStart, nLenOfPath))
SET PATH TO PROGS,LIBS,MENUS,HELP,INCLUDE,FORMS,BITMAPS
*-- 修改程序标题并将屏幕放到最大，在编译成.EXE的文件运行时，这是必须的
MODIFY WINDOW SCREEN TITLE "测试" NOCLOSE
ZOOM WINDOW SCREEN MAX
*-- 屏蔽系统菜单
SET SYSMENU OFF
*--定义用于保存系统设置的全局变量
PUBLIC ;
GcOldTalk,;
gcOldPath,;
gcOldDir,;
gcOldClassLib,;
gcOldEscape,;
gcOldSafety,;
gcOldProc,;
gcOldStatus,;
gnOldMemo,;
gcOldMultiLocks,;
gcOldHelp,;
gcOldDeleted,;
gcOldExclusive,;
gcOldNotify,;
gcOldBell,;
gcOldNear,;
gcOldExact,;
gcOldIntensity,;
gcOldConfirm,;
gcOldOnShutDown,;
gcOldCompatible
*--保存原始的系统状态，以便在退出时恢复
GcOldTalk = SET("TALK")
gcOldPath = SET("PATH")
gcOldDir = FULLPATH(CURDIR())
gcOldClassLib = SET("CLASSLIB")
gcOldEscape = SET("ESCAPE")
gcOldSafety = SET('SAFETY')
gcOldProc = SET('PROCEDURE')
gcOldStatus = SET('STATUS BAR')
gnOldMemo = SET('MEMOWIDTH')
gcOldMultiLocks = SET('MULTILOCKS')
gcOldHelp = SET('HELP', 1)
gcOldDeleted = SET('DELETED')
gcOldExclusive = SET('EXCLUSIVE')
gcOldNotify = SET('NOTIFY')
gcOldBell = SET('BELL')
gcOldNear = SET('NEAR')
gcOldExact = SET('EXACT')
gcOldIntensity = SET('INTENSITY')
gcOldConfirm = SET('CONFIRM')
gcOldOnShutDown = ON('SHUTDOWN')
gcOldCompatible = SET("COMPATIBLE")
gcOldDate = SET("DATE")
gcOldCentury = SET("CENTURY")
*-- 设置SET 和ON 命令
SET SAFETY OFF
SET PROCEDURE TO UTILITY.PRG
SET CLASSLIB TO MAIN
SET MEMOWIDTH TO 120
SET MULTILOCKS ON
SET HELP TO HELP\MAIN.CHM
SET DELETED ON
SET EXCLUSIVE OFF
SET NOTIFY OFF
SET BELL OFF
SET NEAR OFF
SET EXACT OFF
SET INTENSITY OFF
SET CONFIRM ON
SET COMPATIBLE OFF
SET DATE ANSI
SET CENTURY ON
SET ESCAPE OFF
ON SHUTDOWN DO OnShutDown
注意：运行上述代码时程序文件UTILITY.PRG，OnShutDown,类库文件MAIN及帮助文件MAIN.CHM必须存在。
例2：在程序结束时恢复系统环境
LOCAL luTemp SET PATH TO (gcOldPath) luTemp = gcOldClassLib SET CLASSLIB TO &luTemp luTemp = gcOldProc SET PROCEDURE TO &luTemp SET MEMOWIDTH TO gnOldMemo luTemp = gcOldMultiLocks SET MULTILOCKS &luTemp luTemp = gcOldSafety SET SAFETY &luTemp luTemp = gcOldStatus SET STATUS BAR &luTemp CD (gcOldDir) luTemp = gcOldDeleted SET DELETED &luTemp luTemp = gcOldExclusive SET EXCLUSIVE &luTemp IF FILE(gcOldHelp) SET HELP TO (gcOldHelp) ENDIF luTemp = gcOldNotify SET NOTIFY &luTemp luTemp = gcOldBell SET BELL &luTemp luTemp = gcOldNear SET NEAR &luTemp luTemp = gcOldExact SET EXACT &luTemp luTemp = gcOldIntensity SET INTENSITY &luTemp luTemp = gcOldConfirm SET CONFIRM &luTemp luTemp = gcOldOnShutdown ON SHUTDOWN &luTemp luTemp = gcOldEscape SET ESCAPE &luTemp luTemp = gcOldCompatible SET COMPATIBLE &luTemp luTemp = gcOldTalk SET TALK &luTemp luTemp = gcOldDate SET DATE &luTemp luTemp = gcOldCentury SET CENTURY &luTemp CLOSE ALL CLEAR DLLS RELEASE ALL EXTENDED CLEAR ALL
例3：程序崩溃时恢复系统环境
在程序设计期间，有时会因程序错误而使系统崩溃。当系统崩溃时，可能会有打开的表没有关闭，数据工作期不能释放，表单在屏幕上不能清除，菜单没有释放等一系列令人心烦的事。当你要手工地恢复系统到初使状态真还要费不少事，但是你可以自己编写一个过程文件来自动完成这些工作。这样，当系统崩溃时，你只需在命令窗口打入 DO XXX 即可。
*：******************************************************************************
*：
*： 过程文件C：\HIGHMIS\HF.PRG
*：
*：******************************************************************************
ON ERROR
SET PROCEDURE TO
POP KEY ALL
SET COLOR TO
SET SYSMENU TO DEFA
CLOSE ALL
RELEAS ALL EXTE
CLEAR DLLS
CLEAR EVENTS
CLEAR FIELDS
CLEAR GETS
CLEAR MACROS
CLEAR MEMORY
CLEAR MENUS
CLEAR POPUPS
CLEAR PROGRAM
CLEAR PROMPT
CLEAR READ ALL
CLEAR TYPEAHEAD
CLEAR WINDOWS
SET DEVICE TO SCREEN
CLEAR
SET EXCL ON
SET TALK ON
SET MESSAGE ON
RELEASE WINDOW 常用
SET HELP TO
SET HELP ON
CANCEL
例4：查看系统设置
*：******************************************************************************
*：
*： 过程文件C：\HIGHMIS\PROGS\SYSTEST.PRG
*：
* 用途：查看当前系统信息
**************************************************************************
PROCEDURE SYSTEST
PARAMETERS T__Method, T__File
RELEASE ALL EXCEPT T__*
PRIVATE ALL LIKE T__*
CREATE VIEW it
SET TALK OFF
CLOSE ALL
SET SAFETY OFF
SET ALTERNATE TO (IIF(EMPTY(T__File), "SysTest.TXT", T__File))
SET ALTERNATE ON
SET SAFETY ON
SET EXACT OFF
T__IsVisual = .T.
T__OutputFile = SET("ALTERNATE", 1)
DEFINE WINDOW T__win FROM 0,0 TO SROWS(),SCOLS() TITLE T__OutputFile CLOSE SYSTEM ZOOM
ACTIVATE WINDOW T__win
??"*** SysTest Version 2.00","日期",DATE(),"时间",TIME(),"***"
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="SET")
WAIT WINDOW NOWAIT "*** SET() ***"
?
? "*** SET() ***"
?PADR("SET(ALTERNATE)",30) + " == ", SET("ALTERNATE")
?PADR("SET(ANSI)",30) + " == ", SET("ANSI")
?PADR("SET(AUTOSAVE)",30) + " == ", SET("AUTOSAVE")
?PADR("SET(BELL)",30) + " == ", SET("BELL")
?PADR("SET(BLINK)",30) + " == ", SET("BLINK")
?PADR("SET(BLOCKSIZE)",30) + " == ", SET("BLOCKSIZE")
?PADR("SET(BRSTATUS)",30) + " == ", SET("BRSTATUS")
?PADR("SET(CARRY)",30) + " == ", SET("CARRY")
?PADR("SET(CENTURY)",30) + " == ", SET("CENTURY")
?PADR("SET(CLASSLIB)",30) + " == ", SET("CLASSLIB")
?PADR("SET(CLEAR)",30) + " == ", SET("CLEAR")
?PADR("SET(CLOCK)",30) + " == ", SET("CLOCK")
?PADR("SET(COLOR)",30) + " == ", SET("COLOR")
?PADR("SET(COMPATIBLE)",30) + " == ", SET("COMPATIBLE")
?PADR("SET(CONFIRM)",30) + " == ", SET("CONFIRM")
?PADR("SET(CONSOLE)",30) + " == ", SET("CONSOLE")
?PADR("SET(CURRENCY)",30) + " == ", SET("CURRENCY")
?PADR("SET(CURSOR)",30) + " == ", SET("CURSOR")
?PADR("SET(DATE)",30) + " == ", SET("DATE")
?PADR("SET(DEBUG)",30) + " == ", SET("DEBUG")
?PADR("SET(DECIMALS)",30) + " == ", SET("DECIMALS")
?PADR("SET(DEFAULT)",30) + " == ", SET("DEFAULT")
?PADR("SET(DELETED)",30) + " == ", SET("DELETED")
?PADR("SET(DELIMITERS)",30) + " == ", SET("DELIMITERS")
?PADR("SET(DEVELOPMENT)",30) + " == ", SET("DEVELOPMENT")
?PADR("SET(DEVICE)",30) + " == ", SET("DEVICE")
?PADR("SET(DISPLAY)",30) + " == ", SET("DISPLAY")
?PADR("SET(DOHISTORY)",30) + " == ", SET("DOHISTORY")
?PADR("SET(ECHO)",30) + " == ", SET("ECHO")
?PADR("SET(ESCAPE)",30) + " == ", SET("ESCAPE")
?PADR("SET(EXACT)",30) + " == ", SET("EXACT")
?PADR("SET(EXCLUSIVE)",30) + " == ", SET("EXCLUSIVE")
?PADR("SET(FIELDS)",30) + " == ", SET("FIELDS")
?PADR("SET(FILTER)",30) + " == ", SET("FILTER")
?PADR("SET(FIXED)",30) + " == ", SET("FIXED")
?PADR("SET(FULLPATH)",30) + " == ", SET("FULLPATH")
?PADR("SET(HEADING)",30) + " == ", SET("HEADING")
?PADR("SET(HELP)",30) + " == ", SET("HELP")
?PADR("SET(HISTORY)",30) + " == ", SET("HISTORY")
?PADR("SET(HOURS)",30) + " == ", SET("HOURS")
?PADR("SET(INTENSITY)",30) + " == ", SET("INTENSITY")
?PADR("SET(KEYCOMP)",30) + " == ", SET("KEYCOMP")
?PADR("SET(LIBRARY)",30) + " == ", SET("LIBRARY")
?PADR("SET(LOCK)",30) + " == ", SET("LOCK")
?PADR("SET(LOGERRORS)",30) + " == ", SET("LOGERRORS")
?PADR("SET(MACKEY)",30) + " == ", SET("MACKEY")
?PADR("SET(MARGIN)",30) + " == ", SET("MARGIN")
?PADR("SET(MARK)",30) + " == ", SET("MARK")
?PADR("SET(MEMOWIDTH)",30) + " == ", SET("MEMOWIDTH")
?PADR("SET(MENU)",30) + " == ", SET("MENU")
?PADR("SET(MESSAGE)",30) + " == ", SET("MESSAGE")
?PADR("SET(MOUSE)",30) + " == ", SET("MOUSE")
?PADR("SET(MULTILOCKS)",30) + " == ", SET("MULTILOCKS")
?PADR("SET(NEAR)",30) + " == ", SET("NEAR")
?PADR("SET(NOTIFY)",30) + " == ", SET("NOTIFY")
?PADR("SET(ODOMETER)",30) + " == ", SET("ODOMETER")
?PADR("SET(OPTIMIZE)",30) + " == ", SET("OPTIMIZE")
?PADR("SET(ORDER)",30) + " == ", SET("ORDER")
?PADR("SET(PALETTE)",30) + " == ", SET("PALETTE")
?PADR("SET(PATH)",30) + " == ", SET("PATH")
?PADR("SET(PDSETUP)",30) + " == ", SET("PDSETUP")
?PADR("SET(POINT)",30) + " == ", SET("POINT")
?PADR("SET(PRINTER)",30) + " == ", SET("PRINTER")
?PADR("SET(PROCEDURE)",30) + " == ", SET("PROCEDURE")
?PADR("SET(REFRESH)",30) + " == ", SET("REFRESH")
?PADR("SET(REPROCESS)",30) + " == ", SET("REPROCESS")
?PADR("SET(RESOURCE)",30) + " == ", SET("RESOURCE")
?PADR("SET(SAFETY)",30) + " == ", SET("SAFETY")
?PADR("SET(SCOREBOARD)",30) + " == ", SET("SCOREBOARD")
?PADR("SET(SEPARATOR)",30) + " == ", SET("SEPARATOR")
?PADR("SET(SHADOWS)",30) + " == ", SET("SHADOWS")
?PADR("SET(SPACE)",30) + " == ", SET("SPACE")
?PADR("SET(STATUS)",30) + " == ", SET("STATUS")
?PADR("SET(STATUS BAR)",30) + " == ", SET("STATUS BAR")
?PADR("SET(STEP)",30) + " == ", SET("STEP")
?PADR("SET(STICKY)",30) + " == ", SET("STICKY")
?PADR("SET(SYSMENU)",30) + " == ", SET("SYSMENU")
?PADR("SET(TALK)",30) + " == ", SET("TALK")
?PADR("SET(TEXTMERGE)",30) + " == ", SET("TEXTMERGE")
?PADR("SET(TOPIC)",30) + " == ", SET("TOPIC")
?PADR("SET(TYPEAHEAD)",30) + " == ", SET("TYPEAHEAD")
?PADR("SET(UDFPARMS)",30) + " == ", SET("UDFPARMS")
?PADR("SET(UNIQUE)",30) + " == ", SET("UNIQUE")
?PADR("SET(ALTERNATE,1)",30) + " == ", SET("ALTERNATE",1)
?PADR("SET(CLOCK,1)",30) + " == ", SET("CLOCK",1)
?PADR("SET(CURRENCY,1)",30) + " == ", SET("CURRENCY",1)
?PADR("SET(DELIMITERS,1)",30) + " == ", SET("DELIMITERS",1)
?PADR("SET(FIELDS,1)",30) + " == ", SET("FIELDS",1)
?PADR("SET(HELP,1)",30) + " == ", SET("HELP",1)
?PADR("SET(MESSAGE,1)",30) + " == ", SET("MESSAGE",1)
?PADR("SET(PRINTER,1)",30) + " == ", SET("PRINTER",1)
?PADR("SET(RESOURCE,1)",30) + " == ", SET("RESOURCE",1)
?PADR("SET(TALK,1)",30) + " == ", SET("TALK",1)
?PADR("SET(TEXTMERGE,1)",30) + " == ", SET("TEXTMERGE",1)
ENDIF
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="ON")
WAIT WINDOW NOWAIT "*** ON() ***"
?
? "*** ON() ***"
?PADR("ON(ERROR)",30) + " == ", ON("ERROR")
?PADR("ON(ESCAPE)",30) + " == ", ON("ESCAPE")
?PADR("ON(KEY)",30) + " == ", ON("KEY")
?PADR("ON(KEY LABEL)",30) + " == ", ON("KEY LABEL")
?PADR("ON(PAGE)",30) + " == ", ON("PAGE")
?PADR("ON(READERROR)",30) + " == ", ON("READERROR")
?PADR("ON(SHUTDOWN)",30) + " == ", ON("SHUTDOWN")
ENDIF
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="MIS")
WAIT WINDOW NOWAIT "其他设置"
?
? "其他设置"
?PADR("CAPSLOCK()",30) + " == ", EVALUATE("CAPSLOCK()")
?PADR("CPCURRENT()",30) + " == ", EVALUATE("CPCURRENT()")
?PADR("CPCURRENT(1)",30) + " == ", EVALUATE("CPCURRENT(1)")
?PADR("CPCURRENT(2)",30) + " == ", EVALUATE("CPCURRENT(2)")
?PADR("DISKSPACE()",30) + " == ", EVALUATE("DISKSPACE()")
?PADR("FULLPATH('')",30) + " == ", EVALUATE("FULLPATH('')")
?PADR("GETENV('COMSPEC')",30) + " == ", EVALUATE("GETENV('COMSPEC')")
?PADR("GETENV('FOXPROCFG')",30) + " == ", EVALUATE("GETENV('FOXPROCFG')")
?PADR("GETENV('FOXPROSWX')",30) + " == ", EVALUATE("GETENV('FOXPROSWX')")
?PADR("GETENV('FOXPROX')",30) + " == ", EVALUATE("GETENV('FOXPROX')")
?PADR("GETENV('PATH')",30) + " == ", EVALUATE("GETENV('PATH')")
?PADR("GETENV('TEMP')",30) + " == ", EVALUATE("GETENV('TEMP')")
?PADR("INSMODE()",30) + " == ", EVALUATE("INSMODE()")
?PADR("ISCOLOR()",30) + " == ", EVALUATE("ISCOLOR()")
?PADR("MEMORY()",30) + " == ", EVALUATE("MEMORY()")
?PADR("NUMLOCK()",30) + " == ", EVALUATE("NUMLOCK()")
?PADR("OS()",30) + " == ", EVALUATE("OS()")
?PADR("OS(1)",30) + " == ", EVALUATE("OS(1)")
?PADR("PRINTSTATUS()",30) + " == ", EVALUATE("PRINTSTATUS()")
?PADR("VERSION(1)",30) + " == ", EVALUATE("VERSION(1)")
?PADR("VERSION(2)",30) + " == ", EVALUATE("VERSION(2)")
?PADR("VERSION(3)",30) + " == ", EVALUATE("VERSION(3)")
ENDIF
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="VAR")
WAIT WINDOW NOWAIT "系统内存变量"
?
? "系统内存变量"
?PADR("_ASCIICOLS",30) + " == ", EVALUATE("_ASCIICOLS")
?PADR("_ASCIIROWS",30) + " == ", EVALUATE("_ASCIIROWS")
?PADR("_BROWSER",30) + " == ", EVALUATE("_BROWSER")
?PADR("_BUILDER",30) + " == ", EVALUATE("_BUILDER")
?PADR("_CONVERTER",30) + " == ", EVALUATE("_CONVERTER")
?PADR("_DBLCLICK",30) + " == ", EVALUATE("_DBLCLICK")
?PADR("_GENGRAPH",30) + " == ", EVALUATE("_GENGRAPH")
?PADR("_GENMENU",30) + " == ", EVALUATE("_GENMENU")
?PADR("_GENPD",30) + " == ", EVALUATE("_GENPD")
?PADR("_GENSCRN",30) + " == ", EVALUATE("_GENSCRN")
?PADR("_GENXTAB",30) + " == ", EVALUATE("_GENXTAB")
?PADR("_PDRIVER",30) + " == ", EVALUATE("_PDRIVER")
?PADR("_PDSETUP",30) + " == ", EVALUATE("_PDSETUP")
?PADR("_SHELL",30) + " == ", EVALUATE("_SHELL")
?PADR("_SPELLCHK",30) + " == ", EVALUATE("_SPELLCHK")
?PADR("_STARTUP",30) + " == ", EVALUATE("_STARTUP")
?PADR("_TRANSPORT",30) + " == ", EVALUATE("_TRANSPORT")
?PADR("_WIZARD",30) + " == ", EVALUATE("_WIZARD")
ENDIF
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="FONT")
WAIT WINDOW NOWAIT "可用字体"
?
? "可用字体"
=AFONT(T__fonts)
FOR T__i = 1 TO ALEN(T__fonts)
T__string = T__fonts[m.T__i] + "： "
IF AFONT(T__sizes, T__fonts[m.T__i])
FOR T__j = 1 TO ALEN(T__sizes)
T__string = m.T__string+IIF(m.T__j==1, "", ", ")+;
IIF(T__sizes[m.T__j]==-1,"scalable", LTRIM(STR(T__sizes[m.T__j])))
ENDFOR
ENDIF
? m.T__string
ENDFOR
RELEASE T__i, T__j, T__fonts, T__sizes, T__string
ENDIF
T__IsError = .F.
IF (EMPTY(m.T__Method) OR UPPER(m.T__Method)="CONFIG")
FOR T__i = 1 TO 3
DO CASE
CASE m.T__i==1
T__File = SYS(2019)
IF EMPTY(m.T__File)
T__File = SYS(2004)+"CONFIG.FPW"
ENDIF
CASE m.T__i==2
T__File = "C：\CONFIG.SYS"
CASE m.T__i==3
T__File = "C：\AUTOEXEC.BAT"
ENDCASE
WAIT WINDOW NOWAIT "配置文件"
?
DO CASE
CASE m.T__i==1
T__File = SYS(2019)
IF EMPTY(m.T__File)
T__File = SYS(2004)+"CONFIG.FPW"
? "*** " + "配置文件" + SYS(2004) + " CONFIG.FPW ***"
ELSE
? "*** " + "配置文件" + SYS(2019) + " CONFIG.FPW ***"
ENDIF
CASE m.T__i==2
T__File = "C：\CONFIG.SYS"
? "*** " + "配置文件" + "C：\CONFIG.SYS ***"
CASE m.T__i==3
T__File = "C：\AUTOEXEC.BAT"
? "*** " + "配置文件" + "C：\AUTOEXEC.BAT ***"
ENDCASE
IF FILE(m.T__File)
T__handle = FOPEN(m.T__File)
IF m.T__handle>-1
DO WHILE NOT FEOF(m.T__handle)
? FGETS(m.T__handle)
ENDDO
=FCLOSE(m.T__handle)
ELSE
? "不能打开文件."
ENDIF
ELSE
? "不能找到文件."
ENDIF
ENDFOR
RELEASE T__File, T__handle, T__i
ENDIF
SET CONSOLE OFF
? "完成"
SET CONSOLE ON
CLOSE ALL
T__handle = FOPEN(T__OutputFile, 2)
IF NOT m.T__handle==-1
=FSEEK(m.T__handle, -1, 2)
IF FREAD(m.T__handle,1)==CHR(26)
=FCHSIZE(m.T__handle, FSEEK(m.T__handle, -1, 2))
ENDIF
=FCLOSE(m.T__handle)
ENDIF
ACTIVATE SCREEN
SET TALK OFF
SET MESSAGE TO "检查完成,结果已写至" + T__OutputFile
WAIT CLEAR
ZOOM WINDOW T__win MAX
MODIFY COMMAND (T__OutputFile) NOEDIT WINDOW T__win NOMENU
RELEASE WINDOW T__win
SET VIEW TO it.vue
DELETE FILE it.vue
SET MESSAGE TO " "
RETURN
|