1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
| const
RANDOMWERT = 10;
type
TThisWork = (R,W,A,SQL,Nothing,D);
ComboArray = array [0..5] of TThisWork;
type
Thr_BADODataset = class(TThread)
private
DataSet : TBetterADODataSet; // ADO-Obj
counter,maxcount : cardinal;
checkbool : boolean;
flist : string;
operation : ComboArray;
howner:hwnd;
procedure mySleep(NumberOfSeconds:LongWord);
procedure Attach;
procedure Read;
procedure SQLRead;
procedure Write;
procedure Delete;
procedure DataSetStandardConfig;
function getPCName : ShortString;
function tryUpdate: boolean;
procedure retry;
procedure datasetBeforeEdit(Dataset : TDataset);
public
fwin : TDebugWin;
Constructor Create(CreateSuspended: Boolean; Owner : hwnd; Conn : TADOConnection; Const TCI_CONNECTIONSTRING : string; myShow : TDebugWin; WorkType : ComboArray);
Destructor Destroy; Override;
property list : string read flist;
property count : cardinal read counter;
property max : cardinal read maxcount;
protected
procedure Execute; override;
published
end;
implementation
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.Execute;
var i:byte;
begin
flist:='ThreadId '+inttostr(threadid)+'|';
repeat
mySleep(1000+(random(RANDOMWERT)+1));
for i:=low(operation) to high(operation) do
begin
if not dataset.Active then dataset.Open;
case operation[i] of
R : read;
A : Attach;
W : write;
SQL : SQLRead;
D : Delete;
Nothing : mysleep(100);
end;
if dataset.Active then dataset.Close;
mySleep(1000+(random(RANDOMWERT)+1));
if checkbool then flist:=flist+'T'+inttostr(counter)+'|'
else if not checkbool then flist:= flist+'F'+inttostr(counter)+'|';
if terminated then break;
end;
until terminated;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.retry;// wurde noch nicht getestet
begin
dataset.Close;
with DataSet do
begin
LockType:=ltBatchOptimistic;
open;
UpdateBatch(arcurrent);
end;{with}
DataSetStandardConfig;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.datasetBeforeEdit(Dataset : TDataset);
begin
if not tryUpdate then
begin
if Messagedlg('Datensatz gesperrt ! Wollen sie es erneut versuchen ?',mtCustom,[mbyes,mbno],0)=idYes then
begin
retry;
end
else Abort;
end;
end;
//----------------------------------------------------------------------------//
function Thr_BADODataset.tryUpdate: boolean;
begin
result:=true;
try
dataset.UpdateCursorPos;
dataset.Resync([]);
except
result:=false;
end;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.SQLRead;
begin
try
dataset.Close;
dataset.CommandType:=cmdtext;
dataset.CommandText:='SELECT [Kunden-Nr] FROM Kunden';
dataset.Open;
try
dataset.Requery;
try
if dataset.Recordset.RecordCount>0 then
while not dataset.Eof do
begin
if not assigned(fwin) then break;
fwin.Writeln([string(dataset.Recordset.Fields.Item[0].Value)]);
if not dataset.FindNext then break;
end;
except
end;
finally
DataSetStandardConfig;
end;
except
beep;
end;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.Write;
var i,r:integer;
begin
try
if dataset.recordcount<=0 then exit;
inc(counter);
r:=random(dataset.RecordCount-1);
if counter > maxcount then maxcount:=counter;
dataset.first;
for i:=0 to r do dataset.FindNext;
dataset.UpdateCursorPos;
if (dataset.CanModify)AND(dataset.Found) then
begin
dataset.Recordset.Fields.Item[2].Value:='OVERRIDE '+getPCName+' '+inttoStr(counter);//randname;
dataset.Recordset.Fields.Item[1].Value:='ID_'+inttostr(ThreadID);
end;
except
on E : Exception do
showmessage(E.Message);
end;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.Attach;
begin
inc(counter);
if counter > maxcount then maxcount:=counter;
if (dataset.CanModify)then
try
if dataset.RecordCount>0 then dataset.Last;
try
dataset.Append;
dataset.FieldValues['KontaktVorname']:=getPCName+' '+inttoStr(counter)+' | '+TimeToStr(Now);
dataset.FieldValues['KontaktNachname']:='ID_'+inttostr(ThreadID);
dataset.Post;
finally
end;
except
end;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.Read;
var i,j : word;
buf :string;
begin
try
buf:='';
if dataset.Recordset.RecordCount>0 then begin
if not dataset.FindFirst then exit;
for j:=0 to dataset.Recordset.RecordCount-1 do
begin
for i:=0 to dataset.Recordset.Fields.Count-1 do
buf:=buf+' | '+string(DataSet.Recordset.Fields.Item[i].Value);
if buf<>'' then
if not assigned(fwin) then break else fwin.Writeln([buf]);
buf:='';
if terminated then exit else dataset.FindNext;
end;
end;
except
beep;
end;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.Delete;
var i:integer;
begin
dataset.First;
for i:=0 to (random(dataset.recordcount-1)+1) do dataset.Next;
dataset.UpdateCursorPos;
if (dataset.CanModify)AND(dataset.Found)then
try
dataset.DeleteRecords(arcurrent);
except
end;
end;
//----------------------------------------------------------------------------//
Constructor Thr_BADODataset.Create(CreateSuspended: Boolean; Owner : hwnd; Conn : TADOConnection; Const TCI_CONNECTIONSTRING : string; myShow : TDebugWin; WorkType : ComboArray);
var buffer:string;
Procedure ConnectionStringDiaglog;
begin
Dataset.ConnectionString := PromptDataSource(0,'');
end;// function
begin
inherited Create(CreateSuspended);
operation := Worktype;
counter:=0;
maxcount:=0;
fwin:=myShow;
howner := owner;
DataSet:=TBetterAdoDataSet.Create(NIL);
DataSet.BeforeEdit := datasetBeforeEdit;// diese verfahren dienen
DataSet.BeforeInsert := datasetBeforeEdit;// zur konfliktvermeidung
DataSet.BeforeDelete := datasetBeforeEdit;// s.h. tryupdate
if Assigned(Conn) then
DataSet.Connection:=Conn
else
begin
if TCI_CONNECTIONSTRING<>'' then
begin
buffer:=pchar(@TCI_CONNECTIONSTRING[pos('Source=',TCI_CONNECTIONSTRING)+7]);
buffer:=copy(buffer,1,pos(';',buffer)-1);
buffer:='T:\Temp\Projekt_ADO&Delphi\MyDB.mdb';
end else buffer:='';
if FileExists(buffer) then
dataset.ConnectionString:=buffer //TCI_CONNECTIONSTRING
else
begin
ConnectionStringDiaglog;
end;
end;
DataSetStandardConfig;
end;
//----------------------------------------------------------------------------//
procedure Thr_BADODataset.DataSetStandardConfig;
begin
if dataset.Active then dataset.close;
with DataSet do
begin
CursorLocation:=clUseServer;
CursorType:=ctkeyset;
CommandType:=cmdTableDirect;
LockType:=ltPessimistic;
CommandText:='Adressen';
end;{with}
if not dataset.Active then dataset.Open;
end;
//----------------------------------------------------------------------------//
Destructor Thr_BADODataSet.Destroy;
begin
if dataset.Active then dataset.Close;
DataSet.Free;
inherited Destroy;
end;
[...] |