Форум программистов [Powered by Invision Power Board]

Код


program DeltaServer;
uses
//  FastMM4 in 'FastMM4.pas',
  FixBDE4GbBug in 'Units\FixBDE4GbBug.pas',
  Forms,
  Main in 'Units\Main.pas' {fmMain},
  Settings in 'Units\Settings.pas' {fmSettings},
  DataModule in 'Units\DataModule.pas' {dmDataModule: TDataModule},
  Cycle in 'Units\Cycle.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfmMain, fmMain);
  Application.CreateForm(TfmSettings, fmSettings);
  Application.CreateForm(TdmDataModule, dmDataModule);
  Application.Title := 'DeltaServer';
  Application.Run;
end.

Код


type
  TfmMain = class(TForm)
    mmMainMenu: TMainMenu;
    miStart: TMenuItem;
    miStop: TMenuItem;
    miExit: TMenuItem;
    meLog: TMemo;
    pbCycle: TProgressBar;
    procedure miExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure miStartClick(Sender: TObject);
    procedure WorkLogUpdate(Key : String);
    procedure FormCreate(Sender: TObject);
    ...
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure TfmMain.miStartClick(Sender: TObject);
begin
  miStart.Enabled := False;
  miStop.Enabled := True;
  flStop := False;
  flStopping := False;
  //стартуем дочерний поток
  MainCycle := TMainCycle.Create(True);
  MainCycle.FreeOnTerminate := True;
  MainCycle.Priority := tpNormal;
  MainCycle.Resume;
end;

procedure TfmMain.miStopClick(Sender: TObject);
begin
  flStopping := True;
  MainCycle.Terminate;
end;

procedure TMainCycle.AddLog;
begin
  fmMain.meLog.Lines.Add(LogRecord);
end;

procedure TfmMain.FormShow(Sender: TObject);
begin
  if dmDataModule.ssThreadSession.Active then
    dmDataModule.ssThreadSession.Active := False;
  dmDataModule.ssThreadSession.Active := True;
  ...
end;

Код


  TMainCycle = class(TThread)
  private
    CycleProgressMin: Integer;
    CycleProgressMax: Integer;
    CycleProgressPosition: Integer;
    UserName: String;
    Password: String;
    ConnectionString: String;
    Stopping: Boolean;
    procedure AddLog;
    procedure CycleProgressInit;
    procedure CycleProgressInc;
    procedure OptionsSync;
    ...
  protected
    procedure Execute; override;
  end;

procedure TMainCycle.CycleProgressInit;
begin
  fmMain.pbCycle.Min := CycleProgressMin;
  fmMain.pbCycle.Max := CycleProgressMax;
  fmMain.pbCycle.Position := CycleProgressPosition;
end;

procedure TMainCycle.CycleProgressInc;
begin
  fmMain.pbCycle.StepIt;
end;

procedure TMainCycle.GetStopping;
begin
  Stopping := flStopping;
end;

procedure TMainCycle.Execute;
begin
  LogRecord := 'Process started on ' + DateToStr(Now) + ' at ' + TimeToStr(Now);
  Synchronize(AddLog);
  if dmDataModule.dbComTec.Connected then
    dmDataModule.dbComTec.Connected := False;
  Synchronize(GetOptionUserName);
  dmDataModule.dbComTec.Params[0] := 'USER NAME=' + UserName;
  dmDataModule.dbComTec.Params[1] := 'PASSWORD=' + Password;
  dmDataModule.dbComTec.AliasName := MidStr(Task, 1, Pos(' % ', Task)-1);
  dmDataModule.dbComTec.Connected := True;
  if dmDataModule.dbOptimum.Connected then
    dmDataModule.dbOptimum.Connected := False;
  dmDataModule.dbOptimum.ConnectionString := ConnectionString;
  dmDataModule.dbOptimum.Connected := True;
  Synchronize(GetStopping);
  while Not Stopping do begin
    CycleProgressMin := 0;
    CycleProgressMax := 12;
    CycleProgressPosition := 0;
    Synchronize(CycleProgressInit);
    // Опции системы ***********************************************************
    OptionsSync;
    Synchronize(CycleProgressInc);
    ...
    if MainCycle.Terminated then begin
      Stopping := True;
      Synchronize(SetStopping);
    end;
  end;
  if dmDataModule.dbOptimum.Connected then
    dmDataModule.dbOptimum.Connected := False;
  if dmDataModule.dbComTec.Connected then
    dmDataModule.dbComTec.Connected := False;
end;