Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
690 views
in Technique[技术] by (71.8m points)

delphi - Is COM broken in XE2, and how might I work around it?

Update: XE2 Update 2 fixes the bug described below.

The program below, cutdown from the real program, fails with an exception in XE2. This is a regression from 2010. I don't have XE to test on but I'd expect that the program works fine on XE (thanks to Primo? for confirming that the code runs fine on XE).

program COMbug;

{$APPTYPE CONSOLE}

uses
  SysUtils, Variants, Windows, Excel2000;

var
  Excel: TExcelApplication;
  Book: ExcelWorkbook;
  Sheet: ExcelWorksheet;
  UsedRange: ExcelRange;
  Row, Col: Integer;
  v: Variant;

begin
  Excel := TExcelApplication.Create(nil);
  try
    Excel.Visible[LOCALE_USER_DEFAULT] := True;
    Book := Excel.Workbooks.Add(EmptyParam, LOCALE_USER_DEFAULT) as ExcelWorkbook;
    Sheet := Book.Worksheets.Add(EmptyParam, EmptyParam, 1, EmptyParam, LOCALE_USER_DEFAULT) as ExcelWorksheet;

    Sheet.Cells.Item[1,1].Value := 1.0;
    Sheet.Cells.Item[2,2].Value := 1.0;
    UsedRange := Sheet.UsedRange[LOCALE_USER_DEFAULT] as ExcelRange;
    for Row := 1 to UsedRange.Rows.Count do begin
      for Col := 1 to UsedRange.Columns.Count do begin
        v := UsedRange.Item[Row, Col].Value;
      end;
    end;
  finally
    Excel.Free;
  end;
end.

In XE2 32 bit the error is:

Project COMbug.exe raised exception class $C000001D with message 'system exception (code 0xc000001d) at 0x00dd6f3e'.

The error occurs on the second execution of UsedRange.Columns.

In XE2 64 bit the error is:

Project COMbug.exe raised exception class $C0000005 with message 'c0000005 ACCESS_VIOLATION'

Again, I think that the error occurs on the second execution of UsedRange.Columns, but the 64 bit debugger steps through the code in a slightly weird way so I'm not 100% sure of that.

I have submitted a QC report for the issue.

I looks very much to me as though something in the Delphi COM/automation/interface stack is comprehensively broken. This is a complete show-stopper for my XE2 adoption.

Does anyone have any experience of this problem? Does anyone have any tips and advice as to how I might attempt to work around the problem? Debugging what's really going on here is outside my area of expertise.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Workaround

rowCnt := UsedRange.Rows.Count;
colCnt := UsedRange.Columns.Count;
for Row := 1 to rowCnt do begin
  for Col := 1 to colCnt do begin
    v := UsedRange.Item[Row, Col].Value;
  end;
end;

This also works (and may help you find a workaround in more complicated use cases):

function ColCount(const range: ExcelRange): integer;
begin
  Result := range.Columns.Count;
end;

for Row := 1 to UsedRange.Rows.Count do begin
  for Col := 1 to ColCount(UsedRange) do begin
    v := UsedRange.Item[Row, Col].Value;
  end;
end;

Analysis

It crashes in System.Win.ComObj in DispCallByID when executing _Release in

varDispatch, varUnknown:
  begin
    if PPointer(Result)^ <> nil then
      IDispatch(Result)._Release;
    PPointer(Result)^ := Res.VDispatch;
  end;

Although the PUREPASCAL version of this same procedure in Delphi XE (XE uses an assembler version) is different ...

varDispatch, varUnknown:
  begin
    if PPointer(Result)^ <> nil then
      IDispatch(Result.VDispatch)._Release;
    PPointer(Result)^ := Res.VDispatch;
  end;

... the assembler code in both cases is the same (EDIT: not true, see my notes at the end):

@ResDispatch:
@ResUnknown:
        MOV     EAX,[EBX]
        TEST    EAX,EAX
        JE      @@2
        PUSH    EAX
        MOV     EAX,[EAX]
        CALL    [EAX].Pointer[8]
@@2:    MOV     EAX,[ESP+8]
        MOV     [EBX],EAX
        JMP     @ResDone

Interestingly enough, this crashes ...

for Row := 1 to UsedRange.Rows.Count do begin
  for Col := 1 to UsedRange.Columns.Count do begin
  end;
end;

... and this doesn't.

row := UsedRange.Rows.Count;
col := UsedRange.Columns.Count;
col := UsedRange.Columns.Count;

The reason for this is the use of hidden local variables. In the first example, the code compiles to ...

00564511 6874465600       push $00564674
00564516 6884465600       push $00564684
0056451B A12CF35600       mov eax,[$0056f32c]
00564520 50               push eax
00564521 8D8508FFFFFF     lea eax,[ebp-$000000f8]
00564527 50               push eax
00564528 E8933EEAFF       call DispCallByIDProc

... and that is called twice.

In the second example, two different temporary locations on the stack are used (ebp - ???? offsets):

00564466 6874465600       push $00564674
0056446B 6884465600       push $00564684
00564470 A12CF35600       mov eax,[$0056f32c]
00564475 50               push eax
00564476 8D8514FFFFFF     lea eax,[ebp-$000000ec]
0056447C 50               push eax
0056447D E83E3FEAFF       call DispCallByIDProc
...
0056449B 6874465600       push $00564674
005644A0 6884465600       push $00564684
005644A5 A12CF35600       mov eax,[$0056f32c]
005644AA 50               push eax
005644AB 8D8510FFFFFF     lea eax,[ebp-$000000f0]
005644B1 50               push eax
005644B2 E8093FEAFF       call DispCallByIDProc

The bug occurs when an internal interface stored in this temporary location is being cleared, which happens only when the "for" case is executed for the second time because there's something already stored in this interface - it was put there when "for" was called for the first time. In the second example, two locations are used so this internal interface is always initialized to 0 and Release is not called at all.

The true bug is that this internal interface contains garbage and when Release is called, sh!t happens.

After some more digging, I noticed that the assembler code that frees the old interface is not the same - XE2 version is missing one "mov eax, [eax]" instruction. IOW,

IDispatch(Result)._Release;

is a mistake and it really should be

IDispatch(Result.VDispatch)._Release;

Nasty RTL bug.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...