{"id":93,"date":"2013-12-13T08:10:19","date_gmt":"2013-12-13T08:10:19","guid":{"rendered":"http:\/\/tastaturkind.ch\/?p=93"},"modified":"2013-12-13T08:10:19","modified_gmt":"2013-12-13T08:10:19","slug":"delphi-webserver-with-indy","status":"publish","type":"post","link":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/2013\/12\/13\/delphi-webserver-with-indy\/","title":{"rendered":"Delphi Webserver with Indy"},"content":{"rendered":"

{
\n implements a very basic webserver with Systray icon and menu using Indy components
\n (C) 2010 Oliver Frick
\n}<\/p>\n

unit Unit1;<\/p>\n

interface<\/p>\n

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

const
\n WM_ICONTRAY = WM_USER + 1; \/\/ User-defined message<\/p>\n

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

var
\n Form1: TForm1;
\n NotifyIconData : TNotifyIconData;
\n FDirectory: string;
\n LogfileMaxLines: Word;
\nimplementation<\/p>\n

{$R *.dfm}<\/p>\n

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

MIMEMap := TIdMIMETable.Create(true);
\n {get current dir and set Label}
\n GetDir(0, FDirectory);
\n Label2.Caption := FDirectory;
\n LogfileMaxLines := 500;
\nend;<\/p>\n

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
\nbegin
\n Action := caNone;
\n Hide;
\n \/\/ Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
\nend;<\/p>\n

procedure TForm1.mnuExitClick(Sender: TObject);
\nbegin
\n Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
\n Application.ProcessMessages;
\n Application.Terminate;
\nend;<\/p>\n

procedure TForm1.Button2Click(Sender: TObject);
\nconst
\n SELDIRHELP = 1000;
\nvar
\n dir: String;
\nbegin
\n if SelectDirectory(
\n dir,
\n [sdAllowCreate,
\n sdPerformCreate,
\n sdPrompt],
\n SELDIRHELP
\n ) then
\n {show dir in Label}
\n Label2.Caption := dir;
\nend;<\/p>\n

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

procedure TForm1.Button1Click(Sender: TObject);
\nvar
\n Status : string;
\nbegin
\n If IdHTTPServer1.Active then begin
\n IdHTTPServer1.Active := False;
\n Button1.Caption := 'Start';
\n Status := 'SimpleHTTP is stopped';
\n end else begin
\n IdHTTPServer1.Active := True;
\n Button1.Caption := 'Stop';
\n Status := 'SimpleHTTP is running';
\n end;
\n StrPCopy(NotifyIconData.szTip, Status);
\n Shell_NotifyIcon(NIM_MODIFY, @NotifyIconData);
\nend;<\/p>\n

procedure TForm1.Logfile(Text: String);
\nbegin
\n If Memo1.Lines.Count > LogFileMaxLines then Memo1.Clear;
\n Memo1.Lines.Append( Text );
\nend;<\/p>\n

function TForm1.GetMIMEType(sFile: TFileName): String;
\nbegin
\n result := MIMEMap.GetFileMIMEType(sFile);
\nend;<\/p>\n

procedure TForm1.FormDestroy(Sender: TObject);
\nbegin
\n MIMEMap.Free;
\nend;<\/p>\n

end.
\n<\/code><\/p>\n","protected":false},"excerpt":{"rendered":"

{ implements a very basic webserver with Systray icon and menu using Indy components (C) 2010 Oliver Frick } unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI, Menus, ExtCtrls, StdCtrls, FileCtrl, IdBaseComponent, IdComponent, IdTCPServer, … Weiterlesen →<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"closed","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[],"tags":[],"class_list":["post-93","post","type-post","status-publish","format-standard","hentry"],"_links":{"self":[{"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/posts\/93","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/comments?post=93"}],"version-history":[{"count":0,"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/posts\/93\/revisions"}],"wp:attachment":[{"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/media?parent=93"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/categories?post=93"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/oliver-frick.ch\/wordpress\/index.php\/wp-json\/wp\/v2\/tags?post=93"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}