要把過帳程式寫好,一般都需要花不少時間及經驗才有辦法結案,以下提供由SD Module自動產生的即時過帳原始碼讓各位參考! unit SINV04011_SELu; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, UpdateComp, DBTables, Variants, AutoNumber; type TSINV04011_SEL = class(TDataModule) ServiceManager: TServiceManager; Database: TDatabase; qryORDER_MASTER: TQuery; ucORDER_MASTER: TUpdateComponent; dsORDER_MASTER: TDataSource; qryORDER_DETAIL: TQuery; ucORDER_DETAIL: TUpdateComponent; procedure ucORDER_DETAILAfterInsert2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); procedure ucORDER_DETAILAfterModify2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); procedure ucORDER_DETAILAfterDelete2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); private { Private declarations } protected { Protected declarations } public { Public declarations } Function VarToInt(Value:Variant):Integer; Function VarToStr(Value:Variant):String; Function VarToFloat(Value:Variant):Double; Procedure GetInitValues(InitFields,InitValues:String;KeyFields,KeyValues:TStrings); Procedure GetStrings(StrList:String;Strings:TStrings); procedure AutoAppend(UpdateComponent:TUpdateComponent;Params: TParams; ParamObj: TParamObject;DataSet:TDataSet;TableName:String;InitFields,InitValues,DesKeyFields,DesKeyValues:String); Function GetSelectFieldList(FieldList,KeyFieldList:String):String; Function GetWhereSQL(Params:TParams;SrcKeyFieldList,DesKeyFieldList:String;RaiseExceptionWhenEmpty:Boolean=true):String; Function GetKeyValues(Params:TParams;SrcKeyFieldList,DeskeyFieldList:String;OlnyValue:Boolean):String; Function ChangeKeyFields(Params:TParams;UpdateType:String;SrcKeyFields:String):Boolean; Procedure ConstructOldParamsFromParams(Params:TParams;NewParams:TParams;SelectFieldList,KeyfieldList:String); Procedure ConstructNewParamsFromParams(Params:TParams;NewParams:TParams;SelectFieldList,KeyfieldList:String); Procedure ORDER_DETAIL_Trans(ServiceManager:TServiceManager;UpdateComponent:TUpdateComponent;Params:TParams;ParamObj:TParamObject;UpdateType:String); Function InitNull(FieldType:String):Variant; function GetFieldCurrentValue(Params: TParams; FieldName: string): Variant; function GetFieldOldValue(Params: TParams; FieldName: string; bGetNew: boolean=false): Variant; published { Published declarations } end; var SINV04011_SEL: TSINV04011_SEL; implementation {$R *.DFM} uses CommonUtils; procedure TSINV04011_SEL.ucORDER_DETAILAfterInsert2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); begin {#ORDER_DETAIL} ORDER_DETAIL_Trans(ServiceManager,Sender,Params,ParamObj,'Insert') {ORDER_DETAIL#} end; procedure TSINV04011_SEL.ucORDER_DETAILAfterModify2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); begin {#ORDER_DETAIL} ORDER_DETAIL_Trans(ServiceManager,Sender,Params,ParamObj,'Modify') {ORDER_DETAIL#} end; procedure TSINV04011_SEL.ucORDER_DETAILAfterDelete2(Sender: TUpdateComponent; SQL: String; Params: TParams; ParamObj: TParamObject); begin {#ORDER_DETAIL} ORDER_DETAIL_Trans(ServiceManager,Sender,Params,ParamObj,'Delete') {ORDER_DETAIL#} end; Function TSINV04011_SEL.VarToInt(Value:Variant):Integer; var WS:WideString; VType:integer; B:Boolean; begin VType := VarType(Value); try case VType and varTypeMask of varEmpty: Result:=0; varNull: Result:=0; varOleStr: begin WS:= value; Result:=StrToInt(WS); end; varString: Result:=StrToInt(WS); varByte, varSmallInt, varInteger, varSingle: begin Result:=Value; end; else Raise Exception.Create('DataType is mismatch!'); end; Except Raise; end; end; Function TSINV04011_SEL.VarToStr(Value:Variant):String; var WS:WideString; VType:integer; B:Boolean; begin VType := VarType(Value); try case VType and varTypeMask of varEmpty: Result:=''; varNull: Result:=''; varOleStr: begin WS:= value; Result:='''' Ws ''''; end; varString: Result:='''' Variants.VarToStr(Value) ''''; varByte: Result:=IntToStr(Value); varSmallInt:Result:=IntToStr(Value); varInteger: Result:=IntToStr(Value); varSingle: Result:=IntToStr(Value); varDouble: Result:=FloatToStr(Value); varCurrency:Result:=CurrToStr(Value); varDate: Result:=DateTimeToStr(VarToDateTime(Value)); varBoolean: begin B:=Value; Result:=IntToStr(Integer(B)); end; else Result:=''; end; Except Result:=''; end; end; Function TSINV04011_SEL.VarToFloat(Value:Variant):Double; var WS:WideString; VType:integer; B:Boolean; D:Double; begin VType := VarType(Value); try case VType and varTypeMask of varEmpty: Result:=0; varNull: Result:=0; varOleStr: begin WS:= value; Result:=StrToFloat(WS); end; varString: Result:=StrToFloat(WS); varByte, varSmallInt, varInteger, varSingle: begin D:=Value; Result:=D; end; varDouble: Result:=Value; varCurrency:Result:=Value; varDate: Result:=Value; varBoolean: begin D:=Value; Result:=D; end; else Result:=0; end; Except Result:=0; end; end; Procedure TSINV04011_SEL.GetInitValues(InitFields,InitValues:String;KeyFields,KeyValues:TStrings); var Field,Value:String; Index:integer; begin While InitFields<>'' do begin Field:=GetToken(InitFields,[',']); Value:=GetToken(InitValues,[',']); Index:=KeyFields.Indexof(Field); if Index<>-1 then Continue; KeyFields.Add(Field); KeyValues.Add(Value); end; end; Procedure TSINV04011_SEL.GetStrings(StrList:String;Strings:TStrings); var Field:String; Index:integer; begin While StrList<>'' do begin Field:=GetToken(StrList,[',']); Index:=Strings.Indexof(Field); if Index=-1 then Strings.Add(Field); end; end; procedure TSINV04011_SEL.AutoAppend(UpdateComponent:TUpdateComponent;Params: TParams; ParamObj: TParamObject;DataSet:TDataSet;TableName:String;InitFields,InitValues,DesKeyFields,DesKeyValues:String); var i: integer; Param: TParam; KeyFields,KeyValues : TStrings; KeyField:String; Field:TField; SQL:string; Query:TQuery; SQLFields:String; SQLValues:String; Value:String; begin KeyFields:=TStringList.Create; KeyValues:=TStringList.Create; ServiceManager.CreateQuery(ServiceManager.GetDefaultDatabaseName,Query); try //處理Init欄位 SQLFields:=''; SQLValues:=''; GetInitValues(InitFields,InitValues,KeyFields,KeyValues); //處理鍵值 GetStrings(DesKeyFields,KeyFields); GetStrings(DesKeyValues,KeyValues); For I := 0 to KeyFields.Count -1 do begin KeyField := KeyFields[i]; Field:=DataSet.FieldByName(KeyField); Value:=KeyValues[i]; if SQLFields<>'' then SQLFields:=SQLFields ','; if SQLValues<>'' then SQLValues:=SQLValues ','; SQLFields:=SQLFields KeyField; If Field.DataType in [ftString,ftWideString,ftfixedChar] then SQLValues:=SQLValues '''' Value '''' else SQLValues:=SQLValues Value; end; SQL := 'INSERT INTO ' TableName ' (' SQLFields ' ) Values ( ' SQLValues ' )'; Query.SQL.Text:=SQL; Query.ExecSQL; if Query.RowsAffected<=0 then Raise Exception.Create('Auto Append is error!'); finally KeyFields.free; KeyValues.free; Query.free; end; end; Function TSINV04011_SEL.GetSelectFieldList(FieldList,KeyFieldList:String):String; var Fields,KeyFields:TStrings; I:Integer; DesKeyField,SrcKeyField,SQL:String; Param:TParam; begin Fields:=TStringList.Create; KeyFields:=TStringList.create; try GetStrings(FieldList,Fields); GetStrings(KeyFieldList,KeyFields); Result:=''; For I:=0 to Fields.Count -1 do begin if Result<>'' then Result:=Result ','; Result:=Result Fields[i]; end; For I:=0 to KeyFields.Count -1 do begin if Result<>'' then Result:=Result ','; Result:=Result KeyFields[i]; end; finally KeyFields.free; Fields.free; end; end; Function TSINV04011_SEL.GetWhereSQL(Params:TParams;SrcKeyFieldList,DesKeyFieldList:String;RaiseExceptionWhenEmpty:Boolean=true):String; var SrcKeyFields,DesKeyFields:TStrings; I:Integer; DesKeyField,SrcKeyField,SQL:String; Param:TParam; begin SrcKeyFields:=TStringList.Create; DesKeyFields:=TStringList.create; try GetStrings(SrcKeyFieldList,SrcKeyFields); GetStrings(DesKeyFieldList,DesKeyFields); Result:=''; For I:=0 to SrcKeyFields.Count -1 do begin SrcKeyField:=SrcKeyFields[i]; DesKeyField:=DeskeyFields[i]; // Param:=Params.ParamByName(SrcKeyField); Param:=GetFieldOldParam(Params,SrcKeyField,true); if Param=nil then Raise Exception.CreateFmt('Cannot find Field:%s',[SrcKeyField]); SQL:=''; if Param.DataType in [ftString,ftWideString,ftFixedChar] then begin if Param.AsString<>'' then SQL:=DesKeyField '=' '''' Param.AsString '''' end else if Param.AsString<>'' then SQL:=DesKeyField '=' Param.AsString; if Param.AsString='' then if RaiseExceptionWhenEmpty then Raise Exception.CreateFmt('%s is empty!',[Param.Name]); if SQL<>'' then begin if Result<>'' then Result:=Result ' and '; Result:=Result SQL; end; end; finally SrcKeyFields.free; DesKeyFields.free; end; end; Function TSINV04011_SEL.GetKeyValues(Params:TParams;SrcKeyFieldList,DeskeyFieldList:String;OlnyValue:Boolean):String; var SrcKeyFields,DesKeyFields:TStrings; I:Integer; DesKeyField,SrcKeyField,DesField:String; Param:TParam; begin SrcKeyFields:=TStringList.Create; DeskeyFields:=TStringList.Create; try GetStrings(SrcKeyFieldList,SrcKeyFields); GetStrings(DeskeyFieldList,DesKeyFields); Result:=''; For I:=0 to SrcKeyFields.Count -1 do begin SrcKeyField:=SrcKeyFields[i]; Param:=Params.ParamByName(SrcKeyField); if Param=nil then Raise Exception.CreateFmt('Cannot find Field:%s',[SrcKeyField]); if Param.AsString='' then Continue; if Result<>'' then Result:=Result ','; if OlnyValue then Result:=Result Param.AsString else begin DesField:=DesKeyFields[i]; Result:=Result DesField '=' Param.AsString; end; end; finally SrcKeyFields.free; DesKeyFields.free; end; end; Function TSINV04011_SEL.ChangeKeyFields(Params:TParams;UpdateType:String;SrcKeyFields:String):Boolean; var s, FieldName: string; begin Result := False; if Comparetext(UpdateType , 'Modify')<>0 then exit; if SrcKeyFields='' then Raise Exception.Create('SrcKeyFields is empty!'); while SrcKeyFields <> '' do begin FieldName := GetToken(SrcKeyFields,[',']); //如果GetFieldNewValue是Empty代表沒有改. if VarIsEmpty(GetFieldNewValue(Params,FieldName)) then continue; Result := True; Break; end; end; Procedure TSINV04011_SEL.ConstructOldParamsFromParams(Params:TParams;NewParams:TParams;SelectFieldList,KeyfieldList:String); var FieldName: string; NewParam, aParam: TParam; i: integer; SelectFields: TStrings; begin SelectFields := TStringList.Create; try GetStrings(SelectFieldList,SelectFields); GetStrings(KeyfieldList,SelectFields); for i := 0 to SelectFields.Count -1 do begin FieldName := SelectFields[i]; aParam := Params.FindParam(OldValueLeading FieldName); NewParam := TParam(NewParams.Add); if aParam <> nil then begin NewParam.Assign(aParam); NewParam.Name := FieldName; end else begin aParam := Params.FindParam(FieldName); if aParam = nil then Raise Exception.CreateFmt('Field:%s in not in Params of updatecomponent.',[FieldName]); NewParam.Name := aParam.Name; NewParam.DataType := aParam.DataType; NewParam.AsInteger := 0; end; end; finally SelectFields.Free; end; end; Procedure TSINV04011_SEL.ConstructNewParamsFromParams(Params:TParams;NewParams:TParams;SelectFieldList,KeyfieldList:String); var FieldName: string; SelectFields: TStrings; NewParam, aParam: TParam; i: integer; begin SelectFields := TStringList.Create; try GetStrings(SelectFieldList,SelectFields); GetStrings(KeyfieldList,SelectFields); for i := 0 to SelectFields.Count -1 do begin FieldName := SelectFields[i]; aParam := Params.FindParam(FieldName); NewParam := TParam(NewParams.Add); if aParam <> nil then begin NewParam.Assign(aParam); NewParam.Value := GetFieldCurrentValue(Params,FieldName); end else Raise Exception.CreateFmt('Field:%s in not in Params of updatecomponent.',[FieldName]); end; finally SelectFields.Free; end; end; //本程式由訊光SA/SD產生 Procedure TSINV04011_SEL.ORDER_DETAIL_Trans(ServiceManager:TServiceManager;UpdateComponent:TUpdateComponent;Params:TParams;ParamObj:TParamObject;UpdateType:String); Procedure DoTransaction0_Name(DesTableName:String;Params:TParams;ParamObj:TParamObject;UpdateType:String); var SQL:String; UpdateSQL,WhereSQL:String; DBTable,Query:TQuery; DesFieldValue_V,DesFieldValue_S:Variant; KeyValues:Variant; OldValueWhere:String; AllDesFieldList:String; QTY_OValue:Double; QTY_NValue:Double; Procedure CheckDBTable(DesFieldList:String); var SelectSQL:String; DesKeyValues:String; SelectFieldList:String; WhereStatement:String; InitFields:String; InitValues:String; begin SelectFieldList:=GetSelectFieldList(DesFieldList,'PROD_NO'); WhereStatement:=GetWhereSQL(Params,'PROD_NO','PROD_NO'); if WhereStatement<>'' then WhereStatement:=' Where ' WhereStatement; SelectSQL:='Select ' SelectFieldList ' From ' DesTableName WhereStatement; DBTable.SQL.Text:=SelectSQL; DBTable.Open; DBTable.Next; DBTable.first; if DBTable.Eof then begin //-------AppendMode----------Auto----------- //抓取Key值 DesKeyValues:=GetKeyValues(Params,'PROD_NO','PROD_NO',true); //抓取一般欄位的Initial值 InitFields:=''; InitValues:=''; AutoAppend(UpdateComponent,Params,ParamObj,DBTable,'PRODUCT',InitFields,InitValues,'PROD_NO',DesKeyValues); end; DBTable.Close; DBTable.Open; end; begin ServiceManager.CreateQuery(ServiceManager.GetDefaultDatabaseName,DBTable); try AllDesFieldList:=''; AllDesFieldList:=AllDesFieldList 'QTY'; CheckDBTable(AllDesFieldList); UpdateSQL:=''; OldValueWhere:=''; if Comparetext(UpdateType,'Insert')=0 then begin UpdateSQL:=''; //--------QTY TransMode = Dec----------- QTY_NValue:=GetFieldCurrentValue(Params,'QTY'); DesFieldValue_V:=DBTable.FieldByName('QTY').AsFloat-VarToFloat(QTY_NValue); DesFieldValue_S:=VarToStr(DesFieldValue_V); if UpdateSQL<>'' then UpdateSQL:=UpdateSQL ','; UpdateSQL:=UpdateSQL 'QTY = ' DesFieldValue_S; //組舊值 if VarToStr(DBTable.FieldByName('QTY').Value)<>'' then begin if OldValueWhere<>'' then OldValueWhere:=OldValueWhere ' and '; OldValueWhere:=OldValueWhere ' QTY = ' VarToStr(DBTable.FieldByName('QTY').Value); end; end; if Comparetext(UpdateType,'Modify')=0 then begin UpdateSQL:=''; //--------QTY TransMode = Dec----------- QTY_NValue:=GetFieldCurrentValue(Params,'QTY'); QTY_OValue:=GetFieldOldValue(Params,'QTY',true); DesFieldValue_V:=DBTable.FieldByName('QTY').AsFloat-(VarToFloat(QTY_NValue)-VarToFloat(QTY_OValue)); DesFieldValue_S:=VarToStr(DesFieldValue_V); if UpdateSQL<>'' then UpdateSQL:=UpdateSQL ','; UpdateSQL:=UpdateSQL 'QTY = ' DesFieldValue_S; //組舊值 if VarToStr(DBTable.FieldByName('QTY').Value)<>'' then begin if OldValueWhere<>'' then OldValueWhere:=OldValueWhere ' and '; OldValueWhere:=OldValueWhere ' QTY = ' VarToStr(DBTable.FieldByName('QTY').Value); end; end; if Comparetext(UpdateType,'Delete')=0 then begin UpdateSQL:=''; //--------QTY TransMode = Dec----------- QTY_NValue:=GetFieldCurrentValue(Params,'QTY'); DesFieldValue_V:=DBTable.FieldByName('QTY').AsFloat VarToFloat(QTY_NValue); DesFieldValue_S:=VarToStr(DesFieldValue_V); if UpdateSQL<>'' then UpdateSQL:=UpdateSQL ','; UpdateSQL:=UpdateSQL ' QTY = ' DesFieldValue_S; //組舊值 if VarToStr(DBTable.FieldByName('QTY').Value)<>'' then begin if OldValueWhere<>'' then OldValueWhere:=OldValueWhere ' and '; OldValueWhere:=OldValueWhere ' QTY = ' VarToStr(DBTable.FieldByName('QTY').Value); end; end; //表示沒有任何欄位合乎條件. if UpdateSQL='' then exit; WhereSQL:=''; //必須Where舊值 WhereSQL:=GetWhereSQL(Params,'PROD_NO','PROD_NO'); if WhereSQL='' then Raise Exception.Create('PROD_NO is empty!'); if (OldValueWhere<>'') and (WhereSQL<>'') then WhereSQL:=WhereSQL ' and ' OldValueWhere; SQL:='Update ' DesTableName ' Set ' UpdateSQL ' Where ' WhereSQL; ServiceManager.CreateQuery(ServiceManager.GetDefaultDatabaseName,Query); try Query.SQL.Text:=SQL; Query.ExecSQL; if Query.RowsAffected<=0 then begin Raise Exception.CreateFmt('Transaction error! Table:%s; ValueList:%s',['PRODUCT',WhereSQL]); end; finally Query.free; end; finally DBTable.free; end; end; Procedure ExeTransaction0_Name; var Params1,Params2:TParams; SrcFieldList:String; AllSrcFieldList:String; begin if not ChangeKeyFields(Params,UpdateType,'PROD_NO') then DoTransaction0_Name('PRODUCT',Params,ParamObj,UpdateType) else begin Params1 := TFastParams.Create; Params2 := TFastParams.Create; try //扣除舊的Key值 AllSrcFieldList:=''; AllSrcFieldList:=AllSrcFieldList 'QTY'; ConstructOldParamsFromParams(Params,Params1,AllSrcFieldList,'PROD_NO'); //新增的新的Key值 ConstructNewParamsFromParams(Params,Params2,AllSrcFieldList,'PROD_NO'); DoTransaction0_Name('PRODUCT',Params1,ParamObj,'Delete'); DoTransaction0_Name('PRODUCT',Params2,ParamObj,'Insert'); finally Params1.free; Params2.free; end; end; //通知前端更改Table版本 UpdateComponent.IncTableVersion('PRODUCT'); end; begin // ORDER_DETAIL_Trans; //--------------Trasaction----begin-------- ExeTransaction0_Name; //--------------Trasaction----end-------- end; Function TSINV04011_SEL.InitNull(FieldType:String):Variant; begin Result:=''; if Comparetext('Double',Fieldtype)=0 then Result:=0; if Comparetext('Currency',Fieldtype)=0 then Result:=0; if Comparetext('Integer',Fieldtype)=0 then Result:=0; if Comparetext('SmallInt',Fieldtype)=0 then Result:=0; if Comparetext('String',Fieldtype)=0 then Result:=''; end; function TSINV04011_SEL.GetFieldCurrentValue(Params: TParams; FieldName: string): Variant; var Param:TParam; begin Result:=CommonUtils.GetFieldCurrentValue(Params,FieldName); if not VarIsNull(Result) then exit; param:=Params.FindParam(FieldName); Case Param.DataType of ftString,ftFixedChar, ftWideString: Result:=''; ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime: Result:=0; ftVariant: Result:=NULL; else Result:=''; end; end; function TSINV04011_SEL.GetFieldOldValue(Params: TParams; FieldName: string; bGetNew: boolean=false): Variant; var Param:TParam; begin Result:=CommonUtils.GetFieldOldValue(Params,FieldName,bGetNew); if not VarIsNull(Result) then exit; param:=Params.FindParam(FieldName); Case Param.DataType of ftString,ftFixedChar, ftWideString: Result:=''; ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime: Result:=0; ftVariant: Result:=NULL; else Result:=''; end; end; initialization RegisterPackageClass(TSINV04011_SEL); end.