Это обычный сервер. Вам нужно в датамодуль добавить компоненты ssl хэндлеров и с ними уже экспериментировать.
unit U_HTTPSrv;
interface
uses
SysUtils, Classes, IdServerIOHandler, IdServerIOHandlerSocket,
IdServerIOHandlerStack, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdCustomHTTPServer, IdHTTPServer, IdContext;
type
TDataModule1 = class(TDataModule)
IdHTTPServer: TIdHTTPServer;
IdServerIOHandlerStack: TIdServerIOHandlerStack;
procedure IdHTTPServerCommandGet(AContext: TIdContext;ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
protected
public
end;
var
DataModule1: TDataModule1;
implementation
uses
IdHttp
, U_Mach4_HTTP
, T_Mach4
;
{$R *.dfm}
function NormalFileName(aFileName: String): String;
begin
Result := copy(aFileName, 2 ,255);
end;
procedure TDataModule1.IdHTTPServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
FS : TFilestream;
aFilename: String;
_messages: String;
FA: T_FahrauftragRec;
FAO : T_FahrauftragObj;
i : Integer;
pn: String;
begin
(* ('Req.QueryParams(GET):'+ ARequestInfo.QueryParams);
('Req.Document:'+ ARequestInfo.Document);
('Req.Params(REQUEST):'+ ARequestInfo.Params.Text);
('Req.UnparsedParams(braucht nicht):'+ ARequestInfo.UnparsedParams);
('Req.FormParams(POST [ungetrennt]):'+ ARequestInfo.FormParams); *)
with TIdHttp.Create(nil) do
try
//if (ARequestInfo.Document = '/ppppp') then
begin
if ARequestInfo.Document = '/' then
ARequestInfo.Document := ARequestInfo.Document + 'form.html';
aFilename := NormalFileName(ARequestInfo.Document);
if FileExists(aFilename) then
begin
//AResponseInfo.ContentType := GenContType(aFilename); // определяет тип содержимого по расширению запрашиваемого файла *.htm == text/html *.txt == text/plain ну и так далее
AResponseInfo.ResponseNo := 200;// все успешно
AResponseInfo.ContentStream := TFileStream.Create(aFileName,fmShareDenyNone);
Exit;
end
else
begin
//localhost:8080/MB_FA?id=1&lageroperation=1&packung.packungsart=1&packung.artikelcode=A1234567&packung.breite=123,4
if (ARequestInfo.Document = '/MB_FA') then
with T_FahrauftragObj.Create( nil ) do
try
FAO := T_FahrauftragObj(ObjInstance);
for i := 0 to ARequestInfo.Params.Count -1 do
begin
pn := ARequestInfo.Params.Names[i];
FAO.setProperty(pn , ARequestInfo.Params.Values[pn]);
end;
AResponseInfo.CustomHeaders.Add('Content-type: text/xml;'); //Content-type: text/xml; charset=utf-8
AResponseInfo.ContentText := FAO.buildXML('MB_FA');
exit;
finally
Free;
end;
if (ARequestInfo.Document = '/MB_WBA') then
with T_WBAuftragObj.Create( nil ) do
try
FAO := T_FahrauftragObj(ObjInstance);
for i := 0 to ARequestInfo.Params.Count -1 do
begin
pn := ARequestInfo.Params.Names[i];
FAO.setProperty(pn , ARequestInfo.Params.Values[pn]);
end;
AResponseInfo.CustomHeaders.Add('Content-type: text/xml;'); //Content-type: text/xml; charset=utf-8
AResponseInfo.ContentText := FAO.buildXML('MB_WBA');
exit;
finally
Free;
end;
end;
_messages := _messages+(Format('Client %s:%d trying to get nonexistent file "%s" at %s',[
AContext.Binding.PeerIP,
AContext.Binding.PeerPort,
ARequestInfo.Document,
FormatDateTime('yyyy/mm/dd hh:mm:ss', Now)]))+#13#10;
aFilename := NormalFileName('/404.htm');//выдаем 404 ошибку
// AResponseInfo.ContentType := GenContType(aFilename);
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'NoInfo';
//AResponseInfo.ContentStream := TFileStream.Create(aFileName,fmShareDenyNone);
end;
finally
Free;
end;
end;
end.
object DataModule1: TDataModule1
OldCreateOrder = False
Height = 130
Width = 185
object IdHTTPServer: TIdHTTPServer
Active = True
Bindings = <>
DefaultPort = 8080
IOHandler = IdServerIOHandlerStack
AutoStartSession = True
SessionState = True
OnCommandGet = IdHTTPServerCommandGet
Left = 64
Top = 8
end
object IdServerIOHandlerStack: TIdServerIOHandlerStack
Left = 64
Top = 56
end
end
