I've installed the latest version 7.2.5 due to a bugfix of viewtopic.php?f=28&t=36459
Unfortunateley an Exception raises in PgClassesUni.pas function TPgSQLRecordSet.InternalCompareFieldValue on closing a form with TUniTables where Guid fields are used. That was not the case in previous versions of UniDac.
Search for **** more details in the code below. It goes wrong when ValueType = 38 = dtGuid. Is the fix I suggest right?
Regards,
Yves
Code: Select all
function TPgSQLRecordSet.InternalCompareFieldValue(ValuePtr: IntPtr; ValueType: Word; FieldBuf: IntPtr; FieldType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; const Options: TCompareOptions): integer;
var
str, str1: {$IFDEF NEXTGEN}string{$ELSE}AnsiString{$ENDIF};
v: variant;
Obj: TSharedObject;
NeedFree: boolean;
ts1, ts2: TCustomPgTimeStamp;
int1, int2: TPgInterval;
Geom1, Geom2: TPgGeometric;
begin
Obj := nil;
NeedFree := False;
try
case FieldType of
dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ: begin
ts2 := TCustomPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
ts1 := nil;
v := Unassigned;
case ValueType of
dtDateTime, dtDate, dtTime:
v := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(ValuePtr));
dtString:
v := Marshal.PtrToStringAnsi(ValuePtr);
dtWideString:
v := Marshal.PtrToStringUni(ValuePtr);
dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ:
ts1 := TCustomPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
else
Assert(False);
end;
if ts1 = nil then begin
case FieldType of
dtPgDate:
TPgBufferConverter.VarToPgDate(v, Obj, NeedFree);
dtPgTime:
TPgBufferConverter.VarToPgTime(v, ts2.HasTimeZone, Obj, NeedFree);
dtPgTimeStamp, dtPgTimeStampTZ:
TPgBufferConverter.VarToPgTimeStamp(v, Obj, NeedFree);
end;
ts1 := TCustomPgTimeStamp(Obj);
end;
Result := ts1.Compare(ts2);
end;
dtPgInterval: begin
int2 := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
int1 := nil;
v := Unassigned;
case ValueType of
dtString:
v := Marshal.PtrToStringAnsi(ValuePtr);
dtWideString:
v := Marshal.PtrToStringUni(ValuePtr);
dtPgInterval:
int1 := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
else
Assert(False);
end;
if int1 = nil then begin
TPgBufferConverter.VarToPgInterval(v, Obj, NeedFree);
int1 := TPgInterval(Obj);
end;
Result := int1.Compare(int2);
end;
dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle: begin
Geom2 := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
Geom1 := nil;
v := Unassigned;
case ValueType of
dtString:
v := Marshal.PtrToStringAnsi(ValuePtr);
dtWideString:
v := Marshal.PtrToStringUni(ValuePtr);
dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
Geom1 := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
else
Assert(False);
end;
if Geom1 = nil then begin
TPgBufferConverter.VarToPgGeometric(v, FieldType, Obj, NeedFree);
Geom1 := TPgGeometric(Obj);
end;
Result := AnsiCompareStr(Geom1.AsString, Geom2.AsString);
end;
dtGuid: begin
str := {$IFDEF NEXTGEN}string{$ELSE}AnsiString{$ENDIF}(Marshal.PtrToStringAnsi(FieldBuf));
case ValueType of
// dtString: begin // **** Original Devart Code
dtString, dtGuid: begin // **** Updated Code. Is this fix right???
str1 := {$IFDEF NEXTGEN}string{$ELSE}AnsiString{$ENDIF}(Marshal.PtrToStringAnsi(ValuePtr));
if (str1 <> '') and (str1[1] <> '{') then
str1 := '{' + str1 + '}';
end;
else
Assert(False);
end;
Result := AnsiCompareStr(AnsiUpperCase(str), AnsiUpperCase(str1));
end;
else
Result := inherited InternalCompareFieldValue(ValuePtr, ValueType, FieldBuf, FieldType, FieldLength, HasParent, IsFixed, Options);
end;
finally
if NeedFree then
Obj.Free;
end;
end;