ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBBatchMove.pas
Revision: 5
Committed: Fri Feb 18 16:26:16 2011 UTC (13 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 8182 byte(s)
Log Message:
Committing updates for Release pre-release

File Contents

# Content
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 {************************************************************************}
28
29 unit IBBatchMove;
30
31 {$Mode Delphi}
32
33 interface
34
35 uses
36 {$IFDEF LINUX }
37 unix,
38 {$ELSE}
39 Windows,
40 {$ENDIF}
41 SysUtils, Graphics, Classes, Controls, Db,
42 IB, IBCustomDataSet, IBDatabase, IBTable;
43
44 type
45 TBatchMode = (batAppend, batUpdate, batAppendUpdate, batDelete, batCopy);
46
47 { TBatchMove }
48
49 TIBBatchMove = class(TComponent)
50 private
51 FIBLoaded: Boolean;
52 FDestination: TIBTable;
53 FSource: TIBCustomDataSet;
54 FMode: TBatchMode;
55 FAbortOnKeyViol: Boolean;
56 FAbortOnProblem: Boolean;
57 FTransliterate: Boolean;
58 FRecordCount: Longint;
59 FMovedCount: Longint;
60 FKeyViolCount: Longint;
61 FProblemCount: Longint;
62 FChangedCount: Longint;
63 FMappings: TStrings;
64 FKeyViolTableName: TFileName;
65 FProblemTableName: TFileName;
66 FChangedTableName: TFileName;
67 FCommitCount: Integer;
68 procedure SetMappings(Value: TStrings);
69 procedure SetSource(Value: TIBCustomDataSet);
70 procedure InternalExecute (BatchMode: TBatchMode; FieldCount: Word);
71 protected
72 procedure Notification(AComponent: TComponent;
73 Operation: TOperation); override;
74 public
75 constructor Create(AOwner: TComponent); override;
76 destructor Destroy; override;
77 procedure Execute;
78 public
79 property ChangedCount: Longint read FChangedCount;
80 property KeyViolCount: Longint read FKeyViolCount;
81 property MovedCount: Longint read FMovedCount;
82 property ProblemCount: Longint read FProblemCount;
83 published
84 property AbortOnKeyViol: Boolean read FAbortOnKeyViol write FAbortOnKeyViol
85 default True;
86 property AbortOnProblem: Boolean read FAbortOnProblem write FAbortOnProblem
87 default True;
88 property CommitCount: Integer read FCommitCount write FCommitCount default 0;
89 property ChangedTableName: TFileName read FChangedTableName write FChangedTableName;
90 property Destination: TIBTable read FDestination write FDestination;
91 property KeyViolTableName: TFileName read FKeyViolTableName write FKeyViolTableName;
92 property Mappings: TStrings read FMappings write SetMappings;
93 property Mode: TBatchMode read FMode write FMode default batAppend;
94 property ProblemTableName: TFileName read FProblemTableName write FProblemTableName;
95 property RecordCount: Longint read FRecordCount write FRecordCount default 0;
96 property Source: TIBCustomDataSet read FSource write SetSource;
97 property Transliterate: Boolean read FTransliterate write FTransliterate
98 default True;
99 end;
100
101 implementation
102
103 uses IBIntf;
104
105 { TIBBatchMove }
106
107 constructor TIBBatchMove.Create(AOwner: TComponent);
108 begin
109 inherited Create(AOwner);
110 FIBLoaded := False;
111 CheckIBLoaded;
112 FIBLoaded := True;
113 FAbortOnKeyViol := True;
114 FAbortOnProblem := True;
115 FTransliterate := True;
116 FMappings := TStringList.Create;
117 end;
118
119 destructor TIBBatchMove.Destroy;
120 begin
121 if FIBLoaded then
122 FMappings.Free;
123 inherited Destroy;
124 end;
125
126 procedure TIBBatchMove.Execute;
127 type
128 TFieldMap = array of Word;
129 var
130 SourceActive, DestinationActive: Boolean;
131 BatchMode: TBatchMode;
132 I: Integer;
133 FieldCount: Word;
134 FieldMap: TFieldMap;
135 DestName, SourceName: string;
136
137 procedure GetMappingNames;
138 var
139 P: Integer;
140 Mapping: string;
141 begin
142 Mapping := FMappings[I];
143 P := Pos('=', Mapping); {MBCS OK}
144 if P > 0 then
145 begin
146 DestName := Copy(Mapping, 1, P - 1);
147 SourceName := Copy(Mapping, P + 1, 255);
148 end
149 else begin
150 DestName := Mapping;
151 SourceName := Mapping;
152 end;
153 end;
154
155 begin
156 if (Destination = nil) or (Source = nil) or (Destination = Source) then
157 IBError(ibxeInvalidBatchMove, [nil]);
158 SourceActive := Source.Active;
159 DestinationActive := Destination.Active;
160 FieldCount := 0;
161 FieldMap := nil;
162 try
163 Source.DisableControls;
164 Destination.DisableControls;
165 Source.Open;
166 Source.CheckBrowseMode;
167 Source.UpdateCursorPos;
168 BatchMode := FMode;
169 if BatchMode = batCopy then
170 begin
171 Destination.Close;
172 if FMappings.Count = 0 then
173 Destination.FieldDefs := Source.FieldDefs
174 else
175 begin
176 Destination.FieldDefs.Clear;
177 for I := 0 to FMappings.Count - 1 do
178 begin
179 GetMappingNames;
180 with Source.FieldDefs.Find(SourceName) do
181 Destination.FieldDefs.Add(DestName, DataType, Size, Required);
182 end;
183 end;
184 Destination.IndexDefs.Clear;
185 Destination.CreateTable;
186 BatchMode := batAppend;
187 end;
188 Destination.Open;
189 Destination.CheckBrowseMode;
190 if FMappings.Count <> 0 then
191 begin
192 FieldCount := Destination.FieldDefs.Count;
193 SetLength(FieldMap, FieldCount);
194 for I := 0 to FMappings.Count - 1 do
195 begin
196 GetMappingNames;
197 FieldMap[Destination.FieldDefs.Find(DestName).FieldNo-1] :=
198 Source.FieldDefs.Find(SourceName).FieldNo;
199 end;
200 end;
201 if FRecordCount > 0 then
202 begin
203 Source.UpdateCursorPos;
204 FMovedCount := FRecordCount;
205 end else
206 begin
207 FMovedCount := MaxLongint;
208 end;
209 Source.CursorPosChanged;
210 try
211 InternalExecute (BatchMode, FieldCount);
212 finally
213 if DestinationActive then Destination.First;
214 end;
215 finally
216 if not DestinationActive then
217 Destination.Close;
218 if not SourceActive then
219 Source.Close;
220 Destination.EnableControls;
221 Source.EnableControls;
222 end;
223 end;
224
225 procedure TIBBatchMove.Notification(AComponent: TComponent;
226 Operation: TOperation);
227 begin
228 inherited Notification(AComponent, Operation);
229 if Operation = opRemove then
230 begin
231 if Destination = AComponent then
232 Destination := nil;
233 if Source = AComponent then
234 Source := nil;
235 end;
236 end;
237
238 procedure TIBBatchMove.SetMappings(Value: TStrings);
239 begin
240 FMappings.Assign(Value);
241 end;
242
243 procedure TIBBatchMove.SetSource(Value: TIBCustomDataSet);
244 begin
245 FSource := Value;
246 if Value <> nil then
247 Value.FreeNotification(Self);
248 end;
249
250
251 procedure TIBBatchMove.InternalExecute (BatchMode: TBatchMode; FieldCount: Word);
252 begin
253
254 end;
255
256 end.