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.