EUpdateError -2147217900 .

最新推荐文章于 2024-06-14 17:27:44 发布

hrdzkj

最新推荐文章于 2024-06-14 17:27:44 发布

阅读量1.6k

点赞数

分类专栏：其他

其他专栏收录该内容

43 篇文章

订阅专栏

http://blog.youkuaiyun.com/acrodelphi/article/details/6934815

Delphi XE（delphi7没有这个问题）

在用ADO+TClientDataSet删除数据时，用DataSetProvider.ApplyUpdates更新，DataSetProvider.ResolveToDataSet要设为false，为true时没有这个现象。

如果sqlserver2008数据库中有个触发器，它检查资料被别的表引用到了，用raiseerror拒绝删除。

[sql] view plain copy print ?

ALTER TRIGGER [dbo].[csMachinesCategories_Delete]
ON [dbo].[csMachinesCategories]
AFTER DELETE
AS
BEGIN
SET NOCOUNT ON;
if exists(select * from csMachinesSeries ,deleted as d
where csMachinesSeries.CategoryOID=d.CategoryOID)
begin
raiserror('Current machine category is using by machine series,can`t delete!',11,1)
rollback
end
delete s from csMachinesCategoriesSpecs as s,deleted as d
where s.CategoryOID=d.CategoryOID
END

ALTER TRIGGER [dbo].[csMachinesCategories_Delete]
   ON  [dbo].[csMachinesCategories]
   AFTER DELETE
AS 
BEGIN
	SET NOCOUNT ON;
    if exists(select * from csMachinesSeries ,deleted as d 
              where csMachinesSeries.CategoryOID=d.CategoryOID)
    begin
      raiserror('Current machine category is using by machine series,can`t delete!',11,1) 
      rollback
    end
    
    delete s from csMachinesCategoriesSpecs as s,deleted as d
    where s.CategoryOID=d.CategoryOID
END

BizServer会产生如下错误：

先是这个：

Project Project6.exe raised exception class EDatabaseError with message 'Unable to find record. No key specified'.

再出现这个：

Project Project6.exe raised exception class EDatabaseError with message '-2147217900 is not a valid value for field 'ERROR_CODE'. The allowed range is 0 to 4294967295'.

-2147217900的16进制是：FFFFFFFF80040E14，delphi的EUpdateError的ErrorCode数据类型是Integer，看起来是超界了，但-2147217900并没有超过integer的范围，integer的范围是-2147483648..2147483647，那怎么回事呢？

跟踪发现错误点在Provider.pas

[delphi] view plain copy print ?

procedure TUpdateTree.InitErrorPacket(E: EUpdateError; Response: TResolverResponse);
var
TrueRecNo: LongWord;
begin
with ErrorDS do
begin
if Assigned(Parent) then Parent.InitErrorPacket(nil, rrSkip);
Self.Delta.UpdateCursorPos;
Self.Delta.DSCursor.GetRecordNumber(TrueRecNo);
if not Locate('ERROR_RECORDNO', Integer(TrueRecNo), []) then
Append else
Edit;
if not Assigned(E) then
begin
if Response = rrSkip then
begin
SetFields([TrueRecNo]);
Post;
end else
SetFields([TrueRecNo, 0, '', '', 0, 0]);
end else
SetFields([TrueRecNo, Ord(Response)+1, E.Message, '', 1, E.ErrorCode]);
end;
end;

procedure TUpdateTree.InitErrorPacket(E: EUpdateError; Response: TResolverResponse);
var
  TrueRecNo: LongWord;
begin
  with ErrorDS do
  begin
    if Assigned(Parent) then Parent.InitErrorPacket(nil, rrSkip);
    Self.Delta.UpdateCursorPos;
    Self.Delta.DSCursor.GetRecordNumber(TrueRecNo);
    if not Locate('ERROR_RECORDNO', Integer(TrueRecNo), []) then
      Append else
      Edit;
    if not Assigned(E) then
    begin
      if Response = rrSkip then
      begin
        SetFields([TrueRecNo]);
        Post;
      end else
        SetFields([TrueRecNo, 0, '', '', 0, 0]);
    end else
      SetFields([TrueRecNo, Ord(Response)+1, E.Message, '', 1, E.ErrorCode]);
  end;
end;

而'ERROR_CODE'字段的类型是TLongWordField，在DB.pas对其赋值时，检查了范围：

[delphi] view plain copy print ?

procedure TLongWordField.SetAsInteger(Value: LongInt);
begin
if (FMinValue <> 0) or (FMaxValue <> 0) then begin
if Value < 0 then
RangeError(Value, FMinValue, FMaxValue);
CheckRange(Value, FMinValue, FMaxValue)
end else begin
if Value < 0 then
RangeError(Value, FMinRange, FMaxRange);
CheckRange(Value, FMinRange, FMaxRange);
end;
SetData(@Value);
end;

procedure TLongWordField.SetAsInteger(Value: LongInt);
begin
  if (FMinValue <> 0) or (FMaxValue <> 0) then begin
    if Value < 0 then
      RangeError(Value, FMinValue, FMaxValue);
    CheckRange(Value, FMinValue, FMaxValue)
  end else begin
    if Value < 0 then
      RangeError(Value, FMinRange, FMaxRange);
    CheckRange(Value, FMinRange, FMaxRange);
  end;
  SetData(@Value);
end;

所以，问题在于，delphi认为ErrorCode应该是LongWord，不应该出现负数，或者说SQLServer是使用int64来表示ErrorCode。

如何修改呢或避免呢？

（1）改法1，ds.cpp

[cpp] view plain copy print ?

// Set the sixth field for the error code.
LdStrCpy((pCHAR)pFldDes->szName, szdsERRCODE);
pFldDes->iFldType = fldUINT32;
pFldDes->iFldLen = sizeof(UINT32);
pFldDes++;

      // Set the sixth field for the error code.
      LdStrCpy((pCHAR)pFldDes->szName, szdsERRCODE);
      pFldDes->iFldType = fldUINT32;
      pFldDes->iFldLen = sizeof(UINT32);
      pFldDes++;

把fldUINT32改成fldINT32，改了编译midas.cbproj，还是不行（使用Midaslib.pas)

（2）改法2，DB.pas

[delphi] view plain copy print ?

procedure TField.AssignValue(const Value: TVarRec);
procedure Error;
begin
DatabaseErrorFmt(SFieldValueError, [DisplayName]);
end;
begin
with Value do
case VType of
vtInteger:
//AsInteger := VInteger; //delete by wxh
asVariant:=VInteger; //add by wxh
vtBoolean:
AsBoolean := VBoolean;
vtChar:
AsAnsiString := VChar;
vtWideChar:
AsString := VWideChar;
vtExtended:
AsExtended := VExtended^;
vtString:
AsString := string(VString^);
vtPointer:
if VPointer <> nil then Error;
vtPChar:
AsString := string(VPChar);
vtPWideChar:
AsString := string(VPWideChar);
vtObject:
if (VObject = nil) or (VObject is TPersistent) then
Assign(TPersistent(VObject))
else
Error;
vtAnsiString:
AsAnsiString := AnsiString(VAnsiString);
vtCurrency:
AsCurrency := VCurrency^;
vtVariant:
if not VarIsClear(VVariant^) then AsVariant := VVariant^;
vtWideString:
AsWideString := WideString(VWideString);
vtInt64:
AsVariant := VInt64^;
vtUnicodeString:
AsString := string(VUnicodeString);
else
Error;
end;
end;

procedure TField.AssignValue(const Value: TVarRec);

  procedure Error;
  begin
    DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  end;

begin
  with Value do
    case VType of
      vtInteger:
        //AsInteger := VInteger;   //delete by wxh
        asVariant:=VInteger;       //add by wxh
      vtBoolean:
        AsBoolean := VBoolean;
      vtChar:
        AsAnsiString := VChar;
      vtWideChar:
        AsString := VWideChar;
      vtExtended:
        AsExtended := VExtended^;
      vtString:
        AsString := string(VString^);
      vtPointer:
        if VPointer <> nil then Error;
      vtPChar:
        AsString := string(VPChar);
      vtPWideChar:
        AsString := string(VPWideChar);
      vtObject:
        if (VObject = nil) or (VObject is TPersistent) then
          Assign(TPersistent(VObject))
        else
          Error;
      vtAnsiString:
        AsAnsiString := AnsiString(VAnsiString);
      vtCurrency:
        AsCurrency := VCurrency^;
      vtVariant:
        if not VarIsClear(VVariant^) then AsVariant := VVariant^;
      vtWideString:
        AsWideString := WideString(VWideString);
      vtInt64:
        AsVariant := VInt64^;
      vtUnicodeString:
        AsString := string(VUnicodeString);
    else
      Error;
    end;
end;

但这种改法对这个问题看起来对了，但其实有很大问题。

向Embarcadero报告，答复这里有Hotfix可以解决：

http://edn.embarcadero.com/article/41312

http://cc.embarcadero.com/item/28247

网速极慢，下载后，看到是修改了Provider.pas的TUpdateTree.InitErrorPacket：

[delphi] view plain copy print ?

SetFields([TrueRecNo, Ord(Response)+1, E.Message, '', 1, Variant(LongWord(E.ErrorCode))]);

      SetFields([TrueRecNo, Ord(Response)+1, E.Message, '', 1, Variant(LongWord(E.ErrorCode))]);

测试后，没有问题了。