Skip to content

Instantly share code, notes, and snippets.

@Eckankar
Last active November 29, 2018 10:20
Show Gist options
  • Save Eckankar/4d88ea4027fa48965d058d1641165efb to your computer and use it in GitHub Desktop.
Save Eckankar/4d88ea4027fa48965d058d1641165efb to your computer and use it in GitHub Desktop.
Arto profile system in Delphi (file timestamped May 2nd 2004)
unit Unit1;
interface
uses
SysUtils, Classes, HTTPApp, DB, DBTables;
type
TWebModule1 = class(TWebModule)
Query1: TQuery;
UpdateSQL1: TUpdateSQL;
procedure WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1admingetAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1adminpostAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1WebActionItem4Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.dfm}
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
op: tstringlist;
begin
if (request.QueryFields.Values['id'] <> '') then
begin
Query1.SQL.Text := 'SELECT * FROM ":EGNE:arto" WHERE login = "'+request.QueryFields.Values['id']+'"';
Query1.Prepare;
Query1.Active := true;
Query1.Open;
if (Query1.Eof) then response.Content := 'No such user '+request.QueryFields.Values['id']+'.'
else
begin
op := tstringlist.Create;
op.LoadFromFile('D:\Web\Arto\template.html');
if (query1.FieldByName('TEXT').AsString <> '') then op.Text := stringreplace(op.text,'<#TEXT#>',query1.FieldByName('TEXT').AsString,[rfIgnoreCase])
else op.Text := stringreplace(op.text,'<#TEXT#>','And the sign said <b>"Long-haired freaky people need not apply"</b>.',[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#BGIMG#>',query1.FieldByName('BGIMG').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#TOPIMG#>',query1.FieldByName('TOPIMG').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#TITLE#>',query1.FieldByName('TITLE').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#BGCOLOR#>',query1.FieldByName('BGCOLOR').AsString,[rfIgnoreCase]);
response.Content := op.Text;
op.Free;
end;
end
else
response.Content := 'No such user.';
response.SendResponse;
end;
procedure TWebModule1.WebModule1admingetAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
op: tStringList;
begin
op := tStringlist.Create;
op.LoadFromFile('d:\web\arto\login.html');
response.Content := op.Text;
response.SendResponse;
op.free;
end;
procedure TWebModule1.WebModule1adminpostAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
op: tStringList;
begin
if (request.ContentFields.Values['login'] <> '') or (request.ContentFields.Values['pass'] <> '') then
begin
Query1.SQL.Text := 'SELECT * FROM ":EGNE:arto" WHERE login = "'+request.ContentFields.Values['login']+'"';
Query1.Prepare;
Query1.Active := true;
if ((Query1.Eof) or (Query1.FieldByName('pass').AsString <> request.ContentFields.Values['pass'])) then response.SendRedirect('admin')
else
begin
op := tStringList.Create;
op.LoadFromFile('D:\Web\Arto\admin.html');
if (query1.FieldByName('TEXT').AsString <> '') then op.Text := stringreplace(op.text,'<#TEXT#>',query1.FieldByName('TEXT').AsString,[rfIgnoreCase])
else op.Text := stringreplace(op.text,'<#TEXT#>','And the sign said <b>"Long-haired freaky people need not apply"</b>.',[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#TITLE#>',query1.FieldByName('TITLE').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#BGCOLOR#>',query1.FieldByName('BGCOLOR').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#LOGIN#>',query1.FieldByName('LOGIN').AsString,[rfIgnoreCase]);
op.Text := stringreplace(op.text,'<#PASS#>',query1.FieldByName('PASS').AsString,[rfIgnoreCase]);
response.Content := op.text;
response.SendResponse;
end;
end
else
response.SendRedirect('admin');
end;
procedure TWebModule1.WebModule1WebActionItem4Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
if (request.ContentFields.Values['login'] <> '') or (request.ContentFields.Values['pass'] <> '') then
begin
Query1.SQL.Text := 'SELECT * FROM ":EGNE:arto" WHERE login = "'+request.ContentFields.Values['login']+'"';
Query1.Prepare;
Query1.RequestLive := true;
Query1.UniDirectional := false;
Query1.Active := true;
if ((Query1.Eof) or (Query1.FieldByName('pass').AsString <> request.ContentFields.Values['pass'])) then response.SendRedirect('admin')
else
begin
updatesql1.ModifySQL.Text := 'UPDATE ":EGNE:arto" SET text = "'+stringreplace(request.ContentFields.Values['text'],'"','""',[rfReplaceAll])+'"'+
', title = "'+stringreplace(request.ContentFields.Values['title'],'"','""',[rfReplaceAll])+'"'+
', bgcolor = "'+stringreplace(request.ContentFields.Values['bgcolor'],'"','""',[rfReplaceAll])+'"'+
' where login = "'+request.ContentFields.Values['login']+'";';
updatesql1.ExecSQL(ukModify);
response.SendRedirect('view?id='+request.ContentFields.Values['login']);
end;
end;
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment