home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / ARDOCI.ZIP / DataSetQuery.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-19  |  26KB  |  851 lines
  1. unit DataSetQuery;
  2.  
  3. {$define myora}
  4. {$define mymem}
  5.  
  6. {
  7.  ═α±δσΣ≤σ≥±  ε≥ TVirtualDataSet
  8.  
  9.   Wrapper Σδ  Γ±σ⌡ ≥αßδΦ÷, ε±φεΓαφ√⌡ φα TADataSet.
  10.   ╧ετΓεδ σ≥ Φ±∩εδⁿτεΓα≥ⁿ Φ⌡ ΩαΩ TDataSet, ≥.σ. Γ Ωεφ≥≡εδα⌡ Delphi
  11. }
  12.  
  13. interface
  14.  
  15. uses
  16.   VirtualDataSet, DynamicArrays, Db, Classes,
  17.   DBConsts, ADataSet
  18.  
  19. {$ifdef myora},OraDB,AOraSQL{$endif}
  20. {$ifdef mymem},AMemoryDataSet{$endif}
  21. {$ifdef myib},ibDB,AibSQL{$endif}
  22. ;
  23.  
  24. {
  25.   ┬ ValuesNull ⌡≡αφΦ≥±  True - σ±δΦ Σαφφ√σ σ±≥ⁿ, Φ False - σ±δΦ Σαφφ√⌡ φσ≥
  26.  
  27.   ΦφΣΦΩα≥ε≡√ ∩≡Φ⌡εΣ ≥ Γ ΓΦΣσ : -1 - ²≥ε NUll, >=0 - NOT NULL
  28.   ─δ  ∩α≡α∞σ≥≡εΓ ≥αΩ Φ ⌡≡αφΦ≥± 
  29. }
  30.  
  31. type
  32.   TQueryType=(qtUnknown,qtOracle,qtMemory,qtInterBase);
  33.  
  34.   PBlobRec=^TBlobRec;
  35.   TBlobRec=record
  36.    size:integer;
  37.    data:pointer;
  38.   end;
  39.  
  40.  TDataSetQuery = class;
  41.  
  42. {
  43.   ∩ε≥εΩ Σδ  ≈≥σφΦ  Φ τα∩Φ±Φ Σαφφ√⌡ Γ ∩εδ  ≥Φ∩α Blob
  44.   Φ±∩εδⁿτ≤σ≥±  Γφ≤≥≡Φ Ωε∞∩εφσφ≥√ ∩≡Φ Γ√τεΓα⌡ BlobField.LoadFromStream Φ BlobField.SaveToStream
  45. }
  46.  
  47.  TABlobStream = class(TStream)
  48.   private
  49.     FField:TAField;
  50.     FBlobField:TBlobField;
  51.     FDataSet: TDataSetQuery;
  52.     FMode: TBlobStreamMode;
  53.     FFieldNo: Integer;
  54.     FModified: Boolean;
  55.     FPosition: integer;
  56.     FBlobData: PChar;
  57.     FCacheSize: integer;
  58.     procedure UpdateActiveBuffer;
  59.   public
  60.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  61.     destructor Destroy; override;
  62.     function Read(var Buffer; Count: Longint): Longint; override;
  63.     function Write(const Buffer; Count: Longint): Longint; override;
  64.     function Seek(Offset: integer; Origin: Word): Longint; override;
  65.     function GetBlobSize: integer;
  66.     procedure Truncate;
  67.   end;
  68.  
  69.  
  70.  { TDataSetQuery }
  71.  
  72.   TDataSetQuery = class(TVirtualDataSet)
  73.   private
  74.    FQueryType:TQueryType;
  75.  
  76.    FDatabase:TADatabase;
  77.    FSQL:TStrings;
  78.    FUpdateRecord:TUpdateRecordEvent;
  79.    FDParams:TParams;
  80.  
  81.    function GetField(Index:integer):TAField;
  82.    procedure SetSQL(Value:TStrings);
  83.    function GetParams:TParams;
  84.    procedure QueryChanged(Sender:TObject);
  85.    function GetFetched:boolean;
  86.    procedure SetParams(const Value: TParams);
  87.    procedure BeforeDel(DataSet : TADataSet; num : integer);
  88.    procedure AfterIns(DataSet : TADataSet; num : integer);
  89.   protected
  90.    Query:TADataSet;
  91. //   updRecNum:integer;
  92.    updType:TUpdateKind;
  93.    function VOpen:boolean; override;
  94.    function VClose:boolean; override;
  95.    function VPrepare:boolean; override;
  96.  
  97.    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  98.    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  99.    function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  100.    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  101.  
  102.    function  VGetFieldValue(RecordNum:integer;FieldID:integer;Buffer:pointer):boolean; override;
  103.    procedure VPutFieldValue(RecordNum:integer;FieldID:integer;Buffer:pointer;mode:TPutMode;IfNotNull:Boolean); override;
  104.    procedure VInitFieldDefs(Opened:boolean); override;
  105.  
  106.    function VDeleteRecord (RecordNum:integer):TUpdateAction; override;
  107.    function VPost         (RecordNum:integer):TUpdateAction; override;
  108.    function VInsert       (RecordNum:integer):TUpdateAction; override;
  109.    procedure BindParameters;
  110.    procedure MapParams;
  111.  
  112.    procedure GetDataFromParameters;
  113.    procedure SetFetchCount(Value:word);
  114.    function GetFetchCount:word;
  115.    procedure ApplyUpdates;virtual;
  116.    function  GetRecordCount:integer;override;
  117.  
  118.    property FetchCount:word read GetFetchCount write SetFetchCount;
  119.    property SQL:TStrings read FSQL write SetSQL;
  120.    property Params:TParams read GetParams write SetParams stored True;
  121.    property OnUpdateRecord:TUpdateRecordEvent read FUpdateRecord write FUpdateRecord;
  122.  
  123.   public
  124.    constructor CreateSet(AOwner:TComponent;RQueryType:TQueryType);
  125.    destructor Destroy; override;
  126.    procedure SetDatabase(Value:TADatabase);
  127.    procedure Prepare;
  128.    procedure UnPrepare;
  129.    procedure ExecSQL;
  130.  
  131.    function ParamByName(Name:string):TParam;
  132.    function GetFieldNullHArray(FieldID : integer) : THArrayBoolean;
  133.    function GetFieldHArray(FieldID : integer) : THArray;
  134.    procedure VGoto(RecordNum:integer); override;
  135.    procedure ReadAll;
  136.    function FetchNextBlock:boolean; override;
  137.  
  138.    procedure SetFieldValue(RecordNum:integer; FieldID : integer; Value:variant); override;
  139.    function  GetFieldValue(RecordNum:integer; FieldID : integer):variant; override;
  140.    function  CreateBlobStream(Field:TField;Mode: TBlobStreamMode): TStream;override;
  141.    procedure MoveRecord(FromPos,Count,Offset : integer);
  142.      // ±ΣΓΦπ τα∩Φ±σΘ
  143.  
  144.    property Fetched:boolean read GetFetched;
  145.    procedure DefineProperties(Filer:TFiler); override;
  146.    property AField[Index:integer]:TAField read GetField;
  147.  
  148.    procedure SyncBookm;
  149.  
  150.   published
  151.    property Active;
  152.   protected
  153.    property Database:TADatabase read FDatabase write SetDatabase;
  154.   end;
  155.  
  156. implementation
  157.  
  158. uses  SysUtils, Windows, GoodDate, Math;
  159.  
  160. procedure TDataSetQuery.MoveRecord(FromPos,Count,Offset : integer);
  161. var
  162.   i : integer;
  163. begin
  164.   if Offset=0 then exit;
  165.   for i:=0 to Query.FieldCount-1 do
  166.   begin
  167.    if Assigned(Query.FieldByIndex[i].HArrayValues) then Query.FieldByIndex[i].HArrayValues.MoveData(FromPos,Count,Offset);
  168.    if Assigned(Query.FieldByIndex[i].HArrayValuesNull) then Query.FieldByIndex[i].HArrayValuesNull.MoveData(FromPos,Count,Offset);
  169.   end;
  170.   FBookm.MoveData(FromPos,Count,Offset);
  171. end;
  172.  
  173. procedure TDataSetQuery.SetDatabase(Value:TADatabase);
  174. begin
  175.  if Assigned(FDatabase) then FDatabase.RemoveDataSet(self);
  176.  FDatabase:=Value;
  177.  if Assigned(FDatabase) then FDatabase.AddDataSet(self); //τα∩Φ±√Γασ∞ ≥σΩ≤∙ΦΘ DataSet Γ ±∩Φ±εΩ Σδ  TADatabase ≈≥ε ß√ TADatabase ∩σ≡σΣ ≤φΦ≈≥εµσφΦσ∞ ±∞επ ταΩ≡√≥ⁿ Γ±σ DataSet√ Ωε≥ε≡√σ ≈σ≡στ φσπε ⌡εΣ ≥
  178.  
  179. {$ifdef myora}
  180.  if FQueryType=qtOracle then TAOraSQL(Query).Database:=TOraDB(Value);
  181. {$endif}
  182. {$ifdef mymem}
  183.  if FQueryType=qtMemory then exit;
  184. {$endif}
  185. {$ifdef myib}
  186.  if FQueryType=qtInterBase then TAibSQL(Query).Database:=TibDB(Value);
  187. {$endif}
  188. end;
  189.  
  190. constructor TDataSetQuery.CreateSet(AOwner:TComponent;RQueryType:TQueryType);
  191. begin
  192.  FQueryType:=RQueryType;
  193.  inherited Create(AOwner);
  194.  
  195.  case FQueryType of
  196. {$ifdef myora}
  197.   qtOracle: Query:=TAOraSQL.Create(self);
  198. {$endif}
  199. {$ifdef mymem}
  200.   qtMemory: Query:=TAMemoryDataSet.Create(self);
  201. {$endif}
  202. {$ifdef myib}
  203.   qtInterBase: Query:=TAibSQL.Create(self);
  204. {$endif}
  205.  end;
  206.  
  207.  FDParams:=TParams.Create(self);
  208.  FSQL:=TStringList.Create;
  209.  
  210.  TStringList(FSQL).OnChange:=QueryChanged;
  211.  Query.aaAfterInsert := AfterIns;
  212.  Query.aaBeforeDelete := BeforeDel;
  213.  Query.Name:='Query';
  214. end;
  215.  
  216. destructor TDataSetQuery.Destroy;
  217. begin
  218.  UnPrepare;
  219.  Close;
  220.  FSQL.Free;
  221.  FDParams.Free;
  222.  Query.Free;
  223.  
  224.  if Assigned(FDatabase) then FDatabase.RemoveDataSet(self);  // ∩≡Φ ≡ατ≡≤°σφΦΦ ≤Σαδ σ∞ ±σß  Φτ ±∩Φ±Ωα Γ TADatabase
  225.  inherited Destroy;
  226. end;
  227.  
  228. procedure TDataSetQuery.QueryChanged(Sender:TObject);
  229. var List:TParams;
  230.     p:TParam;
  231.     i:integer;
  232. begin
  233. {$ifdef myora}
  234.  if FQueryType=qtOracle then TAOraSQL(Query).SetQuery(FSQL.Text);
  235. {$endif}
  236.  
  237. {$ifdef mymem}
  238.  if FQueryType=qtMemory then exit;
  239. {$endif}
  240.  
  241. {$ifdef myib}
  242.  if FQueryType=qtInterBase then TAibSQL(Query).SetQuery(FSQL.Text);
  243. {$endif}
  244.  
  245.  List:=TParams.Create(self);
  246.  try
  247.   List.ParseSQL(FSQL.Text,True);
  248.   List.AssignValues(FDParams);
  249.   FDParams.Clear;
  250.   for i:=0 to List.Count-1 do begin
  251.    p:=List[i];
  252.    if p.Name='=' then continue;
  253.    if FDParams.FindParam(p.Name)=nil
  254.      then FDParams.CreateParam(p.DataType,p.Name,p.ParamType);
  255.   end;
  256.  finally
  257.   List.Free;
  258.  end;
  259. end;
  260.  
  261. procedure TDataSetQuery.SetSQL(Value:TStrings);
  262. begin
  263.  FSQL.Assign(Value);
  264.  
  265. {$ifdef myora}
  266.  if FQueryType=qtOracle then TAOraSQL(Query).SetQuery(FSQL.Text);
  267. {$endif}
  268.  
  269. {$ifdef mymem}
  270.  if FQueryType=qtMemory then exit;
  271. {$endif}
  272.  
  273. {$ifdef myib}
  274.  if FQueryType=qtInterBase then TAibSQL(Query).SetQuery(FSQL.Text);
  275. {$endif}
  276. end;
  277.  
  278. function TDataSetQuery.ParamByName(Name:string):TParam;
  279. begin
  280.  Result:=FDParams.ParamByName(Name);
  281. end;
  282.  
  283. procedure TDataSetQuery.Prepare;
  284. begin
  285.  Query.Prepare;
  286. end;
  287.  
  288. procedure TDataSetQuery.BindParameters;
  289. var i:integer;
  290. begin
  291.  for i:=0 to Params.Count-1 do begin
  292.   if Params[i].IsNull then Query.ParamByName[Params[i].Name].Clear else
  293.   case Params[i].DataType of
  294.    ftString:   Query.ParamByName[Params[i].Name].AsString:=Params[i].Value;
  295.    ftBoolean:  Query.ParamByName[Params[i].Name].AsBoolean:=Params[i].Value;
  296.    ftFloat:    Query.ParamByName[Params[i].Name].AsDouble:=Params[i].Value;
  297.    ftCurrency: Query.ParamByName[Params[i].Name].AsCurrency:=Params[i].Value;
  298.    ftDate:     Query.ParamByName[Params[i].Name].AsDate:=DateTimeToGoodDate(Params[i].Value);
  299.    ftTime:     Query.ParamByName[Params[i].Name].AsTime:=DateTimeToGoodTime(Params[i].Value);
  300.    ftDateTime: Query.ParamByName[Params[i].Name].AsDateTime:=DateTimeToGoodDateTime(Params[i].Value);
  301.    ftInteger:  Query.ParamByName[Params[i].Name].AsInteger:=Params[i].Value;
  302.    ftSmallInt: Query.ParamByName[Params[i].Name].AsSmallInt:=Params[i].Value;
  303.    ftWord:     Query.ParamByName[Params[i].Name].AsWord:=Params[i].Value;
  304.   else
  305.    raise Exception.Create('Unknown parameter data type !');
  306.   end;
  307.  end;
  308. end;
  309.  
  310. procedure TDataSetQuery.GetDataFromParameters;
  311. var i:integer;
  312. begin
  313.  for i:=0 to Params.Count-1 do begin
  314.   if Query.ParamByName[Params[i].Name].IsNull
  315.    then Params[i].Clear
  316.   else
  317.   case Params[i].DataType of
  318.    ftString:   Params[i].Value:=Query.ParamByName[Params[i].Name].AsString;
  319.    ftBoolean:  Params[i].Value:=Query.ParamByName[Params[i].Name].AsBoolean;
  320.    ftFloat:    Params[i].Value:=Query.ParamByName[Params[i].Name].AsDouble;
  321.    ftCurrency: Params[i].Value:=Query.ParamByName[Params[i].Name].AsCurrency;
  322.    ftDate:     Params[i].Value:=GoodDateToDateTime(Query.ParamByName[Params[i].Name].AsDate);
  323.    ftTime:     Params[i].Value:=GoodTimeToDateTime(Query.ParamByName[Params[i].Name].AsTime);
  324.    ftDateTime: Params[i].Value:=GoodDateTimeToDateTime(Query.ParamByName[Params[i].Name].AsDateTime);
  325.    ftInteger:  Params[i].Value:=Query.ParamByName[Params[i].Name].AsInteger;
  326.    ftSmallInt: Params[i].Value:=Query.ParamByName[Params[i].Name].AsSmallInt;
  327.    ftWord:     Params[i].Value:=Query.ParamByName[Params[i].Name].AsWord;
  328.   else
  329.    raise Exception.Create('Unknown parameter data type !');
  330.   end;
  331.  end;
  332. end;
  333.  
  334. procedure TDataSetQuery.ExecSQL;
  335. begin
  336.  Query.ClearFields;
  337.  MapParams;
  338.  BindParameters;
  339. {$ifdef myora}
  340.  if FQueryType=qtOracle then TAOraSQL(Query).ExecSQL;
  341. {$endif}
  342. {$ifdef mymem}
  343.  if FQueryType=qtMemory then exit;
  344. {$endif}
  345. {$ifdef myib}
  346.  if FQueryType=qtInterBase then TAibSQL(Query).ExecSQL;
  347. {$endif}
  348.  GetDataFromParameters;
  349. end;
  350.  
  351. procedure TDataSetQuery.MapParams;
  352. var i:integer;
  353. //    pt:TAParamType;
  354. begin
  355.  Query.ClearParams;
  356.  for i:=0 to Params.Count-1 do begin
  357. {  case Params[i].ParamType of
  358.    ptInput:  pt:=ptoInput;
  359.    ptOutput: pt:=ptoOutput;
  360.   else
  361.    pt:=ptoInputOutput;
  362.   end;}
  363. //  if not Assigned(Query.ParamByName[Params[i].Name]) then
  364.   Query.AddParam(Params[i].Name,TypeDelphiToA(Params[i].DataType),ParamTypeDelphiToA(Params[i].ParamType));
  365.  end;
  366. end;
  367.  
  368. function TDataSetQuery.VOpen:boolean;
  369. var i:integer;
  370. begin
  371.  if not DefaultFields then begin
  372.  {τα∩εδφ σ∞ ε∩≡σΣσδσφΦ  ∩εδσΘ ≥εδⁿΩε σ±δΦ ∩εδ  ß√δΦ ταΣαφ√ ∩≤≥σ∞
  373.   doubleClick φα Ωε∞∩εφσφ≥σ ∩ε≥ε∞ new field Φ ≥.Σ. - Γ ²≥ε∞ ±δ≤≈ασ
  374.   ∩εδ  ⌡≡αφ ≥±  Γ ∞α±±ΦΓσ Fields Φ εφ ε∩≡σΣσδσφ σ∙σ Σε ε≥Ω≡√≥Φ  DataSeta)}
  375.  
  376.   Query.ClearFields;
  377.   FieldDefs.Clear;
  378.   for i:=0 to Fields.Count-1 do
  379.    FieldDefs.Add(Fields[i].FieldName,Fields[i].DataType,Fields[i].Size,Fields[i].Required);
  380.  
  381.   for i:=0 to FieldDefs.Count-1 do
  382.    Query.AddField(FieldDefs[i].Name,TypeDelphiToA(FieldDefs[i].DataType),FieldDefs[i].Size,FieldDefs[i].Required);
  383.  end;
  384.  
  385.  MapParams;
  386.  BindParameters;
  387.  Query.Open;
  388.  Result:=Query.Active;
  389. end;
  390.  
  391. procedure TDataSetQuery.VInitFieldDefs(Opened:boolean);
  392. { Γ√τ√Γασ≥±  ≥εδⁿΩε σ±δΦ ∩εδⁿτεΓα≥σδσ∞ ═┼ ß√δΦ  Γφε ταΣαφ√ ∩εδ  (doubleClick
  393.   φα Ωε∞∩εφσφ≥σ ∩ε≥ε∞ new field Φ ≥.Σ.)
  394.   σ±δΦ ∩εδ  Γ ∩≡επ≡α∞∞σ ταΣαφ√  Γφε ≈σ≡στ FieldDefs ≥ε ∩σ≡σφε±Φ∞ ²≥Φ ∩εδ 
  395.   Φ Γ Query
  396. }
  397. var i:integer;
  398. begin
  399.  MapParams;
  400.  BindParameters;
  401. {$ifdef myora}
  402.  if FQueryType=qtOracle then begin // σ±δΦ ≡αßε≥ασ∞ ± ε≡αΩδε∞ ≥ε ∩εδ  Σε±≥ασ∞ Φτ ßατ√ Φ ΦφΦ≥Φ∞ FieldDefs
  403.   TAOraSQL(Query).LoadFields;
  404.   FieldDefs.Clear;
  405.   for i:=0 to Query.FieldCount-1 do
  406.    FieldDefs.Add(Query.FieldByIndex[i].Name,TypeAToDelphi(Query.FieldByIndex[i].FieldType),Query.FieldByIndex[i].FieldSize,Query.FieldByIndex[i].Required);
  407.  end;
  408. {$endif}
  409.  
  410. {$ifdef mymem}
  411.  if FQueryType=qtMemory then begin // σ±δΦ ≡αßε≥ασ∞ ± MemoryDataSet ≥ε Γ FieldDefs ∩εδ  ≤µσ ταΣαφ√ Φ ΦφΦ≥Φ∞ ∩εδ  Γ Query
  412.   Query.ClearFields;
  413.   for i:=0 to FieldDefs.Count-1 do
  414.    Query.AddField(FieldDefs[i].Name,TypeDelphiToA(FieldDefs[i].DataType),FieldDefs[i].Size,FieldDefs[i].Required);
  415.  end;
  416. {$endif}
  417. end;
  418.  
  419. function TDataSetQuery.VClose:boolean;
  420. begin
  421.  Query.Close;
  422.  Result:=not Active;
  423. end;
  424.  
  425. procedure TDataSetQuery.UnPrepare;
  426. begin
  427.  if Active then Close;
  428.  Query.UnPrepare;
  429. end;
  430.  
  431. procedure TDataSetQuery.VGoto(RecordNum:integer);
  432. //var oldnumrow,i:integer;
  433. begin
  434. // oldnumrow:=Query.RecordCount;
  435.  Query.ReadRecord(RecordNum);
  436.  SyncBookm;
  437. end;
  438.  
  439. function  TDataSetQuery.VGetFieldValue(RecordNum:integer;FieldID:integer;Buffer:pointer):boolean;
  440. var d:TDateTimeRec;
  441.     F:TAField;
  442.     s:string;
  443.     pp:pointer;
  444. //    c:integer;
  445.     st:TMemoryStream;
  446. begin
  447.  F:=Query.FieldByIndex[FieldID];
  448.  Result:=not F.IsNull[RecordNum];
  449.  if not Result then exit;
  450.  case F.FieldType of
  451.   ftoString:   begin
  452.                 s:=F.AsString[RecordNum];
  453.                 memclr(Buffer,F.FieldSize);
  454.                 memcpy(pchar(s),Buffer,Length(s));
  455.                end;
  456.   ftoBoolean:  pboolean(Buffer)^:=F.AsBoolean[RecordNum];
  457.   ftoDouble:   pdouble(Buffer)^:=F.AsDouble[RecordNum];
  458.   ftoCurrency: pdouble(Buffer)^:=F.AsCurrency[RecordNum];
  459.   ftoDate:     begin
  460.                 d.Date:=F.AsDate[RecordNum];
  461.                 memcpy(@d,Buffer,sizeof(d));
  462.                end;
  463.   ftoTime:     begin
  464.                 d.Time:=F.AsTime[RecordNum];
  465.                 memcpy(@d,Buffer,sizeof(d));
  466.                end;
  467.   ftoDateTime: begin
  468.                 d.DateTime:=F.AsDateTime[RecordNum];
  469.                 memcpy(@d,Buffer,sizeof(d));
  470.                end;
  471.   ftoInteger:  pinteger(Buffer)^:=F.AsInteger[RecordNum];
  472.   ftoSmallInt: psmallint(Buffer)^:=F.AsSmallInt[RecordNum];
  473.   ftoWord:     pword(Buffer)^:=F.AsWord[RecordNum];
  474.   ftoBlob,
  475.   ftoClob:     begin
  476.                 st:=TMemoryStream.Create;
  477.                 F.ReadBlobToStream(RecordNum,st);
  478.                 pp:=AllocMem(st.Size); // Ωε∩Φ≡≤σ∞ Blob Φτ ∩εδ  Γε Γ≡σ∞σφφ≤■ ∩α∞ ≥ⁿ φα Γ≡σ∞  ≡σΣαΩ≥Φ≡εΓαφΦ  (∩≡Φ post ²≥α ∩α∞ ≥ⁿ ε±ΓεßεµΣασ≥± )
  479.                 memcpy(st.Memory,pp,st.Size);
  480.                 PBlobRec(Buffer)^.size:=st.Size; // Γ buffer Ωε∩Φ≡≤σ∞ ≡ατ∞σ≡ Blobα
  481.                 PBlobRec(Buffer)^.Data:=pp; // Γ buffer+4 Ωε∩Φ≡≤σ∞ αΣ≡σ± ∩α∞ ≥Φ (4 ßαΘ≥α) ε≥Ω≤Σα φα≈Φφα■≥±  Σαφφ√σ BLOBα
  482.                 st.Free;
  483.                end;
  484.  else
  485.   raise Exception.Create('Unknown data type !');
  486.  end;
  487. end;
  488.  
  489. procedure TDataSetQuery.VPutFieldValue(RecordNum, FieldID: integer;
  490.   Buffer: pointer; mode: TPutMode; IfNotNull: Boolean);
  491. var F:TAField;
  492. begin
  493.  F:=Query.FieldByIndex[FieldID];
  494.  
  495.  if not IfNotNull then begin F.IsNull[RecordNum]:=True; exit; end;
  496.  case F.FieldType of
  497.   ftoString:   F.AsString[RecordNum]:=strpas(Buffer);
  498.   ftoBoolean:  F.AsBoolean[RecordNum]:=pboolean(Buffer)^;
  499.   ftoDouble:   F.AsDouble[RecordNum]:=pdouble(Buffer)^;
  500.   ftoCurrency: F.AsCurrency[RecordNum]:=pdouble(Buffer)^;
  501.   ftoDate:     F.AsDate[RecordNum]:=TDateTimeRec(Buffer^).Date;
  502.   ftoTime:     F.AsTime[RecordNum]:=TDateTimeRec(Buffer^).Time;
  503.   ftoDateTime: F.AsDateTime[RecordNum]:=int64(Buffer^);
  504.   ftoInteger:  F.AsInteger[RecordNum]:=pinteger(Buffer)^;
  505.   ftoSmallInt: F.AsSmallInt[RecordNum]:=psmallint(Buffer)^;
  506.   ftoWord:     F.AsWord[RecordNum]:=pword(Buffer)^;
  507.   ftoBlob:     begin
  508.                 F.WriteBlob(RecordNum,0,PBlobRec(Buffer)^.Data,PBlobRec(Buffer)^.Size);
  509.                 FreeMem(PBlobRec(Buffer)^.Data);
  510.                 PBlobRec(Buffer)^.Data:=nil;
  511.                 PBlobRec(Buffer)^.Size:=0;
  512.                end;
  513.  else
  514.   raise Exception.Create('Unknown data type !');
  515.  end;
  516. end;
  517.  
  518. function TDataSetQuery.GetParams:TParams;
  519. begin
  520.  Result:=FDParams;
  521. end;
  522.  
  523. function TDataSetQuery.GetFieldNullHArray(FieldID : integer) : THArrayBoolean;
  524. begin
  525.   Result:=Query.FieldByIndex[FieldID].HArrayValuesNull;
  526. end;
  527.  
  528. function TDataSetQuery.GetFieldHArray(FieldID : integer) : THArray;
  529. begin
  530.   Result:=Query.FieldByIndex[FieldID].HArrayValues;
  531. end;
  532.  
  533. procedure TDataSetQuery.ApplyUpdates;
  534. begin
  535.  raise Exception.Create('Error ApplyUpdates !');
  536. end;
  537.  
  538. function TDataSetQuery.VDeleteRecord(RecordNum:integer):TUpdateAction;
  539. begin
  540. { if not Assigned(FUpdateRecord) then begin
  541.   Result:=uaFail;
  542.   exit;
  543.  end;}
  544.  Result:=uaFail;
  545.  updType:=ukDelete;
  546. // updRecNum:=RecordNum;
  547.  if Assigned(FUpdateRecord) then FUpdateRecord(self,ukDelete,Result);
  548.  if Result=uaApplied then Query.DeleteRecord(RecordNum);
  549. end;
  550.  
  551. function TDataSetQuery.VPost(RecordNum:integer):TUpdateAction;
  552. var UpdtKind:TUpdateKind;
  553. begin
  554. { if not Assigned(FUpdateRecord) then begin
  555.   Result:=uaAbort;
  556.   exit;
  557.  end;}
  558.  case State of
  559.   dsEdit   : UpdtKind:=ukModify;
  560.   dsInsert : UpdtKind:=ukInsert;
  561.   else  raise Exception.Create('Unknown State of DataSetQuery !');
  562.  end;
  563.  Result:=uaFail;
  564.  updType:=UpdtKind;
  565. // updRecNum:=RecordNum;
  566.  if Assigned(FUpdateRecord) then FUpdateRecord(self,UpdtKind,Result);
  567. end;
  568.  
  569. function TDataSetQuery.VInsert(RecordNum:integer):TUpdateAction;
  570. begin
  571. { if not Assigned(FUpdateRecord) then begin
  572.   Result:=uaAbort;
  573.   exit;
  574.  end;}
  575.  Result:=uaApplied;
  576. // FUpdateRecord(self,ukModify,Result);
  577. // if Result=uaApplied then
  578.  Query.InsertRecord(RecordNum);
  579. end;
  580.  
  581. procedure TDataSetQuery.DefineProperties(Filer:TFiler);
  582. begin
  583.  inherited DefineProperties(Filer);
  584. end;
  585.  
  586. function TDataSetQuery.GetFetched:boolean;
  587. begin
  588.  Result:=Query.Fetched;
  589. end;
  590.  
  591. function TDataSetQuery.FetchNextBlock;
  592. //var oldnumrow,i:integer;
  593. begin
  594.  Result:=not Query.Fetched;
  595.  if not Result then exit;
  596.  
  597. // oldnumrow:=Query.RecordCount;
  598.  Query.Fetch;
  599.  SyncBookm;
  600. end;
  601.  
  602. function TDataSetQuery.GetFieldValue(RecordNum, FieldID: integer): variant;
  603. begin
  604.  if Query.FieldByIndex[FieldID].IsNull[RecordNum] then begin
  605.   Result:=Null;
  606.   exit;
  607.  end;
  608.   case Query.FieldByIndex[FieldID].FieldType of
  609.    ftoInteger : Result:=Query.FieldByIndex[FieldID].AsInteger[RecordNum];
  610.    ftoSmallInt: Result:=Query.FieldByIndex[FieldID].AsSmallInt[RecordNum];
  611.    ftoBoolean : Result:=Query.FieldByIndex[FieldID].AsBoolean[RecordNum];
  612.    ftoDouble:   Result:=Query.FieldByIndex[FieldID].AsDouble[RecordNum];
  613.    ftoDate:     Result:=Query.FieldByIndex[FieldID].AsDate[RecordNum];
  614.    ftoTime :    Result:=Query.FieldByIndex[FieldID].AsTime[RecordNum];
  615.    ftoDateTime: Result:=GoodDateTimeToDateTime(Query.FieldByIndex[FieldID].AsDateTime[RecordNum]);
  616.    ftoCurrency: Result:=Query.FieldByIndex[FieldID].AsCurrency[RecordNum];
  617.    ftoString  : Result:=Query.FieldByIndex[FieldID].AsString[RecordNum];
  618.   else
  619.    raise Exception.Create('Unknown field type !');
  620.   end;
  621. end;
  622.  
  623. procedure TDataSetQuery.SetFieldValue(RecordNum, FieldID: integer;
  624.   Value: variant);
  625. begin
  626.  if Value=Null then begin
  627.   Query.FieldByIndex[FieldID].IsNull[RecordNum]:=True;
  628.   exit;
  629.  end;
  630.   case Query.FieldByIndex[FieldID].FieldType of
  631.    ftoInteger : Query.FieldByIndex[FieldID].AsInteger[RecordNum]:=Value;
  632.    ftoSmallInt: Query.FieldByIndex[FieldID].AsSmallInt[RecordNum]:=Value;
  633.    ftoBoolean : Query.FieldByIndex[FieldID].AsBoolean[RecordNum]:=Value;
  634.    ftoDouble:   Query.FieldByIndex[FieldID].AsDouble[RecordNum]:=Value;
  635.    ftoDate:     Query.FieldByIndex[FieldID].AsDate[RecordNum]:=Value+DateDelta;
  636.    ftoTime :    Query.FieldByIndex[FieldID].AsTime[RecordNum]:=Value;
  637.    ftoDateTime: Query.FieldByIndex[FieldID].AsDateTime[RecordNum]:=DateTimeToGoodDateTime(Value);
  638.    ftoCurrency: Query.FieldByIndex[FieldID].AsCurrency[RecordNum]:=Value;
  639.    ftoString  : Query.FieldByIndex[FieldID].AsString[RecordNum]:=Value;
  640.   else
  641.    raise Exception.Create('Unknown field type !');
  642.   end;
  643. end;
  644.  
  645. function TDataSetQuery.GetField(Index: integer): TAField;
  646. begin
  647.  Result:=Query.FieldByIndex[Index];
  648. end;
  649.  
  650. procedure TDataSetQuery.SetFetchCount(Value: word);
  651. begin
  652. {$ifdef myora}
  653.  if FQueryType=qtOracle then TAOraSQL(Query).FetchCount:=Value;
  654. {$endif}
  655. {$ifdef myib}
  656.  if FQueryType=qtInterBase then TAibSQL(Query).FetchCount:=Value;
  657. {$endif}
  658. end;
  659.  
  660. procedure TDataSetQuery.SetParams(const Value: TParams);
  661. begin
  662.  raise Exception.Create('Setparams called!!')
  663. end;
  664.  
  665. function TDataSetQuery.GetFetchCount: word;
  666. begin
  667.  case FQueryType of
  668.   qtUnknown: Result:=0;
  669. {$ifdef myora}
  670.   qtOracle: Result:=TAOraSQL(Query).FetchCount;
  671. {$endif}
  672. {$ifdef myib}
  673.   qtInterBase: Result:=TAibSQL(Query).FetchCount;
  674. {$endif}
  675.  else Result:=0;
  676.  end;
  677. end;
  678.  
  679. function TDataSetQuery.GetRecordCount: integer;
  680. begin
  681. // result:= inherited GetRecordCount;
  682.  Result:=Query.RecordCount;
  683. end;
  684.  
  685. procedure TDataSetQuery.BeforeDel(DataSet : TADataSet; num : integer);
  686. begin
  687.   FBookm.Delete(num);
  688. end;
  689.  
  690. procedure TDataSetQuery.AfterIns(DataSet : TADataSet; num : integer);
  691. begin
  692.   FBookm.Insert(num, @UniqBookmark);
  693.   Inc(UniqBookmark);
  694. end;
  695.  
  696. procedure TDataSetQuery.SyncBookm;
  697. var i:integer;
  698. begin
  699. // ²≥ε φσ ε≈σφⁿ Ωδα±±φε! δ≤≈°σ ΩαΩ φΦµσ ταΩε∞σφ≥α≡σφε.
  700.  FBookm.Clear;
  701.  for i:=0 to Query.RecordCount-1 do
  702.   FBookm.AddValue(i);
  703.  UniqBookmark:=Query.RecordCount;
  704.  
  705.  { for i:=FBookm.Count to Query.RecordCount-1 do begin
  706.   FBookm.AddValue(UniqBookmark);
  707.   Inc(UniqBookmark);
  708.  end;}
  709. end;
  710.  
  711. function TDataSetQuery.VPrepare: boolean;
  712. begin
  713.  Result:=True;
  714. end;
  715.  
  716. procedure TDataSetQuery.GetBookmarkData(Buffer: PChar; Data: Pointer);
  717. begin
  718.   PInteger(Data)^:=PBookmInfo(Buffer).Bookmark;
  719. end;
  720.  
  721. function TDataSetQuery.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  722. begin
  723.   Result:=PBookmInfo(Buffer).BookmarkFlag;
  724. end;
  725.  
  726. procedure TDataSetQuery.SetBookmarkData(Buffer: PChar; Data: Pointer);
  727. begin
  728.   PBookmInfo(Buffer).Bookmark:=PInteger(Data)^;
  729. end;
  730.  
  731. procedure TDataSetQuery.SetBookmarkFlag(Buffer: PChar;
  732.   Value: TBookmarkFlag);
  733. begin
  734.   PBookmInfo(Buffer).BookmarkFlag:=Value;
  735. end;
  736.  
  737. procedure TDataSetQuery.ReadAll;
  738. begin
  739.  Query.ReadAll;
  740.  SyncBookm;
  741. end;
  742.  
  743. function TDataSetQuery.CreateBlobStream(Field: TField;
  744.   Mode: TBlobStreamMode): TStream;
  745. begin
  746. // if (currentrecord <0)or(currentrecord >recordcount) then raise Exception.Create('in CreateBlobStream currentrecord !!!!');
  747.  Result := TABlobStream.Create(Field as TBlobField, Mode);
  748. end;
  749.  
  750. { TABlobStream }
  751.  
  752. constructor TABlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  753. var br:TBlobRec;
  754. begin
  755.  FFieldNo:=Field.FieldNo;
  756.  FBlobField:=Field;
  757.  FField:=(Field.DataSet as TDataSetQuery).Query.FieldByIndex[FFieldNo-1];
  758.  FMode:=Mode;
  759.  FDataSet:=Field.DataSet as TDataSetQuery;
  760.  FPosition:=0;
  761.  FCacheSize:=0;
  762.  FModified:=False;
  763.  FBlobData:=nil;
  764.  
  765.  if Mode<>bmRead then begin
  766.   if Field.ReadOnly
  767.    then DatabaseErrorFmt(SFieldReadOnly,[Field.DisplayName], FDataSet);
  768.   if not (FDataSet.State in [dsEdit, dsInsert])
  769.    then DatabaseError(SNotEditing, FDataSet);
  770.  end;
  771.  
  772.  if FDataSet.GetFieldData(FBlobField,@br) then begin
  773.   FCacheSize:=br.Size;
  774.   FBlobData:=br.Data;
  775.  end;
  776. end;
  777.  
  778. destructor TABlobStream.Destroy;
  779. begin
  780.  FBlobData:=nil;
  781.  inherited Destroy;
  782. end;
  783.  
  784. function TABlobStream.GetBlobSize: Longint;
  785. begin
  786.   Result:=FCacheSize;
  787. end;
  788.  
  789. function TABlobStream.Seek(Offset: Integer; Origin: Word): Longint;
  790. begin
  791.   case Origin of
  792.    soFromBeginning:begin
  793.                     if(Offset<0)or(Offset>FCacheSize) then raise EStreamError.Create('Offset out of bouns !');
  794.                     FPosition:=Offset;
  795.                    end;
  796.    soFromCurrent:  begin
  797.                     if(FPosition+Offset<0)or(FPosition+Offset>FCacheSize) then raise EStreamError.Create('Offset out of bouns !');
  798.                     inc(FPosition,Offset);
  799.                    end;
  800.    soFromEnd:      begin
  801.                     if(FCacheSize-Offset<0)or(FCacheSize-Offset>FCacheSize) then raise EStreamError.Create('Offset out of bouns !');
  802.                     FPosition:=FCacheSize-Offset;
  803.                    end;
  804.    else raise EStreamError.Create('Unknown parameter "Origin" in function Seek !');
  805.   end;
  806.  Result:=FPosition;
  807. end;
  808.  
  809. procedure TABlobStream.Truncate;
  810. begin
  811.  FBlobData:=nil;
  812.  FPosition:=0;
  813.  FCacheSize:=0;
  814.  FModified:=True;
  815.  UpdateActiveBuffer;
  816. end;
  817.  
  818. function TABlobStream.Read(var Buffer; Count: Integer): Longint;
  819. begin
  820.  Result:=min(FCacheSize-FPosition,Count);
  821.  memcpy(FBlobData+FPosition ,@Buffer,Result);
  822.  inc(FPosition,Result);
  823. end;
  824.  
  825. function TABlobStream.Write(const Buffer; Count: Integer): Longint;
  826. begin
  827.  if FPosition+Count>FCacheSize then begin
  828.   FCacheSize:=FPosition+Count;
  829.   ReallocMem(FBlobData,FCacheSize);
  830.  end;
  831.  
  832.  memcpy(@Buffer,FBlobData+FPosition ,Count);
  833.  UpdateActiveBuffer;  // Φτ∞σφ σ∞ Σαφφ√σ Γ αΩ≥ΦΓφε∞ ß≤⌠⌠σ≡σ.
  834.  
  835. // FPosition:=FCacheSize;
  836.  inc(FPosition,Count);
  837.  Result:=Count;
  838.  FModified:=True;
  839. end;
  840.  
  841. procedure TABlobStream.UpdateActiveBuffer;
  842. var buf:TBlobRec;
  843. begin
  844.  buf.size:=FCacheSize;
  845.  buf.data:=FBlobData;
  846.  FDataSet.SetFieldData(FBlobField,@buf);
  847. end;
  848.  
  849. end.
  850.  
  851.