unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask, ComCtrls, Buttons; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Memo1: TMemo; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; procedure FormShow(Sender: TObject); procedure Button1Click(Sender : TObject); procedure Button2Click(Sender : TObject); private { Private declarations } public { Public declarations } end; TCreateRecord = class(TThread) private { Private declarations } protected procedure Execute; override; procedure DoWork; public res:string; end; TSaveRecord = class(TThread) private { Private declarations } protected procedure Execute; override; procedure DoWork; public i_start :integer; f:TextFile; end; var Form1: TForm1; T1 : TCreateRecord; T2 : TSaveRecord; implementation {$R *.dfm} procedure TForm1.FormShow(Sender: TObject); begin // Form1.Memo1.Clear; end; {Телефон абонента} function GenerateTelAbon:string; var nom:integer; begin nom:=random(899999)+100000; GenerateTelAbon:=' 8-375-16-'+IntToStr(nom); end; function GenerateTel:string; var k,ks,kg,nom:integer; pr,pr1:string; Kod:Array[1..2] of integer; begin Kod[1]:=8; Kod[2]:=10; k:=random(2)+1; ks:=random(899)+100; kg:=random(89)+10; nom:=random(899999)+100000; if Kod[k]=10 then begin pr:=' '; pr1:=' '; end else begin pr:=' '; pr1:=' '; end; GenerateTel:=' '+pr+IntToStr(Kod[k])+'-'+IntToStr(ks)+'-'+IntToStr(kg)+'-'+IntToStr(nom)+pr1; end; {Дата} function GenerateDate:string; var d,m:integer; day,month:string; begin m:=random(12); if m=2 then d:=random(28); if (m=1)or(m=3)or(m=5)or(m=7)or(m=8)or(m=10)or(m=12) then d:=random(31) else d:=random(30); day:=IntToStr(d); if Length(day)=1 then day:='0'+day; month:=IntToStr(m); if Length(month)=1 then month:='0'+month; GenerateDate:=day+'.'+month+'.'+'2006 '; end; {Начало и конец разговора} function GenerateTimeStartFinish:string; var h,m:integer; hour,minute:string; begin h:=random(24); hour:=IntToStr(h); if Length(hour)=1 then hour:='0'+hour; if hour='24' then hour:='00'; m:=random(60); minute:=IntToStr(m); if Length(minute)=1 then minute:='0'+minute; if hour='60' then minute:='00'; GenerateTimeStartFinish:=hour+':'+minute; end; {Продолжительность разговора} function GetTime(start,finish:string):string; var h1,h2,m1,m2,m:integer; hour1,hour2,minute1,minute2,minute:string; begin hour1:=start[1]+start[2]; h1:=StrToInt(hour1); h1:=h1*60; minute1:=start[4]+start[5]; m1:=StrToInt(minute1); m1:=m1+h1; hour2:=finish[1]+finish[2]; h2:=StrToInt(hour2); h2:=h2*60; minute2:=finish[4]+finish[5]; m2:=StrToInt(minute2); m2:=m2+h2; m:=m2-m1; if m<0 then m:=m+1440; minute:=IntToStr(m); if Length(minute)=1 then minute:=minute+' '; if Length(minute)=2 then minute:=minute+' '; if Length(minute)=3 then minute:=minute+' '; if Length(minute)=4 then minute:=minute+' '; GetTime:=minute; end; {Идентификатор линии} function GenerateIdent:string; var i:integer; id:Array[1..5] of string; iden:string; begin id[1]:='C'; id[2]:='O'; id[3]:='I'; id[4]:='S'; id[5]:='R'; i:=random(5)+1; iden:=id[i]; GenerateIdent:=iden; end; procedure TCreateRecord.Execute; const s=' '; var start,finish:string; begin while not Terminated do begin {Пока процесс не прервали, выполняем} start:=GenerateTimeStartFinish; finish:=GenerateTimeStartFinish; res:=GenerateTelAbon+GenerateTel+GenerateDate+ Start+s+Finish+s+GetTime(start,finish)+s+GenerateIdent; Synchronize(DoWork); end; end; procedure TCreateRecord.DoWork; begin Form1.Memo1.Lines.Add(res); Application.ProcessMessages; end; procedure TSaveRecord.Execute; begin AssignFile(f,'CallRecord.txt'); Rewrite(f); i_start:=0; {Пока процесс не прервали, выполняем DoWork} while not Terminated do begin Synchronize(DoWork); end; CloseFile(f); end; procedure TSaveRecord.DoWork; var i :integer; begin if i_start=0 then writeln(f,' '+Form1.Label1.Caption+' ' +Form1.Label2.Caption+' '+Form1.Label3.Caption+ ' '+Form1.Label4.Caption+' '+Form1.Label5.Caption+ ' '+Form1.Label6.Caption+' '+Form1.Label7.Caption); for i:=i_start to Form1.Memo1.Lines.Count-1 do writeln(f,Form1.Memo1.Lines[i]); i_start:=Form1.Memo1.Lines.Count; Application.ProcessMessages; end; procedure TForm1.Button1Click(Sender : TObject); begin Button1.Enabled:=False; Button2.Enabled:=True; T1:=TCreateRecord.Create(False); T2:=TSaveRecord.Create(False); end; procedure TForm1.Button2Click(Sender : TObject); begin T1.Terminate; T2.Terminate; Button1.Enabled:=True; Button2.Enabled:=False; end; end.