Ado protocol = TZQuery problem rev 82.

aperger · Post by **aperger** » 19.07.2006, 11:29

This version of the code (come from latest cvs entry) is ok:

{**
  Sets a variant value into specified parameter.
  @param ParameterIndex a index of the parameter.
  @param SqlType a parameter SQL type.
  @paran Value a new parameter value.
}
procedure TZAdoPreparedStatement.SetInParam(ParameterIndex: Integer;
  SQLType: TZSQLType; Value: TZVariant);
var
  S: Integer;
  HR: HResult;
  T: Integer;
  PC: Integer;
  P: ZPlainAdo.Parameter;
  B: IZBlob;
  V: Variant;
  OleDBCommand: IUnknown;
  OleDBCmdParams: ICommandWithParameters;
  OleDBCmdPrepare: ICommandPrepare;
  OleDBPC: Cardinal;
  ParamInfo: PDBParamInfo;
  NamesBuffer: PPOleStr;
begin
  PC := 0;
  if FAdoCommand.CommandType = adCmdStoredProc then
  begin
    try
//some providers generates exceptions here mainly for update statements
      PC := FAdoCommand.Parameters.Count;
    except
    end;
  end
  else
  begin
    OleDBCommand := (FAdoCommand as ADOCommandConstruction).OLEDBCommand;
    OleDBCommand.QueryInterface(ICommandWithParameters, OleDBCmdParams);
    ParamInfo := nil;
    NamesBuffer := nil;
    if Assigned(OleDBCmdParams) then
    begin
      HR := OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
//Access needs to be prepared for parameters
      if HR = DB_E_NOTPREPARED then
      begin
        OleDBCommand.QueryInterface(ICommandPrepare, OleDBCmdPrepare);
        if Assigned(OleDBCmdPrepare) then
        begin
          OleDBCmdPrepare.Prepare(0);
          OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
        end
      end;
      if Assigned(ParamInfo) then ZAdoMalloc.Free(ParamInfo);
      if Assigned(NamesBuffer) then ZAdoMalloc.Free(NamesBuffer);
      PC := OleDBPC;
    end;
  end;

  if (SQLType in [stAsciiStream, stUnicodeStream, stBinaryStream]) then
  begin
    B := DefVarManager.GetAsInterface(Value) as IZBlob;
    case SQLType of
      stAsciiStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsString(Value, B.GetString);
          SQLType := stString;
        end;
      stUnicodeStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsUnicodeString(Value, B.GetUnicodeString);
          SQLType := stUnicodeString;
        end;
      stBinaryStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsString(Value, BytesToStr(B.GetBytes));
          SQLType := stBytes;
        end;
    end;
  end;

  case Value.VType of
    vtNull: V := Null;
    vtBoolean: V := SoftVarManager.GetAsBoolean(Value);
    vtInteger: V := Integer(SoftVarManager.GetAsInteger(Value));
    vtFloat: V := SoftVarManager.GetAsFloat(Value);
    vtString: V := SoftVarManager.GetAsString(Value);
    vtUnicodeString: V := SoftVarManager.GetAsUnicodeString(Value);
    vtDateTime: V := SoftVarManager.GetAsDateTime(Value);
  end;

  S := 0;
  if SQLType = stString then
  begin
    S := Length(VarToStr(V));
    if S = 0 then
    begin
      S := 1;
      V := Null;
    end;
  end;

  if SQLType in [stUnicodeString] then
  begin
    S := Length(VarToWideStr(V));
    if S = 0 then
    begin
      S := 1;
      V := Null;
    end;
  end;

  if SQLType = stBytes then
  begin
    V := StrToBytes(VarToStr(V));
    if (VarType(V) and varArray) <> 0 then
      S := VarArrayHighBound(V, 1) + 1;
    if S = 0 then V := Null;
  end;

  if VarIsNull(V) then
    T := ConvertSqlTypeToAdo(SQLType)
  else
    T := ConvertVariantToAdo(VarType(V));

  if ParameterIndex <= PC then
  begin
    P := FAdoCommand.Parameters.Item[ParameterIndex - 1];
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Type_ := T;
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Size := S;
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Value := V;
  end
  else
  begin
    FAdoCommand.Parameters.Append(FAdoCommand.CreateParameter(
      'P' + IntToStr(ParameterIndex), T, adParamInput, S, V));
  end;
end;

And the latest one is not working (SVN rev 82):

Code: Select all

{**
  Sets a variant value into specified parameter.
  @param ParameterIndex a index of the parameter.
  @param SqlType a parameter SQL type.
  @paran Value a new parameter value.
}
procedure TZAdoPreparedStatement.SetInParam(ParameterIndex: Integer;
  SQLType: TZSQLType; const Value: TZVariant);
var
  S: Integer;
  HR: HResult;
  T: Integer;
  PC: Integer;
  P: ZPlainAdo.Parameter;
  B: IZBlob;
  V: Variant;
  OleDBCommand: IUnknown;
  OleDBCmdParams: ICommandWithParameters;
  OleDBCmdPrepare: ICommandPrepare;
  OleDBPC: Cardinal;
  ParamInfo: PDBParamInfo;
  NamesBuffer: PPOleStr;
  RetValue: TZVariant;
begin
  PC := 0;
  if FAdoCommand.CommandType = adCmdStoredProc then
  begin
    try
//some providers generates exceptions here mainly for update statements
      PC := FAdoCommand.Parameters.Count;
    except
    end;
  end
  else
  begin
    OleDBCommand := (FAdoCommand as ADOCommandConstruction).OLEDBCommand;
    OleDBCommand.QueryInterface(ICommandWithParameters, OleDBCmdParams);
    ParamInfo := nil;
    NamesBuffer := nil;
    if Assigned(OleDBCmdParams) then
    begin
      HR := OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
//Access needs to be prepared for parameters
      if HR = DB_E_NOTPREPARED then
      begin
        OleDBCommand.QueryInterface(ICommandPrepare, OleDBCmdPrepare);
        if Assigned(OleDBCmdPrepare) then
        begin
          OleDBCmdPrepare.Prepare(0);
          OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
        end
      end;
      if Assigned(ParamInfo) then ZAdoMalloc.Free(ParamInfo);
      if Assigned(NamesBuffer) then ZAdoMalloc.Free(NamesBuffer);
      PC := OleDBPC;
    end;
  end;

  if (SQLType in [stAsciiStream, stUnicodeStream, stBinaryStream]) then
  begin
    B := DefVarManager.GetAsInterface(Value) as IZBlob;
    case SQLType of
      stAsciiStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsString(RetValue, B.GetString);
          SQLType := stString;
        end;
      stUnicodeStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsUnicodeString(RetValue, B.GetUnicodeString);
          SQLType := stUnicodeString;
        end;
      stBinaryStream:
        begin
          if Assigned(B) then
            DefVarManager.SetAsString(RetValue, BytesToStr(B.GetBytes));
          SQLType := stBytes;
        end;
    end;
  end;

  case RetValue.VType of
    vtNull: V := Null;
    vtBoolean: V := SoftVarManager.GetAsBoolean(RetValue);
    vtInteger: V := Integer(SoftVarManager.GetAsInteger(RetValue));
    vtFloat: V := SoftVarManager.GetAsFloat(RetValue);
    vtString: V := SoftVarManager.GetAsString(RetValue);
    vtUnicodeString: V := SoftVarManager.GetAsUnicodeString(RetValue);
    vtDateTime: V := SoftVarManager.GetAsDateTime(RetValue);
  end;

  S := 0;
  if SQLType = stString then
  begin
    S := Length(VarToStr(V));
    if S = 0 then
    begin
      S := 1;
      V := Null;
    end;
  end;

  if SQLType in [stUnicodeString] then
  begin
    S := Length(VarToWideStr(V));
    if S = 0 then
    begin
      S := 1;
      V := Null;
    end;
  end;

  if SQLType = stBytes then
  begin
    V := StrToBytes(VarToStr(V));
    if (VarType(V) and varArray) <> 0 then
      S := VarArrayHighBound(V, 1) + 1;
    if S = 0 then V := Null;
  end;

  if VarIsNull(V) then
    T := ConvertSqlTypeToAdo(SQLType)
  else
    T := ConvertVariantToAdo(VarType(V));

  if ParameterIndex <= PC then
  begin
    P := FAdoCommand.Parameters.Item[ParameterIndex - 1];
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Type_ := T;
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Size := S;
    FAdoCommand.Parameters.Item[ParameterIndex - 1].Value := V;
  end
  else
  begin
    FAdoCommand.Parameters.Append(FAdoCommand.CreateParameter(
      'P' + IntToStr(ParameterIndex), T, adParamInput, S, V));
  end;
end;

aperger · Post by **aperger** » 19.07.2006, 11:50

If I try to understand the code, looks me if the Parameter Type is not BLOB/CLOB, IMAGE the parameter value is never set.

Terence · Post by **Terence** » 19.07.2006, 12:17

aperger wrote:

Code: Select all

>RetValue:=Value;
.........
B := DefVarManager.GetAsInterface(Value) as IZBlob;
.........
DefVarManager.SetAsString(RetValue, B.GetString);
.........
DefVarManager.SetAsUnicodeString(RetValue, B.GetUnicodeString);
.........
DefVarManager.SetAsString(RetValue, BytesToStr(B.GetBytes));
.........
  case RetValue.VType of
    vtNull: V := Null;
    vtBoolean: V := SoftVarManager.GetAsBoolean(RetValue);
    vtInteger: V := Integer(SoftVarManager.GetAsInteger(RetValue));
    vtFloat: V := SoftVarManager.GetAsFloat(RetValue);
    vtString: V := SoftVarManager.GetAsString(RetValue);
    vtUnicodeString: V := SoftVarManager.GetAsUnicodeString(RetValue);
    vtDateTime: V := SoftVarManager.GetAsDateTime(RetValue);
  end;

"RetValue:=Value;" this is required for correct working because all of the "DefVarManager.Set*/Get*" function use RetValue.

B := DefVarManager.GetAsInterface(Value) as IZBlob;
..writes Value to B and the B is written to RetValue depeding - eg on the Charset Unicode. Then depeding on Type ReValie is written to V and v later is posted, so it looks quite ok.

aperger · Post by **aperger** » 19.07.2006, 12:27

Hi

I understand you but the latest version is not working. If I use the CVS version everything is OK. There was not RetValue and Value was not a constant in this version. If I use version from SVN (rev 82.) I should set RetValue (RevValue := Value;) in the first line in the procedure after this modification everything is working correctly. Something is wrong.
Attila

Terence · Post by **Terence** » 19.07.2006, 13:33

If i understood ypu correctly the Value.VTyp is not correctly copied in method
GetAsInterface(Value). Here the typ shall be taken from Value and returned together with B.
Even i would suggest to add an "else " for branch
"case RetValue.VType of"

If we would have that already we won't have to search now for an error without exception.

Would you ckeck please what value RetValue.VType will have with revision 82?
I will also check the GetAsInterface(Value) for deep copy of typ.

Terence · Post by **Terence** » 19.07.2006, 13:38

The interface has typ "interface", concrete typ may be set again by using original Value.vtyp, if so the line "case RetValue.VType of" must be to changed to "case Value.VType of".
Your fix will also work, but isn't such "secure" and "readable".
Tx for your report, seems really to be a bug, sry it took me some time to see, its too hot here in Germany for clear thoughts.

If you confirm the bug fix i can commit to testing branch soon.

@mdaems: seems to be your lot, i just found you changed that behave. any idea?

aperger · Post by **aperger** » 19.07.2006, 15:00

Hi

Thanx... I try to follow your explamation and try to find the details in the code too. I will compare RetValue.VType and Value.VType in revison 82 and I will inform you, but I should work now, I will have time at night.
Thanks again.

aperger · Post by **aperger** » 19.07.2006, 15:13

TEST with revision 82

....
case RetValue.VType of
.....

At this point RetValue.VType is vtNull, because the parameter type in not a stream type

Code: Select all

if (SQLType in [stAsciiStream, stUnicodeStream, stBinaryStream] then

Somewhere in the else branch you should set the value from Value.VType and all of the fields in the RetValue record.

Attila

aperger · Post by **aperger** » 19.07.2006, 15:26

So... my solution is: attached!

Terence · Post by **Terence** » 20.07.2006, 05:26

1.) I can't click/see a link in your message above
2.) SQLType - Huh? That is something new. I was only talking of "VType" for
Value..but ok. The SQLType mybe null if you have eg "vtInteger" or "vtBoolean".
Then again the RetValue won't carry any value because never set.
More and more it looks for me as we have to completly remove the local var "RetValue" and replace it through "Value", elsethis whole code makes no sense. But of the Param got COnmst that is not possible, so your patch makes absolutly sense. I will apply it.

Terence · Post by **Terence** » 20.07.2006, 05:37

Would you test it a last time, just to be sure, then i will commit
http://cforce.dnsalias.org/files/patch_ ... ev82.patch

aperger · Post by **aperger** » 20.07.2006, 09:08

Terence wrote:Would you test it a last time, just to be sure, then i will commit
http://cforce.dnsalias.org/files/patch_ ... ev82.patch

Hi,
It is ok for me AND I have already test it.
Thanx.
Attila.

Terence · Post by **Terence** » 20.07.2006, 13:24

ok, changes have been commited to testing branch