(Bug?)用D7的朋友帮测试一下。 (200分)

河清

Unregistered / Unconfirmed
GUEST, unregistred user!
我用的是D7 (Build 4.453)
以下代码在D6.02下正常,在D7下无法通过。
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Form 代码
object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 416
Top = 160
Width = 120
Height = 13
Caption = '请更改数据然后按按钮'
end
object DBGrid1: TDBGrid
Left = 16
Top = 48
Width = 320
Height = 361
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Button1: TButton
Left = 464
Top = 184
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object IBDatabase1: TIBDatabase
DatabaseName =
'C:/Program Files/Borland/InterBase/examples/database/employee.gd' +
'b'
Params.Strings = (
'')
DefaultTransaction = IBTransaction1
IdleTimer = 0
SQLDialect = 1
TraceFlags = []
Left = 96
Top = 88
end
object IBTransaction1: TIBTransaction
Active = False
DefaultDatabase = IBDatabase1
Params.Strings = (
'read_committed'
'rec_version'
'nowait')
AutoStopAction = saNone
Left = 152
Top = 88
end
object IBQuery1: TIBQuery
Database = IBDatabase1
Transaction = IBTransaction1
BufferChunks = 1000
CachedUpdates = False
SQL.Strings = (
'select * from COUNTRY')
Left = 96
Top = 144
end
object DataSetProvider1: TDataSetProvider
DataSet = IBQuery1
Options = [poIncFieldProps]
Left = 152
Top = 144
end
object ClientDataSet1: TClientDataSet
Active = True
Aggregates = <>
Params = <>
ProviderName = 'DataSetProvider1'
Left = 200
Top = 152
end
object DataSource1: TDataSource
DataSet = ClientDataSet1
Left = 264
Top = 160
end
end
unit 代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, DBClient, IBCustomDataSet,
Provider, IBQuery, IBDatabase;
type
TForm1 = class(TForm)
IBDatabase1: TIBDatabase;
IBTransaction1: TIBTransaction;
IBQuery1: TIBQuery;
DataSetProvider1: TDataSetProvider;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if ClientDataSet1.ApplyUpdates(0)=0 then
showmessage('s');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientDataSet1.Active:=True;
end;

end.

 
if ClientDataSet1.ApplyUpdates(0)=0 then
showmessage('s');
.------------
捕獲錯誤不是這樣來的..........
try
except
end;
或者
procedure TForm1.ClientDataSet1ReconcileError(
DataSet: TCustomClientDataSet;
E: EReconcileError;
UpdateKind: TUpdateKind;
var Action: TReconcileAction);
begin
showmessage(e.message);
end;
 
RAISE抛出异常
连form代码都有,吐血了
 
问题出IBSQL的在下面代码:
procedure TIBSQL.PreprocessSQL;
var
cCurChar, cNextChar, cQuoteChar: Char;
sSQL, sProcessedSQL, sParamName: String;
i, iLenSQL, iSQLPos: Integer;
iCurState, iCurParamState: Integer;
iParamSuffix: Integer;
slNames: TStrings;
const
DefaultState = 0;
CommentState = 1;
QuoteState = 2;
ParamState = 3;
ParamDefaultState = 0;
ParamQuoteState = 1;
procedure AddToProcessedSQL(cChar: Char);
begin
sProcessedSQL[iSQLPos] := cChar;
Inc(iSQLPos);
end;

begin
slNames := TStringList.Create;
try
{do
some initializations of variables }
iParamSuffix := 0;
cQuoteChar := '''';
sSQL := FSQL.Text;
iLenSQL := Length(sSQL);
SetString(sProcessedSQL, nil, iLenSQL + 1);
i := 1;
iSQLPos := 1;
iCurState := DefaultState;
iCurParamState := ParamDefaultState;
{ Now, traverse through the SQL string, character by character,
picking out the parameters and formatting correctly for InterBase }
while (i <= iLenSQL)do
begin
{ Get the current token and a look-ahead }
cCurChar := sSQL;
if i = iLenSQL then
cNextChar := #0
else
cNextChar := sSQL[i + 1];
{ Now act based on the current state }
case iCurState of
DefaultState: begin
case cCurChar of
'''', '"': begin
cQuoteChar := cCurChar;
iCurState := QuoteState;
end;
'?', ':': begin
iCurState := ParamState;
AddToProcessedSQL('?');
end;
'/': if (cNextChar = '*') then
begin
AddToProcessedSQL(cCurChar);
Inc(i);
iCurState := CommentState;
end;
end;
end;
CommentState: begin
if (cNextChar = #0) then
IBError(ibxeSQLParseError, [SEOFInComment])
else
if (cCurChar = '*') then
begin
if (cNextChar = '/') then
iCurState := DefaultState;
end;
end;
QuoteState: begin
if cNextChar = #0 then
IBError(ibxeSQLParseError, [SEOFInString])
else
if (cCurChar = cQuoteChar) then
begin
if (cNextChar = cQuoteChar) then
begin
AddToProcessedSQL(cCurChar);
Inc(i);
end else
iCurState := DefaultState;
end;
end;
ParamState:
begin
{ collect the name of the parameter }
if iCurParamState = ParamDefaultState then
begin
if cCurChar = '"' then
iCurParamState := ParamQuoteState
else
if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
sParamName := sParamName + cCurChar
else
if [red]FGenerateParamNames[/red] then
[blue]本应该为True 但为 False[/blue]
begin
sParamName := 'IBXParam' + IntToStr(iParamSuffix);
{do not localize}
Inc(iParamSuffix);
iCurState := DefaultState;
slNames.Add(sParamName);
sParamName := '';
end
else
[red]IBError(ibxeSQLParseError, [SParamNameExpected]);[/red] end
else
begin
{ determine if Quoted parameter name is finished }
if cCurChar = '"' then
begin
Inc(i);
slNames.Add(sParamName);
SParamName := '';
iCurParamState := ParamDefaultState;
iCurState := DefaultState;
end
else
sParamName := sParamName + cCurChar
end;
{ determine if the unquoted parameter name is finished }
if (iCurParamState <> ParamQuoteState) and
(iCurState <> DefaultState) then
begin
if not (cNextChar in ['A'..'Z', 'a'..'z',
'0'..'9', '_', '$']) then
begin
Inc(i);
iCurState := DefaultState;
slNames.Add(sParamName);
sParamName := '';
end;
end;
end;
end;
if iCurState <> ParamState then
AddToProcessedSQL(sSQL);
Inc(i);
end;
AddToProcessedSQL(#0);
FSQLParams.Count := slNames.Count;
for i := 0 to slNames.Count - 1do
FSQLParams.AddName(slNames, i);
FProcessedSQL.Text := sProcessedSQL;
finally
slNames.Free;
end;
end;
 
呵呵,是测试代码,ClientDataset.ApplyUpdates的错误用try..except 是捕获不了的
 
出现什么异常,不要贴出这么多的代码,别人不可能耐心看的,
说明代码错误,并标出D6 d7下的特别处,解决是不难的
 

function TIBCustomDataSet.PSExecuteStatement(const ASQL: string;
AParams: TParams;
ResultSet: Pointer = nil): Integer;
var
FQuery: TIBDataSet;
i : Integer;
begin
if Assigned(ResultSet) then
begin
TDataSet(ResultSet^) := TIBDataSet.Create(nil);
with TIBDataSet(ResultSet^)do
begin
Database := Database;
Transaction := Transaction;
SelectSQL.Text := ASQL;
for i := 0 to AParams.Count - 1do
Params.ByName(AParams.Name).Value := AParams.Value;
Open;
Result := RowsAffected;
end;
end
else
begin
FQuery := TIBDataSet.Create(nil);
try
FQuery.Database := Database;
FQuery.Transaction := Transaction;
[red]// FQuery.GenerateParamNames := True;
此行代码在VCL中被注释掉了,在D6中是存在的,而且D7中TIBDataSet确实没有GenerateParamNames [/red]
FQuery.SelectSQL.Text := ASQL;
for i := 0 to AParams.Count - 1do
FQuery.Params.ByName(AParams.Name).Value := AParams.Value;
FQuery.ExecSQL;
Result := FQuery.RowsAffected;
finally
FQuery.Free;
end;
end;
end;
 
to:zhbj
我现在正在分析VCL,后两段代码是VCL中我分析出的可能问题点,第一段是测试程序,我自己的代码就就写了这么多
procedure TForm1.Button1Click(Sender: TObject);
begin
if ClientDataSet1.ApplyUpdates(0)=0 then
showmessage('s');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientDataSet1.Active:=True;
end;
 
聽說IB在d7了作了很大改動..你曼曼修改好了...
 
to:kouchun
啊,我原来开发系统一直用D6.02+Interbase6.5,前段时间刚转到D7,项目时间太紧,D7的IBX的可靠性究竟如何?不然我只好回到D6了
 
下栽了最新的IBX,问题解决。
 

Similar threads

I
回复
0
查看
615
import
I
I
回复
0
查看
658
import
I
I
回复
0
查看
560
import
I
I
回复
0
查看
2K
import
I
顶部