1 | program UMainForm;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | uses
|
---|
6 | {$IFDEF UNIX}{$IFDEF UseCThreads}
|
---|
7 | cthreads,
|
---|
8 | {$ENDIF}{$ENDIF}
|
---|
9 | SysUtils, Classes, UHtmlClasses, UXmlClasses, IdContext, IdSocketHandle,
|
---|
10 | IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer, IdHTTPServer,
|
---|
11 | USqlDatabase, DateUtils;
|
---|
12 |
|
---|
13 | type
|
---|
14 | TUser = class
|
---|
15 | public
|
---|
16 | Database: TSqlDatabase;
|
---|
17 | SessionId: string;
|
---|
18 | Name: string;
|
---|
19 | Password: string;
|
---|
20 | Email: string;
|
---|
21 | FullName: string;
|
---|
22 | LastLogin: TDateTime;
|
---|
23 | function Login(UserName, Password: string): Boolean;
|
---|
24 | end;
|
---|
25 |
|
---|
26 | TUserOnline = class
|
---|
27 | public
|
---|
28 | User: TUser;
|
---|
29 | IpAddress: string;
|
---|
30 | Time: TDateTime;
|
---|
31 | SessionId: string;
|
---|
32 | end;
|
---|
33 |
|
---|
34 | TMainForm = class
|
---|
35 | IdHTTPServer1: TIdHTTPServer;
|
---|
36 | constructor Create;
|
---|
37 | procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
---|
38 | procedure IdHTTPServer1SessionStart(Sender: TIdHTTPSession);
|
---|
39 | procedure IdHTTPServer1SessionEnd(Sender: TIdHTTPSession);
|
---|
40 | destructor Destroy; override;
|
---|
41 | private
|
---|
42 | { Private declarations }
|
---|
43 | public
|
---|
44 | Database: TSqlDatabase;
|
---|
45 | UserSessions: TList; // of TUser;
|
---|
46 | HtmlPage: THtmlPage;
|
---|
47 | Page: THtmlPage;
|
---|
48 | end;
|
---|
49 |
|
---|
50 | var
|
---|
51 | MainForm: TMainForm;
|
---|
52 |
|
---|
53 | constructor TMainForm.Create;
|
---|
54 | var
|
---|
55 | SocketHandle : TIdSocketHandle;
|
---|
56 | begin
|
---|
57 | Database := TSqlDatabase.Create;
|
---|
58 | with Database do begin
|
---|
59 | Hostname := 'localhost';
|
---|
60 | UserName := 'root';
|
---|
61 | Password := '';
|
---|
62 | Database := 'wow';
|
---|
63 | Connect;
|
---|
64 | end;
|
---|
65 | UserSessions := TList.Create;
|
---|
66 |
|
---|
67 | (*
|
---|
68 | HtmlPage := THtmlPage.Create;
|
---|
69 | with HtmlPage do begin
|
---|
70 | Title := 'Centrála - Rozcestník';
|
---|
71 | Charset := 'windows-1250';
|
---|
72 | with Body, THtmlLink(SubItems[SubItems.Add(THtmlLink.Create)]) do begin
|
---|
73 | Target.AsString := 'http://user:pass@www.zdechov.net:80/folder/index.html?param1=value1¶m2=value2#Fragment';
|
---|
74 | Content := THtmlString.Create;
|
---|
75 | THtmlString(Content).Text := 'Odkaz';
|
---|
76 | end;
|
---|
77 | with Body, THtmlImage(SubItems[SubItems.Add(THtmlImage.Create)]) do begin
|
---|
78 | AlternateText := 'Peníze';
|
---|
79 | Source.AsString := 'images/favicons/money.gif';
|
---|
80 | Size.Width := 16;
|
---|
81 | Size.Height := 16;
|
---|
82 | end;
|
---|
83 | end;
|
---|
84 | *)
|
---|
85 | (*
|
---|
86 | Page := THtmlPage.Create;
|
---|
87 | with Page do begin
|
---|
88 | Title := 'ZdìchovNET - Úvodní stránka';
|
---|
89 | with Body do begin
|
---|
90 | with TDiv(SubItems[SubItems.Add(TDiv.Create)]) do begin
|
---|
91 |
|
---|
92 | end;
|
---|
93 | end;
|
---|
94 |
|
---|
95 | end;
|
---|
96 | Memo1.Lines.Text := Page.GenerateOutput;
|
---|
97 | *)
|
---|
98 | //Memo1.Lines.Text := HtmlPage.AsXmlDocument.AsString;
|
---|
99 | // Xmldocument.Free;
|
---|
100 |
|
---|
101 | IdHTTPServer1 := TIdHTTPServer.Create;
|
---|
102 | with IdHTTPServer1 do begin
|
---|
103 | SocketHandle := Bindings.Add;
|
---|
104 | with SocketHandle do begin
|
---|
105 | IP := '0.0.0.0';
|
---|
106 | Port := 8000;
|
---|
107 | end;
|
---|
108 | DefaultPort := 25000;
|
---|
109 | AutoStartSession := True;
|
---|
110 | ServerSoftware := 'Chronosoft web server';
|
---|
111 | SessionTimeOut := 600000;
|
---|
112 | OnSessionStart := IdHTTPServer1SessionStart;
|
---|
113 | OnSessionEnd := IdHTTPServer1SessionEnd;
|
---|
114 | OnCommandGet := IdHTTPServer1CommandGet;
|
---|
115 | SessionState := True;
|
---|
116 | Active := True;
|
---|
117 | end;
|
---|
118 | end;
|
---|
119 |
|
---|
120 | destructor TMainForm.Destroy;
|
---|
121 | begin
|
---|
122 | IdHTTPServer1.Free;
|
---|
123 | end;
|
---|
124 |
|
---|
125 | procedure TMainForm.IdHTTPServer1CommandGet(AContext: TIdContext;
|
---|
126 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
---|
127 | var
|
---|
128 | PathParts: TStringArray;
|
---|
129 | QueryParts: TStringArray;
|
---|
130 | Output: string;
|
---|
131 | User: TUser;
|
---|
132 | I: Integer;
|
---|
133 | begin
|
---|
134 | I := 0;
|
---|
135 | while (I < UserSessions.Count) and (TUser(UserSessions[I]).SessionId <> ARequestInfo.Session.SessionID) do Inc(I);
|
---|
136 | if (I < UserSessions.Count) then User := TUser(UserSessions[I]) else begin
|
---|
137 | User := TUser.Create;
|
---|
138 | User.Database := Database;
|
---|
139 | end;
|
---|
140 | PathParts := Explode('/', Copy(ARequestInfo.Document, 2, High(Integer)));
|
---|
141 | if PathParts[0] = 'user' then begin
|
---|
142 | if PathParts[1] = 'login2' then
|
---|
143 | //AResponseInfo.ContentText := '<div class="sysmessage">' +
|
---|
144 | //User.Login(ARequestInfo.Params.Values['nick'], ARequestInfo.Params.Values['password']);
|
---|
145 | //+ '</div>';
|
---|
146 | if Assigned(ARequestInfo.Session) then
|
---|
147 | AResponseInfo.ContentText := ARequestInfo.Session.SessionID;
|
---|
148 | if Assigned(AResponseInfo.Session) then
|
---|
149 | AResponseInfo.ContentText := AResponseInfo.ContentText + ' X' + AResponseInfo.Session.SessionID;
|
---|
150 | // AResponseInfo.ContentText := IntToStr(IdHTTPServer1.SessionList
|
---|
151 | end else begin
|
---|
152 | AResponseInfo.ContentText := '<div class="Title">Pøihláení uivatele:</div>' +
|
---|
153 | '<div class="Form"><form action="/user/login2/" method="post">' +
|
---|
154 | '<table><tr><td>Pøezdívka:</td><td><input name="nick"></td></tr>' +
|
---|
155 | '<tr><td>Heslo:</td><td><input type="password" name="password"></td></tr>' +
|
---|
156 | '</table><input type="submit" value="Pøihlásit"><br>' +
|
---|
157 | '</form>' +
|
---|
158 | '<a href="?module=user&action=sendpassword">Zaslat heslo na email</a></div>';
|
---|
159 | end;
|
---|
160 | //AResponseInfo.ContentText := HtmlPage.AsXmlDocument.AsString
|
---|
161 | User.Free;
|
---|
162 | end;
|
---|
163 |
|
---|
164 | { TUser }
|
---|
165 |
|
---|
166 | function TUser.Login(UserName, Password: string): Boolean;
|
---|
167 | var
|
---|
168 | Rows: TDbRows;
|
---|
169 | begin
|
---|
170 | Rows := Database.Select('user', '*', 'username="' + UserName + '"');
|
---|
171 | if Rows.Count > 0 then begin
|
---|
172 | if Rows[0].Values['password'] = Password then begin
|
---|
173 | Result := True;
|
---|
174 | LastLogin := Now;
|
---|
175 |
|
---|
176 | //Database.Update(
|
---|
177 | end;
|
---|
178 | end;
|
---|
179 |
|
---|
180 | end;
|
---|
181 |
|
---|
182 | procedure TMainForm.IdHTTPServer1SessionStart(Sender: TIdHTTPSession);
|
---|
183 | begin
|
---|
184 | with TUser(UserSessions[UserSessions.Add(TUser.Create)]) do begin
|
---|
185 | Database := Self.Database;
|
---|
186 | SessionId := Sender.SessionID;
|
---|
187 | end;
|
---|
188 | end;
|
---|
189 |
|
---|
190 | procedure TMainForm.IdHTTPServer1SessionEnd(Sender: TIdHTTPSession);
|
---|
191 | var
|
---|
192 | I: Integer;
|
---|
193 | begin
|
---|
194 | I := 0;
|
---|
195 | while (I < UserSessions.Count) and (TUser(UserSessions[I]).SessionId <> Sender.SessionID) do Inc(I);
|
---|
196 | if (I < UserSessions.Count) then
|
---|
197 | TUser(UserSessions[I]).Free;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | begin
|
---|
201 | MainForm := TMainForm.Create;
|
---|
202 | ReadLn;
|
---|
203 | end.
|
---|