ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBBatchMove.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 8129 byte(s)
Log Message:
Borland IBX Open Source 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 interface
32
33 uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
34 IB, IBCustomDataSet, IBDatabase, IBTable;
35
36 type
37 TBatchMode = (batAppend, batUpdate, batAppendUpdate, batDelete, batCopy);
38
39 { TBatchMove }
40
41 TIBBatchMove = class(TComponent)
42 private
43 FIBLoaded: Boolean;
44 FDestination: TIBTable;
45 FSource: TIBCustomDataSet;
46 FMode: TBatchMode;
47 FAbortOnKeyViol: Boolean;
48 FAbortOnProblem: Boolean;
49 FTransliterate: Boolean;
50 FRecordCount: Longint;
51 FMovedCount: Longint;
52 FKeyViolCount: Longint;
53 FProblemCount: Longint;
54 FChangedCount: Longint;
55 FMappings: TStrings;
56 FKeyViolTableName: TFileName;
57 FProblemTableName: TFileName;
58 FChangedTableName: TFileName;
59 FCommitCount: Integer;
60 procedure SetMappings(Value: TStrings);
61 procedure SetSource(Value: TIBCustomDataSet);
62 procedure InternalExecute (BatchMode: TBatchMode; FieldCount: Word);
63 protected
64 procedure Notification(AComponent: TComponent;
65 Operation: TOperation); override;
66 public
67 constructor Create(AOwner: TComponent); override;
68 destructor Destroy; override;
69 procedure Execute;
70 public
71 property ChangedCount: Longint read FChangedCount;
72 property KeyViolCount: Longint read FKeyViolCount;
73 property MovedCount: Longint read FMovedCount;
74 property ProblemCount: Longint read FProblemCount;
75 published
76 property AbortOnKeyViol: Boolean read FAbortOnKeyViol write FAbortOnKeyViol
77 default True;
78 property AbortOnProblem: Boolean read FAbortOnProblem write FAbortOnProblem
79 default True;
80 property CommitCount: Integer read FCommitCount write FCommitCount default 0;
81 property ChangedTableName: TFileName read FChangedTableName write FChangedTableName;
82 property Destination: TIBTable read FDestination write FDestination;
83 property KeyViolTableName: TFileName read FKeyViolTableName write FKeyViolTableName;
84 property Mappings: TStrings read FMappings write SetMappings;
85 property Mode: TBatchMode read FMode write FMode default batAppend;
86 property ProblemTableName: TFileName read FProblemTableName write FProblemTableName;
87 property RecordCount: Longint read FRecordCount write FRecordCount default 0;
88 property Source: TIBCustomDataSet read FSource write SetSource;
89 property Transliterate: Boolean read FTransliterate write FTransliterate
90 default True;
91 end;
92
93 implementation
94
95 uses IBIntf;
96
97 { TIBBatchMove }
98
99 constructor TIBBatchMove.Create(AOwner: TComponent);
100 begin
101 inherited Create(AOwner);
102 FIBLoaded := False;
103 CheckIBLoaded;
104 FIBLoaded := True;
105 FAbortOnKeyViol := True;
106 FAbortOnProblem := True;
107 FTransliterate := True;
108 FMappings := TStringList.Create;
109 end;
110
111 destructor TIBBatchMove.Destroy;
112 begin
113 if FIBLoaded then
114 FMappings.Free;
115 inherited Destroy;
116 end;
117
118 procedure TIBBatchMove.Execute;
119 type
120 TFieldMap = array of Word;
121 var
122 SourceActive, DestinationActive: Boolean;
123 BatchMode: TBatchMode;
124 I: Integer;
125 FieldCount: Word;
126 FieldMap: TFieldMap;
127 DestName, SourceName: string;
128
129 procedure GetMappingNames;
130 var
131 P: Integer;
132 Mapping: string;
133 begin
134 Mapping := FMappings[I];
135 P := Pos('=', Mapping); {MBCS OK}
136 if P > 0 then
137 begin
138 DestName := Copy(Mapping, 1, P - 1);
139 SourceName := Copy(Mapping, P + 1, 255);
140 end
141 else begin
142 DestName := Mapping;
143 SourceName := Mapping;
144 end;
145 end;
146
147 begin
148 if (Destination = nil) or (Source = nil) or (Destination = Source) then
149 IBError(ibxeInvalidBatchMove, [nil]);
150 SourceActive := Source.Active;
151 DestinationActive := Destination.Active;
152 FieldCount := 0;
153 FieldMap := nil;
154 try
155 Source.DisableControls;
156 Destination.DisableControls;
157 Source.Open;
158 Source.CheckBrowseMode;
159 Source.UpdateCursorPos;
160 BatchMode := FMode;
161 if BatchMode = batCopy then
162 begin
163 Destination.Close;
164 if FMappings.Count = 0 then
165 Destination.FieldDefs := Source.FieldDefs
166 else
167 begin
168 Destination.FieldDefs.Clear;
169 for I := 0 to FMappings.Count - 1 do
170 begin
171 GetMappingNames;
172 with Source.FieldDefs.Find(SourceName) do
173 Destination.FieldDefs.Add(DestName, DataType, Size, Required);
174 end;
175 end;
176 Destination.IndexDefs.Clear;
177 Destination.CreateTable;
178 BatchMode := batAppend;
179 end;
180 Destination.Open;
181 Destination.CheckBrowseMode;
182 if FMappings.Count <> 0 then
183 begin
184 FieldCount := Destination.FieldDefs.Count;
185 SetLength(FieldMap, FieldCount);
186 for I := 0 to FMappings.Count - 1 do
187 begin
188 GetMappingNames;
189 FieldMap[Destination.FieldDefs.Find(DestName).FieldNo-1] :=
190 Source.FieldDefs.Find(SourceName).FieldNo;
191 end;
192 end;
193 if FRecordCount > 0 then
194 begin
195 Source.UpdateCursorPos;
196 FMovedCount := FRecordCount;
197 end else
198 begin
199 FMovedCount := MaxLongint;
200 end;
201 Source.CursorPosChanged;
202 try
203 InternalExecute (BatchMode, FieldCount);
204 finally
205 if DestinationActive then Destination.First;
206 end;
207 finally
208 if not DestinationActive then
209 Destination.Close;
210 if not SourceActive then
211 Source.Close;
212 Destination.EnableControls;
213 Source.EnableControls;
214 end;
215 end;
216
217 procedure TIBBatchMove.Notification(AComponent: TComponent;
218 Operation: TOperation);
219 begin
220 inherited Notification(AComponent, Operation);
221 if Operation = opRemove then
222 begin
223 if Destination = AComponent then
224 Destination := nil;
225 if Source = AComponent then
226 Source := nil;
227 end;
228 end;
229
230 procedure TIBBatchMove.SetMappings(Value: TStrings);
231 begin
232 FMappings.Assign(Value);
233 end;
234
235 procedure TIBBatchMove.SetSource(Value: TIBCustomDataSet);
236 begin
237 FSource := Value;
238 if Value <> nil then
239 Value.FreeNotification(Self);
240 end;
241
242
243 procedure TIBBatchMove.InternalExecute (BatchMode: TBatchMode; FieldCount: Word);
244 begin
245
246 end;
247
248 end.