Subject | Help! Simple routine keeps giving Invalid Pointer on close of app. |
---|---|
Author | Chuck Belanger |
Post date | 2009-09-25T15:19:48Z |
Hello:
I really need some help with a routine. On close of the sample app I
created it keeps giving "Invalid Pointer". It also causes the same in
the main application. I've spent many hours trying all kinds of possible
combinations without any luck.
The code seems simple and is similar to other code that I use without
this problem.
The sample app is a button which starts ResetIrrelevantITems. (code
below) This procedure does a WHILE not EOF loop through a dataset and
then calls a DSQL Update. That's it.
The apparent problem is when I call FillIrrelevant which has a FOR loop
that calls GetUserRegItem 8 times.
If I limit the call to only 1 time all is well.
GetUserRegItem() is a simple function with a query with two parameters
and returns an integer.
What can I do to call GetUserRegItem more than once. What am I missing?
Thank you,
Chuck Belanger
Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, fcStatusBar, IB_Components, StdCtrls, Buttons, fcProgressBar, DB,
IBODataset;
type
TForm1 = class(TForm)
fcProgressBar1: TfcProgressBar;
lblProgress: TStaticText;
btnStart: TBitBtn;
IB_Transaction1: TIB_Transaction;
ib_connection1: TIB_Connection;
qryAnyUse2: TIB_Query;
fcStatusBar1: TfcStatusBar;
qryAnyUse3: TIB_Query;
dsql_AnyUse3: TIB_DSQL;
procedure btnStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
IrrelevantFolderArray : Array of integer;
PROCEDURE ResetIrrelevantItems;
FUNCTION GetUserRegItem(RIOwner, OrigRIID : Integer) : Integer;
procedure FillIrrelevant;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnStartClick(Sender: TObject);
begin
resetIrrelevantItems;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IB_Connection1.Connected := true;
end;
FUNCTION TForm1.GetUserRegItem(RIOwner, OrigRIID : Integer) : Integer;
BEGIN
with qryAnyUse3 do
begin
{SQL:
Select RI_ID from REGISTRY_ITEMS
WHERE RI_Owner = :riowner
AND Old_RI_ID = :oldid
}
Prepare;
ParambyName('RIOWNER').asInteger := RIowner;
ParambyName('OldID').asInteger := OrigRIID;
Open;
IF EOF THEN
begin Result := -1 end
ELSE
begin Result := FieldByName('RI_ID').asInteger end;
Close;
end;
END;
procedure TForm1.FillIrrelevant;
var
i,OrigID, aOwner: integer;
begin
SetLength(IrrelevantFolderArray, 9 );
//fill the array
for i := 0 to 9 do
begin
case i of
0:
begin
OrigID := 49; //Irrelevant Items folder
aOwner := 11553424;
end;
1:
begin
OrigID := 17041; //Key Symptoms
aOwner := 11553424;
end;
2:
begin
OrigID := 17042; //OHI: Error Incl
aOwner := 11553424;
end;
3:
begin
OrigID := 17043; //OHI: Error Excl
aOwner := 11553424;
end;
4:
begin
OrigID := 17045; //Pract/Pat EDP Positive Statements
aOwner := 11553424;
end;
5:
begin
OrigID := 17046; //Pract/Pat TSK Positive Statements
aOwner := 11553424;
end;
6:
begin
OrigID := 17050;//Pract/Pat EDP Negative Statements
aOwner := 11553424;
end;
7:
begin
OrigID := 17051; //Pract/Pat TSK Negative Statements
aOwner := 11553424;
end;
8:
begin
OrigID := 17044;//Conditions
aOwner := 11553424;
end;
end; //case
//49 is actually a RC_ID, main folder parent
if OrigID <> 49 then
begin
IrrelevantFolderArray[i] := GetUserRegItem(aOwner, OrigID);
end
else
IrrelevantFolderArray[i] := 49;
end;//for
end;
PROCEDURE Tform1.ResetIrrelevantItems;
var
i ,j, x, OrigID, aOwner, ParentID: integer;
FoundFolder : boolean;
begin
fcProgressBar1.Visible := true;
x := 0;
lblProgress.Visible := true;
lblProgress.Caption := 'Resetting Registry Items';
lblProgress.update;
fcStatusBar1.SimpleText := 'Resetting Registry Items that are orphans in
Irrelevant Items Folder';
fcStatusBar1.update;
FillIrrelevant;
with qryAnyUse2 do
OPEN;
fcProgressBar1.Max := RecordCount;
First;
while not eof do
begin
ParentID := FieldByName('RI_PARENTID').asInteger;
for j := 0 to 8 do
begin
if ParentID = IrrelevantFolderArray[j] then
begin
FoundFolder := true;
Break;
end;
end; //for
//if not one of the regular parent folders or the main folder
//simply make the item a child of the main folder=Irrelevant ITems
if not FoundFolder then
begin
with dsql_AnyUse3 do
begin
ib_connection := IB_Connection1;
IB_Transaction := ib_transaction1;
SQL.Clear;
SQL.Add('Update Registry_Items ');
SQL.Add('Set RI_ParentID = 49');
SQL.Add('Where RI_ID = :RIID');
Prepare;
ParamByName('riid').asInteger :=
qryAnyUse2.FieldByName('RI_ID').asInteger;
ExecSQL;
end; //dsql
end;
Next;
FoundFolder := false;
Inc(x);
fcProgressBar1.Progress := x;
fcProgressBar1.Update;
end;//while
Close;
IB_Connection := nil;
end; //with qryAnyUse2 /IBQry
IB_Transaction1.Commit;
lblProgress.Visible := false;
lblProgress.Update;
end;
end.
I really need some help with a routine. On close of the sample app I
created it keeps giving "Invalid Pointer". It also causes the same in
the main application. I've spent many hours trying all kinds of possible
combinations without any luck.
The code seems simple and is similar to other code that I use without
this problem.
The sample app is a button which starts ResetIrrelevantITems. (code
below) This procedure does a WHILE not EOF loop through a dataset and
then calls a DSQL Update. That's it.
The apparent problem is when I call FillIrrelevant which has a FOR loop
that calls GetUserRegItem 8 times.
If I limit the call to only 1 time all is well.
GetUserRegItem() is a simple function with a query with two parameters
and returns an integer.
What can I do to call GetUserRegItem more than once. What am I missing?
Thank you,
Chuck Belanger
Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, fcStatusBar, IB_Components, StdCtrls, Buttons, fcProgressBar, DB,
IBODataset;
type
TForm1 = class(TForm)
fcProgressBar1: TfcProgressBar;
lblProgress: TStaticText;
btnStart: TBitBtn;
IB_Transaction1: TIB_Transaction;
ib_connection1: TIB_Connection;
qryAnyUse2: TIB_Query;
fcStatusBar1: TfcStatusBar;
qryAnyUse3: TIB_Query;
dsql_AnyUse3: TIB_DSQL;
procedure btnStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
IrrelevantFolderArray : Array of integer;
PROCEDURE ResetIrrelevantItems;
FUNCTION GetUserRegItem(RIOwner, OrigRIID : Integer) : Integer;
procedure FillIrrelevant;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnStartClick(Sender: TObject);
begin
resetIrrelevantItems;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IB_Connection1.Connected := true;
end;
FUNCTION TForm1.GetUserRegItem(RIOwner, OrigRIID : Integer) : Integer;
BEGIN
with qryAnyUse3 do
begin
{SQL:
Select RI_ID from REGISTRY_ITEMS
WHERE RI_Owner = :riowner
AND Old_RI_ID = :oldid
}
Prepare;
ParambyName('RIOWNER').asInteger := RIowner;
ParambyName('OldID').asInteger := OrigRIID;
Open;
IF EOF THEN
begin Result := -1 end
ELSE
begin Result := FieldByName('RI_ID').asInteger end;
Close;
end;
END;
procedure TForm1.FillIrrelevant;
var
i,OrigID, aOwner: integer;
begin
SetLength(IrrelevantFolderArray, 9 );
//fill the array
for i := 0 to 9 do
begin
case i of
0:
begin
OrigID := 49; //Irrelevant Items folder
aOwner := 11553424;
end;
1:
begin
OrigID := 17041; //Key Symptoms
aOwner := 11553424;
end;
2:
begin
OrigID := 17042; //OHI: Error Incl
aOwner := 11553424;
end;
3:
begin
OrigID := 17043; //OHI: Error Excl
aOwner := 11553424;
end;
4:
begin
OrigID := 17045; //Pract/Pat EDP Positive Statements
aOwner := 11553424;
end;
5:
begin
OrigID := 17046; //Pract/Pat TSK Positive Statements
aOwner := 11553424;
end;
6:
begin
OrigID := 17050;//Pract/Pat EDP Negative Statements
aOwner := 11553424;
end;
7:
begin
OrigID := 17051; //Pract/Pat TSK Negative Statements
aOwner := 11553424;
end;
8:
begin
OrigID := 17044;//Conditions
aOwner := 11553424;
end;
end; //case
//49 is actually a RC_ID, main folder parent
if OrigID <> 49 then
begin
IrrelevantFolderArray[i] := GetUserRegItem(aOwner, OrigID);
end
else
IrrelevantFolderArray[i] := 49;
end;//for
end;
PROCEDURE Tform1.ResetIrrelevantItems;
var
i ,j, x, OrigID, aOwner, ParentID: integer;
FoundFolder : boolean;
begin
fcProgressBar1.Visible := true;
x := 0;
lblProgress.Visible := true;
lblProgress.Caption := 'Resetting Registry Items';
lblProgress.update;
fcStatusBar1.SimpleText := 'Resetting Registry Items that are orphans in
Irrelevant Items Folder';
fcStatusBar1.update;
FillIrrelevant;
with qryAnyUse2 do
OPEN;
fcProgressBar1.Max := RecordCount;
First;
while not eof do
begin
ParentID := FieldByName('RI_PARENTID').asInteger;
for j := 0 to 8 do
begin
if ParentID = IrrelevantFolderArray[j] then
begin
FoundFolder := true;
Break;
end;
end; //for
//if not one of the regular parent folders or the main folder
//simply make the item a child of the main folder=Irrelevant ITems
if not FoundFolder then
begin
with dsql_AnyUse3 do
begin
ib_connection := IB_Connection1;
IB_Transaction := ib_transaction1;
SQL.Clear;
SQL.Add('Update Registry_Items ');
SQL.Add('Set RI_ParentID = 49');
SQL.Add('Where RI_ID = :RIID');
Prepare;
ParamByName('riid').asInteger :=
qryAnyUse2.FieldByName('RI_ID').asInteger;
ExecSQL;
end; //dsql
end;
Next;
FoundFolder := false;
Inc(x);
fcProgressBar1.Progress := x;
fcProgressBar1.Update;
end;//while
Close;
IB_Connection := nil;
end; //with qryAnyUse2 /IBQry
IB_Transaction1.Commit;
lblProgress.Visible := false;
lblProgress.Update;
end;
end.