?? 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 + -