ADOQUEYR复制到内存表(kbmmemtable),怎样可以更快?现在有代码复制速度不太理想,需要改进 ( 积分: 200 )

  • 主题发起人 主题发起人 hsgrass
  • 开始时间 开始时间
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;
pRec:PkbmRecord;
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;
 
// source=上面的QUERY,在建立ADO的时候已经尽量设置为最优。
// 有没有更好的?如果改用sdac之类的工作量太大,而且改动比较多。。。。。
function TkbmMWCustomADOXQuery.PerformQuery: TDataset;
var
q: TADOQuery;
c: TkbmMWADOXConnection;
begin
result := nil;
CoInitialize(nil);
c := TkbmMWADOXConnection(Connection);
// Open a new cursor.
q := TADOQuery.Create(nil);
try
q.Connection := c.FDatabase;
q.CursorType := ctOpenForwardOnly;
q.LockType := ltReadOnly;
// referencedo
c/Improving MDAC Application Performance.htm
q.CursorLocation := clUseServer;
q.CacheSize := 600;
// 按实际设置
q.SQL.Assign(CookedQuery);
ADOXCopyParamsValueAndType(Params, q.Parameters);
q.Open;

Params.Assign(q.Parameters);
Result := q;
self.RowsAffected := q.RecordCount;
finally
CoUninitialize;
end;
end;
 
dev有个内存表控件,你可参考一下它的代码
 
谢谢
看过一下,我需要快速的ADO与内存表复制.....
delphi 的provider的实现方法放在接口里面,
怎样提高速度阿............
 
传送ADODATASET,不进行转存。。。。。
给分
 

Similar threads

后退
顶部