I'm trying to write a stored procedure that should insert data into a table only for records within the range of 0 and 350.
It gets two integers as a parameter
CREATE PROCEDURE SP_MesaEnRango
(#nroMesa INT,
#cantidadVotantes INT)
AS
BEGIN
IF #nroMesa IS NOT NULL OR #cantidadVotantes IS NOT NULL OR
#cantidadVotantes < 0 OR #cantidadVotantes > 350
BEGIN
DECLARE #errorMessage NVARCHAR(50);
BEGIN TRANSACTION;
BEGIN TRY
INSERT INTO Mesas (nroMesa, cantidadVotantes)
VALUES (#nroMesa, #cantidadVotantes);
END TRY
BEGIN CATCH
SET #errorMessage = 'ERROR';
IF ##TRANCOUNT > 0
BEGIN
ROLLBACK TRANSACTION;
END;
END CATCH;
IF ##TRANCOUNT > 0
BEGIN
COMMIT TRANSACTION;
END;
END;
I get a syntax error near to ';'
You are missing an END at the very end to complete the procedure body. If you indent consistently and keep your BEGINs and ENDs lined up, you'll have an easier time spotting these kinds of issues. Here's a reformatted version of your code with the missing END added:
CREATE PROCEDURE SP_MesaEnRango
(#nroMesa int,
#cantidadVotantes int)
AS
BEGIN
IF #nroMesa IS NOT NULL OR
#cantidadVotantes IS NOT NULL OR
#cantidadVotantes < 0 OR
#cantidadVotantes > 350
BEGIN
DECLARE #errorMessage nvarchar(50);
BEGIN TRANSACTION;
BEGIN TRY
INSERT INTO Mesas (nroMesa,cantidadVotantes)
VALUES (#nroMesa,#cantidadVotantes);
END TRY
BEGIN CATCH
SET #errorMessage = 'ERROR';
IF ##TRANCOUNT > 0
BEGIN
ROLLBACK TRANSACTION;
END
END CATCH
IF ##TRANCOUNT > 0
BEGIN
COMMIT TRANSACTION;
END
END
END
Related
I have a dataset, and I'm using this to catch the errors:
try
FDataSource.DataSet.Post;
ShowMessage('success message!');
except
on E : EDatabaseError do
begin
if (Pos('duplicate value', E.Message) > 0) or (Pos('duplicate key', E.Message) > 0) then
ShowMessage('my custom error message')
else
ShowMessage('generic db error message');
end;
end;
This is a horrible solution cause it's relying on finding the string 'duplicate value' or 'duplicate key' on the error message.
I want to be able to get some error code.
Is there any way to get it?
You may be able to catch the error via your AdoConnection object.
The TAdoConnection has an Errors object (see definition in AdoInt.Pas). To
investigate it, I used a stored proc on the server defined as
create PROCEDURE [dbo].[spRaiseError](#AnError int)
AS
BEGIN
declare #Msg Char(20)
if #AnError > 0
begin
Select #Msg = 'MyError ' + convert(Char(8), #AnError)
RaisError(#Msg, 16, -1)
end
else
select 1
END
Then, in my Delphi code I have something like this:
uses [...] AdoInt, AdoDB, [...]
procedure TForm1.Button1Click(Sender: TObject);
var
S : String;
IErrors : Errors;
IError : Error;
ErrorCount : Integer;
i : Integer;
begin
S := 'exec spRaiseError ' + Edit1.Text;
AdoQuery1.SQL.Text := S;
try
AdoQuery1.Open;
except
IErrors := AdoConnection1.Errors;
ErrorCount := IErrors.Count;
for i := 0 to ErrorCount - 1 do begin
IError := IErrors.Item[i];
S := Format('error: %d, source: %s description: %s', [i, IError.Source, IError.Description]);
Memo1.Lines.Add(S);
end;
Caption := IntToStr(ErrorCount);
end;
end;
If I set AdoQuery1's Sql.Text to 'select * from anything' I get
error: 0, source: Microsoft OLE DB Provider for SQL Server description: Invalid object name 'anything'.
If you try it out, you should find that the contents of the Errors collection
is cumulative, but Errors has a Clear method to clear it.
See https://learn.microsoft.com/en-us/sql/ado/reference/ado-api/error-object?view=sql-server-2017
https://learn.microsoft.com/en-us/sql/ado/reference/ado-api/errorvalueenum?view=sql-server-2017
for more info (links courtesy of Remy Lebeau)
I've hit an issue when trying to delete layers using Graphics32. It seems that unless you delete layers in reverse order (from the last added to the first) an exception is thrown. I created the simplest application to test this and it is repeatable every time.
I created a simple form with a TImgView32 component (properties all at default) then a button which does the following:
procedure TMainForm.btnDeleteTestClick(Sender: TObject);
var
Layer1: TCustomLayer;
Layer2: TCustomLayer;
begin
Layer1 := TCustomLayer.Create(ImageView.Layers);
Layer2 := TCustomLayer.Create(ImageView.Layers);
Layer1.Free;
Layer2.Free;
end;
If I reverse the order (Layer2.Free then Layer1.Free) it works fine, but this way round it crashes every time. It's also the same whether I use TCustomLayer, TPositionedLayer, TBitmapLayer, or whatever.
I've traved the error and the fault seems to originate here:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
with FBuckets[BucketIndex] do begin
Result := Items[ItemIndex].Data;
if FCount = 0 then Exit;
Dec(Count);
if Count = 0 then SetLength(Items, 0)
else if (ItemIndex < Count) then
Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
end;
Dec(FCount);
end;
Any idea what is causing this or if I'm doing something wrong? I'm running Delphi XE, by the way.
Here's the code for TCustomLayer.Destroy
destructor TCustomLayer.Destroy;
var
I: Integer;
begin
if Assigned(FFreeNotifies) then
begin
for I := FFreeNotifies.Count - 1 downto 0 do
begin
TCustomLayer(FFreeNotifies[I]).Notification(Self);
if FFreeNotifies = nil then Break;
end;
FFreeNotifies.Free;
FFreeNotifies := nil;
end;
SetLayerCollection(nil); <<-- bug, see below.
inherited; <<---- See note below.
end;
Notice that there's a bug in SetLayerCollection.
Buggy code
procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
if FLayerCollection <> Value then begin
if Assigned(FLayerCollection) then begin
if FLayerCollection.MouseListener = Self then
FLayerCollection.MouseListener := nil;
FLayerCollection.RemoveItem(Self);
end;
if Assigned(Value) then Value.InsertItem(Self);
end;
/// FLayerCollection is never set!
end;
The line SetLayerCollection(nil); does not actually set the LayerCollection!
The internal FLayerCollection can suffer from a use after free condition, which is possibly what's happening to you.
Change the code for SetLayerCollection like so:
Bug fix
procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
if FLayerCollection <> Value then begin
if Assigned(FLayerCollection) then begin
if FLayerCollection.MouseListener = Self then begin
FLayerCollection.MouseListener := nil;
end;
FLayerCollection.RemoveItem(Self);
end;
if Assigned(Value) then begin
Value.InsertItem(Self)
end;
FLayerCollection:= Value; // add this line.
end;
end;
Note
My hypothesis is that the following snippet causes the error:
SetLayerCollection(nil);
inherited;
SetLayerCollection(value); leaves FLayerCollection unchanged.
The inherited destructor somehow calls something having to do with LayerCollection.
Let me know if this fixes the error.
I've filed a new issue: https://github.com/graphics32/graphics32/issues/13
Update: issue is off by one error in TPointerMap.Delete
The actual issue is here:
https://github.com/graphics32/graphics32/issues/14
The code for TPointerMap.Delete is incorrect:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
with FBuckets[BucketIndex] do
begin
Result := Items[ItemIndex].Data;
if FCount = 0 then Exit; <<-- error: how can result be valid if count = 0?
Dec(Count);
if Count = 0 then
SetLength(Items, 0)
else
if (ItemIndex < Count) then
//Oops off by 1 error! ---------------------------------------VVVVV
Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
end;
Dec(FCount); <<-- The use of with makes this statement confusing.
end;
The code should be changed as follows:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
var
Bucket: TPointerBucket ;
begin
if FCount = 0 then Exit(nil);
//Perhaps add some code to validate BucketIndex & ItemIndex?
Assert(BucketIndex < Length(FBuckets));
Bucket:= FBuckets[BucketIndex];
if ItemIndex >= Bucket.
Assert(ItemIndex < Length(Bucket.Items));
Result := Bucket.Items[ItemIndex].Data;
Dec(Bucket.Count);
if Bucket.Count = 0 then
SetLength(Bucket.Items, 0)
else
/// assume array like so: 0 1 2 3 4 , itemindex = 0
/// result should be 1 2 3 4
/// move(1,0,4) (because 4 items should be moved.
/// Thus move (itemindex+1, intemindex, count-itemindex)
if (ItemIndex < Bucket.Count) then
Move(Items[ItemIndex + 1], Items[ItemIndex], (Bucket.Count - ItemIndex) * SizeOf(TPointerBucketItem));
end;
Dec(FCount);
end;
procedure searchAndReceipt;
var
amt, counter, check: integer;
gtinStore, qtyStore: array of integer;
totalCost: real;
begin
check := 0;
totalCost := 0.0;
write('Enter how many products you are purchasing: ');
repeat
readln(amt);
if (amt > 11) and (amt <= 0) then
writeln ('Please re-enter how many products are you purchasing with a value between 1-10')
else
check:= 1;
until check = 1;
SetLength(gtinStore, amt);
SetLength(qtyStore, amt);
SetLength(receiptArray, amt);
for counter:=1 to amt do
begin
write('Enter a GTIN code: ');
repeat
readln(gtinStore[counter]);
if (gtinStore[counter] >= 99999999) and (gtinStore[counter] <= 1000000) then
writeln ('Please re-enter the Gtin Code with a value of 8 digits')
else
check:= 1;
until check = 1;
check := 0;
write('Enter the Quantity: ');
repeat
readln(qtyStore[counter]);
if (qtyStore[counter] >= 11) and (qtyStore[counter] <= 0) then
writeln ('Please re-enter the quantity with a value between 1-10')
else
check:= 1;
until check = 1;
end;
assign(stockFile,'stockFile.dat');
Reset(stockFile);
counter:=1;
while not EOF(stockFile) do
begin
receiptArray[counter].productName := ('Product Not Found');
receiptArray[counter].productGTIN := 0;
receiptArray[counter].productPrice := 0.0;
inc(counter);
end;
read (stockFile, Stock);
for counter:=1 to amt+1 do
begin
while not EOF(stockFile) do
begin
read (stockFile, Stock);
if Stock.productGTIN = gtinStore[counter] then
receiptArray[counter].productGTIN:= Stock.productGTIN;
receiptArray[counter].productName:= Stock.productName;
receiptArray[counter].productPrice:= Stock.productPrice;
end;
end;
assign(receiptFile, 'receipt.txt');
rewrite(receiptFile);
for counter:= 1 to amt+1 do
begin
if receiptArray[counter].productName = 'Product Not Found' then
begin
writeln(receiptFile, 'GTIN: ', gtinStore[counter]);
writeln(receiptFile, receiptArray[counter].productName);
writeln(receiptFile, '');
end
else
begin
writeln(receiptFile, 'GTIN: ',gtinStore[counter]);
writeln(receiptFile, 'Name: ',receiptArray[counter].productName);
writeln(receiptFile, 'Quantity: ', qtyStore[counter]);
writeln(receiptFile, 'Price: £',receiptArray[counter].productPrice*qtyStore[counter]:4:2);
writeln(receiptFile, '');
totalCost := ((receiptArray[counter].productPrice * qtyStore[counter]) + totalCost);
end;
end;
choices:=1;
end;
begin
choices:= 1;
while choices <> 3 do
begin;
writeln('Press 1 to create the stock file');
writeln('Press 2 to search for an item and print a receipt');
writeln('Press 3 to exit');
write('Choice: ');
readln(choices);
writeln;
case choices of
1: createStock;
2: searchAndReceipt;
end;
end;
end.
I run this procedure (there's another procedure before this that places stock into a file), what this is supposed to do is to take that stock out and place it into a text file... however after I've entered the GTIN number and the quantities of the items my program produces this error
Exception EAccessViolation in module Task_2.exe at 00002550.
Access violation at address 00402550 in module 'Task_2.exe'. Read of address 03491DD4.
within the shell, and a message box pops up saying
Project Task_2.exe raised exception class EInvalidPointer with message 'invalid Pointer Operation'. Process Stopped
Thanks in advance
Dynamic arrays are 0-based, but your code assumes 1-based indexing. Hence you index off the end of the array, and hence the runtime errors. Fix the code by using 0-based indices. That is loop from 0 to N-1 rather than from 1 to N.
Even what you fix that, you have loops that run from 1 to N+1 so you aren't even allocating enough space for your arrays.
You should enable range checking in the compiler options so that the compiler can emit diagnostics code to give you better error messages.
I've this Stored Procedure defined within a Firebird Database:
create or alter procedure GET_MSG (
IDLNG smallint,
IDMSG integer)
returns (
MSG varchar(200) character set UTF8)
as
begin
IF (:IDMSG > 40000) THEN
BEGIN
IF (:IDLNG = 1) THEN
BEGIN
SELECT NOMBRE01 FROM XMSG2 WHERE ID_XMSG2 = :IDMSG INTO :MSG;
EXIT;
END
IF (:IDLNG = 2) THEN
BEGIN
SELECT NOMBRE02 FROM XMSG2 WHERE ID_XMSG2 = :IDMSG INTO :MSG;
EXIT;
END
END ELSE
BEGIN
IF (:IDLNG = 1) THEN
BEGIN
SELECT NOMBRE01 FROM XMSG WHERE ID_XMSG = :IDMSG INTO :MSG;
EXIT;
END
IF (:IDLNG = 2) THEN
BEGIN
SELECT NOMBRE02 FROM XMSG WHERE ID_XMSG = :IDMSG INTO :MSG;
EXIT;
END
END
end
and I use this code to call this Stored Procedure from Firedac :
SPGeneric.StoredProcName:= 'GET_MSG';
SPGeneric.FetchOptions.Items:= SPGeneric.FetchOptions.Items - [fiMeta];
SPGeneric.Prepare;
with SPGeneric.Params do begin
Clear;
with Add do begin
Name:= 'IDLNG';
ParamType:= ptInput;
DataType:= ftSmallint;
Value:= IdLan;
end;
with Add do begin
Name:= 'IDMSG';
ParamType:= ptInput;
DataType:= ftInteger;
Value:= Id;
end;
with Add do begin
Name:= 'MSG';
ParamType:= ptOutput;
DataType:= ftString;
Size:= 200;
end;
end;
SPGeneric.ExecProc;
result:= VarToStr(SPGeneric.Params[2].Value);
The problem is that when I call this code with correct parameters (checked within Firebird), the result is always null. Is there anything wrong with this code?. Thanks
This is the code that works ok:
SPGeneric.StoredProcName:= 'GET_MSG';
SPGeneric.FetchOptions.Items:= SPGeneric.FetchOptions.Items - [fiMeta];
SPGeneric.Params.Clear;
with SPGeneric.Params.Add do begin
Name:= 'IDLNG';
ParamType:= ptInput;
DataType:= ftSmallint;
end;
with SPGeneric.Params.Add do begin
Name:= 'IDMSG';
ParamType:= ptInput;
DataType:= ftInteger;
end;
with SPGeneric.Params.Add do begin
Name:= 'MSG';
ParamType:= ptOutput;
DataType:= ftWideString;
Size:= 200;
end;
SPGeneric.Prepare;
SPGeneric.Params[0].Value:= IdLan;
SPGeneric.Params[1].Value:= Id;
SPGeneric.ExecProc;
result:= VarToStr(SPGeneric.Params[2].Value);
call Prepare after filling the parameters.
assign the parameters values after call prepare.
From the documentation :
After Prepare is called, the application cannot change command parameter data types and sizes. Otherwise, during the next Execute / ExecSQL / ExecProc / Open call, an exception will be raised. It is recommended to setup parameters before the Prepare call.
Here you have elected to not autopopulate the parameter information with
SPGeneric.FetchOptions.Items:= SPGeneric.FetchOptions.Items - [fiMeta];
So, since you are manually defining the parameters you should do this before calling Prepare.
i got this sp:
DROP TABLE IF EXISTS SplitValuesDump;
CREATE TABLE SplitValuesDump (
value VARCHAR(1000) NOT NULL PRIMARY KEY
);
DELIMITER $$
DROP PROCEDURE IF EXISTS `ChangeSitesRedirects`$$
CREATE PROCEDURE `ChangeSitesRedirects`(
prodimainAddress varchar(255),
subdomainMainAddress varchar(255)
)
SQL SECURITY INVOKER
BEGIN
DECLARE tdomain varchar(1000);
DECLARE tvalue varchar(1000);
DECLARE prepValue varchar(1000);
DECLARE subdomainFullAddress varchar(1000);
DECLARE totalDomain int;
DECLARE tclientid int;
DECLARE sitedone INT DEFAULT 0;
DECLARE splitdone INT DEFAULT 0;
DECLARE lastDomain varchar(1000);
DECLARE curlSites CURSOR FOR (SELECT domain,clientid from sites where redirectsubdomain = 'N');
DECLARE CONTINUE HANDLER FOR NOT FOUND SET sitedone = 1;
set sitedone := 0;
OPEN curlSites;
Scan_Sites:WHILE (sitedone = 0) DO
IF sitedone = 1 THEN
BEGIN
LEAVE Scan_Sites;
END;
ELSE
BEGIN
DECLARE curlStringDump CURSOR FOR (SELECT `value` from SplitValuesDump);
DECLARE CONTINUE HANDLER FOR NOT FOUND SET splitdone = 1;
FETCH curlSites INTO tdomain,tclientid;
CALL split_string(tdomain,';');
OPEN curlStringDump;
SET splitdone:=0;
ScanDump: WHILE (splitdone = 0) DO
IF splitdone = 1 THEN
BEGIN
LEAVE ScanDump;
END;
ELSE
BEGIN
FETCH curlStringDump INTO tvalue;
SET subdomainFullAddress:= subdomainMainAddress;
IF tvalue <> "" THEN
BEGIN
IF tvalue like prodimainAddress OR tvalue like subdomainMainAddress THEN
BEGIN
set totalDomain := totalDomain + 1;
IF tvalue like subdomainMainAddress THEN
BEGIN
SET subdomainFullAddress := tvalue;
END;
END IF;
END;
ELSE
BEGIN
set totalDomain := totalDomain + 1;
set lastDomain := tvalue;
END;
END IF;
END;
END IF;
END;
END IF;
END WHILE ScanDump;
CLOSE curlStringDump;
SET splitdone :=0;
SET prepValue:='N';
IF lastDomain = '' AND totalDomain = 2 THEN
BEGIN
set prepValue := subdomainFullAddress || CHAR(2) || prodimainAddress;
INSERT INTO sites_tmp SELECT * FROM sites where clientid = tclientid limit 1;
UPDATE sites_tmp SET redirectsubdomain = prepValue WHERE clientid = tclientid limit 1;
END;
ELSE
BEGIN
set prepValue := prodimainAddress || CHAR(2) || lastDomain || CHAR(1) ||subdomainFullAddress || CHAR(2) || lastDomain;
INSERT INTO sites_tmp SELECT * FROM sites where clientid = tclientid limit 1;
UPDATE sites_tmp SET redirectsubdomain = prepValue WHERE clientid = tclientid limit 1;
END;
END IF;
END;
END IF;
END WHILE Scan_Sites;
CLOSE curlSites;
SET sitedone :=0;
END$$
i try in the get few info from column data split his data and bring some data ion there.
for each recored on table sites
and then update table sites_tmp.
i got issue that i not know how i can debug at or make at faster?
what ur recommend here?
as well why its so slow???
and in the end its not passed the all the records?