untpub.pas

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

        ' (DatePart(yy,'+sFN+')'+sOptr+sYear+       // 年大/小
        ' or (DatePart(yy,'+sFN+')='+sYear+         // 年等, 月大/小
          ' and DatePart(mm,'+sFN+')'+sOptr+sMonth+')'+
        ' or (DatePart(yy,'+sFN+')='+sYear+         // 年等, 月等, 日大/小
          ' and DatePart(mm,'+sFN+')='+sMonth+
          ' and DatePart(dd,'+sFN+')'+sOptr+sDay+')) '
    else
      sCondition:=' 1=1 ';
    exit;           // 退出
  end;

  // ODBC
  if sDB='ODBC' then
  begin
    sFN:=sFieldName;
    if sOptr = '=' then
      sCondition := ' (DatePart(''yyyy'','+sFN+')='+sYear+
        ' and DatePart(''m'','+sFN+')='+sMonth+
        ' and DatePart(''d'','+sFN+')='+sDay+') '
    else if sOptr = '<>' then
      sCondition := ' (DatePart(''yyyy'','+sFN+')<>'+sYear+
        ' or DatePart(''m'','+sFN+')<>'+sMonth+
        ' or DatePart(''d'','+sFN+')<>'+sDay+') '
    else if (sOptr = '>') or (sOptr = '>=') or
      (sOptr = '<') or (sOptr = '<=') then
      sCondition :=
        ' (DatePart(''yyyy'','+sFN+')'+sOptr+sYear+       // 年大/小
        ' or (DatePart(''yyyy'','+sFN+')='+sYear+         // 年等, 月大/小
          ' and DatePart(''m'','+sFN+')'+sOptr+sMonth+')'+
        ' or (DatePart(''yyyy'','+sFN+')='+sYear+         // 年等, 月等, 日大/小
          ' and DatePart(''m'','+sFN+')='+sMonth+
          ' and DatePart(''d'','+sFN+')'+sOptr+sDay+')) '
    else
      sCondition:=' 1=1 ';
    exit;           // 退出
  end;

  // Oracle
  if sDB='ORACLE' then
  begin
    sCondition := ' ('+sFieldName+sOptr+'to_date('''+sDate+''', ''YYYY-MM-DD'')) ';
    exit;           // 退出
  end;
end;

// 返回 SQL 字符串匹配通配符, 与数据库相关
function MyFuzzLetter(const sDatabaseType: string): string;
begin
  if sDatabaseType='MSACCESS' then
    Result:='*'
  else
    Result:='%';
end;

// 返回 SQL 字符串引号, 与数据库相关
function MyRefLetter(const sDatabaseType: string): string;
begin
  if (sDatabaseType='ORACLE') or (sDatabaseType='ODBC') then
    Result:=''''
  else
    Result:='"';
end;

procedure ClearCtrl(ParentControls:array of TWincontrol);
var
  iCount,iNumber:integer;
  parent : TWinControl;
begin
  for iNumber:=0 to length(parentControls)-1 do
  begin
    parent := parentControls[iNumber];
    for iCount:=0 to parent.ControlCount-1 do
    begin
    //TEdit
    if parent.controls[iCount] is TEdit then
    TEdit(parent.controls[iCount]).text:=''
    //TStaTicText
    else if parent.controls[iCount] is TStaticText then
    TStaticText(parent.controls[iCount]).Caption:='';
    end;
  end;
end;

//★★★
// 调用公式编译器，进行公式编译
// 输入参数：
//     sFormula：公式
//     sProcName：存储过程名称
// 输出参数：
//     sSQL：成功时=编译结果；失败时=列表信息
// 返回值：
//     0：成功
//     其他：错误号
function CompileFormula(const sFormula: string; var sSQL: string;
         const sProcName: string): integer;
var
  i, iRtn: integer;
  pList: array [1.._iCompilerBufLen] of char;
  pSQL:  array [1.._iCompilerBufLen] of char;
begin
  sSQL := '';
  iRtn := CP(pchar(sFormula),
             @pList,
             @pSQL,
             pchar(sProcName),
             0);
  if (iRtn = 0) then
    for i:=1 to _iCompilerBufLen do
      if (pSQL[i] <> #0) then
        sSQL := sSQL + pSQL[i]
      else
        break
  else
    for i:=1 to _iCompilerBufLen do
      if (pList[i] <> #0) then
        sSQL := sSQL + pList[i]
      else
        break;

  Result := iRtn;
end;

//★★★
// 调用公式编译器，进行公式编译
// 输入参数：
//     sFormula：公式
//     sProcName：存储过程名称
//     sVars：附加的变量定义
//     sStart：附加的开始语句
//     sEnd：附加的结束语句
// 输出参数：
//     sSQL：成功时=编译结果；失败时=列表信息
// 返回值：
//     0：成功
//     其他：错误号
function CompileFormula2(const sFormula: string; var sSQL: string;
         const sProcName: string; const sVars: string;
         const sStart: string; const sEnd: string): integer;
var
  i, iRtn: integer;
  pList: array [1.._iCompilerBufLen] of char;
  pSQL:  array [1.._iCompilerBufLen] of char;
begin
  sSQL := '';
  iRtn := CP2(pchar(sFormula),
             @pList,
             @pSQL,
             pchar(sProcName),
             0,
             pchar(sVars),
             pchar(sStart),
             pchar(sEnd));
  if (iRtn = 0) then
    for i:=1 to _iCompilerBufLen do
      if (pSQL[i] <> #0) then
        sSQL := sSQL + pSQL[i]
      else
        break
  else
    for i:=1 to _iCompilerBufLen do
      if (pList[i] <> #0) then
        sSQL := sSQL + pList[i]
      else
        break;

  Result := iRtn;
end;

//★★★
// 调用公式编译器，进行公式编译
// 输入参数：
//     sFormula：公式
//     sProcName：存储过程名称
//     sParams：附加的存储过程参数定义
//     sVars：附加的变量定义
//     sStart：附加的开始语句
//     sEnd：附加的结束语句
// 输出参数：
//     sSQL：成功时=编译结果；失败时=列表信息
// 返回值：
//     0：成功
//     其他：错误号
function CompileFormula3(const sFormula: string; var sSQL: string;
         const sProcName: string; const sParams: string; const sVars: string;
         const sStart: string; const sEnd: string): integer;
var
  i, iRtn: integer;
  pList: array [1.._iCompilerBufLen] of char;
  pSQL:  array [1.._iCompilerBufLen] of char;
begin
  sSQL := '';
  iRtn := CP3(pchar(sFormula),
             @pList,
             @pSQL,
             pchar(sProcName),
             0,
             pchar(sParams),
             pchar(sVars),
             pchar(sStart),
             pchar(sEnd));
  if (iRtn = 0) then
    for i:=1 to _iCompilerBufLen do
      if (pSQL[i] <> #0) then
        sSQL := sSQL + pSQL[i]
      else
        break
  else
    for i:=1 to _iCompilerBufLen do
      if (pList[i] <> #0) then
        sSQL := sSQL + pList[i]
      else
        break;

  Result := iRtn;
end;

//★★★
// 调用公式编译器，进行公式编译
// 输入参数：
//     sFormula：公式
//     sProcName：触发器名称
//     sRTable：替换用的实际数据表表名
// 输出参数：
//     sSQL：成功时=编译结果；失败时=列表信息
// 返回值：
//     0：成功
//     其他：错误号
function CompileFormula4(const sFormula: string; var sSQL: string;
         const sProcName: string; const sRTable: string): integer;
var
  i, iRtn: integer;
  pList: array [1.._iCompilerBufLen] of char;
  pSQL:  array [1.._iCompilerBufLen] of char;
begin
  sSQL := '';
  iRtn := CP4(pchar(sFormula),
             @pList,
             @pSQL,
             pchar(sProcName),
             pchar(sRTable),
             0);
  if (iRtn = 0) then
    for i:=1 to _iCompilerBufLen do
      if (pSQL[i] <> #0) then
        sSQL := sSQL + pSQL[i]
      else
        break
  else
    for i:=1 to _iCompilerBufLen do
      if (pList[i] <> #0) then
        sSQL := sSQL + pList[i]
      else
        break;

  Result := iRtn;
end;

// 调用公式编译器，进行合法性测试
// 输入参数：
//     sFormula：公式
// 输出参数：
//     sList：列表信息
//     iLineNo：出错行号
// 返回值：
//     0：公式合法
//     其他：错误号
function TestFormula(const sFormula: string; var sList: string;
         var iLineNo: integer): integer;
var
  i, iRtn: integer;
  pList: array [1.._iCompilerBufLen] of char;
begin
  sList := '';
  iRtn := CT(pchar(sFormula),
             @pList,
             0,
             i);
  iLineNo := i;
  for i:=1 to _iCompilerBufLen do
    if (pList[i] <> #0) then
      sList := sList + pList[i]
    else
      break;

  Result := iRtn;
end;

// 取当前程序的唯一标识符
procedure GetProgramID;
var
  acTmp1, acTmp2: array [1..255] of char;
  a,b: cardinal;
begin
  GetVolumeInformationA('C:\',@acTmp1, 254, @_iVolumn,
                        a, b, @acTmp2, 254) ;
  _iVolumn := _iVolumn and $7FFFFFFF ;
  _iThread := GetCurrentThreadID() and $7FFFFFFF ;
end;

// 返回唯一的名称
function UniqueFileName: string;
begin
  Inc(iUniqueID);
  Result := _sAppTmpPath + IntToStr(iUniqueID);
end;

//
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);
var
  Control: TStoredProc;
begin
  Control:= TStoredProc.Create(Application);
  Control.DatabaseName := 'taxcheck';
  Control.StoredProcName := 'Control;1';
  //Control.Active := True;
  with Control do
    begin
      Prepare;
      ParamByname('@Sign').asInteger:=Sign;
      ParamByname('@HDSerial').asInteger:=_iVolumn;
      ParamByname('@Thread').asInteger:=_iThread;
      ParamByname('@_sUserID').asstring:=_sUserID;
      ParamByname('@_iUserID').asInteger:=_iUserID;
      ParamByname('@_sUserName').asstring:=_sUserName;
      ParamByname('@_sPassWord').asstring:=_sPassWord;
      ParamByname('@_sRight').asstring:=_sRight;
      ParamByname('@_iDptID').asInteger:=_iDptID;
      ParamByname('@_sDptName').asstring:=_sDptName;
      ParamByname('@_sAgent').asstring:=_sAgent;
      ParamByname('@_iTaxID').asInteger:=_iTaxID;
      ParamByname('@_sTaxID').asstring:=_sTaxID;
      ParamByname('@_sTaxName').asstring:=_sTaxName;
      ParamByname('@_iPerPlanID').asInteger:=_iPerPlanID;
      ParamByname('@_iYear').asInteger:=_iPlanYear;
      ParamByname('@_sAccSession').asstring:=_sAccSession;
      ParamByname('@_sRptID').asstring:=_sRptID;
      ParamByname('@_sPlanID').asstring:=_sPlanID;
      ParamByname('@_iEnpID').asInteger:=_iEnpID;
      ParamByname('@_sEnpName').asstring:=_sEnpName;
      ParamByname('@_sEnpAddr').asstring:=_sEnpAddr;
      ParamByname('@_sEconType').asstring:=_sEconType;
      ParamByname('@_sEconName').asstring:=_sEconName;
      ParamByname('@_sTradeID').asstring:=_sTradeID;
      ParamByname('@_sTradeName').asstring:=_sTradeName;
      ParamByname('@_iProjectMngID').asInteger:=_iProjectMngID;
      ParamByname('@_sProjectMngName').asstring:=_sProjectMngName;
      ParamByname('@_sContractID').asstring:=_sContractID;
      try
        Execproc;
      except
        on E:Exception do
        begin
          ErrorHandler(E,'Control');
          Application.MessageBox('系统出现异常错误',PChar(_sAppTitle),mb_ok+mb_iconinformation);
        end;
      end;
    end;
    with Control do
    begin
      UnPrepare;
      Close;
      free;
    end;
end;



//---- 初始化部分, 作为整个系统的初始化.
initialization
  //-- 统一日期时间的格式: 修改相关系统变量.
  Application.UpdateFormatSettings := true; // 开放修改权限
  DateSeparator := '-';
  ShortDateFormat	:= 'yyyy-mm-dd';
  TimeSeparator := ':';
  ShortTimeFormat	:= 'hh:nn:ss';
  Application.UpdateFormatSettings := false;// 禁止后续修改

  //-- 本地计算机名称
  ssMachine := TServerSocket.Create(nil);
  ssMachine.Open;
  _sMachineName:=ssMachine.Socket.LocalHost;
  ssMachine.Close;
  ssMachine.Free;

  //-- 本程序标识
  GetProgramID;

  //-- 系统安装目录, 如 'C:\TimeData\'
  _sAppPath:=ExtractFilePath(Application.ExeName);
  _sAppTmpPath:=_sAppPath+'Tmp\'+_sMachineName+
                '\'+Trim(IntToStr(_iThread))+'\';
  if not DirectoryExists(_sAppTmpPath) then
  begin
    ForceDirectories(_sAppTmpPath);
    if not DirectoryExists(_sAppTmpPath) then
      Application.MessageBox(#13+'    无法创建临时目录。    '+#13,
                             pchar(_sAppTitle), MB_OK+MB_ICONWARNING);
  end;

end.