I have been banging my head against the desk with this. I have a simple table with 2 columns, like so:
CREATE TABLE [dbo].[MiscInitializers](
[PKey] [int] IDENTITY(1,1) NOT NULL,
[Value] [text] NULL,
CONSTRAINT [PK_MiscInitializers] PRIMARY KEY CLUSTERED
(
[PKey] ASC
)WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
I am trying to update a row with a procedure like this:
function TdmSQL.SetInitializer(Value: string; var Key: string): boolean;
const
UpdateCmd =
'update MiscInitializers set Value = :theValue where PKey = :theKey';
InsertCmd = 'insert into MiscInitializers (Value) values (:Param1)';
var
tmp: integer;
rsTmp: TADODataSet;
foo: TParameter;
sTmp: string;
begin
Result := false;
adoGenericCommand.CommandText := '';
adoGenericCommand.Parameters.Clear;
if Key <> '' then
begin
// attempt update
if not TryStrToInt(Key, tmp) then
exit;
adoGenericCommand.CommandText := UpdateCmd;
adoGenericCommand.Prepared := true;
adoGenericCommand.Parameters.Refresh;
// some debug stuff
sTmp := Format('Num Params: %d', [adoGenericCommand.Parameters.Count]);
ShowMessageBox(sTmp);
for tmp := 0 to adoGenericCommand.Parameters.Count - 1 do
begin
sTmp := Format('Param %d: Name %s',
[tmp, adoGenericCommand.Parameters.Items[tmp].Name]);
ShowMessageBox(sTmp);
end;
// end debug stuff
foo := adoGenericCommand.Parameters.ParamByName('theValue');
foo.Value.AsString := Value;
foo := adoGenericCommand.Parameters.ParamByName('theKey');
foo.Value := Key;
rsTmp.Recordset := adoGenericCommand.Execute;
Result := rsTmp.RecordCount = 1;
exit;
// etc
What I see happening (with those debug messagebox calls) is that the update command gets 2 parameters, but their names are Param1 and Param2, not theValue and theKey.
Is there a way to set up the parameters at runtime so the ParamByName calls will work with the names I actually want, rather than the Param*N* that I'm getting?
You can use ParseSQL to generate the Parameters
const
UpdateCmd = 'update MiscInitializers set Value = :theValue where PKey = :theKey';
var
ds: TADODataSet;
I: Integer;
begin
ds := TADODataSet.Create(nil);
try
ds.CommandText := UpdateCmd;
ds.Parameters.ParseSQL(ds.CommandText, True);
for I := 0 to ds.Parameters.Count - 1 do
ShowMessage(ds.Parameters.Items[I].name);
finally
ds.Free;
end;
end;
Don't call Refresh on the 'Parameters' after you assign the 'CommandText'. When you call 'Refresh', the VCL turns to the provider for parameter information, and if the returned information does not contain parameter names then the VCL makes up them on the fly.
Related
I want to store images in a database using sql but cant seem to get it to work:
qry.SQL.Clear;
qry.Sql.Add('update tbl set pic = :blobVal where id = :idVal');
qry.Parameters.ParamByName('idVal')._?:=1;
.Parameters has no .asinteger like .Param has but .Param isn't compatible with a TADOquery - to workaround I tried:
a_TParameter:=qry.Parameters.CreateParameter('blobval',ftBlob,pdinput,SizeOf(TBlobField),Null);
a_TParam.Assign(a_TParameter);
a_TParam.asblob:=a_Tblob;
qry.ExecSql;
This also doesnt work:
qry.SQL.Clear;
qry.Sql.Add('update tbl set pic = :blobVal where id = 1')
qry.Parameters.ParamByName('blobVal').LoadFromStream(img as a_TFileStream,ftGraphic);//ftblob
//or
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg',ftgrafic);//ftblob
qry.ExecSql;
Should be something like:
qry.Parameters.Clear;
qry.Parameters.AddParameter.Name := 'blobVal';
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg', ftBlob);
// or load from stream:
// qry.Parameters.ParamByName('blobVal').LoadFromStream(MyStream, ftBlob);
qry.Parameters.AddParameter.Name := 'idVal';
qry.Parameters.ParamByName('idVal').Value := 1;
qry.SQL.Text := 'update tbl set pic = :blobVal where id = :idVal';
qry.ExecSQL;
To read the BLOB back from the DB:
qry.SQL.Text := 'select id, pic from tbl where id = 1';
qry.Open;
TBlobField(qry.FieldByName('pic')).SaveToFile('c:\sample_2.jpg');
I'm using Lazarus, not Delphi, but I guess its usually the same syntax. If so, here's a slight improvement on kobiks suggestion:
Parameters are added automatically if the SQL.Text is assigned before trying to assign values to the parameters. Like this:
qry.Parameters.Clear;
qry.SQL.Text := 'update tbl set pic = :blobVal where id = :idVal';
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg', ftBlob);
qry.Parameters.ParamByName('idVal').Value := 1;
qry.ExecSQL;
I wrote this as an answer to this q,
Delphi save packed record as blob in a sql database
which is currently flagged as a duplicate, possibly incorrectly because the technique
used by the OP as described in comments appears to be correct. So, the cause of the problem may lie elsewhere.
If the Duplicate flag gets removed, I'll re-post this answer there.
The following code works fine for me against a Sql Server table defined as shown below.
The data from Rec1 is saved into the table and correctly read back into Rec2.
(* MS Sql Server DDL
CREATE TABLE [blobs] (
[id] [int] NOT NULL ,
[blob] [image] NULL ,
CONSTRAINT [PK_blobs] PRIMARY KEY CLUSTERED
(
[id]
) ON [PRIMARY]
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO
*)
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
qBlobInsert: TADOQuery;
qBlobRead: TADOQuery;
Button1: TButton;
procedure Button1Click(Sender: TObject);
[...]
type
TMyRecord = packed record
FontName: string[30];
FontSize: word;
FontColor: integer;
FontStyle: word;
Attachement: string[255];
URL: string[255];
end;
const
scInsert = 'insert into blobs(id, blob) values(:id, :blob)';
scSelect = 'select * from blobs where id = %d';
procedure TForm1.Button1Click(Sender: TObject);
begin
TestInsert;
end;
procedure TForm1.TestInsert;
var
Rec1,
Rec2 : TMyRecord;
MS : TMemoryStream;
begin
FillChar(Rec1, SizeOf(Rec1), #0);
FillChar(Rec2, SizeOf(Rec2), #0);
Rec1.FontName := 'AName';
Rec1.URL := 'AUrl';
MS := TMemoryStream.Create;
try
// Save Rec1 using an INSERT statement
MS.Write(Rec1, SizeOf(Rec1));
MS.Seek(0, soFromBeginning);
qBlobInsert.Parameters[0].Value := 1;
qBlobInsert.Parameters[1].LoadFromStream(MS, ftBlob);
qBlobInsert.SQL.Text := scInsert;
qBlobInsert.ExecSQL;
// Read saved data back into Rec2
qBlobRead.SQL.Text := Format(scSelect, [1]);
qBlobRead.Open;
MS.Clear;
TBlobField(qBlobRead.FieldByName('blob')).SaveToStream(MS);
MS.Seek(0, soFromBeginning);
MS.Read(Rec2, MS.Size - 1);
Caption := Rec2.FontName + ':' + Rec2.URL;
finally
MS.Free;
end;
end;
Extract from DFM
object qBlobInsert: TADOQuery
Connection = ADOConnection1
Parameters = <
item
Name = 'id'
DataType = ftInteger
Value = Null
end
item
Name = 'blob'
DataType = ftBlob
Value = Null
end>
Left = 56
Top = 32
end
I have several hardcoded validations like these:
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if lFuncID in [FUNCT_1,FUNCT_2,FUNCT_3] then ...
if not (lListType in [cLstAct..cLstOrg,cLstClockAct]) then ...
if not (lPurpose in [0..2]) then ...
that I want to replace with a common method like
function ValidateInSet(AIntValue: integer; AIntSet: ###): Boolean;
begin
Result := (AIntValue in AIntSet);
if not Result then ...
end;
but what type to choose for AIntSet?
Currently the values to be tested throughout the code go up to a const value 232 (so I can e.g. use a TByteSet = Set of Byte), but I can foresee that we will bump into the E1012 Constant expression violates subrange bounds when the constant values exceed 255.
My Google-fu fails me here...
(Currently on Delphi Seattle Update 1)
Use a dictionary, TDictionary<Integer, Integer>. The value is irrelevant and you only care about the key. If the dictionary contains a specific key then that key is a member of the set. Use AddOrSetValue to add a member, Remove to delete a member and ContainsKey to test membership.
The point of using a dictionary is that it gives you O(1) lookup.
You don't want to use this type directly as a set. You should wrap it in a class that just exposes set like capabilities. An example of that can be found here: https://stackoverflow.com/a/33530037/505088
You can use an array of Integer:
function ValidateInSet(AIntValue: integer; AIntSet: array of Integer): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(AIntSet) to High(AIntSet) do
begin
if AIntSet[I] = AIntValue then
begin
Result := True;
Break;
end;
end;
if not Result then ...
end;
const
cLstAct = 1;
cLstOrg = 4;
cLstClockAct = 11;
const
FUNCT_1 = 224;
FUNCT_2 = 127;
FUNCT_3 = 3;
if ValidateInSet(lFuncID, [FUNCT_1, FUNCT_2, FUNCT_3]) then ...
if not ValidateInSet(lListType, [cLstAct, 2, 3, cLstOrg, cLstClockAct]) then ...
if not ValidateInSet(lPurpose, [0, 1, 2]) then ...
If you are on a recent Delphi version, you can use TArray<Integer>.
function ValidateInSet(AIntValue: integer; const AIntSet: TArray<Integer>): Boolean;
var
N: Integer;
begin
{ option1 : if AIntSet is always sorted }
result := TArray.BinarySearch(AIntSet, AIntValue, N);
{ option 2: works for any array }
result := false;
for N in AIntSet do begin
if AIntValue = N then begin
result := true;
Break;
end;
end;
if not Result then begin
// ...
end;
end;
Calling is merely the same as with a set (except for ranges):
if ValidateInSet(lFuncID, [FUNCT_1,FUNCT_2,FUNCT_3]) then begin
end;
The direct answer would be TBits class
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TBits.Bits
Note: This can only be used starting with Delphi XE4 though - http://qc.embarcadero.com/wc/qcmain.aspx?d=108829
However for your "Set of integers" it in most inflated case would take 2^31 / 8 bytes of memory (because negative values of integer would not be even considered), and that would be a lot...
So I hope you would never really want to have a set of the whole integer. Or you should invest into Sparse Arrays instead.
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := (AIntValue >= 0) and (AIntValue < AIntSet.Size);
if Result then
Result := AIntSet.Bits[AIntValue];
if not Result then ...
v-a-l-i-d-a-t-e
end;
or rather
function ValidateInSet(const AIntValue: integer; const AIntSet: TBits): Boolean;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if .... then exit; // Validation criterion #4
if .... then exit; // Validation criterion #5
if .... then exit; // Validation criterion #6
Result := true;
end;
or perhaps
TSetTestCriterion = TFunc<Integer, Boolean>;
TSetTestCriteria = TArray<TFunc<Integer, Boolean>>;
function ValidateInSet(const AIntValue: integer;
const AIntSet: TBits; const Tests: TSetTestCriteria = nil): Boolean;
var ExtraTest: TSetTestCriterion;
begin
Result := false;
if AIntValue < 0 then exit; // Validation criterion #1
if AIntValue >= AIntSet.Size then exit; // Validation criterion #2
if not AIntSet.Bits[AIntValue] then exit; // Validation criterion #3
if Tests <> nil then // Validation criteria #4, #5, #6, ...
for ExtraTest in Tests do
if not ExtraTest(AIntValue) then exit;
Result := true;
end;
http://docwiki.embarcadero.com/Libraries/Seattle/en/System.SysUtils.TFunc
Now - just for demo, in real app you would create those set and array once and cache for long (forever, or at least unless the configuration change would demand rebuilding them).
Type FuncIDs = ( FUNCT_3 = 3, FUNCT_2 = 127, FUNCT_1 = 224);
var MysticGlobalFlag: Boolean;
function ValidateFuncID( const lFuncID: FuncIDs): Boolean;
var map: TBits;
begin
map := TBits.Create;
try
map.Size := High(lFuncID) + 1;
map.Bits[ Ord(Func_1) ] := True;
map.Bits[ Ord(Func_2) ] := True;
map.Bits[ Ord(Func_3) ] := True;
Result := ValidateInSet( Ord(lFuncID), map,
TSetTestCriteria.Create(
function( lFuncID: integer) : Boolean
begin
Result := MysticGlobalFlag or (lFuncID <> Ord(FuncIDs.FUNC_2))
end
,
function( lFuncID: integer) : Boolean
begin
Result := (lFuncID <> Ord(FuncIDs.FUNC_3)) or (DayOfTheWeek(Now()) = 4)
end
)
);
finally
map.Destroy;
end;
if not Result then // from the original question code
... // seems like a placeholder for error handling or object creation and registration
end;
All, I know it's years since people answered this, but here is a new solution using Delphi generics: -
interface
uses
System.Generics.Defaults;
type
TUtilityArray<T> = class
public
class function Contains(const x : T; const an_array : array of T) : boolean;
end;
implementation
class function TUtilityArray<T>.Contains(const x: T; const an_array: array of T): boolean;
var
y : T;
l_comparer : IEqualityComparer<T>;
begin
Result := false;
l_comparer := TEqualityComparer<T>.Default;
for y in an_array do
begin
if l_comparer.Equals(x, y) then
begin
Result := true;
break;
end;
end;
end;
end.
To use include the class, then write if(TUtilityArray<integer>.Contains(some integer value, [value1, value2 etc.])) then .... An added benefit of this method is that it works for other primitives as well.
I am desperately trying to do a Locate on a record whose PK is associated to Column 0 in a TDBAdvGrid. The TMS Component Pack version I have is 6.8.something.
I am using it in a Win7x64 with Delphi XE 1.
PageMode is turned off because I will need sorting and grouping at the client level(no backend db for now, only client datasets in offline mode).
My code for the locate is like this:
procedure TMainFrm.EditAction;
var ItemID : Integer;
ItemIDStr: String;
begin
// With PageMode set to false(which we need), the dataset is not synchronized.
//ItemID := GetActionGrid.Columns[ 0 ].Field.AsInteger;
ItemIDStr := GetActionGrid.Cells[ 0,GetActionGrid.SelectedRow[ 0 ] ];
ItemID := StrToIntDef( ItemIDStr ,-1 );
// GetActionGrid.Fields[ 0 ].AsInteger;
If DMMain.CLNActions.Locate( 'ITEM_ID',ItemID,[] ) Then
CreateApplicationForm( TActionFrm, True );
end;
But it does not work because the ItemIDStr always returns an empty string.
I am really short of ideas now.
Suggestions?
Thank you!
function TFrameDBGrid1.GrFindValInCol(FldName, FldVal : String) : boolean; //search value in a certain column of the grid
var
StartCell:TPoint;
FindParams: TFindParams;
rv:TPoint;
CurrCol: integer;
I: Integer;
const CResultInvalidInt=-1;
begin
Result := false;
StartCell.x := CResultInvalidInt;
StartCell.y := CResultInvalidInt;
CurrCol := GetColumnIndexOfField(FldName);
grdGlobal.FindCol := CurrCol;
FindParams := [fnMatchRegular, fnFindInPresetCol];
rv:=grdGlobal.Find(StartCell, FldVal, FindParams);
Result:= (rv.x <> CResultInvalidInt) and (rv.y <> CResultInvalidInt);
if Result then
if grdGlobal.Row <> rv.y then
grdGlobal.Row := rv.y;
end;
i have an issue where, when i go to add more "names" to the if statements. Its hard for me to see if there all ready on there. Thus is there a more clean way to write this Where i can easly see what names are all read there?
function TfDB.GetW(name: string) :integer;
begin
result := 0;
if (name = 'Destacker') or (name='Router') or (name = 'Turn Table') Then
result := 57;
if (name = 'Laser Marker') then
result := 66;
if (name = 'SP28')OR(name='Chamber') OR (name = 'CM402') OR (name = 'SP60') then
result := 65;
if (name = 'Conveyor') OR (name = 'Slide Gate') OR (name = 'Washer') then
result := 51;
if (name = 'BTU') OR (name = 'Furukawa') OR (name = 'Radial') OR (name = 'HDP') or (name = 'MSR') OR (name = 'Koki') Or (name = 'MSF') then
result := 98;
if (name = 'Buffer')OR (name = 'Reclaimer') OR (name = 'ECO Roller') then
result := 49;
if (name = 'Inverter') or (name = 'CNC') then
result := 42;
if (name = '3-D Check Station') or (name='Screw Machine') or (name='VT-Win') or(name='Component Viewer') then
result := 58;
if (name = 'AOI Panel') or (name='AirBlow') then
result := 42;
if (name='Mag Loader') or (name='Soltec') then
result := 73;
if (name='Tester') then
result := 33;
if (name='LoadBox') then
result := 17;
if (name = 'DeltaWave') then
result := 89;
if (name = 'ScrewFeeder') then
result := 25;
if (name='Pump') then
result := 33;
//if result is 0 show message error.
end;
You could create a dictionary, TDictionary<string, Integer>, and store it in a global variable. Load it up with the name to width mapping at initialization time. And then your function becomes a one-liner.
var
WidthMapping: TDictionary<string, Integer>;
....
function TfDB.GetW(name: string) :integer;
begin
if not WidthMapping.TryGetValue(name, Result) then
... handle error condition
end;
....
initialization
WidthMapping := TDictionary<string, Integer>.Create;
WidthMapping.Add('Destacker', 57);
WidthMapping.Add('Router', 57);
... etc.
....
finalization
WidthMapping.Free;
Yes, don't use an if statement but an array and a loop:
const
NAME_RESULT: array [1..2] of record
Name: string;
Value: Integer;
end = (
(Name: 'whatever'; Value: 57)
, (Name: 'Something else'; Value: 57)
);
var
i: Integer;
begin
Result := 0; // or whatever you need your default to be
for i := Low(NAME_RESULT) to High(NAME_RESULT) do
if SameText(name, NAME_RESULT[i].Name) then
begin
Result := NAME_RESULT[i].Value;
Break;
end;
end;
Additional advantage: you don't need to keep the names which return the same values together but can sort the list alphabetically.
Create an array (or dynamic array if you want to further add more names without any concerns of the array dimensions) of strings that contains all the names you want to test for (here I assumed fixed size string array):
var test = array [1..50] of string;
a[1]:='Destacker';
a[2]:='Router';
etc.
In your test routine you may use the case keyword like this:
function TfDB.GetW(index: integer) :integer
begin
result:=0;
case index of
1,2,3: result:=57;
4: result:=66
end
end;
I think it's easier this way
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?