生产者与消费者.txt

这是一个操作系统的课程设计,生产者与消费者的多线程程序.

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;

  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.