untpub.~pas

是分布式粮库程序,是采用Delphi实现的

    _bmpUnitLogoS.Free;
    _bmpUnitLogoL.Free;
    _icnUnitLogo.Free;
    _bmpTimeSoftLogoS.Free;
    _bmpTimeSoftLogoL.Free;
    _icnTimeSoftLogo.Free;
  except
    on E:exception do ErrorHandler(E,'PubEnd');
  end;

  //-- 释放系统数据模块
  Application.ProcessMessages;
  AddSysLog('释放', ' ', ' ');            // 日志
end;

// ★★★
//---- 系统配置
// 读取:
//   系统配置文件到全程变量.
procedure SysCfgRead;
var
  iniSys: TIniFile;
  slTmp: TStringList;
  iC: integer;
begin
  try
    iniSys := TIniFile.Create(_sAppPath+_sSysCfgFile);
    slTmp := TStringList.Create;
    try
      //-- 1. 系统配置文件到全程变量.
      // Database
      _sDatabase := iniSys.ReadString('数据库', '设备', '');
//      _sServerName := iniSys.ReadString('数据库', '服务器', '');
      _sDBSUserName := iniSys.ReadString('数据库', '用户', '');
      _sDBSPassword := iniSys.ReadString('数据库', '口令', '');
      // 异常
      _bShowSysError := iniSys.ReadBool('系统', '显示内部异常', true);
      // 编译器附加代码
      iniSys.ReadSection('过程参数', slTmp);
      for iC:=0 to slTmp.Count-1 do
        _sSQLParam := _sSQLParam+#13+
                      iniSys.ReadString('过程参数', slTmp[iC], '');
      iniSys.ReadSection('变量定义', slTmp);
      for iC:=0 to slTmp.Count-1 do
        _sSQLVar := _sSQLVar+#13+
                      iniSys.ReadString('变量定义', slTmp[iC], '');
      iniSys.ReadSection('初始化', slTmp);
      for iC:=0 to slTmp.Count-1 do
        _sSQLStart := _sSQLStart+#13+
                      iniSys.ReadString('初始化', slTmp[iC], '');
      iniSys.ReadSection('报表结束', slTmp);
      for iC:=0 to slTmp.Count-1 do
        _sSQLREnd := _sSQLREnd+#13+
                      iniSys.ReadString('报表结束', slTmp[iC], '');
      iniSys.ReadSection('政策结束', slTmp);
      for iC:=0 to slTmp.Count-1 do
        _sSQLPEnd := _sSQLPEnd+#13+
                      iniSys.ReadString('政策结束', slTmp[iC], '');
    except
      On E: Exception do ErrorHandler(E, 'SysCfgRead');
    end;
  finally
    iniSys.Free;
    slTmp.Free;
  end;
end;

// ★★★
//---- 系统注册
// 输入参数：
//     iType：0：普通用户；1：管理员
// 返回值：
//     0：注册成功；1：失败





// ★★★
//---- 应用程序启动窗口
// 显示窗口


// 关闭窗口



// ★★★
//---- 系统日志
// 加入一条日志记录
// 返回值：
//     0：成功
//     其他：错误号
function AddSysLog(const sType, sModule, sContent: string): integer;
begin
end;

// ★★★
//---- 打开 MDI 子窗口
// 输入参数：
//     TfrmMDIChild：子窗体类名
//     frmMDIChild：子窗体实例变量
// 必要条件：
//     _frmMain 已初始化
procedure OpenMDIChild(TfrmMDIChild: TComponentClass; var frmMDIChild: TForm);
var
  iLoop: integer;
begin
  //-- 1. 查询子窗体是否已经存在
  for iLoop:=_frmMain.MDIChildCount-1 downto 0 do
    if _frmMain.MDIChildren[iLoop]=frmMDIChild then
    begin
      frmMDIChild.Icon.Assign(_icnTimeSoftLogo);
      frmMDIChild.Show;         // 已经存在, 推到前面
      exit;                     // 退出
    end;

  //-- 2. 不存在则创建
  Application.CreateForm(TfrmMDIChild, frmMDIChild);
  frmMDIChild.Show;
end;

// ★★★
//---- 联机业务帮助
// 输入参数：
//     sTaxID: 税种代码 char(2) 取全局变量 _sTaxID
//     sBaseItemType: 基础数据类别代码 char(1)
//     sBaseItemID: 基础数据指标代码 char(16) 前四位有用
function ShowOnlineHelp(const sTaxID, sBaseItemType, sBaseItemID: string): integer;
var
  iH, iL: integer;
begin
  Result := 0;
  if _frmHint = nil then
    exit;
  try
    iH := StrToInt(sTaxID) shl 16 + StrToInt(sBaseItemType);
    iL := StrToInt(sBaseItemID);
    if not PostMessage(_frmHint.Handle, WM_HELP, iH, iL) then
      raise EHelpMsg.Create('请求联机业务帮助失败. 错误号='+IntToStr(GetLastError()));
  except
    on E:Exception do
    begin
      Result := 1;
      ErrorHandler(E, 'ShowOnlineHelp');
    end;
  end;
end;

// ★★★
//---- 联机主窗口提示
// 输入参数：
//     sHint: 提示信息
function ShowOnlineHint(const sHint: string): integer;
begin
  Result := 0;
  if _frmMain = nil then
    exit;
  try
    _sHint := sHint;
    if not PostMessage(_frmMain.Handle, WM_HINT, 0, 0) then
      raise EHintMsg.Create('请求联机主窗口提示失败. 错误号='+IntToStr(GetLastError()));
  except
    on E:Exception do
    begin
      Result := 1;
      ErrorHandler(E, 'ShowOnlineHint');
    end;
  end;
end;

//---- 进程指示
//-- 1. 由调用程序驱动的指示杆的编程接口
// 1.1. 初始化，创建窗口
// 输入参数：
//     sFixedMsg: 固定的显示信息
//     iMax: 指示杆的最大值
//     bCanCancel：是否允许用户取消当前进程


// 1.2. 改变显示，移动指示杆的位置
// 输入参数：
//     sChangingMsg: 动态的显示信息
//     iPosition: 指示杆的当前位置
// 返回值：
//     true：用户未取消当前进程
//     false：用户取消当前进程

// 1.3. 结束，关闭窗口


//-- 2. 自动移动指示杆的编程接口
// 2.1. 初始化，创建窗口
// 输入参数：
//     sFixedMsg: 固定的显示信息
//     bCanCancel：是否允许用户取消当前进程


// 2.2. 改变显示，移动指示杆的位置
// 输入参数：
//     sChangingMsg: 动态的显示信息
// 返回值：
//     true：用户未取消当前进程
//     false：用户取消当前进程


// 2.3. 结束，关闭窗口


//---- 自动设定窗体的宽度和高度
procedure SetWinSize(var frmShow: TForm; const poWhich: TPosition; const bDock: boolean);
var
  iCC, iMinW, iMinH, iMaxW, iMaxH: integer;
  ctrlTmp: TControl;
begin
  // 处理所有构件
  iMinW := 1000;
  iMinH := 1000;
  iMaxW := 0;
  iMaxH := 0;
  for iCC:=0 to frmShow.ControlCount-1 do
  begin
    ctrlTmp := frmShow.Controls[iCC];
    if ctrlTmp.Left < iMinW then
      iMinW := ctrlTmp.Left;
    if ctrlTmp.Top < iMinH then
      iMinH := ctrlTmp.Top;
    if ctrlTmp.Left + ctrlTmp.Width > iMaxW then
      iMaxW := ctrlTmp.Left + ctrlTmp.Width;
    if ctrlTmp.Top + ctrlTmp.Height > iMaxH then
      iMaxH := ctrlTmp.Top + ctrlTmp.Height;
  end;
  frmShow.Scaled := True;
  frmShow.Position := poWhich;
  if bDock then
    frmShow.Height := iMaxH + 6
  else
    frmShow.ClientHeight := iMaxH + 6;
  frmShow.Width := iMaxW + iMinW;
end;

//---- 显示全局变量
procedure ShowGlobalAppVars;
begin
  ShowMessage(' 系统使用单位名称 _sUnitName =           ' + _sUnitName + #13 +
              ' 系统使用单位类型 _sUnitType =           ' + _sUnitType + #13 + #13 +                       //
              ' 被审企业代码 _iEnpID =                  ' + IntToStr(_iEnpID) + #13 +
              ' 被审企业名称 _sEnpName =                ' + _sEnpName + #13 +
              ' 被审企业地址 _sEnpAddr =                ' + _sEnpAddr + #13 +
              ' 被审企业行业代码 _sTradeID =            ' + _sTradeID + #13 +
              ' 被审企业行业名称 _sTradeName =          ' + _sTradeName + #13 +
              ' 被审企业经济类型代码 _sEconType =       ' + _sEconType + #13 +
              ' 被审企业经济类型名称 _sEconName =       ' + _sEconName + #13 +
              ' 被审企业所得税率 _dIncomeTaxRate =      ' + FloatToStr(_dIncomeTaxRate) + #13 +
              ' 被审企业城建税率 _dCityTaxRate =        ' + FloatToStr(_dCityTaxRate) + #13 + #13 +
              ' 当前约定书号 _sContractID =             ' + _sContractID + #13 +
              ' 项目经理姓名 _sProjectMngName =         ' + _sProjectMngName +  #13 +
              ' 项目经理工号 _sProjectMngID =           ' + _sProjectMngID + #13 +
              ' 项目经理内部代码 _iProjectMngID =       ' + IntToStr(_iProjectMngID) + #13 + #13 +
              ' 当前被审税种内部号 _iTaxID =            ' + IntToStr(_iTaxID) + #13 +
              ' 当前被审税种号 _sTaxID =                ' + _sTaxID + #13 +
              ' 代理税种名称 _sTaxName =                ' + _sTaxName + #13 +
              ' 代理内容 _sAgent =                      ' + _sAgent + #13 +
              ' 数据录入方法 _iDataFrom =               ' + IntToStr(_iDataFrom) + #13 +
              ' 当前工作所使用的申报表代码 _sRptID =    ' + _sRptID + #13 +
              ' 当前执行的总体工作计划号 _sPlanID =     ' + _sPlanID + #13 +
              ' 当前计划年度 _iPlanYear =               ' + IntToStr(_iPlanYear) + #13 +
              ' 当前个人工作计划号 _iPerPlanID =        ' + IntToStr(_iPerPlanID) + #13 +
              ' 当前个人计划所属会计期间 _sAccSession = ' + _sAccSession + #13 + #13 +
              ' 操作员姓名 _sUserName =                 ' + _sUserName + #13 +
              ' 操作员工号 _sUserID =                   ' + _sUserID + #13 +
              ' 操作员内部代码 _iUserID =               ' + IntToStr(_iUserID) + #13 +
              ' 操作员口令 _sPassWord =                 ' + _sPassWord + #13 +
              ' 操作员所在部门代码 _iDptID =            ' + IntToStr(_iDptID) + #13 +
              ' 操作员所在部门名称 _sDptName =          ' + _sDptName + #13 +
              ' 操作员权限 _sRight =                    ' + _sRight);

end;

procedure ShowGlobalSysVars;
begin
  ShowMessage(' 当前工作站名称 _sMachineName =    ' + _sMachineName + #13 +
              ' 系统安装目录 _sAppPath =          ' + _sAppPath + #13 +
              ' 系统临时目录 _sAppTmpPath =       ' + _sAppTmpPath + #13 +
              ' 系统运行地点 _iRunSite =          ' + IntToStr(_iRunSite) + #13 +
              ' 提示窗口标题 _sAppTitle =         ' + _sAppTitle + #13 +
              ' 系统数据库 _sDatabase =           ' + _sDatabase + #13 +
//              ' 数据库服务器 _sServerName =       ' + _sServerName + #13 +
              ' 显示逻辑错误信息 _bShowSysError = ' + IntToStr(integer(_bShowSysError)) + #13 + #13 +
              ' 过程参数 _sSQLParam =             ' + _sSQLParam + #13 + #13 +
              ' 变量定义 _sSQLVar =               ' + _sSQLVar + #13 + #13 +
              ' 初始化   _sSQLStart =             ' + _sSQLStart + #13 + #13 +
              ' 报表结束 _sSQLREnd =              ' + _sSQLREnd + #13 + #13 +
              ' 政策结束 _sSQLPEnd =              ' + _sSQLPEnd );
end;

// ★★★
// 将回车键转换为TAB键
// 调用方式：将Form的KeyPreviw设为True,在KeyDown事件中加语句
//           ConvertKey(ActiveControl,HANDLE,Key,Shift);
procedure ConvertKey(ActiveControl:TWinControl ;HANDLE: HWND;var Key: Word;Shift: TShiftState);
begin
  if (ord(Key)=13) then
  begin
    if ((ActiveControl is TComboBox) ) then
    begin
      if SendMessage(ActiveControl.HANDLE,CB_GETDROPPEDSTATE ,0,0)=0 then
      begin
         if SendMessage(ActiveControl.HANDLE,CB_GETCURSEL,0,0)= CB_ERR then
           SendMessage(ActiveControl.HANDLE,CB_SETCURSEL,0,0);
         PostMessage(ActiveControl.HANDLE,CB_SHOWDROPDOWN,-1,0);
      end
      else
      begin
         PostMessage(HANDLE,WM_KEYDOWN,vk_TAB,0);
         Key :=0;
      end;
      exit;
    end;

    if ((ActiveControl is TCheckBox)) then
    begin
      PostMessage(HANDLE,WM_KEYDOWN,vk_TAB,0);
      Key := 0;         // 32
      exit;
    end;

    if ((ActiveControl is TEdit)
       or (ActiveControl is TMaskEdit)
       or (ActiveControl is TRadioButton)
       or (ActiveControl is TDBImage)
       or (ActiveControl is TDBComboBox)
       or (ActiveControl is TDBEdit)) then
    begin
      PostMessage(HANDLE,WM_KEYDOWN,vk_TAB,0);
      Key :=0;
    end;
  end;

  if (ord(Key)=9) then
  begin
    if (ActiveControl is TDbgrid) then
    begin
      PostMessage(HANDLE,WM_KEYDOWN,vk_TAB,0);
      Key :=0;
    end;
  end;
end;

// ★★★
// 错误处理程序，供异常处理调用
procedure ErrorHandler(expWhich:Exception; sProcedure:string);
var
  F1: TextFile;
  iNum,iLoop: integer;
  sEM: string;
begin
  try
    // 2. 记入错误日志
    _sErrorMsg := '计算机: '+_sMachineName+
                  '    发生日期: '+DateTimeToStr(Now)+#13+
                  '    错误程序: '+sProcedure+
                  '    错误信息: ';

    // 2.1. 判断错误日志文件是否存在
    AssignFile(F1, _sErrorFile);
    if FileExists(_sErrorFile)=false then
    begin
      rewrite(F1); // 创建并打开
    end
    else
      append(F1);  // 打开并追加

    // 2.2. 判断是否为BDE错误
    if (expWhich is EDBEngineError) then
    begin
      iNum:=(expWhich as EDBEngineError).ErrorCount;  // 取错误的总数
      // 循环取每个错误的号和信息
      for iLoop:=0 to iNum-1 do
      begin
        _iErrorCode := (expWhich as EDBEngineError).Errors[iLoop].Errorcode; //取错误号
        sEM := IntToStr(_iErrorCode) + '  ' +
               (expWhich as EDBEngineError).Errors[iLoop].message;          //取错误信息
        _sErrorMsg := _sErrorMsg+#13+'    '+sEM;
      end;
    end

    // 2.3. 非BDE错误处理
    else
    begin
      _iErrorCode:=1;    //非BDE错误则所有错误号都为'1'
      _sErrorMsg := _sErrorMsg + #13 + '    ' + expWhich.Message;
    end;

    // 2.4. 写入日志
    Writeln(F1, _sErrorMsg);
    CloseFile(F1); // 关闭文件

    if _bShowSysError then
      Application.MessageBox(PChar(_sErrorMsg),
                             pchar(_sAppTitle),
                             mb_IconError+mb_ok);
  except
    Application.MessageBox('记录系统错误时出错.',
                           pchar(_sAppTitle),
                           mb_IconError+mb_ok);
  end;
end;

// ★★★
// 取错误号和错误信息