H
hsgrass
Unregistered / Unconfirmed
GUEST, unregistred user!
// 网的有资料说ADO.savetostream,但这个不会使用,而且需要ADO2。5以上
// 下面的速度放在中间层里面比较慢,使用其它的程序,速度比这个快50%
// 有没有优化的方法?
// 谢谢
function TkbmMWCustomPooledDataset.CopyRawRecords(Source:TDataset;
Count:integer;
UnicodeOptions:TkbmMWUnicodeOptions):integer;
var
i:integer;
fc:integer;
f:TField;
fsrc,fdst:TField;
fi:array [0..KBM_MAX_FIELDS-1] of integer;
RecCnt:integer;
ProgressCnt:integer;
origIgnoreAutoIncPopulation:boolean;
origEnableVersioning:boolean;
pReckbmRecord;
bAutoUTF8:boolean;
begin
// Did we get valid parameters.
Result:=0;
if (Source=nil) or (Source=self) then
exit;
bAutoUTF8:=mwucAutoUTF8 in UnicodeOptions;
origIgnoreAutoIncPopulation:=FIgnoreAutoIncPopulation;
origEnableVersioning:=EnableVersioning;
Progress(0,mtpcCopy);
FIgnoreAutoIncPopulation:=true;
EnableVersioning:=false;
Common.Lock;
SetTempState(dsinsert);
try
//ticker := gettickcount;
source.DisableControls;
// add,18s --> 5s
// Build name index relations between destination and source dataset.
fc:=FieldCount-1;
for i:=0 to fcdo
begin
// Check if not a datafield or not a supported field,do
nt copy it.
case Fields.FieldKind of
fkLookup: fi:=-2;
//do
nt copy,do
nt clearout.
fkData,fkInternalCalc,fkCalculated:
begin
// If unknown datatype,do
nt copy, just leave untouched.
if not (Fields.DataType in (kbmSupportedFieldTypes)) then
begin
fi:=-1;
continue;
end;
// Find matching fieldnames on both sides. If fieldname not found,do
nt copy it, just clearout.
f:=Source.FindField(Fields.FieldName);
if f=nil then
begin
fi:=-1;
continue;
end;
{ Commented out to allow copying non datafields.
// If not a datafield just clearout.
if f.FieldKind<>fkData then
begin
fi:=-1;
continue;
end;
}
// else
copy the field.
fi:=f.Index;
end;
else
// Other fieldkind,do
nt copy, just clearout.
fi:=-1;
end;
end;
// Check number of records in source.
if Assigned(FOnProgress) then
begin
if Count>0 then
RecCnt:=Count
else
RecCnt:=Source.RecordCount;
end
else
RecCnt:=-1;
// Copy data.
FLoadedCompletely:=true;
if (RecCnt<=0) then
Progress(50,mtpcCopy);
ProgressCnt:=0;
while not Source.EOFdo
begin
// Update progress.
if (RecCnt>0) then
begin
inc(ProgressCnt);
if (ProgressCnt mod 100)=0 then
Progress(trunc(ProgressCnt/RecCnt*100),mtpcCopy);
end;
// Add record.
pRec:=TkbmProtCommon(Self.Common)._InternalAllocRecord;
FOverrideActiveRecordBuffer:=pRec;
// Transfer field contents.
for i:=0 to fcdo
begin
if fi>=0 then
begin
fsrc:=Source.Fields[fi];
fdst:=Fields;
if fsrc.IsNull then
fdst.Clear
else
{$IFDEF LEVEL5}
if fsrc is TLargeIntField then
fdst.AsString:=fsrc.AsString
{$IFDEF LEVEL6}
// Check if todo
automatic UTF8 conversion.
else
if bAutoUTF8 and ((fsrc.DataType=ftWideString) or (fdst.DataType=ftWideString)) then
begin
if fsrc.DataType=fdst.DataType then
fdst.Value:=fsrc.Value
else
if fsrc.DataType in [ftString,ftFixedChar] then
fdst.Value:=UTF8Decode(fsrc.AsString)
else
if fdst.DataType in [ftString,ftFixedChar] then
fdst.AsString:=UTF8Encode(fsrc.Value)
else
fdst.Value:=fsrc.Value;
end
{$ENDIF}
// Special error handling for ftOraClob and ftOraBlob fields
else
if ((fsrc is TBlobField) and (TBlobField(fsrc).BlobType in [ftOraClob,ftOraBlob])) then
begin
try
fdst.AsString:=fsrc.AsString;
except
on E: Exceptiondo
begin
// swallow the BDE error, check classname not to import BDE classes.
if E.ClassName='EDBEngineError' then
// ***IMPACT ALERT***
// this leaves the field defined but empty this breaks previous
// functionality where this and subsequent fields just weren't
// defined at all
fdst.Clear
else
raise E;
end;
end
end
else
{$ENDIF}
if fsrc.ClassType<>fdst.ClassType then
fdst.AsString:=fsrc.AsString
else
fdst.Value:=fsrc.Value;
end;
end;
// Finish the appended record.
with TkbmProtCommon(Self.Common), TkbmProtCustomMemTable(Self)do
begin
pRec^.RecordID:=FRecordID;
inc(FRecordID);
pRec^.UniqueRecordID:=FUniqueRecordID;
inc(FUniqueRecordID);
pRec^.Flag:=kbmrfInTable;
FRecords.Add(pRec);
end;
Source.next;
inc(Result);
if (Count>0) and (Result>=Count) then
begin
FLoadedCompletely:=false;
break;
end;
end;
//debug('CopyRawRecords=%d', [(gettickcount - ticker) div 1000]);
finally
source.EnableControls;
FIgnoreAutoIncPopulation:=origIgnoreAutoIncPopulation;
FOverrideActiveRecordBuffer:=nil;
EnableVersioning:=origEnableVersioning;
RestoreState(dsBrowse);
Common.UnLock;
Indexes.RebuildAll;
Resync([]);
Progress(100,mtpcCopy);
end;
end;
// 下面的速度放在中间层里面比较慢,使用其它的程序,速度比这个快50%
// 有没有优化的方法?
// 谢谢
function TkbmMWCustomPooledDataset.CopyRawRecords(Source:TDataset;
Count:integer;
UnicodeOptions:TkbmMWUnicodeOptions):integer;
var
i:integer;
fc:integer;
f:TField;
fsrc,fdst:TField;
fi:array [0..KBM_MAX_FIELDS-1] of integer;
RecCnt:integer;
ProgressCnt:integer;
origIgnoreAutoIncPopulation:boolean;
origEnableVersioning:boolean;
pReckbmRecord;
bAutoUTF8:boolean;
begin
// Did we get valid parameters.
Result:=0;
if (Source=nil) or (Source=self) then
exit;
bAutoUTF8:=mwucAutoUTF8 in UnicodeOptions;
origIgnoreAutoIncPopulation:=FIgnoreAutoIncPopulation;
origEnableVersioning:=EnableVersioning;
Progress(0,mtpcCopy);
FIgnoreAutoIncPopulation:=true;
EnableVersioning:=false;
Common.Lock;
SetTempState(dsinsert);
try
//ticker := gettickcount;
source.DisableControls;
// add,18s --> 5s
// Build name index relations between destination and source dataset.
fc:=FieldCount-1;
for i:=0 to fcdo
begin
// Check if not a datafield or not a supported field,do
nt copy it.
case Fields.FieldKind of
fkLookup: fi:=-2;
//do
nt copy,do
nt clearout.
fkData,fkInternalCalc,fkCalculated:
begin
// If unknown datatype,do
nt copy, just leave untouched.
if not (Fields.DataType in (kbmSupportedFieldTypes)) then
begin
fi:=-1;
continue;
end;
// Find matching fieldnames on both sides. If fieldname not found,do
nt copy it, just clearout.
f:=Source.FindField(Fields.FieldName);
if f=nil then
begin
fi:=-1;
continue;
end;
{ Commented out to allow copying non datafields.
// If not a datafield just clearout.
if f.FieldKind<>fkData then
begin
fi:=-1;
continue;
end;
}
// else
copy the field.
fi:=f.Index;
end;
else
// Other fieldkind,do
nt copy, just clearout.
fi:=-1;
end;
end;
// Check number of records in source.
if Assigned(FOnProgress) then
begin
if Count>0 then
RecCnt:=Count
else
RecCnt:=Source.RecordCount;
end
else
RecCnt:=-1;
// Copy data.
FLoadedCompletely:=true;
if (RecCnt<=0) then
Progress(50,mtpcCopy);
ProgressCnt:=0;
while not Source.EOFdo
begin
// Update progress.
if (RecCnt>0) then
begin
inc(ProgressCnt);
if (ProgressCnt mod 100)=0 then
Progress(trunc(ProgressCnt/RecCnt*100),mtpcCopy);
end;
// Add record.
pRec:=TkbmProtCommon(Self.Common)._InternalAllocRecord;
FOverrideActiveRecordBuffer:=pRec;
// Transfer field contents.
for i:=0 to fcdo
begin
if fi>=0 then
begin
fsrc:=Source.Fields[fi];
fdst:=Fields;
if fsrc.IsNull then
fdst.Clear
else
{$IFDEF LEVEL5}
if fsrc is TLargeIntField then
fdst.AsString:=fsrc.AsString
{$IFDEF LEVEL6}
// Check if todo
automatic UTF8 conversion.
else
if bAutoUTF8 and ((fsrc.DataType=ftWideString) or (fdst.DataType=ftWideString)) then
begin
if fsrc.DataType=fdst.DataType then
fdst.Value:=fsrc.Value
else
if fsrc.DataType in [ftString,ftFixedChar] then
fdst.Value:=UTF8Decode(fsrc.AsString)
else
if fdst.DataType in [ftString,ftFixedChar] then
fdst.AsString:=UTF8Encode(fsrc.Value)
else
fdst.Value:=fsrc.Value;
end
{$ENDIF}
// Special error handling for ftOraClob and ftOraBlob fields
else
if ((fsrc is TBlobField) and (TBlobField(fsrc).BlobType in [ftOraClob,ftOraBlob])) then
begin
try
fdst.AsString:=fsrc.AsString;
except
on E: Exceptiondo
begin
// swallow the BDE error, check classname not to import BDE classes.
if E.ClassName='EDBEngineError' then
// ***IMPACT ALERT***
// this leaves the field defined but empty this breaks previous
// functionality where this and subsequent fields just weren't
// defined at all
fdst.Clear
else
raise E;
end;
end
end
else
{$ENDIF}
if fsrc.ClassType<>fdst.ClassType then
fdst.AsString:=fsrc.AsString
else
fdst.Value:=fsrc.Value;
end;
end;
// Finish the appended record.
with TkbmProtCommon(Self.Common), TkbmProtCustomMemTable(Self)do
begin
pRec^.RecordID:=FRecordID;
inc(FRecordID);
pRec^.UniqueRecordID:=FUniqueRecordID;
inc(FUniqueRecordID);
pRec^.Flag:=kbmrfInTable;
FRecords.Add(pRec);
end;
Source.next;
inc(Result);
if (Count>0) and (Result>=Count) then
begin
FLoadedCompletely:=false;
break;
end;
end;
//debug('CopyRawRecords=%d', [(gettickcount - ticker) div 1000]);
finally
source.EnableControls;
FIgnoreAutoIncPopulation:=origIgnoreAutoIncPopulation;
FOverrideActiveRecordBuffer:=nil;
EnableVersioning:=origEnableVersioning;
RestoreState(dsBrowse);
Common.UnLock;
Indexes.RebuildAll;
Resync([]);
Progress(100,mtpcCopy);
end;
end;