📄 untpub.pas
字号:
{
作者：王政奕, 等
日期：2001.08.01 发布
功能：本单元定义了宏图天安所有用 Delphi 开发的软件系统的
公用的全局变量和函数。
所有打★★★标志的函数是程序员可用的，其余是本单元的内部函数，
外部程序不得使用。
未经批准程序员不得修改本单元任何代码。
修改历史：
2001.09.27 加入 CompileFormula() 王政奕;
2001.10.05 加入 _sAppTmpPath 系统临时目录 王政奕
2001.10.10 加入 TestFormula() 王政奕;
2001.10.14 加入 UserUpdatePswd() 王政奕;
2001.10.14 加入 AdmUpdatePswd() 王政奕;
2001.10.16 加入 CompileFormula2() 王政奕;
2001.11.07 加入 CompileFormula3() 王政奕;
2001.11.07 加入 ShowOnlineHelp() 王政奕;
2001.11.07 加入 InitProgress() 王政奕;
2001.11.07 加入 ShowProgress() 王政奕;
2001.11.07 加入 HideProgress 王政奕;
2001.11.07 加入 InitProgress2() 王政奕;
2001.11.07 加入 ShowProgress2() 王政奕;
2001.11.07 加入 HideProgress2() 王政奕;
2001.11.07 加入 SetWinSize() 王政奕;
2001.11.14 加入 ShowOnlineHint() 王政奕;
2001.11.21 加入 OpenMDIChild() 王政奕;
2001.11.24 加入 OLEFieldToContainer() 王政奕;
2001.11.24 加入 OLEContainerToField() 王政奕;
2001.11.30 加入 CompileFormula4() 王政奕;
}
unit UntPub;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ExtCtrls, ComCtrls, Mask, DBCtrls, Buttons, DBTables,
Grids, DBGrids, IniFiles, DB, Chart, Printers, BDE, FileCtrl, OleCtnrs,
mxgrid, mxgraph, mxpivsrc, mxDB, mxstore, mxtables, mxcommon,
ScktComp;
function CP(const pFormula: pchar;
pList: pchar;
pSQL: pchar;
const pProc: pchar;
const iTrace: integer): LongInt; cdecl; external 'CP.dll' name 'CP';
function CP2(const pFormula: pchar;
pList: pchar;
pSQL: pchar;
const pProc: pchar;
const iTrace: integer;
const pVars: pchar;
const pStart: pchar;
const pEnd: pchar): LongInt; cdecl; external 'CP.dll' name 'CP2';
function CP3(const pFormula: pchar;
pList: pchar;
pSQL: pchar;
const pProc: pchar;
const iTrace: integer;
const pParams: pchar;
const pVars: pchar;
const pStart: pchar;
const pEnd: pchar): LongInt; cdecl; external 'CP.dll' name 'CP3';
function CP4(const pFormula: pchar;
pList: pchar;
pSQL: pchar;
const pProc: pchar;
const pRTable: pchar;
const iTrace: integer): LongInt; cdecl; external 'CP.dll' name 'CP4';
function CT(const pFormula: pchar;
pList: pchar;
const iTrace: integer;
var iLineNo: integer): LongInt; cdecl; external 'CP.dll' name 'CT';
const
//---- 消息
WM_HELP = WM_USER + 1; // 联机业务帮助
WM_HINT = WM_USER + 2; // 主窗体状态栏提示
//---- 系统全局常数
_sErrorFile: string = 'SysError.txt'; // 应用程序系统错误日志文件
_sSysCfgFile: string = 'Audit.cfg'; // 应用程序配置文件
_iRunCenter = 1; // 系统运行地点: LAN
_iRunLocal = 2; // WAN
_iDBAccess = 1; // 数据库种类定义
_iDBOracle = 2;
_iDBSybase = 3;
_iDBMSSQL = 4;
_iDBDBF = 5;
_iDBODBC = 6;
_sZeroDay: string = '18991230'; // 特殊日, Oracle --> Delphi 中显示为 0
_iFailed: integer = -1;
_sFailed: string = '';
_sCRLF: string = #13+#10; // 回车换行
_sFmtInt: string = '############'; // 整数编辑掩码
_sFmtCurr: string = '###########0.00'; // 货币编辑掩码
_sFmtDate: string = '!9900/99/99;1;_'; // 日期编辑掩码
_iCompilerBufLen = 65536; // 公式编译器缓冲区尺寸
//---- 税务系统全局常数
_sAccProperty:string='通用类,应收帐款类,广告类,捐赠类'; //会计科目特殊属性
_sAccType:string='资产类,负债类,所有者权益类,成本类,损益类';
// 税种类别
_iTaxSales = 1; // 营业税
_iTaxIncome = 2; // 所得税
_iTaxRealEstate = 3; // 房产税
_iTaxLandUsage = 4; // 土地使用税
_iTaxStamp = 5; // 印花税
_iTaxVehicleUsage = 6; // 车船使用税
_iTaxEduAdd = 7; // 教育费附加
_iTaxValueAdded = 8; // 增殖税
// 科目分隔符
_sSepChar = '·';
Type
//---- 自定义异常类
EMgrError=class(Exception); // 供管理员类调用。
EExitTry=class(Exception); // 供从 try 部分跳到 except 再跳出。
EHelpMsg=class(Exception); // 供发送联机业务帮助消息失败用
EHintMsg=class(Exception); // 供发送主窗体状态栏提示消息失败用
//---- 初始化和结束
// 系统初始化
procedure PubInit(const iSite: integer = _iRunLocal);
// 系统结束
procedure PubEnd;
// 读配置文件
procedure SysCfgRead;
//---- 系统注册
//---- 应用程序启动窗口
//---- 错误处理
// 错误处理程序，供异常处理调用
procedure ErrorHandler(expWhich:Exception; sProcedure:string);
// 取错误号和错误信息
Procedure GetErrorInfo(var iErrorCode: integer; var sErrorMsg: string);
//---- 系统日志
function AddSysLog(const sType, sModule, sContent: string): integer;
//---- 联机业务帮助
function ShowOnlineHelp(const sTaxID, sBaseItemType, sBaseItemID: string): integer;
//---- 联机主窗口提示
function ShowOnlineHint(const sHint: string): integer;
//---- 进程指示
// 由外界驱动指示杆的编程接口
// 自动移动指示杆的编程接口
//---- 系统函数的增强
// 日期转换校验函数
function MyStrToDate(const sDate:string; var dtDate:TDate): boolean;
// 字符型数据转换成数字型的较验涵数
function MyStrToInt(const sText: string; var iNum: integer): boolean;
// 日期型转换成字符型,用于数据表的明细显示的函数
function MyDateToStr(const dtDate: Tdate; var sDate: string): boolean;
// 字符型数据转换成浮点型的较验涵数
function MyStrToFloat(const sText: string; var iNum: Double): boolean;
// 货币四舍五入（两位小数）
function MyCy2Round(const X: Extended): Currency;
// 将日期 sDate, 字段 sFieldName 和操作符 sOptr 组合成 sCondition，
// 使其能使用在 Select ... where <sCondition> 中。
// 例如: 调用 MyDateCondition('F_Birthday', '1999-01-31', '>=', sCon) 后,
// sCon 将包含一个字符串, 体现了条件 F_Birthday >= 1999-01-31
//---- 数据库相关函数
// Blob 字段 --> OLE 控件
function OLEFieldToContainer(var fldWhich: TBlobField; var ocWhich: TOLEContainer;
const sInitFile: string = ''):boolean;
// Blob 控件 --> 字段
function OLEContainerToField(var fldWhich: TBlobField; var ocWhich: TOLEContainer):boolean;
// 本函数在 MS Access、Oracle、Sybase 数据库中获得通过。
function MyDateCondition(const sFieldName, sDate, sOptr, sDB: string;
var sCondition: string): boolean;
// 根据数据库代码返回数据库类别的字符串
function GetDBSName(const iDBSType: integer): string;
// 返回 SQL 字符串匹配通配符, 与数据库相关
function MyFuzzLetter(const sDatabaseType: string): string;
// 返回 SQL 字符串引号, 与数据库相关
function MyRefLetter(const sDatabaseType: string): string;
// 根据人的身份证号码求出生日期
function GetBirthday(const sInsQueryID: string; var dtBirthday: TDate): boolean;
//---- 编译器
// 公式编译器（当前目录下必须有 cp.dll）
function CompileFormula(const sFormula: string; var sSQL: string;
const sProcName: string): integer;
function CompileFormula2(const sFormula: string; var sSQL: string;
const sProcName: string; const sVars: string;
const sStart: string; const sEnd: string): integer;
function CompileFormula3(const sFormula: string; var sSQL: string;
const sProcName: string; const sParams: string; const sVars: string;
const sStart: string; const sEnd: string): integer;
function CompileFormula4(const sFormula: string; var sSQL: string;
const sProcName: string; const sRTable: string): integer;
// 公式合法性测试
function TestFormula(const sFormula: string; var sList: string;
var iLineNo: integer): integer;
//---- 简化计算
// 返回两个日期之间的月份数
function GetMonthsBetweenTwoDate(const dtD1, dtD2: TDateTime): Integer;
// 相对于 dtDate, 计算新日期.
function GetNextDate(const dtDate: TDate; const iDltYear, iDltMonth, iDltDay: integer): TDate;
// 比较日期是否相同
function SameDateTime(const dtD1, dtD2: TDateTime; const iCmpType: integer): boolean;
//---- 表单操作
// 将一表单在另一主表单客户区居中
// 参数：frmMain: 主表单， frmSub: 待居中的子表单
// iOffset: 垂直方向其他对象占用高度(缺省为0)
// 例如：CenterForm(frmClinicMain, frmRegister, Toolbar.height)
Procedure CenterForm(frmMain, frmSub: TCustomForm; const iOffset: integer=0);
// 将回车键转换为TAB键
// 调用方式：将Form的KeyPreviw设为True, 在KeyDown事件中加语句
// ConvertKey(ActiveControl,HANDLE,Key,Shift);
procedure ConvertKey(ActiveControl:TWinControl;HANDLE: HWND; var Key: Word; Shift: TShiftState);
// 打开 MDI 子窗体
procedure OpenMDIChild(TfrmMDIChild: TComponentClass; var frmMDIChild: TForm);
// 自动设定窗体的宽度和高度
procedure SetWinSize(var frmShow: TForm; const poWhich: TPosition; const bDock: boolean);
//---- 其它
// 盘间复制文件并处理错误
function DiskCopyFile(const SourceFile:string;const TargetFile:string):boolean;
//清除控件的显示
procedure ClearCtrl(ParentControls:array of TWincontrol);
procedure ShowGlobalAppVars;
procedure ShowGlobalSysVars;
// 返回唯一的文件名称
function UniqueFileName: string;
//纳税调整
procedure Control(Sign,_iVolumn,_iThread:integer; _sUserID:string;_iUserID:integer;
_sUserName,_sPassWord,_sRight:string; _iDptID:integer;_sDptName,
_sAgent:string;_iTaxID:integer;_sTaxID,_sTaxName:string;
_iPerPlanID,_iPlanYear:integer; _sAccSession,_sRptID,_sPlanID:string;
_iEnpID:integer;_sEnpName,_sEnpAddr,_sEconType,_sEconName,_sTradeID,
_sTradeName:string;_iProjectMngID:integer;_sProjectMngName,
_sContractID:string);
{调用方法
Control(Sign,_iVolumn,_iThread,_sUserID,_iUserID,
_sUserName,_sPassWord,_sRight,_iDptID,_sDptName,
_sAgent,_iTaxID,_sTaxID,_sTaxName,
_iPerPlanID,_iPlanYear, _sAccSession,_sRptID,_sPlanID,
_iEnpID,_sEnpName,_sEnpAddr,_sEconType,_sEconName,_sTradeID,
_sTradeName,_iProjectMngID:integer;_sProjectMngName,
_sContractID);
Sign为1时表示计算未审数据，其他为会计调整数，其他参数为系统全局变量 }
var
//---- 系统全局变量
_sMachineName: string; // 当前工作站名称
_sAppPath: string = ''; // 系统安装目录, 如 'C:\TimeSoft\'
_sAppTmpPath: string = ''; // 系统临时目录, 如 'C:\TimeSoft\Tmp\Wang'
_iVolumn: int64;
_iThread: int64;
_iRunSite: integer = _iRunCenter; // 系统运行地点
_sAppTitle: string = '杭州粮食局 粮油储备管理';// 提示窗口标题 _sDatabase: string = ''; // 当前主用数据库
// _sServerName: string = ''; // 当前 SQLServer 所在的 Windows 服务器名
_sDatabase: string = ''; // 当前主用数据库设备名
_sDBSUserName: string = ''; // 当前主用数据库用户名
_sDBSPassword: string = ''; // 当前主用数据库用户口令
_bShowSysError: boolean = true; // 是否显示逻辑错误信息. ErrorHandler(...) 使用
_bmpUnitLogoS: TBitmap; // 客户图标 16x16
_bmpUnitLogoL: TBitmap; // 客户图标 32x32
_icnUnitLogo: TIcon; // 客户 ICON
_bmpTimeSoftLogoS: TBitmap; // 公司图标 16x16
_bmpTimeSoftLogoL: TBitmap; // 公司图标 32x32
_icnTimeSoftLogo: TIcon; // 公司 ICON
//---- 税务系统全局变量
_frmMain: TForm = nil; // 主窗口实例变量
_frmHint: TForm = nil; // frmHint 的窗口实例变量
_sHint: string = ''; // 主窗口提示区的提示信息
//-- 1. 当前系统使用单位
_sUnitName:String; // 名称
_sUnitType:String; // 类型（事务所、税务局）
//-- 2. 当前被审企业
_iEnpID:integer; // 企业代码
_sEnpName:string; // 名称
_sEnpAddr:string; // 地址
_sTradeID:string; // 行业代码
_sTradeName:string; // 行业名称
_sEconType:string; // 经济类型代码
_sEconName:string; // 经济类型名称
_asTradeName:array[0..200] of string; // 所有行业名称及会计制度规定，事务所拟定
_dIncomeTaxRate: double; // 企业所得税率
_dCityTaxRate: double; // 企业城建税率
//-- 3. 当前约定书及项目经理
_sContractID:string; // 当前约定书号
_sProjectMngName:string; // 项目经理姓名
_sProjectMngID:string; // 项目经理工号
_iProjectMngID:integer; // 项目经理内部代码
//-- 4. 当前审核税种
_iTaxID:integer; // 当前被审税种内部流水号
_sTaxID:string; // 当前被审税种代码
_sTaxName:string; // 代理税种名称
_sAgent:string; // 代理内容
//-- 5. 当前工作计划和个人工作计划
_sRptID:string; // 当前工作所使用的申报表代码
_sPlanID:string; // 当前执行的总体工作计划号
_iReportCode:integer; // 含计划号和会计期间信息的代码
_iDataFrom: integer; // 当前计划的原始数据来源：0.基础数据输入 1.未审表直接输入
_iPlanYear: integer; // 当前计划年度
_iPerPlanID:Integer; // 当前个人工作计划号
_sAccSession:String; // 当前个人计划所属会计期间
//-- 6. 当前操作员
_sUserName:string; // 姓名
_sUserID:string; // 工号
_iUserID:integer; // 内部代码
_sPassWord:string; // 口令
_iDptID:integer; // 操作员所在部门代码
_sDptName:string; // 操作员所在部门名称
_sRight:string; // 操作员权限
//-- A. 编译器专用
_sSQLParam: string = ''; // 编译器附加代码--过程参数定义
_sSQLVar: string = ''; // 编译器附加代码--变量定义
_sSQLStart: string = ''; // 编译器附加代码--初始化代码
_sSQLREnd: string = ''; // 编译器附加代码--报表结束代码
_sSQLPEnd: string = ''; // 编译器附加代码--政策结束代码
implementation
uses
dmPub;
var
ssMachine: TServerSocket;
_iErrorcode: integer; // 错误号
_sErrorMsg: string; // 错误信息
iUniqueID: integer = 0;
//---- 系统初始化
// ★★★
// 系统初始化
procedure PubInit(const iSite: integer = _iRunLocal);
begin
//-- 读配置文件
Application.ProcessMessages;
SysCfgRead;
//-- 创建系统数据模块
Application.ProcessMessages;
Application.CreateForm(TdmPub, dmSysPub);
AddSysLog('连接', ' ', ' '); // 日志
//-- 加载客户 logo 文件
Application.ProcessMessages;
try
_bmpUnitLogoS := TBitmap.Create;
_bmpUnitLogoL := TBitmap.Create;
_icnUnitLogo := TIcon.Create;
_bmpTimeSoftLogoS := TBitmap.Create;
_bmpTimeSoftLogoL := TBitmap.Create;
_icnTimeSoftLogo := TIcon.Create;
_bmpUnitLogoS.LoadFromFile('UnitS.bmp');
_bmpUnitLogoL.LoadFromFile('UnitL.bmp');
_icnUnitLogo.LoadFromFile('Unit.ico');
_bmpTimeSoftLogoS.LoadFromFile('TimeSoftS.bmp');
_bmpTimeSoftLogoL.LoadFromFile('TimeSoftL.bmp');
_icnTimeSoftLogo.LoadFromFile('TimeSoft.ico');
except
on E:exception do ErrorHandler(E,'PubInit');
end;
end;
// ★★★
// 系统结束
procedure PubEnd;
begin
//-- 释放客户 logo 文件
Application.ProcessMessages;
try
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -