unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, Menus, ExtCtrls, StdCtrls, FileCtrl, IdBaseComponent,
IdComponent, IdTCPServer, IdCustomHTTPServer, IdHTTPServer,
IdAntiFreezeBase, IdAntiFreeze, IdGlobal, StrUtils, IdThreadMgr,
IdThreadMgrDefault;

const
WM_ICONTRAY = WM_USER + 1; // User-defined message

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
mnuExit: TMenuItem;
GroupBox1: TGroupBox;
Label2: TLabel;
Button2: TButton;
Label1: TLabel;
IdHTTPServer1: TIdHTTPServer;
IdAntiFreeze1: TIdAntiFreeze;
Memo1: TMemo;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mnuExitClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdHTTPServer1CommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure Button1Click(Sender: TObject);
procedure Logfile(Text: String);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
function GetMIMEType(sFile: TFileName): String;
procedure Icontray(var Msg: TMessage); message WM_ICONTRAY;
public
MIMEMap: TIdMIMETable;
{ Public declarations }
end;

var
Form1: TForm1;
NotifyIconData : TNotifyIconData;
FDirectory: string;
LogfileMaxLines: Word;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
with NotifyIconData do begin
hIcon := Application.Icon.Handle; // use application icon
StrPCopy(szTip, 'SimpleHTTP is running');
Wnd := Handle;
uCallbackMessage := WM_ICONTRAY;
uID := 1;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
cbSize := sizeof(TNotifyIconData);
end;
Shell_NotifyIcon(NIM_ADD, @NotifyIconData);

MIMEMap := TIdMIMETable.Create(true);
{get current dir and set Label}
GetDir(0, FDirectory);
Label2.Caption := FDirectory;
LogfileMaxLines := 500;
end;

procedure TForm1.Icontray(var Msg: TMessage);
var
CursorPos : TPoint;
begin
if Msg.lParam = WM_RBUTTONDOWN then begin
GetCursorPos(CursorPos);
SetForegroundWindow(Handle); // suggested by Berend Radstaat
PopupMenu1.Popup(CursorPos.x, CursorPos.y);
PostMessage(Handle, WM_NULL, 0, 0); // suggested by Berend Radstaat
end else
if Msg.LParam = WM_LBUTTONDBLCLK then begin
Show;
// Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
end else
inherited;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
// Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;

procedure TForm1.mnuExitClick(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
Application.ProcessMessages;
Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
const
SELDIRHELP = 1000;
var
dir: String;
begin
if SelectDirectory(
dir,
[sdAllowCreate,
sdPerformCreate,
sdPrompt],
SELDIRHELP
) then
{show dir in Label}
Label2.Caption := dir;
end;

procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
FileExt, CType: string;
begin
LFilename := ARequestInfo.Document;
if LFilename = '/' then begin
LFilename := '/index.html';
end;
LPathname := Label2.Caption + LFilename;
if FileExists(LPathname) then begin
AResponseInfo.ContentType := GetMIMEType(LPathname);
AResponseInfo.ContentLength := FileSizeByName(LPathname);
AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);
end else begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'The requested URL ' + ARequestInfo.Document
+ ' was not found on this server.';
end;
Logfile( TimeToStr(Time) + ' ' + ARequestInfo.RawHTTPCommand );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Status : string;
begin
If IdHTTPServer1.Active then begin
IdHTTPServer1.Active := False;
Button1.Caption := 'Start';
Status := 'SimpleHTTP is stopped';
end else begin
IdHTTPServer1.Active := True;
Button1.Caption := 'Stop';
Status := 'SimpleHTTP is running';
end;
StrPCopy(NotifyIconData.szTip, Status);
Shell_NotifyIcon(NIM_MODIFY, @NotifyIconData);
end;

procedure TForm1.Logfile(Text: String);
begin
If Memo1.Lines.Count > LogFileMaxLines then Memo1.Clear;
Memo1.Lines.Append( Text );
end;

function TForm1.GetMIMEType(sFile: TFileName): String;
begin
result := MIMEMap.GetFileMIMEType(sFile);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
MIMEMap.Free;
end;