{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/NPL/NPL-1_1Final.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: janSQL.pas, released March 24, 2002. The Initial Developer of the Original Code is Jan Verhoeven (jan1.verhoeven@wxs.nl or http://jansfreeware.com). Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. All Rights Reserved. Contributor(s): ___________________. Last Modified: 22.01.2014 Current Version: 1.2 Notes: This is a very fast single user SQL engine for text based tables Known Issues: History: 1.1 25-mar-2002 release recordset in subquery release sqloutput in selectfromjoin allow "unlimited" number of tables in join allow calculated updates: set field=expression modified TjanSQLRecord: fields are now objects (for future enhancements) 1.0 24-mar-2002 : original release -----------------------------------------------------------------------------} //Changes by Rene Tegel //* Added RollBack method //* Modified "delete from" to accept "delete from " syntax. {Change log: 05.02.2011: By Zlatko Matić *In JanSQL.Create method added: DecimalSeparator:=SysUtils.DefaultFormatSettings.DecimalSeparator added, so that Jansql uses system decimal separator. 26.12.2013: By Zlatko Matić *.txt replaced with .csv, so that JanSQL now works with .csv extension instead .txt. } {$ifdef fpc} {$mode delphi} {$H+} {$endif} unit janSQL; interface uses {$IFDEF UNIX}{ clocale, cwstring,}{$ENDIF} {LCLIntf, } SysUtils, Classes, janSQLstrings, janSQLExpression2, janSQLTokenizer, mwStringHashList, {$IFNDEF VER130} //Delphi 5 {$IFNDEF VER120} //Delphi 4 { $ IFNDEF VER110} //BCB 3 - not sure if it compiles at all. {$IFNDEF VER100} //Delphi 3 Variants {$ENDIF} {$ENDIF} {$ENDIF} ; type TCompareProc = procedure( Sender : TObject; i, j : Integer; var Result : Integer ) of object ; TSwapProc = procedure( Sender : TObject; i, j : Integer ) of object ; TjanSQLOperator=(jsunknown,jseq,jsne,jsgt,jsge,jslt,jsle); TjanSQLBoolean=(jsnone,jsand,jsor); TjanSQLSort=record FieldIndex:integer; SortAscending:boolean; SortNumeric:boolean; end; TjanSQLJoinIterator=record TableName:string; TableAlias:string; RecordSetIndex:integer; RecordCount:integer; CurrentRecord:integer; end; TjanSQLCalcField=class(TObject) private FCalc:TjanSQLExpression2; Fexpression: string; Fname: string; FFieldIndex: integer; procedure Setexpression(const Value: string); procedure Setname(const Value: string); function getValue: variant; procedure SetFieldIndex(const Value: integer); public constructor create; destructor destroy;override; property expression:string read Fexpression write Setexpression; property name:string read Fname write Setname; property value:variant read getValue; property Calculator:TjanSQLExpression2 read FCalc; property FieldIndex:integer read FFieldIndex write SetFieldIndex; end; TjanSQLOutput=class(TObject) private FFields:TList; function getFieldCount: integer; function getField(index: integer): TjanSQLCalcField; function getFieldNames: string; public constructor create; destructor destroy;override; procedure ClearFields; function AddField:TjanSQLCalcField; property FieldNames:string read getFieldNames; property FieldCount:integer read getFieldCount; property Fields[index:integer]:TjanSQLCalcField read getField; end; TjanSQLField=record FieldName:string; FieldIndex:integer; FieldValue:string; end; TjanSQLFields=array of TjanSQLField; TjanSQLRecordField=class(TObject) private Fsum: double; Fsum2: double; Fcount: integer; Fvalue: variant; procedure Setcount(const Value: integer); procedure Setsum(const Value: double); procedure Setsum2(const Value: double); procedure Setvalue(const Value: variant); published property value:variant read Fvalue write Setvalue; property count:integer read Fcount write Setcount; property sum:double read Fsum write Setsum; property sum2:double read Fsum2 write Setsum2; end; TjanRecord=class(TObject) private FFields:TList; Fmark: boolean; Fcounter: integer; function getrow: string; procedure setrow(const Value: string); function getfield(index: integer): TjanSQLRecordField; procedure setfield(index: integer; const Value: string); procedure Setmark(const Value: boolean); procedure Setcounter(const Value: integer); procedure ClearFields; public constructor create; destructor destroy; override; procedure AddField(value:string); function DeleteField(index:integer):boolean; property row:string read getrow write setrow; property fields[index:integer]:TjanSQLRecordField read getfield; property mark:boolean read Fmark write Setmark; property counter:integer read Fcounter write Setcounter; end; TjanRecordList=class(TList) private public destructor destroy; override; procedure Clear; override; procedure delete(index:integer); end; TjanRecordSetList=class(TStringList) public destructor destroy; override; procedure delete(index:integer);override; end; TjanRecordSet=class(TObject) private FRecordCursor:integer; Fname: string; FFieldNames:TStringList; FFieldFuncs:array of TTokenOperator; FRecords:TjanRecordList; Fpersistent: boolean; Fmodified: boolean; Fmatchrecord: integer; Falias: string; Fintermediate: boolean; procedure Setname(const Value: string); function getrecord(index: integer): TjanRecord; function getfieldvalue(index: variant): string; procedure setfieldvalue(index: variant; const Value: string); procedure Setpersistent(const Value: boolean); function getrecordcount: integer; procedure Setmodified(const Value: boolean); function getfieldcount: integer; procedure Setmatchrecord(const Value: integer); function getLongFieldList: string; function getShortFieldList: string; procedure Setalias(const Value: string); procedure Setintermediate(const Value: boolean); public constructor create; destructor destroy; override; function LoadFromFile(filename:string):boolean; function SaveToFile(filename:string):boolean; function AddRecord:integer; function DeleteRecord(index:integer):boolean; function AddField(fieldname,value:string):integer; function DeleteField(index:variant):integer; function IndexOfField(fieldname:string):integer; function FindFieldValue(fieldindex:integer;fieldvalue:string):integer; procedure Clear; property Cursor: Integer read FRecordCursor write FRecordCursor; property name:string read Fname write Setname; property alias:string read Falias write Setalias; property persistent:boolean read Fpersistent write Setpersistent; property intermediate:boolean read Fintermediate write Setintermediate; property modified:boolean read Fmodified write Setmodified; property FieldNames:TStringList read FFieldNames; property ShortFieldList:string read getShortFieldList; property LongFieldList:string read getLongFieldList; property records[index:integer]:TjanRecord read getrecord; property fields[index:variant]:string read getfieldvalue write setfieldvalue; property recordcount:integer read getrecordcount; property fieldcount:integer read getfieldcount; property matchrecord:integer read Fmatchrecord write Setmatchrecord; end; TjanSQL=class; TjanSQLQuery=class(TObject) private FTokens:TList; FParser:TjanSQLExpression2; FEngine: TjanSQL; procedure SetEngine(const Value: TjanSQL); procedure ClearTokenList; function GetToken(index: integer): TToken; function getParser: TjanSQLExpression2; protected public constructor create; destructor destroy;override; property Engine:TjanSQL read FEngine write SetEngine; property Tokens[index:integer]:TToken read GetToken; property Parser:TjanSQLExpression2 read getParser; end; TjanSQL = class(TObject) private FQueries:TList; gen:TStringList; FSQL:TstringList; FEparser:TjanSQLExpression2; FNameSpace:TmwStringHashList; FNameCounter:integer; Fcatalog: string; FInMemoryDatabase: Boolean; FRecordSets:TjanRecordSetList; FMatchrecordSet: integer; FMatchingHaving: boolean; function getrecordset(index: integer): TjanRecordSet; function getRecordSetCount: integer; procedure getvariable(sender:Tobject;const VariableName:string;var VariableValue:variant;var handled:boolean); procedure procsubexpression(sender:Tobject;const subexpression:string;var subexpressionValue:variant;var handled:boolean); function SQLDirectStatement(query:TjanSQLQuery;value: string): integer; procedure Sort(aRecordset,From, Count : Integer;orderby:array of TjanSQLSort); procedure SortRecordSet(arecordset,From, Count : Integer;orderbylist:string;ascending:boolean); procedure GroupBy(arecordset:TjanRecordset;grouplist:string); function Compare(arecordset,i, j : Integer;orderby:array of TjanSQLSort): Integer; procedure Swap(arecordset,i,j:Integer); procedure ClearQueries; function ISQL(value:string):integer; function uniqueName:string; function addRecordSet(aname:string):integer; function CreateTable(tablename,fields:string):integer; function DropTable(tablename:string):integer; function SaveTable(tablename:string):integer; function ReleaseTable(tablename:string):integer; function AddTableColumn(tablename,column,value:string):integer; function DropTableColumn(tablename,column:string):integer; function IndexOfTable(tablename:string):integer; function openTable(value:string;persistent:boolean):boolean; function InCatalog(value:string):boolean; function openCatalog(value:string):integer; function SelectFromJoin(query:TjanSQLQuery;selectfields,tablelist,wherecondition,orderbylist:string;ascending:boolean;wfrom,wtill:integer;grouplist,having,resultname:string):integer; function SelectFrom(query:TjanSQLQuery;tablename1,selectfields,wherecondition,orderbylist:string;ascending:boolean;wfrom,wtill:integer;grouplist,having,resultname:string):integer; function DeleteFrom(tablename1,wherecondition:string):integer; function InsertInto(tablename1,columns,values:string):integer; function Update(query:TjanSQLQuery;tablename1,updatelist,wherecondition:string):integer; function Commit(query:TjanSQLQuery):integer; function RollBack(query:TjanSQLQuery):integer; function AddQuery:TjanSQLQuery; function DeleteQuery(query:TjanSQLQuery):boolean; { Private declarations } protected { Protected declarations } function SQLSelect(query:TjanSQLQuery;aline,aname:string):integer; function SQLAssign(query:TjanSQLQuery;aline:string):integer; function SQLDelete(query:TjanSQLQuery;aline:string):integer; function SQLInsert(query:TjanSQLQuery;aline:string):integer; function SQLInsertSelect(query:TjanSQLQuery;aline:string):integer; function SQLUpdate(query:TjanSQLQuery;aline:string):integer; function SQLCreate(query:TjanSQLQuery;aline:string):integer; function SQLDrop(query:TjanSQLQuery;aline:string):integer; function SQLSaveTable(query:TjanSQLQuery;aline:string):integer; function SQLReleaseTable(query:TjanSQLQuery;aline:string):integer; function SQLAlter(query:TjanSQLQuery;aline:string):integer; function SQLCommit(query:TjanSQLQuery;aline:string):integer; function SQLRollBack(query:TjanSQLQuery;aline:string):integer; function SQLConnect(query:TjanSQLQuery;aline:string):integer; public { Public declarations } constructor create; destructor destroy; override; function SQLDirect(value:string):integer; function ReleaseRecordset(arecordset:integer):boolean; function Error:string; property RecordSets[index:integer]:TjanRecordSet read getrecordset; property RecordSetCount:integer read getRecordSetCount; property NameSpace:TmwStringHashList read FNameSpace; published { Published declarations } end; implementation const cr = #13#10; //// cr = chr(13)+chr(10); var FError: string; //FDebug: string; procedure err(value:string); begin Ferror:=value; end; procedure chop(var value:string;from:integer); begin value:=trim(copy(value,from,maxint)); end; {soner never used function tokeninset(token,aset:string):boolean; begin end; } function parsetoken(const source:string;var token:string;var delimpos:integer;var delim:string):boolean; var p,L:integer; begin result:=false; L:=length(source); if L=0 then exit; p:=1; while (p<=L) and (not (source[p] in [',',' ',';','=','<','>','(',')'])) do inc(p); if p>L then begin token:=source; delim:=''; delimpos:=0; end else begin token:=copy(source,1,p-1); delim:=copy(source,p,1); delimpos:=p; end; result:=true; end; function checktoken(source,token:string;var delimpos:integer;var delim:string):boolean; var p,LS,LT:integer; begin result:=false; p:=postext(token,source); if p<>1 then exit; LS:=length(source); LT:=length(token); if LS=LT then begin delim:=''; delimpos:=0; result:=true; exit; end; if not (source[LT+1] in [' ',',',';','=','<','>']) then exit; result:=true; delim:=source[LT+1]; delimpos:=LT+1; end; function string2operator(value:string):TjanSQLOperator; begin result:=jsunknown; if value='=' then result:=jseq else if value='<>' then result:=jsne else if value='>' then result:=jsgt else if value='>=' then result:=jsge else if value='<' then result:=jslt else if value='<+' then result:=jsle; end; // split atext at ; into lines procedure split(atext:string;alist:TStrings); //make semicosumn not holy, allow it in quoted values (rene): function posskipquoted (sep: char; text: String; offset: Integer): Integer; var quoted: char; begin result := 0; quoted := #0; while offset <= length(text) do begin if (quoted=#0) and (text[offset]=sep) then begin Result := offset; break; end; //Detect end of quoted values if (quoted <> #0) and (text[offset]=quoted) then begin quoted := #0; inc (offset); //Dak_Alpha Continue; //Dak_Alpha end; //Detect begin of quoted values if (quoted=#0) and (text[offset] in ['''', '"', '`']) then quoted := text[offset]; if text[offset] = PathDelim then //additional step inc(offset); inc (offset); end; end; var tmp:string; p1,p2,L:integer; begin alist.Clear; L:=length(atext); if L=0 then exit; p1:=1; repeat //p2:=PosStr(';',atext,p1); p2 := posskipquoted(';', atext, p1); if p2>0 then begin tmp:=copy(atext,p1,p2-p1); alist.Append(tmp); if p2=L then alist.append(''); p1:=p2+1; if p1>L then p1:=0; end else begin alist.append(copy(atext,p1,maxint)); p1:=0; end; until p1=0; end; function join(alist:TStrings):string; var i,c:integer; begin result:=''; c:=alist.count; if c=0 then exit; for i:=0 to c-1 do if i=0 then result:=alist[i] else result := result + ';' + alist[i]; end; { TjanSQL } function TjanSQL.addRecordSet(aname: string): integer; var rs:TjanRecordSet; begin rs:=TjanRecordSet.create; rs.name:=aname; result:=FRecordSets.AddObject(aname,rs)+1; end; constructor TjanSQL.create; begin inherited; { TODO : This should be completely removed. jansql should behave { as rest of zmsql package... } { //Set decimal separator. //DecimalSeparator:='.'; //This was original value. Disabled by Z.Matić. //Note that DecimalSeparator=SysUtils.FormatSettings.DecimalSeparator DecimalSeparator:=SysUtils.DefaultFormatSettings.DecimalSeparator } FQueries:=TList.create; gen:=TStringList.create; FSQL:=TStringList.create; FNameSpace:=TmwStringHashList.create(tinyhash,HashSecondaryOne,HashCompare); FEParser:=TjanSQLExpression2.create; FEParser.onGetVariable:=getvariable; FrecordSets:=TjanRecordSetList.Create; end; destructor TjanSQL.destroy; begin ClearQueries; FQueries.free; gen.free; FSQL.free; FEParser.free; FrecordSets.free; FNameSpace.free; inherited; end; // join 2 tables on fields in fieldset // return index of resultset // result -1 means failure // fieldset has format field1=field2;field3=field3 function TjanSQL.getrecordset(index: integer): TjanRecordSet; // 1 based begin result:=nil; if (index<1) or (index>Frecordsets.Count) then exit; result:=TjanRecordset(FRecordsets.objects[index-1]); end; // joinfields are of format field1=field2;field3=field4 // all fields must be in table.field format function TjanSQL.selectFromJoin(query:TjanSQLQuery;selectfields,tablelist,wherecondition,orderbylist:string;ascending:boolean;wfrom,wtill:integer;grouplist,having,resultname:string):integer; var t1,t2,t3:integer; i,c,i3,c3:integer; idx:integer; bAggregate:boolean; selectfieldfunctions:array of TTokenOperator; tablecount, outputfieldcount:integer; sqloutput:TjanSQLOutput; tables:array of TjanSQLJoinIterator; function setgroupfunc(avalue:string;ii:integer):string; var ppo,ppc:integer; sfun:string; begin selectfieldfunctions[ii]:=toNone; result:=avalue; ppo:=posstr('(',avalue); if ppo>0 then begin ppc:=posstr(')',avalue,ppo); if ppc=0 then exit; sfun:=lowercase(trim(copy(avalue,1,ppo-1))); result:=copy(avalue,ppo+1,ppc-ppo-1); if sfun='count' then begin selectfieldfunctions[ii]:=tosqlCount; bAggregate:=true; end else if sfun='sum' then begin selectfieldfunctions[ii]:=tosqlSum; bAggregate:=true; end else if sfun='avg' then begin selectfieldfunctions[ii]:=tosqlAvg; bAggregate:=true; end else if sfun='max' then begin selectfieldfunctions[ii]:=tosqlMax; bAggregate:=true; end else if sfun='min' then begin selectfieldfunctions[ii]:=tosqlMin; bAggregate:=true; end else result:=avalue; end; end; function setoutputfields:boolean; var ii,cc:integer; ofld:TjanSQLCalcField; ppa:integer; sfield,prefield:string; begin result:=false; split(selectfields,gen); cc:=gen.count; outputfieldcount:=cc; setlength(selectfieldfunctions,cc); sqloutput:=TjanSQLOutput.create; for ii:=0 to cc-1 do begin ofld:=sqloutput.AddField; ofld.Calculator.onGetVariable:=GetVariable; sfield:=gen[ii]; ppa:=pos('|',sfield); if ppa>0 then begin prefield:=copy(sfield,1,ppa-1); prefield:=setgroupfunc(prefield,ii); ofld.name:=copy(sfield,ppa+1,maxint); try ofld.expression:=prefield; except exit; end; end else begin ofld.name:=setgroupfunc(sfield,ii); try ofld.expression:=sfield; except exit; end; end; end; result:=true; end; procedure addresultoutput(r1,r2:integer); var ii,cc,ir:integer; ss:string; v:variant; begin ir:=recordsets[t3].AddRecord; cc:=sqloutput.FieldCount; FMatchrecordSet:=t1; recordsets[t1].matchrecord:=r1; recordsets[t2].matchrecord:=r2; for ii:=0 to cc-1 do begin v:=sqloutput.Fields[ii].value; ss:=v; recordsets[t3].records[ir].fields[ii].value:=ss; end; end; procedure addResultOutputEx; var ii,cc,ir: integer; ss: string; v: variant; begin ir:=recordsets[t3].AddRecord; cc:=sqloutput.FieldCount; FMatchrecordSet:=t1; for ii:=0 to tablecount-1 do recordsets[tables[ii].RecordSetIndex].matchrecord:=tables[ii].CurrentRecord; for ii:=0 to cc-1 do begin v:=sqloutput.Fields[ii].value; ss:=v; recordsets[t3].records[ir].fields[ii].value:=ss; end; end; function matchrecords(r1,r2:integer):boolean; begin recordsets[t1].matchrecord:=r1; recordsets[t2].matchrecord:=r2; result:=query.parser.Evaluate; end; function matchrecordsEx:boolean; var ii:integer; begin for ii:=0 to tablecount-1 do recordsets[tables[ii].RecordSetIndex].matchrecord:=tables[ii].CurrentRecord; result:=query.parser.Evaluate; end; function matchhaving(arecord:integer):boolean; begin recordsets[t3].matchrecord:=arecord; result:=query.Parser.evaluate; end; function expandall:string; begin result:=recordsets[t1].LongFieldList+';'+recordsets[t2].LongFieldList; end; function settables:boolean; // JV 25-03-2002 // added alias option JV 27-03-2002 var ii,tii,rrc,pp:integer; atom, atomalias:string; begin result:=false; setlength(tables,tablecount); for ii:=0 to tablecount-1 do begin atom:=gen[ii]; pp:=pos('|',atom); if pp=0 then atomalias:=atom else begin atomalias:=copy(atom,pp+1,maxint); atom:=copy(atom,1,pp-1); end; tii:=indexoftable(atom); if tii=-1 then begin err('SELECT: can not find table '+atom); //soner moved here exit; end; rrc:=recordsets[tii].recordcount; if rrc=0 then begin err('SELECT: table '+atom+' has no records'); //soner moved here exit; end; recordsets[tii].alias:=atomalias; tables[ii].TableName:=atom; tables[ii].TableAlias:=atomalias; NameSpace.AddString(atom,tii,0); NameSpace.AddString(atomalias,tii,0); tables[ii].RecordSetIndex:=tii; tables[ii].CurrentRecord:=0; tables[ii].RecordCount:=rrc; end; result:=true; end; procedure matchtables(t:integer); var ii:integer; begin if t=tablecount-1 then for ii:=0 to tables[t].RecordCount-1 do begin tables[t].CurrentRecord:=ii; if matchrecordsEx then begin addresultoutputEx; end; end else for ii:=0 to tables[t].RecordCount-1 do begin tables[t].CurrentRecord:=ii; matchtables(t+1); end; end; begin Fmatchinghaving:=false; bAggregate:=False; //fixed for FPC theo result:=0; split(tablelist,gen); //soner: err('SELECT: join table missing'); tablecount:=gen.count; {soner original: if tablecount<2 then exit; if not settables then exit; } if (tablecount<2)or(not settables) then begin err('SELECT: join table missing'); exit; end; if selectfields='' then begin err('SELECT: missing field list'); //soner moved here exit; end; if selectfields='*' then selectfields:=expandall; {new code} if not setoutputfields then begin sqloutput.free; err('SELECT dev: can not set output fields'); //soner moved here exit; end; // join fields are present, now join if resultname<>'' then begin // check if this is a persistent table if InCatalog(resultname) then begin sqloutput.free; err('SELECT INTO: table '+resultname+' allready exists.'); //soner moved here exit; end; // check index idx:=Frecordsets.IndexOf(resultname); if idx=-1 then begin t3:=AddRecordSet(resultname); Recordsets[t3].intermediate:=true; end else begin // check if this is a intermediate one if recordsets[idx+1].intermediate then begin FRecordsets.delete(idx); t3:=AddRecordSet(resultname); Recordsets[t3].intermediate:=true; end else begin err('ASSIGN: table '+resultname+' is not a variable'); sqloutput.free; exit; end; end; end else t3:=AddRecordSet(uniquename); result:=t3; // assign selectfields split(sqloutput.FieldNames, recordsets[t3].FieldNames); // copy field funcs c:=recordsets[t3].FieldNames.Count; setlength(recordsets[t3].FFieldFuncs,c); for i:=0 to c-1 do recordsets[t3].FFieldFuncs[i]:=selectfieldfunctions[i]; if wfrom<>0 then begin query.Parser.GetTokenList(query.Ftokens,wfrom,wtill); end; matchtables(0); // process any group by clause if bAggregate and (recordsets[t3].recordcount>1) then groupby(recordsets[t3],grouplist); FMatchrecordSet:=t3; Fmatchinghaving:=true; c3:=recordsets[t3].recordcount; // process any having clause if (having<>'') and (c3<>0) then begin query.Parser.Expression:=having; for i3:=0 to c3-1 do recordsets[t3].records[i3].mark:=false; for i3:=0 to c3-1 do if not matchhaving(i3) then recordsets[t3].records[i3].mark:=true; for i3:=c3-1 downto 0 do if recordsets[t3].records[i3].mark then recordsets[t3].DeleteRecord(i3); end; // process any order by clause if (orderbylist<>'') and (recordsets[t3].recordcount>1) then sortRecordset(t3,0,recordsets[t3].recordcount,orderbylist,ascending); sqloutput.free; // JV 25-03-2002 end; function TjanSQL.openCatalog(value: string): integer; begin result:=0; FInMemoryDatabase := trim(lowercase(value))=':memory:'; if not (FInMemoryDatabase or directoryexists(value)) then begin err('Catalog '+value+' does not exist'); //soner moved here exit; end; FCatalog:=value; result:=-1; end; function TjanSQL.openTable(value: string;persistent:boolean): boolean; var fn:string; rs:TjanRecordSet; begin result:=false; if FInMemoryDatabase then //override persistent := false; if persistent then if not directoryexists(FCatalog) then exit; if FRecordSets.IndexOf(value)<>-1 then exit; {fn:=Fcatalog+PathDelim+value+'.txt';} fn:=Fcatalog+PathDelim+value+'.csv'; //Changed by Zlatko Matić, 26.12.2003 if persistent then if not fileexists(fn) then exit; rs:=TjanRecordSet.create; rs.name:=value; rs.persistent:=persistent; FRecordSets.AddObject(value,rs); if persistent then result:=rs.LoadFromFile(fn); end; function TjanSQL.uniqueName: string; begin result:='$$$'+inttostr(FNameCounter); inc(FNameCounter); end; function TjanSQL.SelectFrom(query:TjanSQLQuery;tablename1, selectfields, wherecondition,orderbylist: string;ascending:boolean;wfrom,wtill:integer;grouplist,having,resultname:string): integer; var t1,t3:integer; i,c,i1,c1,i3,c3:integer; idx:integer; outputfieldcount:integer; selectfieldfunctions:array of TTokenOperator; bAggregate:boolean; sqloutput:TjanSQLOutput; function setgroupfunc(avalue:string;ii:integer):string; var ppo,ppc:integer; sfun:string; begin result:=avalue; selectfieldfunctions[ii]:=toNone; ppo:=posstr('(',avalue); if ppo>0 then begin ppc:=posstr(')',avalue,ppo); if ppc=0 then exit; sfun:=lowercase(trim(copy(avalue,1,ppo-1))); result:=copy(avalue,ppo+1,ppc-ppo-1); if sfun='count' then begin selectfieldfunctions[ii]:=tosqlCount; bAggregate:=true; end else if sfun='sum' then begin selectfieldfunctions[ii]:=tosqlSum; bAggregate:=true; end else if sfun='avg' then begin selectfieldfunctions[ii]:=tosqlAvg; bAggregate:=true; end else if sfun='max' then begin selectfieldfunctions[ii]:=tosqlMax; bAggregate:=true; end else if sfun='min' then begin selectfieldfunctions[ii]:=tosqlMin; bAggregate:=true; end else if sfun='stddev' then begin selectfieldfunctions[ii]:=tosqlStdDev; bAggregate:=true; end else result:=avalue; end; end; function setoutputfields:boolean; var ii,cc:integer; ofld:TjanSQLCalcField; ppa:integer; sfield,prefield:string; begin result:=false; split(selectfields,gen); cc:=gen.count; outputfieldcount:=cc; setlength(selectfieldfunctions,cc); sqloutput:=TjanSQLOutput.create; for ii:=0 to cc-1 do begin ofld:=sqloutput.AddField; ofld.Calculator.onGetVariable:=GetVariable; sfield:=gen[ii]; ppa:=pos('|',sfield); if ppa>0 then begin prefield:=copy(sfield,1,ppa-1); prefield:=setgroupfunc(prefield,ii); ofld.name:=copy(sfield,ppa+1,maxint); try ofld.expression:=prefield; except exit; end; end else begin ofld.name:=setgroupfunc(sfield,ii); try ofld.expression:=sfield; except exit; end; end; end; result:=true; end; function matchwhere(arecord:integer):boolean; begin if wherecondition='' then result:=true else begin recordsets[t1].matchrecord:=arecord; result:=query.Parser.evaluate; end; end; function matchhaving(arecord:integer):boolean; begin recordsets[t3].matchrecord:=arecord; result:=query.Parser.evaluate; end; procedure addresultoutput(arecord:integer); var ii,cc,ir:integer; ss:string; v:variant; begin ir:=recordsets[t3].AddRecord; cc:=sqloutput.FieldCount; FMatchrecordSet:=t1; recordsets[t1].matchrecord:=arecord; for ii:=0 to cc-1 do begin v:=sqloutput.Fields[ii].value; ss:=v; recordsets[t3].records[ir].fields[ii].value:=ss; end; end; function expandall:string; // expand * fields to all fieldname begin result:=recordsets[t1].ShortFieldList; end; begin Fmatchinghaving:=false; bAggregate:=false; result:=0; t1:=IndexOfTable(tablename1); if t1=-1 then begin err('SELECT: can not find table '+tablename1); //soner moved here exit; end; if selectfields='' then begin err('SELECT: no selected fields'); //soner moved here exit; end; if selectfields='*' then selectfields:=expandall; //soner never used: err('SELECT: can not find selected fields'); {new code} //soner moved: err('SELECT dev: can not set output fields'); if not setoutputfields then begin sqloutput.free; err('SELECT dev: can not set output fields'); //soner moved here exit; end; if resultname<>'' then begin // check if this is a persistent table if InCatalog(resultname) then begin sqloutput.free; err('SELECT INTO: table '+resultname+' allready exists.'); //soner moved here exit; end; // check index idx:=Frecordsets.IndexOf(resultname); if idx=-1 then begin t3:=AddRecordSet(resultname); Recordsets[t3].intermediate:=true; end else begin // check if this is a intermediate one if recordsets[idx+1].intermediate then begin FRecordsets.delete(idx); t3:=AddRecordSet(resultname); Recordsets[t3].intermediate:=true; end else begin err('ASSIGN: table '+resultname+' is not a variable'); sqloutput.free; exit; end; end; end else t3:=AddRecordSet(uniquename); // assign selectfields // if * then expand split(sqloutput.FieldNames, recordsets[t3].FieldNames); c1:=recordsets[t1].recordcount; //This is no error! If i select empty table, i need least field names! //Dak_Alpha // err('SELECT FROM: no records'); //Dak_Alpha // if (c1=0) then begin //Dak_Alpha // sqloutput.free; //Dak_Alpha // exit; //Dak_Alpha // end; //Dak_Alpha // copy field funcs c:=recordsets[t3].FieldNames.Count; setlength(recordsets[t3].FFieldFuncs,c); for i:=0 to c-1 do recordsets[t3].FFieldFuncs[i]:=selectfieldfunctions[i]; FMatchrecordSet:=t1; if wfrom<>0 then begin query.Parser.GetTokenList(query.Ftokens,wfrom,wtill); end; for i1:=0 to c1-1 do if matchwhere(i1) then begin addresultoutput(i1); end; FMatchrecordSet:=t3; // process any group by clause if bAggregate and (recordsets[t3].recordcount>1) then begin groupby(recordsets[t3],grouplist); end; c3:=recordsets[t3].recordcount; Fmatchinghaving:=true; // process any having clause if (having<>'') and (c3<>0) then begin query.Parser.Expression:=having; for i3:=0 to c3-1 do recordsets[t3].records[i3].mark:=false; for i3:=0 to c3-1 do if not matchhaving(i3) then recordsets[t3].records[i3].mark:=true; for i3:=c3-1 downto 0 do if recordsets[t3].records[i3].mark then recordsets[t3].DeleteRecord(i3); end; // process any order by clause if (orderbylist<>'') and (recordsets[t3].recordcount>1) then sortrecordset(t3,0,recordsets[t3].recordcount,orderbylist,ascending); sqloutput.free; result:=t3; end; function TjanSQL.IndexOfTable(tablename: string): integer; begin result:=Frecordsets.IndexOf(tablename); if result=-1 then begin // auto open tables used in queries if not OpenTable(tablename,true) then exit; result:=Frecordsets.IndexOf(tablename); end; inc(result); end; function TjanSQL.CreateTable(tablename, fields: string): integer; var fn,s:string; begin result:=0; if tablename='' then exit; if fields='' then exit; {fn:=FCatalog+PathDelim+tablename+'.txt';} fn:=FCatalog+PathDelim+tablename+'.csv'; //Changed by Zlatko Matić, 26.12.2013. if fileexists(fn) then begin err('Table already exist'); //Dak_Alpha exit; end; s:=fields; janSQLstrings.savestring(fn,s); result:=-1; end; function TjanSQL.DropTable(tablename: string): integer; var fn:string; idx:integer; begin result:=0; if tablename='' then begin err('DROP TABLE: table name missing'); //soner moved here exit; end; {fn:=FCatalog+PathDelim+tablename+'.txt';} fn:=FCatalog+PathDelim+tablename+'.csv'; //Changed by Zlatko Matić, 26.12.2013. if not fileexists(fn) then begin err('DROP TABLE: can not find file '+fn); //soner exit; end; deletefile(fn); idx:=FRecordSets.IndexOf(tablename); if idx<>-1 then FrecordSets.Delete(idx); result:=-1; end; function TjanSQL.DeleteFrom(tablename1, wherecondition: string): integer; var c1,i1,t1:integer; function matchwhere(arecord:integer):boolean; begin FMatchrecordSet:=t1; recordsets[t1].matchrecord:=arecord; FEParser.Expression:=wherecondition; result:=FEParser.evaluate; end; procedure deletematch(arecord:integer); begin recordsets[t1].DeleteRecord(arecord); end; begin result:=0; t1:=IndexOfTable(tablename1); if t1=-1 then exit; // check filter if wherecondition='' then exit; c1:=recordsets[t1].recordcount; if (c1=0) then exit; for i1:=c1-1 downto 0 do if matchwhere(i1) then DeleteMatch(i1); recordsets[t1].modified:=true; result:=-1; end; function TjanSQL.InsertInto(tablename1, columns, values: string): integer; var t1,r1:integer; insertfields:TjanSQLFields; function parsevalues:boolean; var sline:string; LL,pp:integer; begin result:=false; LL:=0; sline:=trim(values); if sline='' then begin err('INSERT INTO parsing values:empty'); //soner moved here exit; end; repeat if sline[1]='''' then begin pp:=posstr('''',sline,2); if pp=0 then begin err('INSERT INTO parsing values: missing '' delimiter'); //soner moved here exit; end; inc(LL); setlength(insertfields,LL); insertfields[LL-1].FieldValue:=copy(sline,2,pp-2); sline:=trim(copy(sline,pp+1,maxint)); if sline='' then // ready pp:=0 else begin // must have comma if sline[1]<>',' then begin err('INSERT INTO parsing values:missing ,'); //soner moved here exit; end; sline:=trim(copy(sline,2,maxint)); end; end else begin pp:=posstr(',',sline); if pp=0 then begin // single value inc(LL); setlength(insertfields,LL); insertfields[LL-1].FieldValue:=trim(sline); end else begin inc(LL); setlength(insertfields,LL); insertfields[LL-1].FieldValue:=trim(copy(sline,1,pp-1)); sline:=trim(copy(sline,pp,maxint)); if sline='' then // ready pp:=0 else begin // must have comma if sline[1]<>',' then begin err('Missing , in '+sline); //soner moved here exit; end; sline:=trim(copy(sline,2,maxint)); end; end; end; until pp=0; result:=true; end; function parsecolumns:boolean; var ii,LL,fii:integer; sline:string; begin result:=false; LL:=length(insertfields); if columns='' then begin for ii:=0 to LL-1 do insertfields[ii].FieldIndex:=ii; end else begin sline:=columns; split(sline,gen); if gen.Count<>LL then begin // number of columns and values not the same err('INSERT INTO: number of columns and values is different'); //soner moved here exit; end; for ii:=0 to LL-1 do begin fii:=recordsets[t1].IndexOfField(gen[ii]); if fii=-1 then exit; insertfields[ii].FieldIndex:=fii; end; end; result:=true; end; procedure UpdateValues(arecord:integer); var ii,LL:integer; begin LL:=length(insertfields); if LL=0 then exit; for ii:=0 to LL-1 do recordsets[t1].records[arecord].fields[insertfields[ii].FieldIndex].value:=insertfields[ii].FieldValue; end; begin result:=0; if tablename1='' then begin err('Missing table name in INSERT INTO component'); //soner moved here exit; end; if values='' then begin err('Missing values in VALUES component'); //soner moved here exit; end; t1:=IndexOfTable(tablename1); if t1=-1 then begin err('Table '+tablename1+' not open'); //soner moved here exit; end; if not parsevalues then exit; if not parsecolumns then exit; r1:=recordsets[t1].AddRecord; updatevalues(r1); result:=-1; recordsets[t1].modified:=true; end; function TjanSQL.Update(query:TjanSQLQuery;tablename1, updatelist, wherecondition: string): integer; var i1,c1,t1:integer; updatefields:TjanSQLFields; outputfieldcount:integer; sqloutput:TjanSQLOutput; function matchwhere(arecord:integer):boolean; begin FMatchrecordSet:=t1; recordsets[t1].matchrecord:=arecord; if wherecondition<>'' then begin result:=query.Parser.evaluate; end else result:=true; end; function parseUpdateList:boolean; // format userid=10, username='Jan verhoeven' etc var LL,pp,fii:integer; sline,stoken:string; begin result:=false; sline:=trim(updatelist); LL:=0; repeat pp:=posstr('=',sline); if pp=0 then exit; stoken:=trim(copy(sline,1,pp-1)); sline:=trim(copy(sline,pp+1,maxint)); if sline='' then exit; inc(LL); setlength(updatefields,LL); updatefields[LL-1].FieldName:=stoken; fii:=recordsets[t1].FieldNames.IndexOf(stoken); if fii=-1 then begin err('UPDATE: can not find field '+stoken); //soner moved here exit; end; updatefields[LL-1].FieldIndex:=fii; if sline[1]='''' then begin // text value pp:=posstr('''',sline,2); if pp=0 then exit; stoken:=copy(sline,2,pp-2); updatefields[LL-1].FieldValue:=stoken; sline:=trim(copy(sline,pp+1,maxint)); if sline='' then pp:=0 else begin if sline[1]<>',' then exit; system.Delete(sline,1,1); end; end else begin // not text value pp:=posstr(',',sline); if pp=0 then updatefields[LL-1].FieldValue:=trim(sline) else begin stoken:=trim(copy(sline,1,pp-1)); updatefields[LL-1].FieldValue:=stoken; sline:=copy(sline,pp+1,maxint); end; end; until pp=0; result:=true; end; procedure UpdateMatch(arecord:integer); var ii,LL:integer; begin LL:=length(updatefields); if LL=0 then exit; for ii:=0 to LL-1 do recordsets[t1].records[arecord].fields[updatefields[ii].FieldIndex].value:=updatefields[ii].FieldValue; end; function setoutputfields:boolean; var ii,cc,fii:integer; ofld:TjanSQLCalcField; ppa:integer; sfield,prefield:string; begin result:=false; split(updatelist,gen); cc:=gen.count; outputfieldcount:=cc; sqloutput:=TjanSQLOutput.create; for ii:=0 to cc-1 do begin ofld:=sqloutput.AddField; ofld.Calculator.onGetVariable:=GetVariable; sfield:=gen[ii]; ppa:=pos('=',sfield); if ppa=0 then exit; prefield:=copy(sfield,ppa+1,maxint); ofld.name:=trim(copy(sfield,1,ppa-1)); fii:=recordsets[t1].IndexOfField(ofld.name); if fii=-1 then exit; ofld.FieldIndex:=fii; try ofld.expression:=trim(prefield); except exit; end; end; result:=true; end; // JV 26-03-2002 procedure updateresult(arecord:integer); var ii,cc,fii:integer; ss:string; v:variant; begin cc:=sqloutput.FieldCount; FMatchrecordSet:=t1; recordsets[t1].matchrecord:=arecord; for ii:=0 to cc-1 do begin fii:=sqloutput.fields[ii].FieldIndex; v:=sqloutput.Fields[ii].value; ss:=v; recordsets[t1].records[arecord].fields[fii].value:=ss; end; end; begin result:=0; if tablename1='' then begin err('UPDATE: missing tablename'); //soner moved here exit; end; if updatelist='' then begin err('UPDATE: missing update fields'); //soner moved here exit; end; t1:=IndexOfTable(tablename1); if t1=-1 then begin err('UPDATE: cannot find table '+tablename1); //soner moved here exit; end; // table is open; //soner has no effect: err('UPDATE: can not parse updatelist'); // JV 26-Mar-2002 //soner moved: err('SELECT dev: can not set output fields'); if not setoutputfields then begin sqloutput.free; err('SELECT dev: can not set output fields'); exit; end; c1:=recordsets[t1].recordcount; if (c1=0) then begin sqloutput.free; result:=-1; exit; end; FMatchrecordSet:=t1; if wherecondition<>'' then begin query.Parser.Expression:=wherecondition; end; for i1:=0 to c1-1 do if matchwhere(i1) then UpdateResult(i1); // Jv 26-Mar-2002 sqloutput.free; result:=-1; recordsets[t1].modified:=true; end; // save all modified persistent files to disk function TjanSQL.Commit(query:TjanSQLQuery): integer; var i,c:integer; fn:string; begin result:=0; c:=recordsetcount; if c=0 then begin result:=-1; exit; end; for i:=1 to c do if (recordsets[i].persistent) and (recordsets[i].modified) then begin {fn:=Fcatalog+PathDelim+recordsets[i].name+'.txt';} fn:=Fcatalog+PathDelim+recordsets[i].name+'.csv'; //Changed by Zlatko Matić, 26.12.2013. if not fileexists(fn) then exit; recordsets[i].SaveToFile(fn); recordsets[i].modified:=false; end; result:=-1; end; function TjanSQL.getRecordSetCount: integer; begin result:=Frecordsets.Count; end; function TjanSQL.AddTableColumn(tablename, column, value: string): integer; var t1:integer; begin result:=0; t1:=indexoftable(tablename); if t1=-1 then exit; result:=recordsets[t1].AddField(column,value); if result<>0 then recordsets[t1].modified:=true; end; function TjanSQL.DropTableColumn(tablename, column: string): integer; var t1:integer; begin result:=0; t1:=indexoftable(tablename); if t1=0 then exit; result:=recordsets[t1].DeleteField(column); if result<>0 then recordsets[t1].modified:=true; end; // the main function that executes one or more sql statements seperated by a ; function TjanSQL.SQLDirect(value: string): integer; var i,c:integer; resultset:integer; begin result:=0; FError:=''; //soner moved: err('Empty SQL statement'); if value='' then begin err('Empty SQL statement'); //soner moved here for performance exit; end; value:=trim(value); split(value,FSQL); c:=FSQL.count; if c=0 then exit; // remove any empty lines for i:=c-1 downto 0 do if trim(FSQL[i])='' then FSQL.Delete(i); c:=FSQL.count; if c=0 then exit; for i:=0 to c-1 do begin namespace.Clear; resultset:=ISQL(FSQL[i]); if resultset=0 then exit; end; result:=resultset; err('OK'); end; function TjanSQL.SQLDirectStatement(query:TjanSQLQuery;value: string): integer; var sline{,stoken}:string; tokenizer:TjanSQLTokenizer; b:boolean; begin query.ClearTokenList; result:=0; sline:=trim(stringreplace(value,cr,' ',[rfreplaceall])); //soner moved:err('Empty SQL statement'); if sline='' then begin err('Empty SQL statement'); //soner moved here exit; end; //moved: err('Could not tokenize: '+sline); tokenizer:=TjanSQLTokenizer.create; tokenizer.onSubExpression:=procSubExpression; try b:=Tokenizer.Tokenize(sline,query.Ftokens) finally tokenizer.free; end; if not b then begin err('Could not tokenize: '+sline); //soner moved here exit; end; //soner moved: err('No tokens'); if query.Ftokens.Count=0 then begin err('No tokens'); //soner moved here exit; end; case query.tokens[0]._operator of tosqlSELECT: result:=SQLSelect(query,sline,''); tosqlASSIGN: result:=SQLAssign(query,sline); tosqlSAVETABLE: result:=SQLSaveTable(query,sline); tosqlRELEASETABLE: result:=SQLReleaseTable(query,sline); tosqlINSERT: begin if query.Ftokens.Count<5 then exit; if query.Tokens[3]._operator=tosqlselect then result:=SQLInsertSelect(query,sline) else result:=SQLInsert(query,sline); end; tosqlDELETE: result:=SQLDelete(query,sline); tosqlUPDATE: result:=SQLUpdate(query,sline); tosqlCREATE: result:=SQLCreate(query,sline); tosqlDROP: result:=SQLDrop(query,sline); tosqlALTER: result:=SQLAlter(query,sline); tosqlCOMMIT: result:=SQLCommit(query,sline); tosqlCONNECT:result:=SQLConnect(query,sline); tosqlROLLBACK: result:=SQLROLLBACK(query,sline); else err('Unknown SQL command'); end; end; // ALTER TABLE ADD COLUMN columnname // ALTER TABLE DROP COLUMN columnname function TjanSQL.SQLAlter(query:TjanSQLQuery;aline: string): integer; var tablename,column:string; p,t1,L:integer; begin result:=0; L:=query.FTokens.count; if L<6 then exit; p:=0; // check if (query.tokens[0]._operator<>tosqlAlter) or (query.tokens[1]._operator<>tosqlTABLE) or (query.tokens[4]._operator<>tosqlCOLUMN) then exit; // tablename tablename:=query.tokens[2].name; t1:=indexoftable(tablename); if t1=-1 then exit; // add or drop if query.tokens[3]._operator=tosqlADD then begin column:=query.tokens[5].name; if L>6 then result:=AddTableColumn(tablename,column,query.tokens[6].name) else result:=AddTableColumn(tablename,column,'') end else if query.tokens[3]._operator=tosqlDROP then begin column:=query.tokens[5].name; result:=DropTableColumn(tablename,column); end else exit; end; // syntax: COMMIT function TjanSQL.SQLCommit(query:TjanSQLQuery;aline: string): integer; var L:integer; begin result:=-1; L:=query.FTokens.count; if L<>1 then exit; if query.Tokens[0]._operator<>tosqlCOMMIT then exit; result:=Commit(query); end; // syntax: CREATE TABLE tablename (column1[,columnN]) function TjanSQL.SQLCreate(query:TjanSQLQuery;aline: string): integer; var tablename,fieldlist:string; p,L:integer; begin result:=0; L:=query.FTokens.count; if L<6 then exit; if (query.Tokens[0]._operator<>tosqlCREATE) or (query.Tokens[1]._operator<>tosqlTABLE) then exit; tablename:=query.tokens[2].name; if query.tokens[3].tokenkind<>tkOpen then exit; if query.tokens[L-1].tokenkind<>tkClose then exit; fieldlist:=''; for p:=4 to L-2 do if query.tokens[p].name=',' then fieldlist:=fieldlist+';' else fieldlist:=fieldlist+query.tokens[p].name; result:=CreateTable(tablename,fieldlist); end; // syntax: DELETE FROM tablename WERE condition function TjanSQL.SQLDelete(query:TjanSQLQuery;aline: string): integer; var tablename,condition:string; p,L:integer; begin result:=0; L:=query.FTokens.count; //rene: we may have no where clause //if L<7 then exit; if (query.Tokens[0]._operator<>tosqlDELETE) or (query.Tokens[1]._operator<>tosqlFROM) then exit; tablename:=query.tokens[2].name; condition := ''; (* //note (rene) //this is not standard SQL. //no where clause is just delete all records if query.tokens[3]._operator<>tosqlWHERE then exit; for p:=4 to L-1 do condition:=condition+query.tokens[p].name; *) if (L>=6) and (query.tokens[3]._operator=tosqlWHERE) then begin for p:=4 to L-1 do condition:=condition+query.tokens[p].name; end else begin if L > 3 then //error, where expected begin err ('`WHERE` expected but `'+condition+query.tokens[3].name+'` found.'); exit end else //hack here or hack DeleteFrom method, this is slower: condition := '1=1'; end; result:=deletefrom(tablename,condition); end; // syntax DROP TABLE tablename function TjanSQL.SQLDrop(query:TjanSQLQuery;aline: string): integer; var tablename:string; L:integer; begin result:=0; L:=query.FTokens.count; if L<3 then exit; if (query.Tokens[0]._operator<>tosqlDROP) or (query.Tokens[1]._operator<>tosqlTABLE) then exit; tablename:=query.tokens[2].name; result:=DropTable(tablename); end; // syntax INSERT INTO tablename VALUES (value1,[value2]) // or: INSERT INTO tablename (column1[,columnN) VALUES (value1,[valueN]) function TjanSQL.SQLInsert(query:TjanSQLQuery;aline: string): integer; var tablename:string; columns,values:string; p1,p2,L:integer; begin result:=0; L:=query.FTokens.count; if L<4 then exit; if (query.Tokens[0]._operator<>tosqlINSERT) or (query.Tokens[1]._operator<>tosqlINTO) then exit; tablename:=query.tokens[2].name; p1:=3; columns:=''; if query.Tokens[p1].tokenkind=tkOpen then begin // have columns inc(p1); p2:=p1; while (p2tkClose) do inc(p2); if p2>=L then exit; // missing ) if (p1+1)=p2 then exit; // no columns for p1:=p1 to p2-1 do if query.Tokens[p1].name=',' then columns:=columns+';' else columns:=columns+query.Tokens[p1].name; p1:=p2+1; end; if p1+2>=L then begin err('SQLInsert: missing VALUES'); //soner moved here exit; end; if query.Tokens[p1]._operator=tosqlVALUES then begin inc(p1); err('SQLInsert: missing ( after VALUES'); if query.Tokens[p1].tokenkind<>tkOpen then begin //soner moved here exit; end; inc(p1); p2:=p1; while (p2tkClose) do inc(p2); if p2>=L then begin // missing ) err('SQLInsert: missing ) after VALUES'); //soner moved here exit; end; if (p1+1)=p2 then begin // no values err('SQLInsert: no values after VALUES'); //soner moved here exit; end; for p1:=p1 to p2-1 do begin if query.tokens[p1]._operator=toAString then values:=values+''''+query.Tokens[p1].name+'''' else values:=values+query.Tokens[p1].name; end; end else exit; result:=insertinto(tablename,columns,values); end; // syntax: SELECT fieldlist FROM tablename WHERE condition // or: SELECT fieldlist FROM tablename function TjanSQL.SQLSelect(query:TjanSQLQuery;aline,aname: string): integer; var tablelist,fieldlist,condition,orderbylist:string; grouplist,having:string; ascending:boolean; p1,p2,L:integer; wfrom,wtill:integer; bracketopen:integer; alias:integer; begin result:=0; grouplist:=''; having:=''; orderbylist:=''; ascending:=true; L:=query.FTokens.count; if L<4 then begin err('SELECT: Need at least 4 token');//soner moved here exit; end; if (query.Tokens[0]._operator<>tosqlSELECT) then begin err('SELECT: missing SELECT'); //soner moved here exit; end; for p2:=1 to L-1 do if query.Tokens[p2]._operator=tosqlFROM then break; if query.Tokens[p2]._operator<>tosqlFROM then begin err('SELECT: missing FROM'); //soner moved here exit; end; // fieldlist if p2<2 then begin err('SELECT: missing selected field list'); //soner moved here exit; end; // catch for any comma's in functions bracketopen:=0; for p1:=1 to p2-1 do begin case query.tokens[p1]._operator of toOpen: begin fieldlist:=fieldlist+'('; inc(bracketopen); end; toClose: begin fieldlist:=fieldlist+')'; dec(bracketopen); end; toComma: begin if bracketopen=0 then fieldlist:=fieldlist+';' else fieldlist:=fieldlist+','; end; tosqlAS: fieldlist:=fieldlist+'|'; else fieldlist:=fieldlist+query.Tokens[p1].name; end end; p1:=p2+1; if p1>=L then exit; // new alias:=0; while (p1=2 then tablelist:=tablelist+'|'+query.tokens[p1].name else tablelist:=tablelist+query.tokens[p1].name; end; inc(p1); end; // end new condition:=''; wfrom:=0; if p1=L then begin err('SELECT: missing expression after WHERE'); //soner moved here exit; end; wfrom:=p1; while (p10 then result:=selectfromjoin(query,fieldlist,tablelist,condition,orderbylist,ascending,wfrom,wtill,grouplist,having,aname) else result:=selectfrom(query,tablelist,fieldlist,condition,orderbylist,ascending,wfrom,wtill,grouplist,having,aname); end; // syntax: UPDATE tablename SET field1=value1[,fieldN=valueN] WHERE condition function TjanSQL.SQLUpdate(query:TjanSQLQuery;aline: string): integer; var tablename,fieldlist,condition:string; columns{soner nu:,values}:string; p1,L:integer; bCondition:boolean; brackets:integer; begin result:=0; L:=query.FTokens.count; if L<6 then exit; if (query.Tokens[0]._operator<>tosqlUPDATE) then exit; tablename:=query.tokens[1].name; if (query.Tokens[2]._operator<>tosqlSET) then exit; columns:=''; // parse to WHERE p1:=3; bCondition:=true; // parse fieldlist // allow for commas in multiparamer functions brackets:=0; while (p1tosqlWHERE) do begin if query.tokens[p1].tokenkind=tkOpen then begin fieldlist:=fieldlist+'('; inc(brackets); end else if query.tokens[p1].tokenkind=tkClose then begin fieldlist:=fieldlist+')'; dec(brackets); end else if query.tokens[p1].tokenkind=tkcomma then begin if brackets=0 then fieldlist:=fieldlist+';' else fieldlist:=fieldlist+',' end else if query.tokens[p1]._operator=toAString then fieldlist:=fieldlist+''''+query.tokens[p1].name+''' ' else fieldlist:=fieldlist+query.tokens[p1].name+' '; inc(p1); end; // parse condition condition:=''; if (p1tosqlCONNECT) then begin err('CONNECT TO expected'); //soner moved here exit; end; CATALOG:=query.tokens[1].name; result:=opencatalog(catalog); end; function TjanSQL.Error: string; begin result:=FError; end; procedure TjanSQL.getvariable(sender: Tobject;const VariableName: string; var VariableValue: variant; var handled: boolean); var index,p:integer; tablename,fieldname:string; arecordset,arecord:integer; anExId:integer; begin p:=0; if not Fmatchinghaving then p:=pos('.',VariableName); if p>0 then begin tablename:=copy(VariableName,1,p-1); if not namespace.Hash(tablename,aRecordset,anExId) then exit; arecord:=recordsets[arecordset].matchrecord; fieldname:=copy(VariableName,p+1,maxint); end else begin // select without join arecordset:=Fmatchrecordset; arecord:=recordsets[arecordset].matchrecord; fieldname:=VariableName; end; index:=recordsets[arecordset].IndexOfField(fieldname); if index<>-1 then begin VariableValue:=recordsets[arecordset].records[arecord].fields[index].value; handled:=true; end; end; procedure TjanSQL.Sort(arecordset,From, Count: Integer;orderby:array of TjanSQLSort); procedure Sort( iL, iR : Integer ) ; var L, R, M : Integer ; begin repeat L := iL ; R := iR ; M := ( L + R ) div 2 ; repeat while Compare(arecordset, From + L, From + M ,orderby) < 0 do Inc(L) ; while Compare(arecordset, From + M, From + R ,orderby) < 0 do Dec(R) ; if L <= R then begin Swap(arecordset, From + L, From + R ) ; if M = L then M := R else if M = R then M := L ; Inc(L) ; Dec(R) ; end ; until L > R ; if ( R - iL ) > ( iR - L ) then begin {Sort left here} if L < iR then Sort( L, iR ) ; iR := R ; end else begin if iL < R then Sort( iL, R ) ; iL := L ; end ; until iL >= iR ; end ; begin if Count > 1 then Sort( 0, Count - 1 ) ; end; function TjanSQL.Compare(arecordset,i, j: Integer;orderby:array of TjanSQLSort): Integer; var s1,s2:string; index:integer; arecord:integer; obi,obc:integer; function safefloat(atext:string):double; begin try result:=strtofloat(atext); except result:=0; end; end; function comparefloats(afloat1,afloat2:double):integer; begin if afloat1=afloat2 then result:=0 else if afloat1>afloat2 then result:=1 else result:=-1; end; begin result:=0; arecord:=recordsets[arecordset].matchrecord; obc:=length(orderby); for obi:=0 to obc-1 do begin index:=orderby[obi].FieldIndex; s1:=recordsets[arecordset].records[i].fields[index].value; s2:=recordsets[arecordset].records[j].fields[index].value; if orderby[obi].SortAscending then begin if orderby[obi].SortNumeric then result:=comparefloats(safefloat(s1),safefloat(s2)) else result:=ansicomparestr(s1,s2); if result<>0 then break; end else begin if orderby[obi].SortNumeric then result:=comparefloats(safefloat(s2),safefloat(s1)) else result:=ansicomparestr(s2,s1); if result<>0 then break; end end; end; procedure TjanSQL.Swap(arecordset,i, j: Integer); begin recordsets[arecordset].FRecords.Exchange(i,j); end; function TjanSQL.ReleaseRecordset(arecordset: integer): boolean; var idx:integer; begin result:=false; if arecordset<1 then exit; if arecordset>recordsetcount then exit; idx:=arecordset-1; // FrecordSets.Delete(idx); result:=true; end; procedure TjanSQL.ClearQueries; var i,c:Integer; begin c:=FQueries.Count; if c=0 then exit; for i:=0 to c-1 do TjanSQLQuery(FQueries[i]).free; FQueries.clear; end; function TjanSQL.AddQuery: TjanSQLQuery; begin result:=TjanSQLQuery.create; result.engine:=self; Fqueries.Add(result); end; function TjanSQL.DeleteQuery(query: TjanSQLQuery): boolean; var idx:integer; begin result:=false; idx:=FQueries.IndexOf(query); if idx<>-1 then begin TjanSQLQuery(FQueries[idx]).free; Fqueries.Delete(idx); result:=true; end; end; function TjanSQL.ISQL(value: string): integer; var qry:TjanSQLQuery; begin result:=0; qry:=AddQuery; qry.Parser.onGetVariable:=getvariable; try result:=SQLDirectStatement(qry,value); finally DeleteQuery(qry); end; end; procedure TjanSQL.procsubexpression(sender: Tobject; const subexpression: string; var subexpressionValue: variant; var handled: boolean); var sqlresult:integer; function getresultlist:string; var rc,fc,arow:integer; begin result:=''; rc:=RecordSets[sqlresult].recordcount; if rc=0 then exit; fc:=RecordSets[sqlresult].fieldcount; if fc=0 then exit; for arow:=0 to rc-1 do if result='' then result:='['+RecordSets[sqlresult].records[arow].fields[0].value else result:=result+']['+RecordSets[sqlresult].records[arow].fields[0].value; result:=result+']'; end; begin handled:=false; sqlresult:=SQLDirect(subexpression); if sqlresult>0 then begin subexpressionvalue:=getresultlist; ReleaseRecordset(sqlresult); handled:=true; end; end; procedure TjanSQL.GroupBy(arecordset: TjanRecordset; grouplist: string); var grpidx:array of integer; i,fii:integer; g,groups:integer; r,rc,fc:integer; hash:TmwStringHashList; grouper:string; anId,anExId:integer; procedure resetgroup(arecord:integer); var ii:integer; begin for ii:=0 to fc-1 do case arecordset.FFieldFuncs[ii] of tosqlcount: begin arecordset.records[arecord].fields[ii].value:='1'; arecordset.records[arecord].counter:=1; end; else begin arecordset.records[arecord].counter:=1; end; end; end; function forcefloat(atext:string):double; begin try result:=strtofloat(atext); except result:=0; end; end; procedure applygroup(arecord,torecord:integer); var ii,cc:integer; s1,s2:string; d1,d2,d3,sum,sum2,dmean:double; begin for ii:=0 to fc-1 do begin s1:=arecordset.records[arecord].fields[ii].value; s2:=arecordset.records[torecord].fields[ii].value; case arecordset.FFieldFuncs[ii] of tosqlcount: begin arecordset.records[torecord].fields[ii].value:= floattostr(forcefloat(s2)+1); end; tosqlMax: begin if forcefloat(s1)>forcefloat(s2) then arecordset.records[torecord].fields[ii].value:=s1; end; tosqlMin: begin if forcefloat(s1)0 then begin setlength(grpidx,groups); for i:=0 to groups-1 do begin fii:=arecordset.IndexOfField(gen[i]); if fii=-1 then exit; grpidx[i]:=fii; end; end; // unmark all records for r:=0 to rc-1 do begin arecordset.records[r].mark:=false; arecordset.records[r].counter:=0; end; try hash:=TmwStringHashList.create(tinyhash,HashSecondaryOne,HashCompare); for r:=0 to rc-1 do begin grouper:=''; for g:=0 to groups-1 do grouper:=grouper+arecordset.records[r].fields[grpidx[g]].value+'|'; if not hash.Hash(grouper,anId,anExId) then begin // add hash hash.AddString(grouper,r,0); resetgroup(r); end else begin applygroup(r,anId); arecordset.records[r].mark:=true; end; end; finally hash.free; end; for r:=rc-1 downto 0 do if arecordset.records[r].mark then arecordset.DeleteRecord(r); end; procedure TjanSQL.SortRecordSet(arecordset, From, Count: Integer; orderbylist: string; ascending: boolean); var i,c,fii,p:integer; orderby:array of TjanSQLSort; fieldname:string; begin split(orderbylist,gen); c:=gen.count; if c=0 then exit; setlength(orderby,c); for i:=0 to c-1 do begin orderby[i].SortAscending:=true; orderby[i].SortNumeric:=false; fieldname:=gen[i]; p:=pos('#',fieldname); if p>0 then begin system.Delete(fieldname,p,1); orderby[i].SortNumeric:=true; end; p:=pos('-',fieldname); if p>0 then begin system.Delete(fieldname,p,1); orderby[i].SortAscending:=false; end; p:=pos('+',fieldname); if p>0 then begin system.Delete(fieldname,p,1); end; fii:=recordsets[arecordset].IndexOfField(fieldname); if fii=-1 then exit; orderby[i].FieldIndex:=fii; end; sort(arecordset,from,count,orderby); end; function TjanSQL.SQLInsertSelect(query: TjanSQLQuery; aline: string): integer; var tablename:string; t1,t3,L:integer; i:integer; f,fii,fc,r,rc,newr:integer; function havematchingfields:boolean; var ii:integer; begin result:=true; for ii:=0 to fc-1 do if recordsets[t1].IndexOfField(recordsets[t3].fieldnames[ii])<>-1 then exit; result:=false; end; begin result:=0; L:=query.FTokens.count; if L<4 then exit; tablename:=query.tokens[2].name; t1:=indexoftable(tablename); if t1=0 then begin err('INSERT INTO: can not find table '+tablename); //soner moved here exit; end; for i:=0 to 2 do begin query.Tokens[0].free; query.FTokens.Delete(0); end; t3:=SQLSelect(query,aline,''); rc:=recordsets[t3].recordcount; if rc=0 then begin err('No result records'); //soner moved here exit; end; fc:=recordsets[t3].fieldcount; if fc=0 then begin err('No result fields'); //soner moved here exit; end; if not havematchingfields then begin err('INSERT INTO..SELECT: no mathing fields'); //soner moved here exit; end; for r:=0 to rc-1 do begin newr:=recordsets[t1].addrecord; for f:=0 to fc-1 do begin fii:=recordsets[t1].indexoffield(recordsets[t3].fieldnames[f]); if fii<>-1 then recordsets[t1].records[newr].fields[fii].value:=recordsets[t3].records[r].fields[f].value; end; end; ReleaseRecordset(t3); // JV 25-mar-2002 result:=-1; end; function TjanSQL.InCatalog(value: string): boolean; var fn:string; begin result:=true; {fn:=Fcatalog+PathDelim+value+'.txt';} fn:=Fcatalog+PathDelim+value+'.csv'; //Changed by Zlatko Matić, 26.12.2013. if fileexists(fn) then exit; result:=false; end; function TjanSQL.SQLAssign(query: TjanSQLQuery; aline: string): integer; var tablename:string; L:integer; begin result:=0; L:=query.FTokens.count; if L<4 then begin err('SELECT: Need at least 4 token'); //soner moved here exit; end; tablename:=query.tokens[1].name; if (query.Tokens[2]._operator<>tosqlSELECT) then begin err('SELECT: missing SELECT'); //soner moved here exit; end; TToken(query.tokens[0]).free; TToken(query.tokens[1]).free; query.FTokens.Delete(0); query.FTokens.Delete(0); result:=SQLSelect(query,aline,tablename); if result>0 then result:=-1; end; function TjanSQL.SQLSaveTable(query: TjanSQLQuery; aline: string): integer; var tablename:string; L:integer; begin result:=0; L:=query.FTokens.count; if L<2 then begin err('SAVE TABLE: missing tablename'); //soner moved here exit; end; tablename:=query.tokens[1].name; result:=SaveTable(tablename); end; function TjanSQL.SaveTable(tablename: string): integer; var fn:string; idx:integer; begin result:=0; if tablename='' then begin err('DROP TABLE: table name missing'); //soner moved here exit; end; idx:=FRecordSets.IndexOf(tablename); if idx=-1 then begin err('SAVE TABLE: unknown table name '+tablename); //soner moved here exit; end; recordsets[idx+1].intermediate:=false; // force persistance recordsets[idx+1].persistent:=true; {fn:=Fcatalog+PathDelim+recordsets[idx+1].name+'.txt';} fn:=Fcatalog+PathDelim+recordsets[idx+1].name+'.csv'; //Changed by Zlatko Matić, 26.12.2013. recordsets[idx+1].SaveToFile(fn); recordsets[idx+1].modified:=false; result:=-1; end; function TjanSQL.SQLReleaseTable(query: TjanSQLQuery; aline: string): integer; var tablename:string; L:integer; begin result:=0; L:=query.FTokens.count; if L<2 then begin err('SAVE TABLE: missing tablename'); //soner moved here exit; end; tablename:=query.tokens[1].name; result:=ReleaseTable(tablename); end; function TjanSQL.ReleaseTable(tablename: string): integer; var idx:integer; begin result:=0; if tablename='' then begin err('RELEASE TABLE: table name missing'); //soner moved here exit; end; idx:=FRecordSets.IndexOf(tablename); if idx=-1 then begin err('RELEASE TABLE: unknown table name '+tablename); //soner moved here exit; end; FRecordsets.delete(idx); result:=-1; end; function TjanSQL.RollBack(query: TjanSQLQuery): integer; var i,c:integer; fn:string; begin result:=0; c:=recordsetcount; if c=0 then begin result:=-1; exit; end; for i:=1 to c do if (recordsets[i].persistent) and (recordsets[i].modified) then begin {fn:=Fcatalog+PathDelim+recordsets[i].name+'.txt';} fn:=Fcatalog+PathDelim+recordsets[i].name+'.csv'; //Changed by Zlatko Matić, 26.12.2013. if not fileexists(fn) then continue; recordsets[i].LoadFromFile(fn); recordsets[i].modified:=false; end; result:=-1; end; function TjanSQL.SQLRollBack(query: TjanSQLQuery; aline: string): integer; var L:integer; begin result:=-1; L:=query.FTokens.count; if L<>1 then exit; if query.Tokens[0]._operator<>tosqlRollBack then exit; result:=RollBack(query); end; { TjanRecordset } function TjanRecordset.AddField(fieldname,value: string): integer; var i,c:integer; begin result:=0; if FFieldNames.IndexOf(fieldname)<>-1 then exit; FFieldNames.Append(fieldname); c:=Frecords.Count; if c<>0 then for i:=0 to c-1 do Records[i].AddField(value); result:=-1; modified:=true; end; function TjanRecordSet.AddRecord: integer; var i,c:integer; begin result:= FRecords.Add(Tjanrecord.create); c:=FieldNames.count; if c=0 then exit; for i:=1 to c do records[result].AddField(''); modified:=true; end; procedure TjanRecordset.Clear; begin FfieldNames.Clear; FRecords.Clear; end; constructor TjanRecordset.create; begin FFieldNames:=TStringList.Create; FRecords:=TjanRecordList.Create; end; function TjanRecordset.DeleteField(index: variant): integer; var fi,i,c:integer; begin result:=0; if vartype(index)=system.varstring then begin fi:=FFieldNames.IndexOf(index); if fi=-1 then exit; end else fi:=index; if (fi<0) or (fi>=FFieldNames.Count) then exit; c:=recordcount; result:=-1; FFieldNames.Delete(fi); if c=0 then exit; for i:=0 to c-1 do records[i].DeleteField(fi); modified:=true; end; function TjanRecordSet.DeleteRecord(index: integer): boolean; begin result:=false; if (index<0) or (index>=Frecords.count) then exit; Frecords.delete(index); modified:=true; end; destructor TjanRecordset.destroy; begin FFieldNames.Free; Frecords.Free; inherited; end; function TjanRecordSet.FindFieldValue(fieldindex: integer; fieldvalue: string): integer; var i,c:integer; begin result:=-1; c:=recordcount; if c=0 then exit; for i:=0 to c-1 do begin if records[i].fields[fieldindex].value=fieldvalue then begin result:=i; exit; end; end; end; function TjanRecordset.getfieldvalue(index: variant): string; var fi:integer; s:string; rec:TjanRecord; begin result:=''; if FRecordCursor=-1 then exit; if vartype(index)=varstring then begin s:=index; fi:=FFieldNames.IndexOf(s); if fi=-1 then exit; end else fi:=index; rec:=TjanRecord(FRecords.items[FRecordcursor]); result:=rec.fields[fi].value; end; function TjanRecordset.getrecord(index: integer): TjanRecord; begin result:=nil; if FRecords.Count=0 then exit; result:=TjanRecord(FRecords[index]); end; function TjanRecordset.getrecordcount: integer; begin result:=FRecords.Count; end; function TjanRecordSet.IndexOfField(fieldname: string): integer; begin result:=FFieldNames.IndexOf(fieldname); end; function TjanRecordset.LoadFromFile(filename: string): boolean; var gen:TStringList; i,c:integer; rec:TjanRecord; begin result:=false; if not fileexists(filename) then exit; Clear; try gen:=Tstringlist.Create; gen.LoadFromFile(filename); c:=gen.count; if c<>0 then begin split(gen[0],FFieldnames); if c>1 then for i:=1 to c-1 do begin rec:=Tjanrecord.create; rec.row:=gen[i]; Frecords.Add(rec); end; result:=true; end; finally gen.free; end; end; function TjanRecordset.SaveToFile(filename: string): boolean; var gen:TStringList; i,c:integer; begin try gen:=TStringList.Create; gen.append(join(FFieldNames)); c:=RecordCount; if c<>0 then for i:=0 to c-1 do gen.append(Records[i].row); gen.SaveToFile(filename); Result:=true; //soner added finally gen.free; end; end; procedure TjanRecordset.setfieldvalue(index: variant; const Value: string); var fi:integer; s:string; rec:TjanRecord; begin if FRecordCursor=-1 then exit; if vartype(index)=varstring then begin s:=index; fi:=FFieldNames.IndexOf(s); if fi=-1 then exit; end else fi:=index; rec:=TjanRecord(FRecords.items[FRecordcursor]); rec.fields[fi].value:=value; modified:=true; end; procedure TjanRecordset.Setname(const Value: string); begin Fname := Value; end; procedure TjanRecordset.Setpersistent(const Value: boolean); begin Fpersistent := Value; end; procedure TjanRecordSet.Setmodified(const Value: boolean); begin Fmodified := Value; end; function TjanRecordSet.getfieldcount: integer; begin result:=fieldnames.Count; end; procedure TjanRecordSet.Setmatchrecord(const Value: integer); begin Fmatchrecord := Value; end; function TjanRecordSet.getLongFieldList: string; var i,c:integer; begin result:=''; c:=FFieldNames.Count; if c=0 then exit; for i:=0 to c-1 do if result='' then result:=name+'.'+FFieldNames[i] else result:=result+';'+name+'.'+FFieldNames[i]; end; function TjanRecordSet.getShortFieldList: string; var i,c:integer; begin result:=''; c:=FFieldNames.Count; if c=0 then exit; for i:=0 to c-1 do if result='' then result:=FFieldNames[i] else result:=result+';'+FFieldNames[i]; end; procedure TjanRecordSet.Setalias(const Value: string); begin Falias := Value; end; procedure TjanRecordSet.Setintermediate(const Value: boolean); begin Fintermediate := Value; end; { TjanRecord } procedure TjanRecord.AddField(value: string); var f:TjanSQLRecordField; begin f:=TjanSQLRecordField.create; f.value:=value; FFields.Add(f); end; procedure TjanRecord.ClearFields; var i,c:integer; begin c:=FFields.Count; if c=0 then exit; for i:=0 to c-1 do TjanSQLRecordField(FFields[i]).free; FFields.Clear; end; constructor TjanRecord.create; begin FFields:=TList.Create; end; function TjanRecord.DeleteField(index: integer): boolean; begin result:=false; if (index<0) or (index>=FFields.count) then exit; TjanSQLRecordField(FFields[index]).free; FFields.Delete(index); result:=true; end; destructor TjanRecord.destroy; begin ClearFields; FFields.free; inherited; end; function TjanRecord.getfield(index: integer): TjanSQLRecordField; begin result:=nil; if (index<>-1) and (index0 then begin while (pos ('\\', value)>0) do value := StringReplace (value, '\\', PathDelim, [rfReplaceAll]); value := StringReplace (value, PathDelim, '\\', [rfReplaceAll]); end; if pos (#13, value)>0 then value := StringReplace (value, #13, '\n', [rfReplaceAll]); if pos (#10, value)>0 then value := StringReplace (value, #10, '\l', [rfReplaceAll]); if pos (#9, value)>0 then value := StringReplace (value, #9, '\t', [rfReplaceAll]); if pos (#0, value)>0 then value := StringReplace (value, #0, '\0', [rfReplaceAll]); if pos (';', value)>0 then //quotesneeded qn := true; if pos ('''', value)>0 then qn := true; if pos ('"', value)>0 then begin value := StringReplace (value, '"', '\"', [rfReplaceAll]); qn := true; end; if qn then value := '"'+value+'"'; result := value; end; var i:integer; begin result:=''; for i:=0 to FFields.count-1 do if i = 0 then //Dak_Alpha result:=validformat(TjanSQLRecordField(FFields[i]).value) else result:=result+';'+validformat(TjanSQLRecordField(FFields[i]).value); end; procedure TjanRecord.Setcounter(const Value: integer); begin Fcounter := Value; end; procedure TjanRecord.setfield(index: integer; const Value: string); begin if (index<>-1) and (index=2) and ( ((value[1]='"') and (value[length(value)]='"')) or //Dak_Alpha ((value[1]='''') and (value[length(value)]='''')) or //Dak_Alpha ((value[1]='`') and (value[length(value)]='`')) //Dak_Alpha ) then value := copy (value, 2, length(value)-2); Result := value; end; var i,c:integer; lis:TStringlist; begin ClearFields; try lis:=TStringList.create; split(value,lis); c:=lis.count; for i:=0 to c-1 do AddField(StripQuotes(lis[i])); finally lis.free; end; end; { TjanRecordList } procedure TjanRecordList.Clear; var i,c:integer; begin c:=count; if c<>0 then for i:=0 to c-1 do TjanRecord(self.items[i]).free; inherited; end; procedure TjanRecordList.delete(index: integer); begin TjanRecord(items[index]).free; inherited; end; destructor TjanRecordList.destroy; begin Clear; inherited; end; { TjanRecordSetList } procedure TjanRecordSetList.delete(index: integer); begin TjanRecordSet(objects[index]).free; inherited; end; destructor TjanRecordSetList.destroy; var i,c:integer; begin c:=self.Count; if c>0 then for i:=0 to c-1 do TjanRecordSet(objects[i]).free; inherited; end; { TjanSQLQuery } procedure TjanSQLQuery.ClearTokenList; var i,c:Integer; begin c:=FTokens.Count; if c=0 then exit; for i:=0 to c-1 do TToken(Ftokens[i]).free; FTokens.clear; end; constructor TjanSQLQuery.create; begin FTokens:=TList.create; FParser:=TjanSQLExpression2.create; end; destructor TjanSQLQuery.destroy; begin ClearTokenList; FTokens.free; FParser.free; inherited; end; function TjanSQLQuery.getParser: TjanSQLExpression2; begin result:=FParser; end; function TjanSQLQuery.GetToken(index: integer): TToken; begin result:=TToken(Ftokens[index]); end; procedure TjanSQLQuery.SetEngine(const Value: TjanSQL); begin FEngine := Value; end; { TjanSQLCalcField } constructor TjanSQLCalcField.create; begin FCalc:=TjanSQLExpression2.create; end; destructor TjanSQLCalcField.destroy; begin FCalc.free; inherited; end; function TjanSQLCalcField.getValue: variant; begin result:=FCalc.Evaluate; end; procedure TjanSQLCalcField.Setexpression(const Value: string); begin Fexpression := Value; FCalc.Expression:=value; end; procedure TjanSQLCalcField.SetFieldIndex(const Value: integer); begin FFieldIndex := Value; end; procedure TjanSQLCalcField.Setname(const Value: string); begin Fname := Value; end; { TjanSQLOutput } function TjanSQLOutput.AddField: TjanSQLCalcField; begin result:=TjanSQLCalcField.create; FFields.Add(result); end; procedure TjanSQLOutput.ClearFields; var i,c:integer; begin c:=FFields.count; if c=0 then exit; for i:=0 to c-1 do TjanSQLCalcField(FFields[i]).free; FFields.clear; end; constructor TjanSQLOutput.create; begin FFields:=TList.create; end; destructor TjanSQLOutput.destroy; begin ClearFields; FFields.free; inherited; end; function TjanSQLOutput.getField(index: integer): TjanSQLCalcField; begin result:=nil; if (index<0) or (index>=FFields.count) then exit; result:=TjanSQLCalcField(FFields[index]); end; function TjanSQLOutput.getFieldCount: integer; begin result:=FFields.count; end; function TjanSQLOutput.getFieldNames: string; var i,c:integer; begin result:=''; c:=FFields.Count; if c=0 then exit; for i:=0 to c-1 do if result='' then result:=Fields[i].name else result:=result+';'+Fields[i].name; end; { TjanSQLRecordField } procedure TjanSQLRecordField.Setcount(const Value: integer); begin Fcount := Value; end; procedure TjanSQLRecordField.Setsum(const Value: double); begin Fsum := Value; end; procedure TjanSQLRecordField.Setsum2(const Value: double); begin Fsum2 := Value; end; procedure TjanSQLRecordField.Setvalue(const Value: variant); begin Fvalue := Value; end; end.