IdHTTPServer如何使用，100分相送！

zhaowd 2003-12-01 03:40:31
怎样使用IdHTTPServer，或者谁有使用IdHTTPServer的源代码，可否提供？
...全文
622 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
zhaowd 2003-12-02
  • 打赏
  • 举报
 回复
应答流的问题已经解决，现在遇到了一个问题就是:在IdHTTPServer控件onCommandGet事件中加入了验证代码以后，当我在客户端向服务器端请求下载一个文件,服务器端也接收到请求并且执行完那段验证代码以后，客户端却无法接收到我要下载的文件，而我去掉onCommandGet事件中的代码，就能正常下载，但这样就无法做验证工作了，请问这是为什么，该怎么办？
是不是onCommandGet事件重写以后，原来的请求他就不响应了？
constantine 2003-12-02
  • 打赏
  • 举报
 回复
太多了，可是delphi的我看不懂刚学。
zhaowd 2003-12-02
  • 打赏
  • 举报
 回复
CBC应该有这个控件的呀，我用的是cbc6.
那能不能麻烦你说具体点呢？
warton 2003-12-02
  • 打赏
  • 举报
 回复
上面是indy的delphi例程的一段，你看看吧！
warton 2003-12-02
  • 打赏
  • 举报
 回复
procedure TfmHTTPServerMain.HTTPServerCommandGet(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);

procedure AuthFailed;
begin
ResponseInfo.ContentText := '<html><head><title>Error</title></head><body><h1>Authentication failed</h1>'#13 +
'Check the demo source code to discover the password:<br><ul><li>Search for <b>AuthUsername</b> in <b>Main.pas</b>!</ul></body></html>';
ResponseInfo.AuthRealm := sauthenticationrealm;
end;

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;

var
LocalDoc: string;
ByteSent: Cardinal;
ResultFile: TFileStream;
begin
// Log the request
DisplayMessage(Format( 'Command %s %s received from %s:%d',
[RequestInfo.Command, RequestInfo.Document,
TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));
if cbAuthentication.Checked and
((RequestInfo.AuthUsername <> 'Indy') or (RequestInfo.AuthPassword <> 'rocks')) then
begin
AuthFailed;
exit;
end;
if cbManageSessions.checked then
ManageUserSession(AThread, RequestInfo, ResponseInfo);
if (Pos('/session', LowerCase(RequestInfo.Document)) = 1) then
begin
ServeVirtualFolder(AThread, RequestInfo, ResponseInfo);
end
else
begin
// Interprete the command to it's final path (avoid sending files in parent folders)
LocalDoc := ExpandFilename(edRoot.text + RequestInfo.Document);
// Default document (index.html) for folder
if not FileExists(LocalDoc) and DirectoryExists(LocalDoc) and FileExists(ExpandFileName(LocalDoc + '/index.html')) then
begin
LocalDoc := ExpandFileName(LocalDoc + '/index.html');
end;
if FileExists(LocalDoc) then // File exists
begin
if AnsiSameText(Copy(LocalDoc, 1, Length(edRoot.text)), edRoot.Text) then // File down in dir structure
begin
if AnsiSameText(RequestInfo.Command, 'HEAD') then
begin
// HEAD request, don't send the document but still send back it's size
ResultFile := TFileStream.create(LocalDoc, fmOpenRead or fmShareDenyWrite);
try
ResponseInfo.ResponseNo := 200;
ResponseInfo.ContentType := GetMIMEType(LocalDoc);
ResponseInfo.ContentLength := ResultFile.Size;
finally
ResultFile.Free; // We must free this file since it won't be done by the web server component
end;
end
else
begin
// Normal document request
// Send the document back
ByteSent := HTTPServer.ServeFile(AThread, ResponseInfo, LocalDoc);
DisplayMessage(Format('Serving file %s (%d bytes / %d bytes sent) to %s:%d',
[LocalDoc, ByteSent, FileSizeByName(LocalDoc),
TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerIP,
TIdIOHandlerSocket(AThread.Connection.IOHandler).Binding.PeerPort]));
end;
end
else
AccessDenied;
end
else
begin
ResponseInfo.ResponseNo := 404; // Not found
ResponseInfo.ContentText := '<html><head><title>Error</title></head><body><h1>' + ResponseInfo.ResponseText + '</h1></body></html>';
end;
end;
end;

procedure TfmHTTPServerMain.FormCreate(Sender: TObject);
begin
UILock := TCriticalSection.Create;
MIMEMap := TIdMIMETable.Create(true);
edRoot.text := ExtractFilePath(Application.exename) + 'Web';
if HTTPServer.active then caption := 'active' else caption := 'inactive';
end;

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

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

procedure TfmHTTPServerMain.HTTPServerSessionEnd(Sender: TIdHTTPSession);
var
dt: TDateTime;
i: Integer;
hour, min, s, ms: word;
begin
DisplayMessage(Format('Ending session %s at %s',[Sender.SessionID, FormatDateTime(LongTimeFormat, now)]));
dt := (StrToDateTime(sender.Content.Values['StartTime'])-now);
DecodeTime(dt, hour, min, s, ms);
i := ((Trunc(dt)*24 + hour)*60 + min)*60 + s;
DisplayMessage(Format('Session duration was: %d seconds', [i]));
DisplaySessionChange(Sender.SessionID);
end;

procedure TfmHTTPServerMain.HTTPServerSessionStart(Sender: TIdHTTPSession);
begin
sender.Content.Values['StartTime'] := DateTimeToStr(Now);
DisplayMessage(Format('Starting session %s at %s',[Sender.SessionID, FormatDateTime(LongTimeFormat, now)]));
DisplaySessionChange(Sender.SessionID);
end;

procedure TfmHTTPServerMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
// desactivate the server
if cbActive.Checked then
acActivate.execute;
end;

procedure TfmHTTPServerMain.lbSessionListDblClick(Sender: TObject);
begin
if lbSessionList.ItemIndex > -1 then
begin
HTTPServer.EndSession(lbSessionList.Items[lbSessionList.ItemIndex]);
end;
end;

// SSL stuff
procedure TfmHTTPServerMain.MyInfoCallback(Msg: String);
begin
DisplayMessage(Msg);
end;

procedure TfmHTTPServerMain.GetKeyPassword(var Password: String);
begin
Password := 'aaaa'; // this is a password for unlocking the server
// key. If you have your own key, then it would
// probably be different
end;

procedure TfmHTTPServerMain.cbSSLClick(Sender: TObject);
begin
edPort.Text := '80';
end;


procedure TfmHTTPServerMain.HTTPServerConnect(AThread: TIdPeerThread);
begin
DisplayMessage('User logged in');
end;

procedure TfmHTTPServerMain.HTTPServerDisconnect(AThread: TIdPeerThread);
begin
DisplayMessage('User logged out');
end;

procedure TfmHTTPServerMain.HTTPServerExecute(AThread: TIdPeerThread);
begin
DisplayMessage('Execute');
end;

procedure TfmHTTPServerMain.HTTPServerCommandOther(Thread: TIdPeerThread;
const asCommand, asData, asVersion: String);
begin
DisplayMessage('Command other: ' + asCommand);
end;

procedure TfmHTTPServerMain.HTTPServerStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: String);
begin
DisplayMessage('Status: ' + aStatusText);
end;
warton 2003-12-02
  • 打赏
  • 举报
 回复
procedure TfmHTTPServerMain.acActivateExecute(Sender: TObject);
var
AppDir: String;
Binding : TIdSocketHandle;
begin
acActivate.Checked := not acActivate.Checked;
lbSessionList.Items.Clear;
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;

if not DirectoryExists(edRoot.text) then
begin
DisplayMessage(Format('Web root folder (%s) not found.',[edRoot.text]));
acActivate.Checked := False;
end
else
begin
if acActivate.Checked then
begin
try
EnableLog := cbEnableLog.Checked;
HTTPServer.SessionState := cbManageSessions.Checked;
HTTPServer.Active := true;
DisplayMessage(format('Listening for HTTP connections on %s:%d.',[HTTPServer.Bindings[0].IP, HTTPServer.Bindings[0].Port]));
except
on e: exception do
begin
acActivate.Checked := False;
DisplayMessage(format('Exception %s in Activate. Error is:"%s".', [e.ClassName, e.Message]));
end;
end;
end
else
begin
HTTPServer.Active := false;
// SSL stuff
HTTPServer.Intercept := nil;
// End SSL stuff
DisplayMessage('Stop listening.');
end;
end;
edPort.Enabled := not acActivate.Checked;
edRoot.Enabled := not acActivate.Checked;
cbAuthentication.Enabled := not acActivate.Checked;
cbEnableLog.Enabled := not acActivate.Checked;
cbManageSessions.Enabled := not acActivate.Checked;
end;

procedure TfmHTTPServerMain.edPortChange(Sender: TObject);
var
FinalLength, i: Integer;
FinalText: String;
begin
// Filter routine. Remove every char that is not a numeric (must do that for cut'n paste)
Setlength(FinalText, length(edPort.Text));
FinalLength := 0;
for i := 1 to length(edPort.Text) do
begin
if edPort.text[i] in [ '0'..'9' ] then
begin
inc(FinalLength);
FinalText[FinalLength] := edPort.text[i];
end;
end;
SetLength(FinalText, FinalLength);
edPort.text := FinalText;
end;

procedure TfmHTTPServerMain.edPortKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in [ '0'..'9', #8 ]) then
Key := #0;
end;

procedure TfmHTTPServerMain.edPortExit(Sender: TObject);
begin
if length(trim(edPort.text)) = 0 then
edPort.text := '80';
end;


procedure TfmHTTPServerMain.ManageUserSession(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
var
NumberOfView: Integer;
begin
// Manage session informations
if assigned(RequestInfo.Session) or (HTTPServer.CreateSession(AThread, ResponseInfo, RequestInfo) <> nil) then
begin
RequestInfo.Session.Lock;
try
NumberOfView := StrToIntDef(RequestInfo.Session.Content.Values['NumViews'], 0);
inc(NumberOfView);
RequestInfo.Session.Content.Values['NumViews'] := IntToStr(NumberOfView);
RequestInfo.Session.Content.Values['UserName'] := RequestInfo.AuthUsername;
RequestInfo.Session.Content.Values['Password'] := RequestInfo.AuthPassword;
finally
RequestInfo.Session.Unlock;
end;
end;
end;

procedure TfmHTTPServerMain.ServeVirtualFolder(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
begin
ResponseInfo.ContentType := 'text/HTML';
ResponseInfo.ContentText := '<html><head><title>Virtual folder</title></head><body>';

if AnsiSameText(RequestInfo.Params.Values['action'], 'close') then
begin
// Closing user session
RequestInfo.Session.Free;
ResponseInfo.ContentText := ResponseInfo.ContentText + '<h1>Session cleared</h1><p><a href="/sessions">Back</a></p>';
end
else
begin
if assigned(RequestInfo.Session) then
begin
if Length(RequestInfo.Params.Values['ParamName'])>0 then
begin
// Add a new parameter to the session
ResponseInfo.Session.Content.Values[RequestInfo.Params.Values['ParamName']] := RequestInfo.Params.Values['Param'];
end;
ResponseInfo.ContentText := ResponseInfo.ContentText + '<h1>Session informations</h1>';
RequestInfo.Session.Lock;
try
ResponseInfo.ContentText := ResponseInfo.ContentText + '<table border=1>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>SessionID</td><td>' + RequestInfo.Session.SessionID + '</td></tr>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>Number of page requested during this session</td><td>'+RequestInfo.Session.Content.Values['NumViews']+'</td></tr>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<tr><td>Session data (raw)</td><td><pre>' + RequestInfo.Session.Content.Text + '</pre></td></tr>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '</table>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<h1>Tools:</h1>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<h2>Add new parameter</h2>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<form method="POST">';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<p>Name: <input type="text" Name="ParamName"></p>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<p>value: <input type="text" Name="Param"></p>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<p><input type="Submit"><input type="reset"></p>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '</form>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<h2>Other:</h2>';
ResponseInfo.ContentText := ResponseInfo.ContentText + '<p><a href="' + RequestInfo.Document + '?action=close">Close current session</a></p>';
finally
RequestInfo.Session.Unlock;
end;
end
else
begin
ResponseInfo.ContentText := ResponseInfo.ContentText + '<p color=#FF000>No session</p>';
end;
end;
ResponseInfo.ContentText := ResponseInfo.ContentText + '</body></html>';
end;


procedure TfmHTTPServerMain.DisplaySessionChange(const Session: string);
var
Index: integer;
begin
if EnableLog then
begin
UILock.Acquire;
try
Index := lbSessionList.Items.IndexOf(Session);
if Index > -1 then
lbSessionList.Items.Delete(Index)
else
lbSessionList.Items.Append(Session);
finally
UILock.Release;
end;
end;
end;

procedure TfmHTTPServerMain.DisplayMessage(const Msg: String);
begin
if EnableLog then
begin
UILock.Acquire;
try
lbLog.ItemIndex := lbLog.Items.Add(Msg);
finally
UILock.Release;
end;
end;
end;

const
sauthenticationrealm = 'Indy http server demo';
warton 2003-12-02
  • 打赏
  • 举报
 回复
你到indy的官方网站下载indy的示例（我只发现了delphi的代码）。
里面有idhttpserver做的web服务器！
zhaowd 2003-12-02
  • 打赏
  • 举报
 回复
谁可以帮帮我
叶子哟 2003-12-01
  • 打赏
  • 举报
 回复
我没有这个控件,但我想应该是让它返回http协议的应答流吧
zhaowd 2003-12-01
  • 打赏
  • 举报
 回复
我想做一个在服务器端验证程序，就是说客户端在向服务器发出http请求以后，服务器端的server程序首先验证发出请求的用户名密码是否有效，如果有效则允许连接，无效则断开连接。现在遇到的问题是服务器端收到请求并且验证以后，该如何向客户端发出回应，告诉客户端连接是否有效？
服务器端我用的是IdHTTPServer控件，请问该怎样实现我的需求。
IdHTTPServer+utf8转换+json解析
本demo用IdHTTPServer接收上报数据,然后进行utf8编码转换,在用delphixe10.2自带的json作解析,代码简洁实用.
IdHTTPServer复杂JSON递归解析.rar
IdHTTPServer复杂JSON递归解析,用递归方法遍历解析任意复杂JSONG,代码简洁规范,堪称经典.
Delphi XE + IdHTTPServer + utf8转换 + json解析（源码+测试可用）
Delphi XE + IdHTTPServer + utf8转换 + json解析（源码+测试可用）
Delphi中idHttp和HttpServer当客户端与服务器作数据传输的实例
idHttpServer不作Web容器使用，而是当服务器监听来自idHttp的数据，运行两个实例中的程序，就可以相互发送文字信息或文件了，希望对新手有帮助！
Delphi10中idHttpServer接收中文参数乱码的处理
idHttpServer在开发中比较方便，一般情况都能应付。但在接收浏览器发送的带中文URL时，取参数就会是乱码。经过查找资源，发现大部分浏览器，中文一般会先转码为utf-8，此时，idHttpServer控件会根据请求头中ContentType的Chatset进行相应的转码，以形成正确的参数。但奇怪的是，控件没有取到这个值，因此，就用默认的Charset进行转码，结果就不是我们所希望的。控件又不能显示的设置这个charset，只能折衷地修改一下源码，以适应针对utf-8编码的转码。
网络及通讯开发

1,316

社区成员

8,873

社区内容

发帖
与我相关
我的任务
社区描述
C++ Builder 网络及通讯开发
社区管理员
  • 网络及通讯开发社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章