Version:0.9 StartHTML:0000000105 EndHTML:0000013765 StartFragment:0000001037 EndFragment:0000013749 mXScriptasHTML 
program Motion_HTTPServer_ALLDocuments2;

// first httpserver docuserver script of webmax internet series
// shows solution to send all docutypes in a MIME table, locs=84

Const  IPADDR = '127.0.0.1';
       APORT = 8000;

var  HTTPServer: TIdCustomHTTPServer;
     //assl: TIdServerInterceptOpenSSL;
     //aMIMEMap: TIdMIMETable;


function GetMIMEType(sFile: TFileName): string;
var aMIMEMap: TIdMIMETable;
begin
  aMIMEMap:= TIdMIMETable.Create(true);
  try
    result:= aMIMEMap.GetFileMIMEType(sFile);
  finally
    aMIMEMap.Free;
  end;
end;

   
procedure HTTPServerGet(aThr: TIdPeerThread; reqInf: TIdHTTPRequestInfo;
                                                 respInf: TIdHTTPResponseInfo);
var localDoc: string;
    ByteSent: Cardinal;
begin
  //RespInfo.ContentType:= 'text/HTML';
  Writeln(Format('Command %s %s at %-10s received from %s:%d',[ReqInf.Command, ReqInf.Document, 
                       DateTimeToStr(Now),aThr.Connection.socket.binding.PeerIP,
                       aThr.Connection.socket.binding.PeerPort]));
  localDoc:= ExpandFilename(Exepath+'/web'+ReqInf.Document);
  RespInf.ContentType:= GetMIMEType(LocalDoc);
  if FileExists(localDoc) then begin
    ByteSent:= HTTPServer.ServeFile(AThr, RespInf, LocalDoc);
    Writeln(Format('Serving file %s (%d bytes/ %d bytes sent) to %s:%d at %s',
          [LocalDoc,ByteSent,FileSizeByName(LocalDoc), aThr.Connection.Socket.Binding.PeerIP,
           aThr.Connection.Socket.Binding.PeerPort, dateTimeToStr(now)]));
  end else begin
    RespInf.ResponseNo:= 404; //Not found RFC
    RespInf.ContentText:=
          '<html><head><title>Sorry WebBox Error</title></head><body><h1>' +
    RespInf.ResponseText + '</h1></body></html>';
  end; 
end;


procedure letOpenBrowser;
// TS_ShellExecuteCmd = (seCmdOpen,seCmdPrint,seCmdExplore);
begin
  //ShellAPI.ShellExecute(Handle,PChar('open'),'http://127.0.0.1:8000/',Nil,Nil,0);
   S_ShellExecute('http:'+IPADDR+':'+IntToStr(APORT)+'/index.htm','',seCmdOpen)
end;

procedure HTTPServerStartExecute(Sender: TObject);
begin
  HTTPServer:= TIdCustomHTTPServer.Create(self)
  with HTTPServer do begin
    if Active then Free;
    if not Active then begin
      Bindings.Clear;
      bindings.Add;
      bindings.items[0].Port:= APORT;
      bindings.items[0].IP:= IPADDR; //'127.0.0.1'; 
      Active:= true;
      onCommandGet:= @HTTPServerGet;
      PrintF('Listening HTTP on %s:%d.', [Bindings[0].IP,Bindings[0].Port]);
    end;
    letOpenBrowser;
    Showmessage('Click OK to close and shut down HTTPServer!');
    HTTPServer.Free;
  end;
end;


begin //main http server App 
  Writeln(GetIpAddress(getHostName))
  HTTPServerStartExecute(self);
  Writeln('All Docu Server Closed at '+DateTimeToInternetStr(Now,true))
  //GetTimeZoneInformation
End.

//***********************************Code Snippets******************

    RespInfo.ContentText:=
      '<html><head><title>maXbox Web</title></head><body><h1>Welcome to FileServer3</h1>'#13 +
      'Check the script 303_webserver_alldocs2 to discover more:<br><ul><li>Search for '#13 +
      '<b>ResponseInfo</b> in <b>the /web to download files</b>!</ul></body></html>';

 (*procedure AccessDenied;
  begin
    ResponseInfo.ContentText:=
      '<html><head><title>Error</title></head><body><h1>Access denied</h1>'#13 +
      'You do not have sufficient priviligies to access this document.</body></html>';
    ResponseInfo.ResponseNo:= 403;
  end;*)
  
   (*procedure AuthFailed;
     begin
      ResponseInfo.ContentText:=
      '<html><head><title>Error</title></head><body><h1>Authentication failed</h1>'#13 +
      'Check the file ip_a.ini to discover the demo password:<br><ul><li>Search for '#13 +
      '<b>AuthUsername</b> in <b>maXboxMain.pas</b>!</ul></body></html>';
    ResponseInfo.AuthRealm:= CAUTHENTICATIONREALM; *)

    (*if not HTTPServer.Active then begin
    HTTPServer.Bindings.Clear;
    Binding := HTTPServer.Bindings.Add;
    Binding.Port := StrToIntDef(edPort.text, 80);
    Binding.IP := '127.0.0.1';
  end;*)
  
     //statusbar1.SimpleText:= 'http active on v1.9';
     //+ [IdServerInterceptOpenSSL.SSLOptions.Method]
      //DisplayMessage(Format('OpenSSLVersion is: %s', [getOpenSSLVersion]))
      
       To disable the URL Error Redirection, go to the option page of your toolbar.  
     
Das wollen wir Ihnen präsentieren:

* In RAD Studio XE3 liefern wir mit Metropolis das einzige Werkzeug, mit dem Sie ganz einfach klassische Windows UIs an das neue Windows 8 Design anpassen können. Matthias Eißing zeigt Ihnen, wie Sie Applikationen auf WinXP, Vista, Windows 7 und 8 sowohl als Desktop-Anwendungen als auch für Tablet-PCs wie Slates oder Surface Pro.   

* Starten Sie Ihre Windows-Applikationen auf Macs mit Standard- oder auch Retina-Displays oder mit klassischen Windows UIs oder mit "Metro" - alles mit der gleichen Code-Basis. In Delphi XE3 und C++Builder XE3 wird dies alles automatisch unterstützt    

* Delphi XE3 und C++Builder XE3 enthalten die neueste Version von FireMonkey – FireMonkey FM2. Mit FM2 können Sie Sie visuell anspruchsvolle Enterprise- und ISV- Anwendungen für Windows 8, Mac OS X Mountain Lion mit nur einer Code-Basis erstellen     

* Visual LiveBindings sind der einfachste Weg zur Verknüpfung der Steuerelemente Ihrer Benutzeroberfläche mit Datensätzen. Zugriffsmöglichkeiten, komfortabler denn je zuvor - mit RAD Studio XE3 Visual LiveBindings brauchen Sie keine Ausdrücke mehr zu schreiben oder im Code zu arbeiten. Augenblicklich erhalten Sie eine große Übersicht und Ihre Verbindungen können Sie mit Drag-and-Drop-Leichtigkeit regeln    

* Mit der Ultimate Version von RAD Studio XE3, bzw. Delphi oder C++Builder XE3 erhalten Sie anspruchsvollen Datenbankwerkzeuge. Matthias Eißing zeigt Ihnen, was Sie damit machen können und wie.

Wir freuen uns auf Sie!    
    

----code_cleared_checked----
----code_cleared_checked----