操作系统多进程设计 第2页
操作系统多进程设计 第2页
三、原代码
采用Delphi 6.0集成工具开发，语言object pascal，开发环境P4 1.8G+384 DDR +Windows 2000运行并测试成功；
unit uMain;
interface
需要完整内容的请联系QQ3249114，本文免费，转发请注明源于www.751com.cn
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;
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;
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;