?? untpub.~pas

?? 是分布式糧庫程序,是采用Delphi實現的
?? ~PAS
?? 第 1 頁 / 共 4 頁
字號:
上一頁 1 2 34
        ' (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.
上一頁 1 2 34
?? 文件大小 3901 K
?? 上傳用戶 k_oyy
?? 所屬分類 Delphi控件源碼
??? 相關標簽

#Delphi #分布式 #程序
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? untpub.~pas

?? 快捷鍵說明
