dsparams.inc 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014
  1. { TParams }
  2. Function TParams.GetItem(Index: Integer): TParam;
  3. begin
  4. Result:=(Inherited GetItem(Index)) as TParam;
  5. end;
  6. Function TParams.GetParamValue(const ParamName: string): Variant;
  7. begin
  8. Result:=ParamByName(ParamName).Value;
  9. end;
  10. Procedure TParams.SetItem(Index: Integer; Value: TParam);
  11. begin
  12. Inherited SetItem(Index,Value);
  13. end;
  14. Procedure TParams.SetParamValue(const ParamName: string; const Value: Variant);
  15. begin
  16. ParamByName(ParamName).Value:=Value;
  17. end;
  18. Procedure TParams.AssignTo(Dest: TPersistent);
  19. begin
  20. if (Dest is TParams) then
  21. TParams(Dest).Assign(Self)
  22. else
  23. inherited AssignTo(Dest);
  24. end;
  25. Function TParams.GetDataSet: TDataSet;
  26. begin
  27. If (FOwner is TDataset) Then
  28. Result:=TDataset(FOwner)
  29. else
  30. Result:=Nil;
  31. end;
  32. Function TParams.GetOwner: TPersistent;
  33. begin
  34. Result:=FOwner;
  35. end;
  36. constructor TParams.Create(AOwner: TPersistent);
  37. begin
  38. Inherited Create(TParam);
  39. Fowner:=AOwner;
  40. end;
  41. constructor TParams.Create;
  42. begin
  43. Create(TPersistent(Nil));
  44. end;
  45. Procedure TParams.AddParam(Value: TParam);
  46. begin
  47. Value.Collection:=Self;
  48. end;
  49. Procedure TParams.AssignValues(Value: TParams);
  50. Var
  51. I : Integer;
  52. P,PS : TParam;
  53. begin
  54. For I:=0 to Value.Count-1 do
  55. begin
  56. PS:=Value[i];
  57. P:=FindParam(PS.Name);
  58. If Assigned(P) then
  59. P.Assign(PS);
  60. end;
  61. end;
  62. Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
  63. ParamType: TParamType): TParam;
  64. begin
  65. Result:=Add as TParam;
  66. With Result do
  67. begin
  68. Name:=ParamName;
  69. DataType:=FldType;
  70. ParamType:=ParamType;
  71. end;
  72. end;
  73. Function TParams.FindParam(const Value: string): TParam;
  74. Var
  75. I : Integer;
  76. begin
  77. Result:=Nil;
  78. I:=Count-1;
  79. While (Result=Nil) and (I>=0) do
  80. If (CompareText(Value,Items[i].Name)=0) then
  81. Result:=Items[i]
  82. else
  83. Dec(i);
  84. end;
  85. Procedure TParams.GetParamList(List: TList; const ParamNames: string);
  86. Function NextName(Var S : String) : String;
  87. Var
  88. P : Integer;
  89. begin
  90. P:=Pos(';',S);
  91. If (P=0) then
  92. P:=Length(S)+1;
  93. Result:=Copy(S,1,P-1);
  94. system.Delete(S,1,P);
  95. end;
  96. Var
  97. L,N : String;
  98. begin
  99. L:=ParamNames;
  100. While (Length(L)>0) do
  101. begin
  102. N:=NextName(L);
  103. List.Add(ParamByName(N));
  104. end;
  105. end;
  106. Function TParams.IsEqual(Value: TParams): Boolean;
  107. Var
  108. I : Integer;
  109. begin
  110. Result:=(Value.Count=Count);
  111. I:=Count-1;
  112. While Result and (I>=0) do
  113. begin
  114. Result:=Items[I].IsEqual(Value[i]);
  115. Dec(I);
  116. end;
  117. end;
  118. Function TParams.ParamByName(const Value: string): TParam;
  119. begin
  120. Result:=FindParam(Value);
  121. If (Result=Nil) then
  122. DatabaseErrorFmt(SParameterNotFound,[Value],Dataset);
  123. end;
  124. Function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
  125. var pb : TParamBinding;
  126. rs : string;
  127. begin
  128. Result := ParseSQL(SQL,DoCreate,psInterbase, pb, rs);
  129. end;
  130. Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle): String;
  131. var pb : TParamBinding;
  132. rs : string;
  133. begin
  134. Result := ParseSQL(SQL,DoCreate,ParameterStyle,pb, rs);
  135. end;
  136. Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String;
  137. var rs : string;
  138. begin
  139. Result := ParseSQL(SQL,DoCreate,ParameterStyle,ParamBinding, rs);
  140. end;
  141. Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
  142. type
  143. // used for ParamPart
  144. TStringPart = record
  145. Start,Stop:integer;
  146. end;
  147. const
  148. ParamAllocStepSize = 8;
  149. var
  150. IgnorePart:boolean;
  151. p,ParamNameStart,BufStart:PChar;
  152. ParamName:string;
  153. QuestionMarkParamCount,ParameterIndex,NewLength:integer;
  154. ParamCount:integer; // actual number of parameters encountered so far;
  155. // always <= Length(ParamPart) = Length(Parambinding)
  156. // Parambinding will have length ParamCount in the end
  157. ParamPart:array of TStringPart; // describe which parts of buf are parameters
  158. NewQueryLength:integer;
  159. NewQuery:string;
  160. NewQueryIndex,BufIndex,CopyLen,i:integer; // Parambinding will have length ParamCount in the end
  161. b:integer;
  162. tmpParam:TParam;
  163. begin
  164. if DoCreate then Clear;
  165. // Parse the SQL and build ParamBinding
  166. ParamCount:=0;
  167. NewQueryLength:=Length(SQL);
  168. SetLength(ParamPart,ParamAllocStepSize);
  169. SetLength(Parambinding,ParamAllocStepSize);
  170. QuestionMarkParamCount:=0; // number of ? params found in query so far
  171. ReplaceString := '$';
  172. if ParameterStyle = psSimulated then
  173. while pos(ReplaceString,SQL) > 0 do ReplaceString := ReplaceString+'$';
  174. p:=PChar(SQL);
  175. BufStart:=p; // used to calculate ParamPart.Start values
  176. repeat
  177. case p^ of
  178. '''': // single quote delimited string
  179. begin
  180. Inc(p);
  181. while not (p^ in [#0, '''']) do
  182. begin
  183. if p^='\' then Inc(p,2) // make sure we handle \' and \\ correct
  184. else Inc(p);
  185. end;
  186. if p^='''' then Inc(p); // skip final '
  187. end;
  188. '"': // double quote delimited string
  189. begin
  190. Inc(p);
  191. while not (p^ in [#0, '"']) do
  192. begin
  193. if p^='\' then Inc(p,2) // make sure we handle \" and \\ correct
  194. else Inc(p);
  195. end;
  196. if p^='"' then Inc(p); // skip final "
  197. end;
  198. '-': // possible start of -- comment
  199. begin
  200. Inc(p);
  201. if p='-' then // -- comment
  202. begin
  203. repeat // skip until at end of line
  204. Inc(p);
  205. until p^ in [#10, #0];
  206. end
  207. end;
  208. '/': // possible start of /* */ comment
  209. begin
  210. Inc(p);
  211. if p^='*' then // /* */ comment
  212. begin
  213. repeat
  214. Inc(p);
  215. if p^='*' then // possible end of comment
  216. begin
  217. Inc(p);
  218. if p^='/' then Break; // end of comment
  219. end;
  220. until p^=#0;
  221. if p^='/' then Inc(p); // skip final /
  222. end;
  223. end;
  224. ':','?': // parameter
  225. begin
  226. IgnorePart := False;
  227. if p^=':' then
  228. begin // find parameter name
  229. Inc(p);
  230. if p^=':' then // ignore ::, since some databases uses this as a cast (wb 4813)
  231. begin
  232. IgnorePart := True;
  233. Inc(p);
  234. end
  235. else
  236. begin
  237. ParamNameStart:=p;
  238. while not (p^ in (SQLDelimiterCharacters+[#0])) do
  239. Inc(p);
  240. ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
  241. end;
  242. end
  243. else
  244. begin
  245. Inc(p);
  246. ParamNameStart:=p;
  247. ParamName:='';
  248. end;
  249. if not IgnorePart then
  250. begin
  251. Inc(ParamCount);
  252. if ParamCount>Length(ParamPart) then
  253. begin
  254. NewLength:=Length(ParamPart)+ParamAllocStepSize;
  255. SetLength(ParamPart,NewLength);
  256. SetLength(ParamBinding,NewLength);
  257. end;
  258. if DoCreate then
  259. begin
  260. // Check if this is the first occurance of the parameter
  261. tmpParam := FindParam(ParamName);
  262. // If so, create the parameter and assign the Parameterindex
  263. if not assigned(tmpParam) then
  264. ParameterIndex := CreateParam(ftUnknown, ParamName, ptInput).Index
  265. else // else only assign the ParameterIndex
  266. ParameterIndex := tmpParam.Index;
  267. end
  268. // else find ParameterIndex
  269. else
  270. begin
  271. if ParamName<>'' then
  272. ParameterIndex:=ParamByName(ParamName).Index
  273. else
  274. begin
  275. ParameterIndex:=QuestionMarkParamCount;
  276. Inc(QuestionMarkParamCount);
  277. end;
  278. end;
  279. if ParameterStyle in [psPostgreSQL,psSimulated] then
  280. begin
  281. if ParameterIndex > 8 then
  282. inc(NewQueryLength,2)
  283. else
  284. inc(NewQueryLength,1)
  285. end;
  286. // store ParameterIndex in FParamIndex, ParamPart data
  287. ParamBinding[ParamCount-1]:=ParameterIndex;
  288. ParamPart[ParamCount-1].Start:=ParamNameStart-BufStart;
  289. ParamPart[ParamCount-1].Stop:=p-BufStart+1;
  290. // update NewQueryLength
  291. Dec(NewQueryLength,p-ParamNameStart);
  292. end;
  293. end;
  294. #0:Break;
  295. else
  296. Inc(p);
  297. end;
  298. until false;
  299. SetLength(ParamPart,ParamCount);
  300. SetLength(ParamBinding,ParamCount);
  301. if ParamCount>0 then
  302. begin
  303. // replace :ParamName by ? for interbase and by $x for postgresql/psSimulated
  304. // (using ParamPart array and NewQueryLength)
  305. if (ParameterStyle = psSimulated) and (length(ReplaceString) > 1) then
  306. inc(NewQueryLength,(paramcount)*(length(ReplaceString)-1));
  307. SetLength(NewQuery,NewQueryLength);
  308. NewQueryIndex:=1;
  309. BufIndex:=1;
  310. for i:=0 to High(ParamPart) do
  311. begin
  312. CopyLen:=ParamPart[i].Start-BufIndex;
  313. Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
  314. Inc(NewQueryIndex,CopyLen);
  315. case ParameterStyle of
  316. psInterbase : NewQuery[NewQueryIndex]:='?';
  317. psPostgreSQL,
  318. psSimulated : begin
  319. ParamName := IntToStr(ParamBinding[i]+1);
  320. for b := 1 to length(ReplaceString) do
  321. begin
  322. NewQuery[NewQueryIndex]:='$';
  323. Inc(NewQueryIndex);
  324. end;
  325. NewQuery[NewQueryIndex]:= paramname[1];
  326. if length(paramname)>1 then
  327. begin
  328. Inc(NewQueryIndex);
  329. NewQuery[NewQueryIndex]:= paramname[2]
  330. end;
  331. end;
  332. end;
  333. Inc(NewQueryIndex);
  334. BufIndex:=ParamPart[i].Stop;
  335. end;
  336. CopyLen:=Length(SQL)+1-BufIndex;
  337. Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
  338. end
  339. else
  340. NewQuery:=SQL;
  341. Result := NewQuery;
  342. end;
  343. Procedure TParams.RemoveParam(Value: TParam);
  344. begin
  345. Value.Collection:=Nil;
  346. end;
  347. { TParam }
  348. Function TParam.GetDataSet: TDataSet;
  349. begin
  350. If Assigned(Collection) and (Collection is TParams) then
  351. Result:=TParams(Collection).GetDataset
  352. else
  353. Result:=Nil;
  354. end;
  355. Function TParam.IsParamStored: Boolean;
  356. begin
  357. Result:=Bound;
  358. end;
  359. Procedure TParam.AssignParam(Param: TParam);
  360. begin
  361. if Not Assigned(Param) then
  362. begin
  363. Clear;
  364. FDataType:=ftunknown;
  365. FParamType:=ptUnknown;
  366. Name:='';
  367. Size:=0;
  368. Precision:=0;
  369. NumericScale:=0;
  370. end
  371. else
  372. begin
  373. FDataType:=Param.DataType;
  374. if Param.IsNull then
  375. Clear
  376. else
  377. FValue:=Param.FValue;
  378. FBound:=Param.Bound;
  379. Name:=Param.Name;
  380. if (ParamType=ptUnknown) then
  381. ParamType:=Param.ParamType;
  382. Size:=Param.Size;
  383. Precision:=Param.Precision;
  384. NumericScale:=Param.NumericScale;
  385. end;
  386. end;
  387. Procedure TParam.AssignTo(Dest: TPersistent);
  388. begin
  389. if (Dest is TField) then
  390. AssignToField(TField(Dest))
  391. else
  392. inherited AssignTo(Dest);
  393. end;
  394. Function TParam.GetAsBoolean: Boolean;
  395. begin
  396. If IsNull then
  397. Result:=False
  398. else
  399. Result:=FValue;
  400. end;
  401. Function TParam.GetAsCurrency: Currency;
  402. begin
  403. If IsNull then
  404. Result:=0.0
  405. else
  406. Result:=FValue;
  407. end;
  408. Function TParam.GetAsDateTime: TDateTime;
  409. begin
  410. If IsNull then
  411. Result:=0.0
  412. else
  413. Result:=FValue;
  414. end;
  415. Function TParam.GetAsFloat: Double;
  416. begin
  417. If IsNull then
  418. Result:=0.0
  419. else
  420. Result:=FValue;
  421. end;
  422. Function TParam.GetAsInteger: Longint;
  423. begin
  424. If IsNull then
  425. Result:=0
  426. else
  427. Result:=FValue;
  428. end;
  429. Function TParam.GetAsLargeInt: LargeInt;
  430. begin
  431. If IsNull then
  432. Result:=0
  433. else
  434. Result:=FValue;
  435. end;
  436. Function TParam.GetAsMemo: string;
  437. begin
  438. If IsNull then
  439. Result:=''
  440. else
  441. Result:=FValue;
  442. end;
  443. Function TParam.GetAsString: string;
  444. begin
  445. If IsNull then
  446. Result:=''
  447. else
  448. Result:=FValue;
  449. end;
  450. Function TParam.GetAsVariant: Variant;
  451. begin
  452. if IsNull then
  453. Result:=Null
  454. else
  455. Result:=FValue;
  456. end;
  457. Function TParam.GetDisplayName: string;
  458. begin
  459. if (FName<>'') then
  460. Result:=FName
  461. else
  462. Result:=inherited GetDisplayName
  463. end;
  464. Function TParam.GetIsNull: Boolean;
  465. begin
  466. Result:= VarIsNull(FValue) or VarIsClear(FValue);
  467. end;
  468. Function TParam.IsEqual(AValue: TParam): Boolean;
  469. begin
  470. Result:=(Name=AValue.Name)
  471. and (IsNull=AValue.IsNull)
  472. and (Bound=AValue.Bound)
  473. and (DataType=AValue.DataType)
  474. and (ParamType=AValue.ParamType)
  475. and (VarType(FValue)=VarType(AValue.FValue))
  476. and (FValue=AValue.FValue);
  477. end;
  478. Procedure TParam.SetAsBlob(const AValue: TBlobData);
  479. begin
  480. FValue:=AValue;
  481. FDataType:=ftBlob;
  482. end;
  483. Procedure TParam.SetAsBoolean(AValue: Boolean);
  484. begin
  485. FValue:=AValue;
  486. FDataType:=ftBoolean;
  487. end;
  488. Procedure TParam.SetAsCurrency(const AValue: Currency);
  489. begin
  490. FValue:=Avalue;
  491. FDataType:=ftCurrency;
  492. end;
  493. Procedure TParam.SetAsDate(const AValue: TDateTime);
  494. begin
  495. FValue:=Avalue;
  496. FDataType:=ftDate;
  497. end;
  498. Procedure TParam.SetAsDateTime(const AValue: TDateTime);
  499. begin
  500. FValue:=AValue;
  501. FDataType:=ftDateTime;
  502. end;
  503. Procedure TParam.SetAsFloat(const AValue: Double);
  504. begin
  505. FValue:=AValue;
  506. FDataType:=ftFloat;
  507. end;
  508. Procedure TParam.SetAsInteger(AValue: Longint);
  509. begin
  510. FValue:=AValue;
  511. FDataType:=ftInteger;
  512. end;
  513. Procedure TParam.SetAsLargeInt(AValue: LargeInt);
  514. begin
  515. FValue:=AValue;
  516. FDataType:=ftLargeint;
  517. end;
  518. Procedure TParam.SetAsMemo(const AValue: string);
  519. begin
  520. FValue:=AValue;
  521. FDataType:=ftMemo;
  522. end;
  523. Procedure TParam.SetAsSmallInt(AValue: LongInt);
  524. begin
  525. FValue:=AValue;
  526. FDataType:=ftSmallInt;
  527. end;
  528. Procedure TParam.SetAsString(const AValue: string);
  529. begin
  530. FValue:=AValue;
  531. FDataType:=ftString;
  532. end;
  533. Procedure TParam.SetAsTime(const AValue: TDateTime);
  534. begin
  535. FValue:=AValue;
  536. FDataType:=ftTime;
  537. end;
  538. Procedure TParam.SetAsVariant(const AValue: Variant);
  539. begin
  540. FValue:=AValue;
  541. FBound:=not VarIsClear(Value);
  542. if FDataType = ftUnknown then
  543. case VarType(Value) of
  544. varBoolean : FDataType:=ftBoolean;
  545. varSmallint,
  546. varShortInt,
  547. varByte : FDataType:=ftSmallInt;
  548. varWord,
  549. varInteger : FDataType:=ftInteger;
  550. varCurrency : FDataType:=ftCurrency;
  551. varLongWord,
  552. varSingle,
  553. varDouble : FDataType:=ftFloat;
  554. varDate : FDataType:=ftDateTime;
  555. varString,
  556. varOleStr : if (FDataType<>ftFixedChar) then
  557. FDataType:=ftString;
  558. varInt64 : FDataType:=ftLargeInt;
  559. else
  560. FDataType:=ftUnknown;
  561. end;
  562. end;
  563. Procedure TParam.SetAsWord(AValue: LongInt);
  564. begin
  565. FValue:=AValue;
  566. FDataType:=ftWord;
  567. end;
  568. Procedure TParam.SetDataType(AValue: TFieldType);
  569. Var
  570. VT : Integer;
  571. begin
  572. FDataType:=AValue;
  573. VT:=FieldTypetoVariantMap[AValue];
  574. If (VT=varError) then
  575. clear
  576. else
  577. if not VarIsEmpty(FValue) then
  578. begin
  579. Try
  580. FValue:=VarAsType(FValue,VT)
  581. except
  582. Clear;
  583. end { try }
  584. end;
  585. end;
  586. Procedure TParam.SetText(const AValue: string);
  587. begin
  588. Value:=AValue;
  589. end;
  590. constructor TParam.Create(ACollection: TCollection);
  591. begin
  592. inherited Create(ACollection);
  593. ParamType:=ptUnknown;
  594. DataType:=ftUnknown;
  595. FValue:=Unassigned;
  596. end;
  597. constructor TParam.Create(AParams: TParams; AParamType: TParamType);
  598. begin
  599. Create(AParams);
  600. ParamType:=AParamType;
  601. end;
  602. Procedure TParam.Assign(Source: TPersistent);
  603. begin
  604. if (Source is TParam) then
  605. AssignParam(TParam(Source))
  606. else if (Source is TField) then
  607. AssignField(TField(Source))
  608. else if (source is TStrings) then
  609. AsMemo:=TStrings(Source).Text
  610. else
  611. inherited Assign(Source);
  612. end;
  613. Procedure TParam.AssignField(Field: TField);
  614. begin
  615. if Assigned(Field) then
  616. begin
  617. // Need TField.Value
  618. AssignFieldValue(Field,Field.Value);
  619. Name:=Field.FieldName;
  620. end
  621. else
  622. begin
  623. Clear;
  624. Name:='';
  625. end
  626. end;
  627. procedure TParam.AssignToField(Field : TField);
  628. begin
  629. if Assigned(Field) then
  630. case FDataType of
  631. ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
  632. // Need TField.AsSmallInt
  633. ftSmallint : Field.AsInteger:=AsSmallInt;
  634. // Need TField.AsWord
  635. ftWord : Field.AsInteger:=AsWord;
  636. ftInteger,
  637. ftAutoInc : Field.AsInteger:=AsInteger;
  638. // Need TField.AsCurrency
  639. ftCurrency : Field.asFloat:=AsCurrency;
  640. ftFloat : Field.asFloat:=AsFloat;
  641. ftBoolean : Field.AsBoolean:=AsBoolean;
  642. ftBlob,
  643. ftGraphic..ftTypedBinary,
  644. ftOraBlob,
  645. ftOraClob,
  646. ftString,
  647. ftMemo,
  648. ftAdt,
  649. ftFixedChar: Field.AsString:=AsString;
  650. ftTime,
  651. ftDate,
  652. ftDateTime : Field.AsDateTime:=AsDateTime;
  653. ftBytes,
  654. ftVarBytes : ; // Todo.
  655. else
  656. If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
  657. DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
  658. end;
  659. end;
  660. procedure TParam.AssignFromField(Field : TField);
  661. begin
  662. if Assigned(Field) then
  663. begin
  664. FDataType:=Field.DataType;
  665. case Field.DataType of
  666. ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
  667. // Need TField.AsSmallInt
  668. ftSmallint : AsSmallint:=Field.AsInteger;
  669. // Need TField.AsWord
  670. ftWord : AsWord:=Field.AsInteger;
  671. ftInteger,
  672. ftAutoInc : AsInteger:=Field.AsInteger;
  673. // Need TField.AsCurrency
  674. ftCurrency : AsCurrency:=Field.asCurrency;
  675. ftFloat : AsFloat:=Field.asFloat;
  676. ftBoolean : AsBoolean:=Field.AsBoolean;
  677. ftBlob,
  678. ftGraphic..ftTypedBinary,
  679. ftOraBlob,
  680. ftOraClob,
  681. ftString,
  682. ftMemo,
  683. ftAdt,
  684. ftFixedChar: AsString:=Field.AsString;
  685. ftTime,
  686. ftDate,
  687. ftDateTime : AsDateTime:=Field.AsDateTime;
  688. ftBytes,
  689. ftVarBytes : ; // Todo.
  690. else
  691. If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
  692. DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
  693. end;
  694. end;
  695. end;
  696. Procedure TParam.AssignFieldValue(Field: TField; const AValue: Variant);
  697. begin
  698. If Assigned(Field) then
  699. begin
  700. if (Field.DataType = ftString) and TStringField(Field).FixedChar then
  701. DataType:=ftFixedChar
  702. else if (Field.DataType = ftMemo) and (Field.Size > 255) then
  703. DataType:=ftString
  704. else
  705. DataType:=Field.DataType;
  706. if VarIsNull(AValue) then
  707. Clear
  708. else
  709. Value:=AValue;
  710. Size:=Field.DataSize;
  711. FBound:=True;
  712. end;
  713. end;
  714. Procedure TParam.Clear;
  715. begin
  716. FValue:=UnAssigned;
  717. end;
  718. Procedure TParam.GetData(Buffer: Pointer);
  719. Var
  720. P : Pointer;
  721. S : String;
  722. begin
  723. case FDataType of
  724. ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
  725. ftSmallint : PSmallint(Buffer)^:=AsSmallInt;
  726. ftWord : PWord(Buffer)^:=AsWord;
  727. ftInteger,
  728. ftAutoInc : PInteger(Buffer)^:=AsInteger;
  729. ftCurrency : PDouble(Buffer)^:=AsCurrency;
  730. ftFloat : PDouble(Buffer)^:=AsFloat;
  731. ftBoolean : PWordBool(Buffer)^:=AsBoolean;
  732. ftString,
  733. ftMemo,
  734. ftAdt,
  735. ftFixedChar:
  736. begin
  737. S:=AsString;
  738. StrMove(PChar(Buffer),Pchar(S),Length(S)+1);
  739. end;
  740. ftTime : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Time;
  741. ftDate : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Date;
  742. ftDateTime : PDouble(Buffer)^:=TimeStampToMSecs(DateTimeToTimeStamp(AsDateTime));
  743. ftBlob,
  744. ftGraphic..ftTypedBinary,
  745. ftOraBlob,
  746. ftOraClob :
  747. begin
  748. S:=GetAsString;
  749. Move(PChar(S)^, Buffer^, Length(S));
  750. end;
  751. ftBytes, ftVarBytes:
  752. begin
  753. if VarIsArray(FValue) then
  754. begin
  755. P:=VarArrayLock(FValue);
  756. try
  757. Move(P^, Buffer^, VarArrayHighBound(FValue, 1) + 1);
  758. finally
  759. VarArrayUnlock(FValue);
  760. end;
  761. end;
  762. end;
  763. else
  764. If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
  765. DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
  766. end;
  767. end;
  768. Function TParam.GetDataSize: Integer;
  769. begin
  770. Result:=0;
  771. case DataType of
  772. ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
  773. ftBoolean : Result:=SizeOf(WordBool);
  774. ftInteger,
  775. ftAutoInc : Result:=SizeOf(Integer);
  776. ftSmallint : Result:=SizeOf(SmallInt);
  777. ftWord : Result:=SizeOf(Word);
  778. ftTime,
  779. ftDate : Result:=SizeOf(Integer);
  780. ftDateTime,
  781. ftCurrency,
  782. ftFloat : Result:=SizeOf(Double);
  783. ftString,
  784. ftFixedChar,
  785. ftMemo,
  786. ftADT : Result:=Length(AsString)+1;
  787. ftBytes,
  788. ftVarBytes : if VarIsArray(FValue) then
  789. Result:=VarArrayHighBound(FValue,1)+1
  790. else
  791. Result:=0;
  792. ftBlob,
  793. ftGraphic..ftTypedBinary,
  794. ftOraClob,
  795. ftOraBlob : Result:=Length(AsString);
  796. ftArray,
  797. ftDataSet,
  798. ftReference,
  799. ftCursor : Result:=0;
  800. else
  801. DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
  802. end;
  803. end;
  804. Procedure TParam.LoadFromFile(const FileName: string; BlobType: TBlobType);
  805. Var
  806. S : TFileStream;
  807. begin
  808. S:=TFileStream.Create(FileName,fmOpenRead);
  809. Try
  810. LoadFromStream(S,BlobType);
  811. Finally
  812. FreeAndNil(S);
  813. end;
  814. end;
  815. Procedure TParam.LoadFromStream(Stream: TStream; BlobType: TBlobType);
  816. Var
  817. Temp : String;
  818. begin
  819. FDataType:=BlobType;
  820. With Stream do
  821. begin
  822. Position:=0;
  823. SetLength(Temp,Size);
  824. ReadBuffer(Pointer(Temp)^,Size);
  825. FValue:=Temp;
  826. end;
  827. end;
  828. Procedure TParam.SetBlobData(Buffer: Pointer; ASize: Integer);
  829. Var
  830. Temp : String;
  831. begin
  832. SetLength(Temp,ASize);
  833. Move(Buffer^,Temp,ASize);
  834. AsBlob:=Temp;
  835. end;
  836. Procedure TParam.SetData(Buffer: Pointer);
  837. Function FromTimeStamp(T,D : Integer) : TDateTime;
  838. Var TS : TTimeStamp;
  839. begin
  840. TS.Time:=T;
  841. TS.Date:=D;
  842. Result:=TimeStampToDateTime(TS);
  843. end;
  844. begin
  845. case FDataType of
  846. ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
  847. ftSmallint : AsSmallInt:=PSmallint(Buffer)^;
  848. ftWord : AsWord:=PWord(Buffer)^;
  849. ftInteger,
  850. ftAutoInc : AsInteger:=PInteger(Buffer)^;
  851. ftCurrency : AsCurrency:= PDouble(Buffer)^;
  852. ftFloat : AsFloat:=PDouble(Buffer)^;
  853. ftBoolean : AsBoolean:=PWordBool(Buffer)^;
  854. ftString,
  855. ftFixedChar: AsString:=StrPas(Buffer);
  856. ftMemo : AsMemo:=StrPas(Buffer);
  857. ftTime : AsTime:=FromTimeStamp(PInteger(Buffer)^,DateDelta);
  858. ftDate : Asdate:=FromTimeStamp(0,PInteger(Buffer)^);
  859. ftDateTime : AsDateTime:=TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(Buffer)^)));
  860. ftCursor : FValue:=0;
  861. ftBlob,
  862. ftGraphic..ftTypedBinary,
  863. ftOraBlob,
  864. ftOraClob : SetBlobData(Buffer, StrLen(PChar(Buffer)));
  865. else
  866. DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
  867. end;
  868. end;
  869. Procedure TParams.CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
  870. Var
  871. I : Integer;
  872. P : TParam;
  873. F : TField;
  874. begin
  875. If (ADataSet<>Nil) then
  876. For I:=0 to Count-1 do
  877. begin
  878. P:=Items[i];
  879. if CopyBound or (not P.Bound) then
  880. begin
  881. F:=ADataset.FieldByName(P.Name);
  882. P.AssignField(F);
  883. If Not CopyBound then
  884. P.Bound:=False;
  885. end;
  886. end;
  887. end;