SD Module自動產生的即時過帳原始碼 |
|
t0922610976
一般會員 ![]() ![]() 發表:11 回覆:16 積分:15 註冊:2003-09-02 發送簡訊給我 |
要把過帳程式寫好,一般都需要花不少時間及經驗才有辦法結案,以下提供由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.
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |