unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin;

type
  TMain = class(TForm)
    GroupBox1: TGroupBox;
    lbox: TListBox;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    btnstartMonitor: TBitBtn;
    btnStopMonitor: TBitBtn;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    btnCreate: TBitBtn;
    edtName: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    edtRetry: TSpinEdit;
    GroupBox5: TGroupBox;
    Label8: TLabel;
    edtSource: TEdit;
    edtUse: TEdit;
    Label9: TLabel;
    lvInfo: TListView;
    Splitter1: TSplitter;
    edtWaitTime: TSpinEdit;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Label7: TLabel;
    edtTimes: TSpinEdit;
    Label10: TLabel;
    CheckBox1: TCheckBox;
    Label11: TLabel;
    procedure btnstartMonitorClick(Sender: TObject);
    procedure btnStopMonitorClick(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
  private
    { Private declarations }
  public
    isMonitor: boolean; //is monitor the status ,is false didn't display the statu information
    procedure AddInfoTolvinfo(index: integer; s: string);
    function GetInfoFromlvInfo(index: integer): string;
    procedure AddInfo(s: string);

    { Public declarations }
  end;

  TDemoProcedure = class(TThread)
  public
    ListIndex: integer;
    strName: string;
    WaitTime, RetryTime, Times: Integer;
    isWantSource: boolean; //申請資源標志
    isDonotWantSource: boolean; //釋放資源標志
    constructor Create();
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure WantSource;
    procedure Wantsourceok;
    procedure donWantSource;
    procedure donWantsourceOK;
    procedure EndThisRun;
    procedure ShowError;
    procedure ShowErrorEx; //釋放資源被鎖定，強制釋放以防死鎖
  end;

const
  sRun = '運行狀態';
  sWait = '申請資源';
  sWaitOk = '申請資源成功，進行使用期';
  sExit = '申請釋放資源';
  sExitOk = '釋放資源ok';
var

  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.btnstartMonitorClick(Sender: TObject);
begin
  isMonitor := true;
  btnStartMonitor.Enabled := false;
  btnStopMonitor.Enabled := true;
end;

procedure TMain.btnStopMonitorClick(Sender: TObject);
begin
  isMonitor := false;
  btnStartMonitor.Enabled := true;
  btnStopMonitor.Enabled := false;
end;

procedure TMain.btnCreateClick(Sender: TObject);
var
  strName: string;
  waitTime, Retry, Times: integer;
  p: TListitem;
  isMore: boolean; //判斷該進程是否已存在
  i: integer;
  DemoProcedure: TDemoProcedure;
begin
  strName := Trim(edtName.Text);
  waitTime := edtWaitTime.Value;
  Retry := edtRetry.Value;
  Times := edtTimes.Value;

  if Trim(edtName.Text) = '' then
  begin ShowMessage('模擬進程的名稱必須輸入，隨便輸'); edtName.SetFocus; exit; end;
  if ((WaitTime <= 0) or (Retry <= 0)) then
  begin ShowMessage('時間是不能設為小于等于0的數的，隨便輸'); exit; end;
  if (Times <= 0) then
  begin ShowMessage('重試次數不能少于0'); edtTimes.SetFocus; exit; end;

  isMore := false;
  for i := 0 to lvinfo.Items.Count - 1 do
  begin
    if lvinfo.Items[i].Caption = strName then
    begin isMore := true; break; end;
  end;
  if isMore then
  begin ShowMessage('模擬進程的名稱要唯一哦'); edtName.SetFocus; exit; end;

  edtName.SetFocus;

  with lvinfo do //如果成功，寫入進程信息列表中
  begin
    p := Items.Add;
    p.Caption := strname;
    p.SubItems.Add(intTostr(waitTime));
    p.SubItems.Add(intTostr(Retry));
    p.SubItems.Add(sRun);
  end;
  i := lvInfo.Items.Count - 1;
  //創建模擬進程
  DemoProcedure := TDemoProcedure.Create();
  DemoProcedure.strName := strName;
  DemoProcedure.Times := Times;
  DemoProcedure.ListIndex := i;
  DemoProcedure.WaitTime := waitTime * 1000;
  DemoProcedure.RetryTime := Retry * 1000;
  DemoProcedure.Resume;
end;

procedure TMain.AddInfotoLvinfo(index: integer; s: string);
begin
  if lvinfo.Items.Count - 1 < index then exit;
  if index < 0 then exit;
  lvinfo.Items[index].SubItems[2] := s; ;
end;

function TMain.GetInfoFromlvInfo(index: integer): string;
begin
  result := lvinfo.Items[index].SubItems[2];
end;

procedure TMain.AddInfo(s: string);
begin
  if not isMonitor then exit;
  lbox.Items.Add(s);
//  Application.ProcessMessages;
end;

{ TDemoProcedure }

constructor TDemoProcedure.Create;
begin
  FreeOnTerminate := True;
  inherited Create(True);
end;

procedure TDemoProcedure.donWantSource;
begin
  with Main do
  begin
    isDonotWantSource := not CheckBox1.checked;

    if isDonotWantSource then
    begin
    //釋放資源
      edtuse.Text := '否';
      Edit1.Text := '無';
      edtSource.Text := intTostr(strToint(edtSource.Text) + 1);

      AddinfoTolvinfo(ListIndex, '釋放資源成功');
      Addinfo(format('%s 試圖釋放資源---資源尚未鎖定，釋放成功', [strname]));
    end
    else
    begin
      AddinfoTolvinfo(ListIndex, '釋放資源失敗');
      Addinfo(format('%s 試圖釋放資源---資源被用戶鎖定，釋放失敗，等待%d毫秒再試', [strname, retrytime]));
    end;
  end;
end;

procedure TDemoProcedure.donWantsourceOK;
begin
  with Main do
  begin
    AddinfoTolvinfo(ListIndex, '釋放資源');
    Addinfo(format('%s 成功釋放資源---釋放資源后馬上會自動終止本進程', [strname]));
  end;
end;

procedure TDemoProcedure.EndThisRun;
begin
  with Main do
  begin
    addinfoTolvinfo(listindex, '成功結束');
    addinfo(format('%s 成功結束', [strName]));
  end;
end;

procedure TDemoProcedure.Execute;
var
  i: integer;
begin
  i := 0;
  repeat
    synchronize(WantSource);
    if isWantSource then break
    else
      sleep(RetryTime);
    Inc(i);
  until (i >= Times);
  if i >= Times then
  begin //未申請到資源退出
    synchronize(self.ShowError);
    self.Terminate;
  end;
  //進行運行態
  synchronize(wantsourceOK);

  //運行
  sleep(waittime); //模擬

  //運行完畢申請釋放資源
  i := 0;
  repeat
    synchronize(donWantSource);
    if isDonotWantSource then break
    else
      sleep(RetryTime);
    Inc(i);
  until (i >= Times);
  if i >= Times then
  begin //未申請到資源退出
    synchronize(self.ShowErrorEx);
    self.Terminate;
  end;
  synchronize(donWantSourceOk);
  synchronize(EndThisRun);
//  self.Terminate;
end;

procedure TDemoProcedure.ShowError;
begin
  with Main do
  begin
    addinfoTolvinfo(ListIndex, '超時錯誤并停止');
    addinfo(format('%s 經過%d秒重試，仍然沒有成功，超時并終止線程', [strName, RetryTime]));
  end;
end;

procedure TDemoProcedure.ShowErrorEx;
begin
  with Main do
  begin
    addinfoTolvinfo(ListIndex, '超時錯誤并停止');
    addinfo(format('%s 經過%d秒重試，用戶仍然鎖定不準釋放資源，為了防止死鎖，強制釋放并終止線程', [strName, RetryTime]));
    edtuse.Text := '否';
    Edit1.Text := '無';
    edtSource.Text := intTostr(strToint(edtSource.Text) + 1);
  end;
end;

procedure TDemoProcedure.WantSource;
begin
  with Main do
  begin
    if edtuse.Text = '是' then
      self.isWantSource := false
    else
      self.isWantSource := True;
    if isWantSource then
    begin
    //申請資源
      edtuse.Text := '是';
      Edit1.Text := strname;
      edtSource.Text := intTostr(strToint(edtSource.Text) - 1);

      AddinfoTolvinfo(ListIndex, '申請資源成功');
      Addinfo(format('%s 試圖申請資源---資源尚未使用，申請成功', [strname]));
    end
    else
    begin
      AddinfoTolvinfo(ListIndex, '申請資源失敗');
      Addinfo(format('%s 試圖申請資源---資源已在使用中，申請失敗，等待%d毫秒再試', [strname, retrytime]));
    end;
  end;
end;


procedure TDemoProcedure.Wantsourceok;
begin
  with Main do
  begin
    AddinfoTolvinfo(ListIndex, '使用資源狀態');
    Addinfo(format('%s 成功申請資源---正在使用過程中，將運行%d毫秒', [strname, waittime]));
  end;
end;

end.