2011年04月16日

[Delphi]CDSで縦フィールドを高速一括更新

TClientDataSet(CDS)に大量にレコードが登録されている場合に、あるフィールドの値を一括して書き換える関数。

データ量が多い場合に威力を発揮。当方では1万チョイの件数で、while not Eof 〜 Edit/Post で30秒が、この関数では4秒弱に。

XMLパーサーにはXercesを使用。MSXMLだと7秒強だったので...なので動かす環境にはXercesのDLLが必須。

使い方)
 // cdsList内の'FIELD_X'の値を(フィルター無関係に)全て'A'に書き換える
 CDSFieldUpdate(cdsList, 'FIELD_X', 'A');

 // cdsList内の'FIELD_X'の値を、フィルター対象のレコードを'A'に書き換える
 // →キーフィールドは'FIELD_A','FIELD_B'とする
 CDSFilterFieldUpdate(cdsList, 'FIELD_X', 'A', 'FIELD_A;FIELD_B');


 日付時刻の指定は'yyyy/mm/ddThh:nn:ss'で('T'を挟むのがミソ)

#相変わらずDelphi7で動作確認(^^;




// CDSのデータをXMLにして返す
//  ※呼び元で解放すること!
//  ・MergeChangeLogを呼ぶので以降のUndoなどは不可に
//  ・フィルター使用時も全てのデータが対象に
//  ・呼出時に編集モードの場合、解除される(Postと同様の効果)
function GetCDSXMLDoc(cds: TClientDataSet): TXMLDocument;
var
s: string;
begin
result := TXMLDocument.Create(Application);
with result do begin
DOMVendor := XercesDOM;
cds.MergeChangeLog;
s := cds.XMLData;

// CDS形式XMLの問題回避
XML.Text := ''
+ RightBStr(s, Length(s) - 40);

Active := true;
end;
end;

// CDSのフィールド値を高速に一括書き換え
//  ・フィルターは無関係に全てのレコードに効果が及ぶ
//  ・クローン&インデックス利用時、呼出前にクローン側インデックスの使用を解除する必要あり
//  ・MergeChangeLogを呼ぶので以降のUndoなどは不可に
//  ・フィールドが存在しない場合、例外を発生
//  ・呼出時に編集モードの場合、解除される(Postと同様の効果)
procedure CDSFieldUpdate(cds: TClientDataSet; sField, sVal: string);
var
nDefRec: integer;
idxDefs: TIndexDefs;
sDefIndexName: string;
xmlDoc: TXMLDocument;
bFindField: boolean;
ndFieldDef: IXMLNode;
ndRowData, ndRow: IXMLNode;
i: integer;
nd: IXMLNode;
begin
sField := UpperCase(sField);
nDefRec := cds.RecNo;

//// ※ここは別関数、まだこのブログにアップしてないので、呼び元で
//// インデックスを消して、関数終了後に復元する必要がある。
{
sDefIndexName := cds.IndexName;
idxDefs := BackupCDSIndex(cds);
ClearCDSIndex(cds);
}

xmlDoc := GetCDSXMLDoc(cds);
try
with xmlDoc do begin
// フィールド定義チェック
bFindField := false;
ndFieldDef := DocumentElement.ChildNodes['METADATA'].ChildNodes['FIELDS'];
for i := 0 to ndFieldDef.ChildNodes.Count - 1 do begin
if UpperCase(ndFieldDef.ChildNodes[i].Attributes['attrname']) = sField then begin
// フィールド発見
bFindField := true;
sField := ndFieldDef.ChildNodes[i].Attributes['attrname'];
break;
end;
end;

if not bFindField then begin
// フィールドなし、例外生成
raise Exception.Create('フィールドが見つかりません: ' + sField);
end;

// 書き換えループ
ndRowData := DocumentElement.ChildNodes['ROWDATA'];
for i := 0 to ndRowData.ChildNodes.Count - 1 do begin
ndRow := ndRowData.ChildNodes[i];
if ndRow.HasAttribute(sField) then begin
// 既存の値が存在する
if sVal = '' then begin
// 新値なし、削除
ndRow.AttributeNodes.Delete(sField);
end
else begin
// 新値あり、書き換え
ndRow.Attributes[sField] := sVal;
end;
end
else begin
// 既存なし
if sVal = '' then begin
// 新値もなし、次へ
continue;
end;

// 追加
nd := CreateNode(sField, ntAttribute);
nd.NodeValue := sVal;
ndRow.AttributeNodes.Add(nd);
end;
end;

// 書き戻し
cds.XMLData := XML.Text;
end;

finally
//// 上記同様
{
RestoreCDSIndex(cds, idxDefs);
cds.IndexName := sDefIndexName;
}
if nDefRec <= cds.RecordCount then begin
// 行指定が可能な場合
cds.RecNo := nDefRec;
end;

xmlDoc.Free;
idxDefs.Free;
end;
end;

// CDSのフィールド値を高速に一括書き換え(Filter有効版)
//  ・クローン&インデックス利用時、呼出前にクローン側インデックスの使用を解除する必要あり
//  ・呼び出し後のRecNoは不定
//  ・sKeyFieldsは指定した方が高速(フィールド名を';'区切りで。Locateの指定と同じ)
//  ・MergeChangeLogを呼ぶので以降のUndoなどは不可に
//  ・フィールドが存在しない場合、例外を発生
//  ・呼出時に編集モードの場合、解除される(Postと同様の効果)
procedure CDSFilterFieldUpdate(cds: TClientDataSet; sField, sVal: string;
sKeyFields: string = '');
var
lstKeyFiels: TStringList;
idxDefs: TIndexDefs;
sDefIndexName: string;
xmlDoc: TXMLDocument;
bFindField: boolean;
ndFieldDef: IXMLNode;
ndRowData, ndRow: IXMLNode;
i, j: integer;
nd: IXMLNode;
cdsWk: TClientDataSet;
aryStrs: array of string;
aryVals: array of TVarRec;

// 全フィールドを';'区切り文字列で返す
//  →sKeyFieldsが指定されなかった場合の主キーにする
function GetKeyFields(): string;
var
i: integer;
begin
result := '';
with cdsWk do begin
for i := 0 to Fields.Count - 1 do begin
result := result + IfThen(result <> '', ';') + Fields[i].FieldName;
end;
end;
end;

// FindKeyの検索キー(文字列)をセット(実体側)
procedure SetKeyStrs();
var
i: integer;
s: string;
begin
with lstKeyFiels do begin
for i := 0 to Count - 1 do begin
if ndRow.HasAttribute(lstKeyFiels[i]) then begin
// 中身あり
s := ndRow.Attributes[lstKeyFiels[i]];
end
else begin
// 空
s := '';
end;
aryStrs[i] := s;
end;
end;
end;

// オープン配列パラメータの指定要素にセット
procedure SetKeyElement(i: integer; ary: array of const);
begin
aryVals[i] := ary[0];
//aryVals[i].VString := ary[0].VString;
end;

// FindKeyのキー(オープン配列パラメータ)をセット
procedure SetKeyValue();
var
i: integer;
begin
with lstKeyFiels do begin
for i := 0 to Count - 1 do begin
if aryStrs[i] <> '' then begin
// 中身あり
SetKeyElement(i, [aryStrs[i]]);
end
else begin
// 中身なし
SetKeyElement(i, [nil]);
end;
end;
end;
end;

begin
if (not cds.Filtered) or (cds.Filter = '') then begin
// フィルターがないなら、普通の呼ぶほうが早い
CDSFieldUpdate(cds, sField, sVal);
exit;
end;

sField := UpperCase(sField);

//// 上記同様
{
sDefIndexName := cds.IndexName;
idxDefs := BackupCDSIndex(cds);
ClearCDSIndex(cds);
}

xmlDoc := GetCDSXMLDoc(cds);
cdsWk := TClientDataSet.Create(nil);
lstKeyFiels := TStringList.Create;
try
// CDSワーク構成
CopyDS2DS_WithStream(cds, cdsWk);
with cdsWk do begin
if sKeyFields = '' then begin
// キーフィールド指定なし、全フィールドで
sKeyFields := GetKeyFields();
end;

AddIndex('DEF', sKeyFields, []);
IndexName := 'DEF';

Filter := cds.Filter;
Filtered := true;
end;

with xmlDoc do begin
// フィールド定義チェック
// (書き込みフィールド)
bFindField := false;
ndFieldDef := DocumentElement.ChildNodes['METADATA'].ChildNodes['FIELDS'];
for i := 0 to ndFieldDef.ChildNodes.Count - 1 do begin
if UpperCase(ndFieldDef.ChildNodes[i].Attributes['attrname']) = sField then begin
// フィールド発見
bFindField := true;
sField := ndFieldDef.ChildNodes[i].Attributes['attrname'];
break;
end;
end;

if not bFindField then begin
// フィールドなし、例外生成
raise Exception.Create('フィールドが見つかりません: ' + sField);
end;

// (キーフィールド)
lstKeyFiels.Delimiter := ';';
lstKeyFiels.DelimitedText := sKeyFields;
for j := 0 to lstKeyFiels.Count - 1 do begin
bFindField := false;
for i := 0 to ndFieldDef.ChildNodes.Count - 1 do begin
if UpperCase(ndFieldDef.ChildNodes[i].Attributes['attrname']) = UpperCase(lstKeyFiels[j]) then begin
// フィールド発見
bFindField := true;
lstKeyFiels[j] := ndFieldDef.ChildNodes[i].Attributes['attrname'];
break;
end;
end;

if not bFindField then begin
// フィールドなし、例外生成
raise Exception.Create('フィールドが見つかりません: ' + lstKeyFiels[j]);
end;
end;


SetLength(aryStrs, lstKeyFiels.Count);
SetLength(aryVals, lstKeyFiels.Count);

// 書き換えループ
ndRowData := DocumentElement.ChildNodes['ROWDATA'];
for i := 0 to ndRowData.ChildNodes.Count - 1 do begin
ndRow := ndRowData.ChildNodes[i];

SetKeyStrs();
SetKeyValue();
if not cdsWk.FindKey(aryVals) then begin
// フィルター外、飛ばす
continue;
end;

if ndRow.HasAttribute(sField) then begin
// 既存の値が存在する
if sVal = '' then begin
// 新値なし、削除
ndRow.AttributeNodes.Delete(sField);
end
else begin
// 新値あり、書き換え
ndRow.Attributes[sField] := sVal;
end;
end
else begin
// 既存なし
if sVal = '' then begin
// 新値もなし、次へ
continue;
end;

// 追加
nd := CreateNode(sField, ntAttribute);
nd.NodeValue := sVal;
ndRow.AttributeNodes.Add(nd);
end;
end;

// 書き戻し
cds.XMLData := XML.Text;
end;

finally
//// 上記同様
{
RestoreCDSIndex(cds, idxDefs);
cds.IndexName := sDefIndexName;
}

xmlDoc.Free;
idxDefs.Free;
cdsWk.Free;
lstKeyFiels.Free;
end;
end;



タグ:Delphi CDS xml
posted by ありい at 18:41| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。
※ブログオーナーが承認したコメントのみ表示されます。
この記事へのトラックバックURL
http://blog.seesaa.jp/tb/196146927
※ブログオーナーが承認したトラックバックのみ表示されます。

この記事へのトラックバック
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。