发信人: yuce()
整理人: hunter__fox(2002-03-16 22:01:29), 站内信件
|
VFP数据库、表、索引等灾难一键恢复
VFP应用系统在使用时，由于用户非正常退出、特别是程序对多用户状态下封锁机
制运用不当、系统运行掉电造成：索引破坏、数据库(.DBC)与实际表索引不匹配
、数据库(.DBC)中记录的字段与实际表不一致等情况出现，虽不是经常性的问题
，一旦出现可能非要专业人员”出马”才能搞定！当然最常用的方法是经常备份
系统(包括.DBC,.DBF,.CDX等)，但在某些时点上可能备份也不顶用了。
曾见网友遭此劫难求救于网易VFP论坛上。当时本人已在解决此事，因无完整预案
只得安慰网友：某日解决定相告吾友。随后日子工作繁忙，断断续续搞了近一个
月，方法已近成型，只是不够通用扔在硬盘里。某日无意发现自已硬盘的VFP6.0
系统中躺着一个叫GENDBC文件夹，打开GENDBC.PRG程序一个。会不会…？！哇噻
！ 我的想法MS的VFP高手竟已写出完整的程序！不知为什么MS就是不说，正版手
册也无从查阅！再也能不犹疑了，仔细阅读，加入自己思路。一个较完整灾难恢
复方法偷“出笼”来。
GENDBC的思路是这样的：将一个已存在的.DBC(内含.DBF,.CDX及各种视图，远程
连接，存贮过程，表间联接关系)转换成一个.DBC的重建程序(ie:databk.prg)。
当系统有问题时：运行databk.prg，自动重建上述数据库及空表。本人在已将此
程序改成了将已有的数据再导入重建的空表中从而完成灾难恢复。此程序已在我
的VFP应用系统中成功应用。我的VFP应用系统中数据库中几乎包括了所有可能的
本远地视图，远程与AS400的连接，触发器，RI关联等。源程序附上，请各位VFP
的看官，挑挑错、强化程序，如谁完成了.FPT文件的通用程序自动恢复，请一定
告之。
My email: [email protected] 中信实业银行嘉兴支行 於策
**********************************************************************
****
** Program Name : GENDBC.PRG此程序来自VFP6.0的示例程序，并修改为带路径
生成
** 数据库及表，索引文件 於策改于 1999.7.8
** Creation Date: 94.12.01
**
** 用途 : 将一已存在的VFP3.0--VFP6.0数据库及其包含的所有内容变换成一可
输出
** 的程序(可重建库数据库程序re_build_database),该程序可再现该
数据库
** 及表,视图,连接,存贮过程等。起数据库备份及恢复如" 索引与数据
库不匹
** 配"等索引文件破坏错误。
** 参数 : cOutFile : 一个输入文件名(可包含路径扩展表，如省略为 .prg
)
** lskipdisplay: 一个表示是否显示工作进度的逻辑变量
**
**********************************************************************
****
LPARAMETERS cOutFile,lskipdisplay
PRIVATE ALL EXCEPT g_*
*! Public Variables
m.g_cSafety = SET("SAFETY")
set safety off
IF SET("TALK") = "ON" && To restore SET TALK after use
SET TALK OFF && -- Have to do it this way so
m.g_cSetTalk = "ON" && -- nothing get's on screen
ELSE
m.g_cSetTalk = "OFF"
ENDIF
m.g_lskipdisplay = IIF(vartype(lskipdisplay)#"L",.F.,lskipdisplay)
m.g_cFullPath = SET("FULLPATH") && To restore old FULLPATH setting
m.g_cOnError = ON("ERROR") && To restore old ON ERROR condition
m.g_cSetDeleted = SET("DELETED") && To restore SET DELETED later
m.g_cSetStatusBar = SET("STATUS BAR") && To restore STATUS bar
m.g_cStatusText = SYS(2001, "MESSAGE", 1) && To restore text that may
be on it
m.g_nMax = 7 && 为状态栏准备的最大信息数
m.g_nCurrentStat = 1 && 为状态栏准备的当前信息数
m.g_cFilterExp = "" && For Non-Supported Filte
r Info
DIMENSION g_aProcs[1]
SET DELETED ON
SET FULLPATH ON
IF m.g_cSetStatusBar = "OFF"
SET STATUS BAR ON
ENDIF
*! 错误处理例程
ON ERROR DO GenDBC_Error WITH MESSAGE(), LINENO()
**********************************************************************
****
** Constants
**********************************************************************
****
#DEFINE CRLF CHR(13) + CHR(10)
#DEFINE DBCS_LOC "81 82 86 88"
**********************************************************************
****
** Error Messages
**********************************************************************
****
#DEFINE NO_DATABASE_IN_USE_LOC "没有打开任何数据库。本程序运行时必须要
有一个数据库可用。"
#DEFINE INVALID_PARAMETERS_LOC "无效参数..." + CRLF +"应该指定一个输出
文件" + CRLF +'ie: DO GENDBC WITH "filename.prg"'
#DEFINE INVALID_DESTINATION_LOC "无效的目标文件"
#DEFINE NO_TEMP_FILE_LOC "不能创建临时文件: "
#DEFINE NO_OUTPUT_WRITTEN_LOC "不能创建输出文件或不能向输出文件写内容
"
#DEFINE ERROR_TITLE_LOC "放弃 GenDBC..."
#DEFINE UNRECOVERABLE_LOC "不可恢复的错误："
#DEFINE AT_LINE_LOC " 行: "
#DEFINE NO_FIND_LOC "不能设置 RI 信息。"
#DEFINE NO_FILE_FOUND_LOC "警告！找不到过程文件！"
#DEFINE GETFILE_GEN_LOC "生成..."
#DEFINE NOT_SUPPORTED_LOC "主索引上的筛选器现在不起作用。" +"注释将被
加入到输出文件中以指明这些筛选器。"
#DEFINE NS_COMMENT_LOC "****** 这些筛选器必须人工添加 ******"
#DEFINE WARNING_TITLE_LOC "GenDBC 警告..."
**********************************************************************
****
** Comments And Other Information
**********************************************************************
****
#DEFINE MESSAGE_START_LOC "正在创建数据库..."
#DEFINE MESSAGE_DONE_LOC "已完成。"
#DEFINE MESSAGE_MAKETABLE_LOC "正在创建表 "
#DEFINE MESSAGE_MAKEVIEW_LOC "正在创建视图 "
#DEFINE MESSAGE_MAKECONN_LOC "正在创建连接 "
#DEFINE MESSAGE_MAKERELATION_LOC "正在创建永久关系..."
#DEFINE MESSAGE_MAKERI_LOC "正在创建关系完整性规则..."
#DEFINE MESSAGE_END_LOC "..."
#DEFINE BEGIN_RELATION_LOC "*************** 开始关系设置 ************
**"
#DEFINE BEGIN_TABLE_LOC "建立表为"
#DEFINE BEGIN_INDEX_LOC "创建每一索引为 "
#DEFINE BEGIN_PROP_LOC "改变属性为 "
#DEFINE BEGIN_VIEW_LOC "建立视图为"
#DEFINE BEGIN_PROC_LOC "重新创建过程"
#DEFINE BEGIN_CONNECTIONS_LOC "连接定义"
#DEFINE BEGIN_RI_LOC "建立参照完整性"
#DEFINE OPEN_DATABASE_LOC "选择数据库..."
#DEFINE SAVE_PRG_NAME_LOC "输出程序名..."
#DEFINE NO_MODIFY_LOC "*** 警告 *** 请不要对此文件做任何修改 *** 警告
***"
#DEFINE TABLE_NAME_LOC "* 表名: "
#DEFINE PRIMARY_KEY_LOC "* 主关键字: "
#DEFINE FILTER_EXP_LOC "* 筛选表达式: "
#DEFINE HEADING_1_LOC "* *********************************************
************" + CRLF +"* *" + CRLF
#DEFINE HEADING_2_LOC "* *" + CRLF +"* *******************************
**************************" + CRLF + "* *" + CRLF + "* * 说明
:" + CRLF + "* * 此程序是 GENDBC 自动生成的" + CRLF + "* * Version 2
.26.67" + CRLF + "* *" + CRLF + "* *************************
********************************" + CRLF
*! 确定必有一个数据库打开
IF EMPTY(DBC())
m.g_cFullDatabase = GETFILE("DBC", OPEN_DATABASE_LOC, GETFILE_GEN_LOC
, 0)
IF EMPTY(m.g_cFullDatabase)
FatalAlert(NO_DATABASE_IN_USE_LOC, .F.)
ENDIF
OPEN DATABASE (m.g_cFullDatabase)
ENDIF
*! 数据库名称的全路径 (全局变量)
m.g_cFullDatabase = DBC()
*! 全局变量来存放数据库名称（不含路径）
IF RAT("\", m.g_cFullDatabase) > 0
m.g_cDatabase = SUBSTR(m.g_cFullDatabase, RAT("\", m.g_cFullDatabase)
+ 1)
ENDIF
*! 检测参数合法性
IF PARAMETERS() < 1 OR TYPE("cOutFile")#"C" OR EMPTY(cOutFile)
m.cOutFile = ""
m.cOutFile = PUTFILE(SAVE_PRG_NAME_LOC, (SUBSTR(m.g_cDatabase, 1, RAT
(".", m.g_cDatabase)) + "PRG"), "PRG")
IF EMPTY(cOutFile)
FatalAlert(INVALID_PARAMETERS_LOC, .F.)
ENDIF
ENDIF
*! 检测合适的扩展名或加一个.PRG扩展名
IF RAT(".PRG", m.cOutFile) = 0 AND RAT(".", m.cOutFile) = 0
m.cOutFile = m.cOutFile + ".PRG"
ENDIF
*! 确定能够创建输出文件
m.hFile = FCREATE(m.cOutFile)
IF m.hFile <= 0
FatalAlert(INVALID_DESTINATION_LOC + m.cOutFile, .F.)
ENDIF
FCLOSE(m.hFile)
ERASE (m.cOutFile)
*!记录所有属于该数据库容器内的表的数量，及表名及其表的大小
*!Aused(array,workalia)返回指定工作中的表名称信息存入array数组中
m.g_nTotal_Tables_Used = AUSED(g_aAlias_Used)
IF m.g_nTotal_Tables_Used > 0
DIMENSION m.g_aTables_Used(m.g_nTotal_Tables_Used)
*! 记录打开表的真实名称
FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
g_aTables_Used(m.nLoop) = DBF(g_aAlias_Used(m.nLoop, 1))
ENDFOR
ENDIF
*! 得到数据库中包含的表的数量，表信息存入aAll_Tables数组中
*! ADBOBJETCS（array,'Table'）,array(1)..array(n)中是表的名称如 'emplo
ye'
m.nTotal_Tables = ADBOBJECTS(aAll_Tables, "Table")
m.g_nMax = m.g_nMax + m.nTotal_Tables
Stat_Message() && 状态行信息显示
*! 得到数据库中包含的视图数量
m.nTotal_Views = ADBOBJECTS(aAll_Views, "View")
m.g_nMax = m.g_nMax + m.nTotal_Views
Stat_Message() && 状态行信息显示
*! 得到数据库中包含的连接数量
m.nTotal_Connections = ADBOBJECTS(aAll_Connections, "Connection")
m.g_nMax = m.g_nMax + m.nTotal_Connections
Stat_Message() && 状态行信息显示
*! 得到数据库中包含的关联数量
m.nTotal_Relations = ADBOBJECTS(aAll_Relations, "Relation")
m.g_nMax = m.g_nMax + m.nTotal_Relations
Stat_Message() && 状态行信息显示
CLOSE DATABASE
SELECT 0
IF FILE("GENDBC.DBF")
ERASE "GENDBC.DBF"
ERASE "GENDBC.FPT"
ENDIF
CREATE TABLE GenDBC (Program M)
&& 创建一个文件GENDBC内有MEMO字段PROGRAM，生成自动程序用
APPEND BLANK
USE
**************************
*** 得到贮存过程
**************************
*! 建立一个输出文件m.cFile 存放贮存过程.
m.cFile = UPPER(SUBSTR(m.cOutFile, 1, RAT(".", m.cOutFile))) + "krt"
*! 把头文件信息写入.KRT存贮在过程文件开头
m.hFile = FCREATE(m.cFile)
IF m.hFile <= 0
FCLOSE(m.hFile)
FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
ENDIF
FPUTS(m.hFile, NO_MODIFY_LOC)
** 写入' *** 警告 *** 请不要对此文件做任何修改 *** 警告 ***'
FCLOSE(m.hFile)
*! No we are going to copy the object and source code
*! For the stored procedures把过程文件存入*.KRT文件中
COMPILE DATABASE (m.g_cFullDatabase)
USE (m.g_cFullDatabase)
LOCATE FOR Objectname = 'StoredProceduresSource'
IF FOUND()
COPY MEMO Code TO (m.cFile) ADDITIVE
ENDIF
ADIR(aTemp, m.cFile) && 取得过程贮存文件的大小为主要目的！
m.nSourceSize = aTemp(1, 2) - LEN(NO_MODIFY_LOC) && aTemp(1,2)内有文件
大小
LOCATE FOR Objectname = 'StoredProceduresObject'
IF FOUND()
COPY MEMO Code TO (m.cFile) ADDITIVE
ENDIF
USE
*! 独占打开数据库
OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
ADIR(aTemp, m.cFile)
*! 检测过程存贮文件是否真的有内容，如果有就生成相应的贮存过程的恢复代码
IF aTemp(1, 2) > LEN(NO_MODIFY_LOC) + 2
*********************
*** 重新创建过程
*********************
m.hOutFile = FCREATE("GenDBC.$$$")
IF m.hOutFile <= 0
= FCLOSE(m.hFile)
= FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
ENDIF
WriteFile(m.hOutFile, "")
WriteFile(m.hOutFile, "********* " + BEGIN_PROC_LOC + " *********")
WriteFile(m.hOutFile, "IF !FILE([" + SUBSTR(m.cFile, RAT("\", m.cFile
) + 1) + "])")
WriteFile(m.hOutFile, " ? [" + NO_FILE_FOUND_LOC + "]")
WriteFile(m.hOutFile, "ELSE")
WriteFile(m.hOutFile, " CLOSE DATABASE")
WriteFile(m.hOutFile, " USE '" + m.g_cFullDatabase + "'") && 改成
全路径
WriteFile(m.hOutFile, " g_SetSafety = SET('SAFETY')")
WriteFile(m.hOutFile, " SET SAFETY OFF")
WriteFile(m.hOutFile, " LOCATE FOR Objectname = 'StoredProceduresSour
ce'")
WriteFile(m.hOutFile, " IF FOUND()")
WriteFile(m.hOutFile, " APPEND MEMO Code FROM [" + SUBSTR(m.cFi
le, RAT("\", m.cFile) + 1) + "] OVERWRITE")
WriteFile(m.hOutFile, " REPLACE Code WITH SUBSTR(Code, " + ALLTRIM
(STR(LEN(NO_MODIFY_LOC) + 3)) + ", " + ALLTRIM(STR(m.nSourceSize - 2))
+ ")")
WriteFile(m.hOutFile, " ENDIF")
WriteFile(m.hOutFile, " LOCATE FOR Objectname = 'StoredProceduresObje
ct'")
WriteFile(m.hOutFile, " IF FOUND()")
WriteFile(m.hOutFile, " APPEND MEMO Code FROM [" + SUBSTR(m.cFi
le, RAT("\", m.cFile) + 1) + "] OVERWRITE")
WriteFile(m.hOutFile, " REPLACE Code WITH SUBSTR(Code, " + ALLTRIM
(STR(LEN(NO_MODIFY_LOC) + m.nSourceSize + 1)) + ")")
WriteFile(m.hOutFile, " ENDIF")
WriteFile(m.hOutFile, " SET SAFETY &g_SetSafety")
WriteFile(m.hOutFile, " USE")
WriteFile(m.hOutFile, " OPEN DATABASE [" + m.g_cFullDatabase + "]")
&& 改成全路径
WriteFile(m.hOutFile, "ENDIF")
WriteFile(m.hOutFile, "")
FCLOSE(m.hOutFile)
********* 重新创建过程 的代码生成（写在文件 GENDBC.$$$中）完成*******
**
USE GenDBC EXCLUSIVE && 追加到GENDBC.DBF的MEMO字段中(GENDBC.FPT文件
内)
APPEND MEMO Program FROM "GENDBC.$$$"
ERASE "GENDBC.$$$"
USE
ELSE
ERASE (m.cFile)
ENDIF
Stat_Message()
* Write out database creation routines
* UpdateProcArray("ON ERROR DO error1562")
UpdateProcArray("DisplayStatus(["+MESSAGE_START_LOC+"])")
UpdateProcArray("CLOSE DATA ALL")
UpdateProcArray("CREATE DATABASE '" + m.g_cFullDatabase + "'")
**************************
*** Get Tables
**************************
IF m.nTotal_Tables > 0
FOR m.nLoop = 1 TO m.nTotal_Tables
DO GetTable WITH ALLTRIM(aAll_Tables(m.nLoop)), "GenDBC.tmp"
Stat_Message()
USE GenDBC EXCLUSIVE
APPEND MEMO Program FROM "GenDBC.tmp"
USE
ERASE "GenDBC.tmp"
UpdateProcArray("DisplayStatus(["+MESSAGE_MAKETABLE_LOC+aAll_Tables(
m.nLoop)+MESSAGE_END_LOC+"])")
UpdateProcArray("MakeTable_"+FixName(aAll_Tables(m.nLoop))+"()")
ENDFOR
ENDIF
**************************
*** Get Connections
**************************
IF m.nTotal_Connections > 0
FOR m.nLoop = 1 TO m.nTotal_Connections
DO GetConn WITH aAll_Connections(m.nLoop), "GenDBC.tmp"
Stat_Message()
USE GenDBC EXCLUSIVE
APPEND MEMO Program FROM "GenDBC.tmp"
USE
ERASE "GenDBC.tmp"
UpdateProcArray("DisplayStatus(["+MESSAGE_MAKECONN_LOC+aAll_Connecti
ons(m.nLoop)+MESSAGE_END_LOC+"])")
UpdateProcArray("MakeConn_"+FIXNAME(aAll_Connections(m.nLoop))+"()")
ENDFOR
ENDIF
**************************
*** Get Views
**************************
IF m.nTotal_Views > 0
FOR m.nLoop = 1 TO m.nTotal_Views
DO GetView WITH ALLTRIM(aAll_Views(m.nLoop)), "GenDBC.tmp"
Stat_Message()
USE GenDBC EXCLUSIVE
APPEND MEMO Program FROM "GenDBC.tmp"
USE
ERASE "GenDBC.tmp"
UpdateProcArray("DisplayStatus(["+MESSAGE_MAKEVIEW_LOC+aAll_Views(m.
nLoop)+MESSAGE_END_LOC+"])")
UpdateProcArray("MakeView_"+FIXNAME(aAll_Views(m.nLoop))+"()")
ENDFOR
ENDIF
**************************
*** Get Relations
**************************
IF m.nTotal_Relations > 0
USE GenDBC EXCLUSIVE
REPLACE Program WITH BEGIN_RELATION_LOC + CRLF ADDITIVE
UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERELATION_LOC+"])")
FOR m.nLoop = 1 TO m.nTotal_Relations
REPLACE Program WITH CRLF + "FUNCTION MakeRelation_"+TRANS(m.nLoop)+
CRLF+;
"ALTER TABLE '" + aAll_Relations(m.nLoop, 1) +;
"' ADD FOREIGN KEY TAG " +;
aAll_Relations(m.nLoop, 3) +;
" REFERENCES " + ;
aAll_Relations(m.nLoop, 2) +;
" TAG " + aAll_Relations(m.nLoop, 4) + ;
CRLF +"ENDFUNC"+CRLF+CRLF ADDITIVE
UpdateProcArray("MakeRelation_"+TRANS(m.nLoop)+"()")
Stat_Message()
ENDFOR
ENDIF
CLOSE DATABASE && Because we're going to start peeking into the
&& table structure of the DBC
**************************
*** Get RI Info
**************************
IF m.nTotal_Relations > 0
DO GetRI WITH "GenDBC.tmp"
IF FILE("GenDBC.tmp")
USE GenDBC EXCLUSIVE
APPEND MEMO Program FROM "GenDBC.tmp"
USE
ERASE "GenDBC.tmp"
UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERI_LOC+"])")
UpdateProcArray("MakeRI()")
ENDIF
ENDIF
UpdateProcArray("DisplayStatus(["+MESSAGE_DONE_LOC+"])")
Stat_Message()
*! Make it a permanent file
USE GenDBC EXCLUSIVE
lcprocstr = ""
FOR i = 1 TO ALEN(g_aprocs)
lcprocstr = lcprocstr + g_aprocs[m.i] + CRLF
ENDFOR
lcMessageStr = "FUNCTION DisplayStatus(lcMessage)"+CRLF+;
"WAIT WINDOW NOWAIT lcMessage"+CRLF+;
"ENDFUNC"
REPLACE Program WITH HEADING_1_LOC + "* * " + DTOC(DATE()) +;
SPACE(19 - LEN(m.g_cDatabase) / 2) + ;
m.g_cDatabase + SPACE(19 - LEN(m.g_cDatabase) / 2) +;
TIME() + CRLF + HEADING_2_LOC + CRLF + ;
IIF(!EMPTY(m.g_cFilterExp), NS_COMMENT_LOC + m.g_cFilterExp + ;
CRLF + REPLICATE("*", 52) + CRLF, "") + ;
CRLF + lcprocstr + CRLF + Program +;
CRLF + lcMessageStr
COPY MEMO Program TO (m.cOutFile)
USE
ERASE "GenDBC.DBF"
ERASE "GenDBC.FPT"
Stat_Message()
*! Exit Program
COMPILE (m.cOutFile) && 能不生成.EXE文件？
GenDBC_CleanUp(.T.)
*********************** END OF PROGRAM ***********************
**********************************************************************
****
**
** Function Name: GETRI(<ExpC>)
** Purpose: To take existing FoxPro 3.0/5.0 RI Infomration, and genera
te an output
** program that can be used to "re-create" this.
**
** Parameters:
**
** cOutFileName - A character string containing the name of the
** output file
**
** Modification History:
**********************************************************************
****
PROCEDURE GetRI
LPARAMETERS m.cOutFileName
PRIVATE ALL EXCEPT g_*
*! Create the output file
m.hGTFile = FCREATE(m.cOutFileName)
IF m.hGTFile < 1
FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
ENDIF
*! USE the database
USE (m.g_cFullDatabase) EXCLUSIVE
LOCATE FOR ObjectType = "Relation" AND !EMPTY(RiInfo)
IF FOUND()
WriteFile(m.hGTFile, "FUNCTION MakeRI")
WriteFile(m.hGTFile, "***** " + BEGIN_RI_LOC + " *****")
WriteFile(m.hGTFile, "CLOSE DATABASE")
WriteFile(m.hGTFile, "USE '" + m.g_cDatabase + "'")
DO WHILE FOUND()
*! Have to get the parent name to verify we are adding
*! Information to the right record.
m.nParentID = ParentID
*! We use select so we won't mess up our LOCATE ... CONTINUE comman
d
SELECT ObjectName FROM (m.g_cFullDatabase) WHERE ObjectID = nParent
ID INTO ARRAY aTableName
m.nStart = 1
m.cITag = ""
m.cTable = ""
m.cRTag = ""
DO WHILE m.nStart <= LEN(Property)
nSize = ASC(SUBSTR(Property, m.nStart, 1)) +;
(ASC(SUBSTR(Property, m.nStart + 1, 1)) * 256) +;
(ASC(SUBSTR(Property, m.nStart + 2, 1)) * 256^2) + ;
(ASC(SUBSTR(Property, m.nStart + 3, 1)) * 256^3)
m.nKey = ASC(SUBSTR(Property, m.nStart + 6, 1))
DO CASE
CASE m.nKey = 13
m.cITag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
CASE m.nKey = 18
m.cTable = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
CASE m.nKey = 19
m.cRTag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
ENDCASE
m.nStart = m.nStart + m.nSize
ENDDO
WriteFile(m.hGTFile, "LOCATE FOR ObjectType = 'Table' AND ObjectNam
e = '" + ;
ALLTRIM(aTableName(1)) + "'")
WriteFile(m.hGTFile, "IF FOUND()")
WriteFile(m.hGTFile, " nObjectID = ObjectID")
WriteFile(m.hGTFile, " LOCATE FOR ObjectType = 'Relation' AND '"
+ m.cITag + ;
"'$Property AND '" + m.cTable + "'$Property AND '" + m.cRTag + ;
"'$Property AND ParentID = nObjectID")
WriteFile(m.hGTFile, " IF FOUND()")
WriteFile(m.hGTFile, " REPLACE RiInfo WITH '" + RiInfo + "'")
WriteFile(m.hGTFile, " ELSE")
WriteFile(m.hGTFile, ' ? "' + NO_FIND_LOC + '"')
WriteFile(m.hGTFile, " ENDIF")
WriteFile(m.hGTFile, "ENDIF")
CONTINUE
ENDDO
WriteFile(m.hGTFile, "USE")
WriteFile(m.hGTFile, "ENDFUNC")
WriteFile(m.hGTFile, "")
FCLOSE(m.hGTFile)
ELSE
FCLOSE(m.hGTFile)
ERASE (m.cOutFileName)
ENDIF
USE
RETURN
**********************************************************************
****
**
** Function Name: GETTABLE(<ExpC>, <ExpC>)
** Purpose : To take an existing FoxPro 6.0 Table, and generate an
output
** program that can be used to "re-create" that Table.
**
** Parameters:
** cTableName - A character string representing the name of th
e
** existing Table
** cOutFileName - A character string containing the name of the
** output file
**********************************************************************
****
PROCEDURE GetTable
LPARAMETERS m.cTableName, m.cOutFileName
PRIVATE ALL EXCEPT g_*
*! Create the output file
m.hGTFile = FCREATE(m.cOutFileName)
IF m.hGTFile < 1
FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
ENDIF
*! Open Table to get field info
USE (m.cTableName) EXCLUSIVE
*! NOTE * NOTE * NOTE
*! If the table is greater than 8 characters then it will fail on pla
tforms that
*! do not support this (Such as Win32s).
m.cOldSetFullPath = SET("FULLPATH")
m.cFullTableFileName = DBF(ALIAS())
SET FULLPATH OFF
m.cTableFileName = DBF(ALIAS())
SET FULLPATH &cOldSetFullPath
*! Get all the fields
m.nNumberOfFields = AFIELDS(aAll_Fields)
*! 判断有没有MEMO或GENERAL字段
m.m_g=.F. && MEMO或General字段没有=.F.
for m.nInner_Loop= 1 to m.nNumberOfFields
if aAll_Fields(m.nInner_Loop, 2) == "M" OR ;
aAll_Fields(m.nInner_Loop, 2) == "G"
m.m_g=.T.
exit
endif
endfor
*! Header Information
WriteFile(m.hGTFile, "FUNCTION MakeTable_"+FIXNAME(m.cTableName))
WriteFile(m.hGTFile, "**" + BEGIN_TABLE_LOC + m.cTableName + " -将变为
自由表的表备份一份by YC 1999.8.1**")
if m.m_g
writeFile(m.hGTFile,"IF FILE("+"'"+m.cFullTableFileName+"') and
;")
writeFile(m.hGTFile," FILE('"+left(m.cFullTableFileName,RAT('.
',m.cFullTableFileName))+"FPT')")
writeFile(m.hGTFile," COPY FILE "+m.cFullTableFileName+" TO .\
tmpdbf.dbf")
writeFile(m.hGTFile," COPY FILE "+left(m.cFullTableFileName,RA
T('.',m.cFullTableFileName));
+"FPT TO .\tmpdbf.fpt")
else
writeFile(m.hGTFile,"IF FILE("+"'"+m.cFullTableFileName+"')" )
writeFile(m.hGTFile," COPY FILE "+m.cFullTableFileName+" TO .\
tmpdbf.dbf")
endif
writeFile(m.hGTFile, "ENDIF ")
writeFile(m.hGTFile,"** Added by YUCE 1999.8.1 Restore the old dat
as **")
m.cTableFileName = SUBSTR(m.cTableFileName, RAT(":", m.cTableFileName
) + 1)
m.cCreateTable = "CREATE TABLE '" + m.cFullTableFileName + "' NAME '"
+ m.cTableName + "' ("
*! Information about each field that can been written with CREATE TAB
LE - SQL
FOR m.nInner_Loop = 1 TO m.nNumberOfFields
IF m.nInner_Loop = 1
m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 1) + "
"
ELSE
m.cCreateTable = SPACE(LEN(m.cTableName) + 15) + ;
aAll_Fields(m.nInner_Loop, 1) + " "
ENDIF
m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 2)
DO CASE
CASE aAll_Fields(m.nInner_Loop, 2) == "C"
m.cCreateTable = m.cCreateTable + "(" + ;
ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ")"
IF aAll_Fields(m.nInner_Loop, 6)
m.cCreateTable = m.cCreateTable + " NOCPTRANS"
ENDIF
CASE aAll_Fields(m.nInner_Loop, 2) == "M"
IF aAll_Fields(m.nInner_Loop, 6)
m.cCreateTable = m.cCreateTable + " NOCPTRANS"
ENDIF
CASE aAll_Fields(m.nInner_Loop, 2) == "N" OR ;
aAll_Fields(m.nInner_Loop, 2) == "F"
cCreateTable = m.cCreateTable + "(" + ;
ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ;
", " + ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) + ")"
CASE aAll_Fields(m.nInner_Loop, 2) == "B"
m.cCreateTable = m.cCreateTable + "(" + ;
ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) ;
+ ")"
ENDCASE
IF aAll_Fields(m.nInner_Loop, 5)
m.cCreateTable = m.cCreateTable + " NULL"
ELSE
m.cCreateTable = m.cCreateTable + " NOT NULL"
ENDIF
*! Get properties for fields
IF !EMPTY(aAll_Fields(m.nInner_Loop, 7))
m.cCreateTable = m.cCreateTable + " CHECK " + aAll_Fields(m.nInner_
Loop, 7)
ENDIF
IF !EMPTY(aAll_Fields(m.nInner_Loop, 8))
m.cCreateTable = m.cCreateTable + " ERROR " + aAll_Fields(m.nInner_
Loop, 8)
ENDIF
IF !EMPTY(aAll_Fields(m.nInner_Loop, 9))
m.cCreateTable = m.cCreateTable + " DEFAULT " + aAll_Fields(m.nInne
r_Loop, 9)
ENDIF
IF m.nInner_Loop <> m.nNumberOfFields
m.cCreateTable = m.cCreateTable + ", ;"
ELSE
m.cCreateTable = m.cCreateTable + ")"
ENDIF
WriteFile(m.hGTFile, m.cCreateTable)
ENDFOR
writeFile(m.hGTFile,"***** 原数据追加到新创建的表中 added by YUCE
****")
writeFile(m.hGTFile,"IF FILE('.\tmpdbf.dbf')")
writeFile(m.hGTFile," APPE FROM .\tmpdbf " )
writeFile(m.hGTFile," ERASE .\tmpdbf.* ")
writeFile(m.hGTFile,"ENDIF")
*! Get Index Information
WriteFile(m.hGTFile, CRLF + "***** " + BEGIN_INDEX_LOC + m.cTableName
+ " *****")
m.cCollate = ""
FOR m.nInner_Loop = 1 TO TAGCOUNT()
m.cTag = UPPER(ALLTRIM(TAG(m.nInner_Loop)))
IF m.cCollate <> IDXCOLLATE(m.nInner_Loop)
m.cCollate = IDXCOLLATE(m.nInner_Loop)
WriteFile(m.hGTFile, "SET COLLATE TO '" + m.cCollate + "'")
ENDIF
IF !EMPTY(m.cTag)
DO CASE
CASE PRIMARY(m.nInner_Loop)
IF !EMPTY(SYS(2021, m.nInner_Loop))
IF EMPTY(m.g_cFilterExp)
MessageBox(NOT_SUPPORTED_LOC, 64, WARNING_TITLE_LOC)
ENDIF
m.g_cFilterExp = m.g_cFilterExp + CRLF + ;
TABLE_NAME_LOC + m.cTableName + CRLF + ;
PRIMARY_KEY_LOC + SYS(14, m.nInner_Loop) +
CRLF + ;
FILTER_EXP_LOC + SYS(2021, m.nInner_Loop)
ENDIF
WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableNa
me + ;
"' ADD PRIMARY KEY " + SYS(14, m.nIn
ner_Loop) ;
+ " TAG " + m.cTag)
CASE CANDIDATE(m.nInner_Loop)
IF EMPTY(SYS(2021, m.nInner_Loop))
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
" TAG " + m.cTag + " CANDIDATE")
ELSE
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) +
;
" TAG " + m.cTag + " FOR " + SYS(2021, m.nInner_Loop) +
;
+ " CANDIDATE")
ENDIF
CASE UNIQUE(m.nInner_Loop)
IF(EMPTY(SYS(2021, m.nInner_Loop)))
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
" TAG " + m.cTag + " UNIQUE")
ELSE
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop);
+ " TAG " + m.cTag + " FOR " + SYS
(2021, m.nInner_Loop) ;
+ " UNIQUE")
ENDIF
OTHERWISE
IF(EMPTY(SYS(2021, m.nInner_Loop)))
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
" TAG " + m.cTag + ;
IIF(DESCENDING(m.nInner_Loop), " DESCENDING ", ""))
ELSE
WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop);
+ " TAG " + m.cTag + " FOR " + SYS(2021, m.nInner_Loop) + ;
IIF(DESCENDING(m.nInner_Loop), " DESCENDING ", ""))
ENDIF
ENDCASE
ELSE
EXIT FOR
ENDIF
ENDFOR
*! Get Properties For Table
WriteFile(hGTFile, CRLF + "***** " + BEGIN_PROP_LOC + m.cTableName +
" *****")
FOR m.nInner_Loop = 1 TO m.nNumberOfFields
m.cFieldAlias = m.cTableName + "." + aAll_Fields(m.nInner_Loop, 1)
m.cFieldHeaderAlias = [DBSETPROP('] + m.cFieldAlias + [', 'Field', ]
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Caption")
IF !EMPTY(cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(hGTFile, m.cFieldHeaderAlias + ['Caption', "] + m.cTemp +
[")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Comment")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
*! Strip Line Feeds
m.cTemp = STRTRAN(m.cTemp, CHR(10))
*! Convert Carriage Returns To Programmatic Carriage Returns
m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['Comment', "] + m.cTemp
+ [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "InputMask")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['InputMask', "] + m.cTe
mp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Format")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['Format', "] + m.cTemp
+ [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClass")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['DisplayClass', "] + m.
cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClassLibrary")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['DisplayClassLibrary',
"] + m.cTemp + [")])
ENDIF
ENDFOR
m.cTemp = DBGETPROP(m.cTableName, "Table", "Comment")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
*! Strip Line Feeds
m.cTemp = STRTRAN(m.cTemp, CHR(10))
*! Convert Carriage Returns To Programmatic Carriage R
eturns
m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
WriteFile(m.hGTFile, [DBSETPROP('] + m.cTableName + [', 'Table', ] +
['Comment', "] + m.cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cTableName, "Table", "DeleteTrigger")
IF !EMPTY(m.cTemp)
WriteFile(hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
"' FOR DELETE AS " + m.cTemp)
ENDIF
m.cTemp = DBGETPROP(m.cTableName, "Table", "InsertTrigger")
IF !EMPTY(m.cTemp)
WriteFile(m.hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
"' FOR INSERT AS " + m.cTemp)
ENDIF
m.cTemp = DBGETPROP(m.cTableName, "Table", "UpdateTrigger")
IF !EMPTY(m.cTemp)
WriteFile(m.hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
"' FOR UPDATE AS " + m.cTemp)
ENDIF
m.cTemp = DBGETPROP(m.cTableName, "Table", "RuleExpression")
IF !EMPTY(m.cTemp)
m.cError = DBGETPROP(m.cTableName, "Table", "RuleText")
IF !EMPTY(cError)
WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableName + ;
"' SET CHECK " + m.cTemp + " ERROR " + ;
m.cError)
ELSE
WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableName + ;
"' SET CHECK " + m.cTemp)
ENDIF
ENDIF
WriteFile(m.hGTFile, "ENDFUNC")
WriteFile(m.hGTFile, "")
FCLOSE(m.hGTFile)
RETURN
**********************************************************************
****
**
** Function Name: GETVIEW(<ExpC>, <ExpC>)
** Purpose : To take an existing FoxPro 3.0/5.0 View, and generat
e an output
** program that can be used to "re-create" that view.
**
** Parameters:
**
** cViewName - A character string representing the name of th
e
** existing view
** cOutFileName - A character string containing the name of the
** output file
**********************************************************************
*****************
PROCEDURE GetView
LPARAMETERS cViewName, cOutFileName
PRIVATE ALL EXCEPT g_*
m.nFileHand = FCREATE(m.cOutFileName, 0)
IF m.nFileHand < 1
FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
ENDIF
*! Get View Information for later use
m.nSourceType = DBGetProp(m.cViewName, 'View', 'SourceType')
m.cConnectName = ALLTRIM(DBGetProp(m.cViewName, 'View', 'ConnectName'
))
m.cSQL = ALLTRIM(DBGetProp(m.cViewName, 'View', 'SQL'))
m.cnUpdateType = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'UpdateTy
pe')))
m.cnWhereType = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'WhereType
')))
m.clFetchMemo = IIF(DBGetProp(m.cViewName, 'View', 'Fetchmemo'),'.T.'
,'.F.')
m.clShareConnection = IIF(DBGetProp(m.cViewName, 'View', 'ShareConnec
tion'),'.T.','.F.')
m.clSendUpdates = IIF(DBGetProp(m.cViewName, 'View', 'SendUpdates'),'
.T.','.F.')
m.cnUseMemoSize = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'UseMemo
Size')))
m.cnFetchSize = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'FetchSize
')))
m.cnMaxRecords = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'MaxRecor
ds')))
m.ccTables = ALLTRIM(DBGetProp(m.cViewName, 'View', 'Tables'))
m.clPrepared = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'Prepared'))
, '.T.', '.F.')
m.clCompareMemo = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'CompareM
emo')), '.T.', '.F.')
m.clFetchAsNeeded = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'FetchA
sNeeded')), '.T.', '.F.')
m.cParams = ALLTRIM(DBGetProp(m.cViewName, 'View', 'ParameterList'))
m.lOffline = DBGetProp(m.cViewName, 'View', 'Offline')
m.cComment = DBGETPROP(m.cViewName, 'View', 'Comment')
IF !EMPTY(m.cComment )
m.cComment = STRTRAN(m.cComment , ["], ['])
*! Strip Line Feeds
m.cComment = STRTRAN(m.cComment , CHR(10))
*! Convert Carriage Returns To Programmatic Carriage Returns
m.cComment = STRTRAN(m.cComment , CHR(13), '" + CHR(13) + "')
ENDIF
m.cnBatchUpdateCount = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'Ba
tchUpdateCount')))
*! Generate Comment Block
WriteFile(m.nFileHand, "FUNCTION MakeView_"+FIXNAME(m.cViewName))
m.cCommentBlock = "***************** " + BEGIN_VIEW_LOC + m.cViewName
+ ;
" ***************" + CRLF
WriteFile(m.nFileHand, m.cCommentBlock)
*! Generate CREATE VIEW command
m.cCreateString = 'CREATE SQL VIEW "'+ALLTRIM(m.cViewName)+'" ; '+CRL
F
IF m.nSourceType != 1 && If it isn't a local view
m.cCreateString = m.cCreateString + ' REMOTE '
IF !EMPTY(m.cConnectName)
m.cCreateString = m.cCreateString + 'CONNECT "' + m.cConnectName +
'" ; '+CRLF
ENDIF
ENDIF
m.cCreateString = m.cCreateString + ' AS '+ m.cSQL + CRLF
WriteFile(m.nFileHand, m.cCreateString)
*! GENERATE code to Set View Level Properties
m.cViewDBSetPrefix = [DBSetProp(']+m.cViewName+[', 'View', ]
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['UpdateType', ] + m.cnUp
dateType + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['WhereType', ] + m.cnWhe
reType + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchMemo', ] + m.clFet
chMemo + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['SendUpdates', ] + m.clS
endUpdates + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['UseMemoSize', ] + m.cnU
seMemoSize + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchSize', ] + m.cnFet
chSize + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['MaxRecords', ] + m.cnMa
xRecords + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Tables', '] + m.ccTable
s + [')])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Prepared', ] + m.clPrep
ared + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['CompareMemo', ] + m.clC
ompareMemo + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchAsNeeded', ] + m.c
lFetchAsNeeded + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchSize', ] + m.cnFet
chSize + [)])
IF !EMPTY(m.cParams)
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['ParameterList', "] + m
.cParams + [")])
ENDIF
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Comment', "] + m.cComm
ent + [")])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['BatchUpdateCount', ] +
m.cnBatchUpdateCount + [)])
WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['ShareConnection', ] + m
.clShareConnection + [)])
IF m.lOffline
WriteFile(m.nFileHand, 'CREATEOFFLINE("' + m.cViewName + '")')
ENDIF
*! GENERATE code to Set Field Level Properties
USE (DBC()) AGAIN IN 0 ALIAS GenViewCursor EXCLUSIVE
SELECT GenViewCursor
LOCATE FOR ALLTRIM(UPPER(GenViewCursor.ObjectName)) == m.cViewName AN
D ;
GenViewCursor.ObjectType = 'View'
m.nObjectId = GenViewCursor.ObjectId
SELECT ObjectName FROM GenViewCursor ;
WHERE GenViewCursor.ParentId = m.nObjectId ;
INTO ARRAY aViewFields
USE in GenViewCursor
WriteFile(m.nFileHand, CRLF + '*!* Field Level Properties for ' + m.c
ViewName)
IF _TALLY # 0
FOR m.nLoop = 1 TO ALEN(aViewFields, 1)
m.cFieldAlias = m.cViewName + "." + ALLTRIM(aViewFields(nLoop, 1))
m.clKeyField = IIF(DBGetProp(m.cFieldAlias, 'Field', 'KeyField'),'.
T.','.F.')
m.clUpdatable = IIF(DBGetProp(m.cFieldAlias, 'Field', 'Updatable'),
'.T.','.F.')
m.ccUpdateName = ALLTRIM(DBGetProp(m.cFieldAlias, 'Field', 'UpdateN
ame'))
m.cViewFieldSetPrefix = [DBSetProp(']+m.cFieldAlias+[', 'Field', ]
WriteFile(m.nFileHand, '* Props for the '+m.cFieldAlias+' field.')
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['KeyField', ] + m.c
lKeyField + [)])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Updatable', ] + m.
clUpdatable + [)])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['UpdateName', '] +
m.ccUpdateName + [')])
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleExpression")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['RuleExpression',
"]+m.cTemp+[")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleText")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['RuleText', "]+m.c
Temp+[")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Caption")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Caption', "] + m.
cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Comment")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
*! Strip Line Feeds
m.cTemp = STRTRAN(m.cTemp, CHR(10))
*! Convert Carriage Returns To Programmatic Carriage Returns
m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Comment', "] + m.
cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "InputMask")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['InputMask', "] +
m.cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Format")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Format', "] + m.c
Temp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClass")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DisplayClass', "]
+ m.cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClassLibrary")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DisplayClassLibra
ry', "] + m.cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DataType")
IF !EMPTY(m.cTemp)
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DataType', "] + m
.cTemp + [")])
ENDIF
m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DefaultValue")
IF !EMPTY(m.cTemp)
m.cTemp = STRTRAN(m.cTemp, ["], ['])
WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DefaultValue', "]
+ m.cTemp + [")])
ENDIF
ENDFOR
ENDIF
WriteFile(m.nFileHand, "ENDFUNC")
WriteFile(m.nFileHand, " ")
*! Close output file
FCLOSE(m.nFileHand)
RETURN
**********************************************************************
****
**
** Function Name: GETCONN(<ExpC>, <ExpC>)
** Purpose : To take an existing FoxPro 6.0 Connection, and genera
te
** an output program that can be used to "re-create" that
connection.
**
** Parameters:
**
** cConnectName - A character string representing the name of th
e
** existing connection
** m.cOutFileName - A character string containing the name of th
e
** output file
**
**********************************************************************
*****************
PROCEDURE GetConn
LPARAMETERS cConnectionName, m.cOutFileName
PRIVATE ALL EXCEPT g_*
m.nFileHand = FCREATE(m.cOutFileName, 0)
IF m.nFileHand < 1
FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
ENDIF
*! Get Connection Information for later use
m.clAsynchronous = IIF(DBGetProp(m.cConnectionName, 'Connection', 'As
ynchronous'),'.T.','.F.')
m.clBatchMode = IIF(DBGetProp(m.cConnectionName, 'Connection', 'Batch
Mode'),'.T.','.F.')
m.ccComment = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Com
ment'))
m.ccConnectString = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection'
, 'ConnectString'))
m.cnConnectTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connec
tion', 'ConnectTimeOut')))
m.ccDataSource = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', '
DataSource'))
m.cnDispLogin = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection'
, 'DispLogin')))
m.clDispWarnings = IIF(DBGetProp(m.cConnectionName, 'Connection', 'Di
spWarnings'),'.T.','.F.')
m.cnIdleTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connectio
n', 'IdleTimeOut')))
m.ccPassword = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Pa
ssword'))
m.cnQueryTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connecti
on', 'QueryTimeOut')))
m.cnTransactions = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connecti
on', 'Transactions')))
m.ccUserId = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'User
Id'))
m.cnWaitTime = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection',
'WaitTime')))
m.ccDatabase = DBGetProp(m.cConnectionName, 'Connection', 'Database')
*! Generate Comment Block
m.cCommentBlock = "***************** " + BEGIN_CONNECTIONS_LOC + " "
+ m.cConnectionName + ;
" ***************" + CRLF
WriteFile(m.nFileHand, "FUNCTION MakeConn_"+FIXNAME(m.cConnectionName
))
WriteFile(m.nFileHand, m.cCommentBlock)
*! Generate CREATE Connection command
m.cCreateString = 'CREATE CONNECTION '+ALLTRIM(m.cConnectionName)+' ;
'+CRLF
IF EMPTY(ALLTRIM(m.ccConnectString)) && If connectstring not specifi
ed
m.cCreateString = m.cCreateString + ' DATASOURCE "' + ALLT(m.ccDat
aSource) + '" ; ' + CRLF
m.cCreateString = m.cCreateString + ' USERID "' + ALLT(m.ccUserId)
+ '" ; ' + CRLF
m.cCreateString = m.cCreateString + ' PASSWORD "'+ ALLT(m.ccPasswo
rd) + '"' + CRLF
ELSE
m.cCreateString = m.cCreateString + ' CONNSTRING "' + ALLT(m.ccCon
nectString) + '"'
ENDIF
WriteFile(m.nFileHand, m.cCreateString)
*! GENERATE code to Set Connection Level Properties
m.cConnectionDBSetPrefix = [DBSetProp(']+m.cConnectionName+[', 'Conne
ction', ]
m.cConnectionProps = '****' + CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['Asynchronous', ] + m.clAsynchronous + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['BatchMode', ] + m.clBatchMode + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['Comment', '] + m.ccComment + [')]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['DispLogin', ] + m.cnDispLogin + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['ConnectTimeOut', ] + m.cnConnectTimeOut + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['DispWarnings', ] + m.clDispWarnings + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['IdleTimeOut', ] + m.cnIdleTimeOut + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['QueryTimeOut', ] + m.cnQueryTimeOut + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['Transactions', ] + m.cnTransactions + [)]+ CRLF
m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix +
;
['Database', '] + m.ccDatabase + [')] + CRLF
WriteFile(m.nFileHand, m.cConnectionProps)
*! Close output file
WriteFile(m.nFileHand, "ENDFUNC")
WriteFile(m.nFileHand, " ")
FCLOSE(m.nFileHand)
RETURN
**********************************************************************
****
**
** Function Name: FATALALERT(<ExpC>)
** Purpose: Place a message box to alert user of a fatal error.
**
** Parameters:
** cAlert_Message - Message to display to user
** lCleanup - If we should try to restore environment
**
**********************************************************************
****
PROCEDURE FatalAlert
LPARAMETERS cAlert_Message, lCleanup
MESSAGEBOX(m.cAlert_Message, 16, ERROR_TITLE_LOC)
GenDBC_CleanUp(m.lCleanup)
CANCEL
RETURN
**********************************************************************
****
**
** Function Name: GenDBC_CleanUp(<ExpL>)
** Purpose: Restore the environment
**
** Parameters:
** lCleanup - If we should try to restore tables open
**********************************************************************
****
PROCEDURE GenDBC_CleanUp
LPARAMETERS lCleanup
*! Restore everything
IF !EMPTY(m.g_cOnError)
ON ERROR &g_cOnError
ELSE
ON ERROR
ENDIF
IF !EMPTY(m.g_cSetTalk)
SET TALK &g_cSetTalk
ENDIF
IF !EMPTY(m.g_cSafety)
SET SAFETY &g_cSafety
ENDIF
IF !EMPTY(m.g_cSetDeleted)
SET DELETED &g_cSetDeleted
ENDIF
IF m.g_cSetStatusBar = "OFF"
SET STATUS BAR OFF
ENDIF
IF !EMPTY(m.g_cStatusText)
SET MESSAGE TO (m.g_cStatusText)
ELSE
SET MESSAGE TO
ENDIF
SET FULLPATH &g_cFullPath
CLOSE ALL
IF m.lCleanUp
IF !EMPTY(m.g_cFullDatabase) AND m.lCleanUp == .T.
OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
IF m.g_nTotal_Tables_Used > 0
FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
IF UPPER(JUSTEXT(m.g_aTables_Used(m.nLoop)))="TMP"
LOOP
ENDIF
USE (m.g_aTables_Used(m.nLoop)) IN (m.g_aAlias_Used(m.nLoop, 2))
EXCLUSIVE;
ALIAS (m.g_aAlias_Used(m.nLoop, 1))
ENDFOR
ENDIF
ENDIF
ENDIF
RETURN
**********************************************************************
****
**
** Function Name: WRITEFILE(<ExpN>, <ExpC>)
** Purpose : Centralized file output routine to check for proper
output
**
** Parameters:
** hFileHandle - Handle of output file
** cText - Contents to write to file
**********************************************************************
****
PROCEDURE WriteFile
LPARAMETERS hFileHandle, cText
m.nBytesSent = FPUTS(m.hFileHandle, m.cText)
IF m.nBytesSent < LEN(m.cText)
FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
ENDIF
RETURN
**********************************************************************
****
** Function Name: GenDBC_Error(<expC>, <expN>)
** Parameters:
** cMess - Message to give user
** nLineNo - Line Number Error Occurred
**********************************************************************
****
PROCEDURE GenDBC_Error
LPARAMETERS cMess, nLineNo
FatalAlert(UNRECOVERABLE_LOC + CRLF + m.cMess + CRLF + ;
AT_LINE_LOC + ALLTRIM(STR(m.nLineNo)), .T.)
RETURN
**********************************************************************
****
**
** Function Name: Stat_Message()
** Creation Date: 1994.01.08
** Purpose : Generalized Status Bar Progression
**********************************************************************
****
PROCEDURE Stat_Message
PRIVATE ALL EXCEPT g_*
m.nStat = m.g_nCurrentStat * (160 / g_nMax)
SET MESSAGE TO REPLICATE("|", m.nStat) + " " + ;
ALLTRIM(STR(INT(100 * (m.g_nCurrentStat / m.g_nMax)))) + "%"
m.g_nCurrentStat = m.g_nCurrentStat + 1
RETURN
********************************************************************
**
** Function Name: UpdateProcArray(<ExpC>)
** Creation Date: 1997.10.22
** Purpose : 用程序语句来填充g_aprocs[]数组
**
** Parameters:
**
** cText - 要加到g_aprocs[]数组中的 程序语句
**********************************************************************
PROCEDURE UpdateProcArray(lcProcName)
*! 如传过来的过程名是 'displayStatus',且不需要显示执行进度就返回了
*! 不需要显示执行进度 参数是 g_lskipdisplay=.T.
IF g_lskipdisplay AND ATC("DisplayStatus",lcprocname)#0
RETURN
ENDIF
IF !EMPTY(g_aprocs[ALEN(g_aprocs)])
DIMENSION g_aprocs[ALEN(g_aprocs)+1]
ENDIF
g_aprocs[ALEN(g_aprocs)] = lcProcName
ENDPROC
**********************************************************************
****
**
** Function Name: FixName(<ExpC>)
** Creation Date: 1997.10.22
** Purpose : Fixes procedure name to remove bad chars
**
** Parameters:
**
** cText - Name of procedure to add fix
**********************************************************************
****
PROCEDURE FixName(lcProcName)
lcProcName=ALLTRIM(lcProcName)
IF VERSION(3) $ DBCS_LOC
cbadchars = '/,-=:;!@#$%&*.<>()?[]\'+'+'+CHR(34)+CHR(39)+" "
ENDIF
lcProcName = CHRTRAN(lcProcName,cbadchars ,REPL('_',LEN(cbadchars)))
RETURN lcProcName
ENDPROC
--
※ 修改:．yuce 于 Aug 25 11:47:42 修改本文．[FROM: 202.96.101.162]
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.96.101.162]
|
|