magnum / proga / Unit1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls, ExtCtrls, Buttons, ToolWin;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Memo1: TMemo;
Messages1: TMenuItem;
Help1: TMenuItem;
Send1: TMenuItem;
Previous1: TMenuItem;
Next1: TMenuItem;
ClearAll1: TMenuItem;
Opt1: TMenuItem;
Exit1: TMenuItem;
Clear1: TMenuItem;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
Timer1: TTimer;
Label1: TLabel;
ViewHistory1: TMenuItem;
Preferences1: TMenuItem;
About1: TMenuItem;
History1: TMenuItem;
procedure Send1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Preferences1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure ShowMess;
procedure BitBtn3Click(Sender: TObject);
procedure History1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
h:THandle;
l:TList;
current:integer;
implementation

uses Unit2, Unit3, Unit5, Unit6;

{$R *.DFM}

procedure TForm1.ShowMess;
var
p:PChar;
s:string;
begin
Memo1.Clear;
p:=L.Items[Current];
s:='Message from ';
repeat
s:=s+p^;
p:=p+1;
until (p^=#0);
p:=p+1;
s:=s+' to';
repeat
s:=s+p^;
p:=p+1;
until (p^=#0);
Label1.Caption:=s;
p:=p+1;
s:='';
repeat
s:=s+p^;
p:=p+1;
until (p^=#0);
Memo1.Lines.Add (s);
StatusBar1.Panels[0].Text:='Current message: '+IntToStr (current+1);
StatusBar1.Panels[1].Text:='Total number of messages: '+IntToStr (L.Count);
end;

procedure TForm1.Send1Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Form2.Memo1.Clear;
Form2.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
lpName:PChar='\\.\mailslot\messngr';
var
error:dword;
begin
h:=CreateMailslot(lpName, 0, MAILSLOT_WAIT_FOREVER, NIL);
if h=INVALID_HANDLE_VALUE then
begin
error:=GetLastError;
ShowMessage ('Error when creating mailslot. Error : '+IntToStr (error));
//Halt (0);
end;
L:=TList.Create;
current:=-1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
// lpMaxMessageSize:pointer;
lpNextSize:DWORD;
lpMessageCount:pointer;
//lpReadTimeout:pointer;
buffer:PChar;
lpNumberOfBytesRead:DWORD;
MessageCount, all:DWORD;
s:string;
begin
lpMessageCount:=addr (MessageCount);
if GetMailslotInfo (h, nil,lpNextSize,lpMessageCount, nil) then
begin
if lpNextSize<>MAILSLOT_NO_MESSAGE then
begin
Beep;
all:=MessageCount;
while all<>0 do
begin
GetMem (buffer, lpNextSize);
if ReadFile (h, buffer^, lpNextSize, lpNumberOfBytesRead, nil) then
begin
s:='';
L.Add (buffer);
StatusBar1.Panels[1].Text:='Total number of messages: '+IntToStr (L.Count);
if L.Count=1 then begin current:=0; ShowMess; end;
GetMailslotInfo (h, nil,lpNextSize,lpMessageCount, nil);
end
else FreeMem (buffer);
all:=all-1;
end;
end;
end;
end;

procedure TForm1.Preferences1Click(Sender: TObject);
begin
Form3.ShowModal;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
Form5.ShowModal;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if L.Count<>0 then
begin
Memo1.Clear;
FreeMem(L.Items[current]);
L.Delete(current);
if L.Count>1 then
begin
if (current<L.Count-1) then BitBtn4Click (Sender)
else BitBtn3Click (Sender);
end
else
begin
StatusBar1.Panels[0].Text:='Current message: 0';
StatusBar1.Panels[1].Text:='Total number of messages: 0';
end;
end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
if current<L.Count-1 then
begin
current:=current+1;
ShowMess;
end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
if current>0 then
begin
current:=current-1;
ShowMess;
end;
end;

procedure TForm1.History1Click(Sender: TObject);
begin
Form6.ShowModal;
end;

end.