Код программы cgidb

unit Unit1;

interface

uses
  SysUtils, Classes, HTTPApp, DB, DBTables;

type
  TWebModule1 = class(TWebModule)
    procedure WebModule1acDefaultAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1acMainAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure WebModule1acEditFormAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.dfm}

function RedText(S: string): string;
begin
  Result := '<font color=red>' + S + '</font>';
end;

procedure TWebModule1.WebModule1acDefaultAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := RedText('Запрашиваемая страница не найдена!');
end;

procedure TWebModule1.WebModule1acMainAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  Page: TStringList;
  Q: TQuery;
  I: Integer;
  CurrentRow, RadioStr: string;

  // Выполняет необходимые действия над записями базы данных
  procedure CheckDatabaseOpeation;
  var
    Operation: string;
    I: Integer;
  begin
    Operation := Request.ContentFields.Values['operationtype']; // Тип операции
    if (Operation = '') or (Request.ContentFields.Values['editformbtn'] <> 'ОК') then Exit;
    
    if Operation = 'Добавить' then              // ДОБАВЛЕНИЕ
    begin
      if Request.ContentFields.Values['db_Name'] = '' then
        Page.Add(RedText('Добавление записи: значение ключевого поля не присвоено!'))
      else
      begin
        Q.Append;
        for I := 0 to Q.FieldCount - 1 do
          Q.Fields[I].AsString := Request.ContentFields.Values['db_' + Q.Fields[I].FieldName];
        Q.Post;
      end; 
    end else if Operation = 'Изменить' then     // ИЗМЕНЕНИЕ
    begin
      if CurrentRow = '' then
        Page.Add(RedText('Изменение записи: запись не выбрана!'))
      else
      begin
        if not Q.Locate('Name', CurrentRow, [loCaseInsensitive]) then
          Page.Add(RedText('Изменение записи: запись не найдена: ' + CurrentRow))
        else
        begin
          if Request.ContentFields.Values['db_Name'] = '' then
            Page.Add(RedText('Изменение записи: значение ключевого поля не присвоено!'))
          else
          begin
            Q.Edit;
            for I := 0 to Q.FieldCount - 1 do
              Q.Fields[I].AsString := Request.ContentFields.Values['db_' + Q.Fields[I].FieldName];
            Q.Post;
          end;
        end;
      end;
    end else if Operation = 'Удалить' then         // УДАЛЕНИЕ
    begin
      if CurrentRow = '' then
        Page.Add(RedText('Удаление записи: запись не выбрана!'))
      else
      begin
        if not Q.Locate('Name', CurrentRow, [loCaseInsensitive]) then
          Page.Add(RedText('Удаление записи: запись не найдена: ' + CurrentRow))
        else
        begin
          Q.Delete;    
        end;
      end;
    end;
  end;
begin
  Page := TStringList.Create;
  try
    CurrentRow := Request.ContentFields.Values['dbrec'];

    Page.Add('<h1>Публикация базы данных</h1>');
    Page.Add('<h2>Данные из "country.db"</h2>');
    Q := TQuery.Create(nil);
    try
      Q.DatabaseName := 'DBDEMOS';
      Q.SQL.Text := 'SELECT * FROM Country ORDER BY Name';
      Q.RequestLive := True;
      Q.Open;

      try
        CheckDatabaseOpeation();
      except
        on E: Exception do
        begin
          Page.Add(RedText('<br>Error: ' + E.Message + '<br>'));
          if Q.Modified then
            Q.Cancel;
        end;
      end;
      
      Q.First;

      Page.Add('<br><br>');
      Page.Add('<form action="editform" method="post">');
      Page.Add('<input name="btn1" type="submit" value="Добавить">');
      Page.Add('<input name="btn1" type="submit" value="Изменить">');
      Page.Add('<input name="btn1" type="submit" value="Удалить">');

      Page.Add('<table border="1">');

      // Выводим наименования столбцов таблицы
      Page.Add('<tr>');
      for I := 0 to Q.FieldCount - 1 do
      begin
        Page.Add('<th>');
        Page.Add(Q.Fields[I].FieldName);
        Page.Add('</th>');
      end;
      Page.Add('<th>*</th>');
      Page.Add('</tr>');

      // Выводим записи таблицы
      while not Q.Eof do
      begin
        Page.Add('<tr>');
        for I := 0 to Q.FieldCount - 1 do
        begin
          Page.Add('<td>');
          Page.Add(Q.Fields[I].AsString);
          Page.Add('</td>');
        end;

        // Добавляем еще один столбец в элементом radiobutton     
        RadioStr := '<input name="dbrec" type="radio" '+
          'value="' + Q.FieldByName('Name').AsString + '"';

        // Устанавливаем radiobutton для текущей записи
        if (CurrentRow <> '') and
           (CurrentRow = Q.FieldByName('Name').AsString) then
          RadioStr := RadioStr + ' CHECKED ';

        RadioStr := RadioStr + '>';
   
        Page.Add('<th>'+RadioStr+'</th>');
        // столбец в элементом radiobutton добавлен!

        Page.Add('</tr>'); // Запись добавлена
        Q.Next;
      end;
      Page.Add('</table>');

      Page.Add('<input name="btn1" type="submit" value="Добавить">');
      Page.Add('<input name="btn1" type="submit" value="Изменить">');
      Page.Add('<input name="btn1" type="submit" value="Удалить">');

      Page.Add('</form>');
    finally
      Q.Free
    end;

    Response.Content := Page.Text; // Окончательный результат
  finally
    Page.Free;
  end;
end;

procedure TWebModule1.WebModule1acEditFormAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  Page: TStringList;
  Q: TQuery;
  CurrentRow, Operation: string;

  // Добавление форму редактирования
  procedure AddEditForm(IsEdit: Boolean; IsDelete: Boolean = False);
  var
    I: Integer;
    Value: string;
  begin
    Page.Add('<form action="main" method="post">');
    if IsDelete then
    begin
      Page.Add('<h2>Вы действительно хотите удалить запись "'+CurrentRow+'"?<h2>');
    end else
    begin
      for I := 0 to Q.FieldCount - 1 do
      begin
        if IsEdit then
          Value := Q.Fields[I].AsString // Для редактирования
        else
          Value := '';                  // Для добавления

        Page.Add(Q.Fields[I].FieldName + ': ');
        Page.Add('<input name="db_' + Q.Fields[I].FieldName + '"' +
                 ' type="text" value="' + Value + '"><br>');
      end;
    end;

    Page.Add('<input name="editformbtn" type="submit" value="ОК">');
    Page.Add('<input name="editformbtn" type="submit" value="Отмена">');

    // Добавляем скрытый элемент, который позволит вернуть главной странице
    // имя выбранной записи. Имя должно быть такое же, как у type="radio"
    Page.Add('<input name="dbrec" type="hidden" value="' + CurrentRow + '">');

    // Добавляем скрытый элемент для типа операции
    Page.Add('<input name="operationtype" type="hidden" value="' + Operation + '">');

    Page.Add('</form>');
  end;
begin
  Page := TStringList.Create;
  try
    CurrentRow := Request.ContentFields.Values['dbrec'];
    Operation := Request.ContentFields.Values['btn1'];
    Page.Add('<h1>Публикация базы данных</h1>');

    Q := TQuery.Create(nil);
    try
      Q.DatabaseName := 'DBDEMOS';
      Q.SQL.Text := 'SELECT * FROM Country';
      Q.RequestLive := True; // Разрешаем редактирование
      Q.Open;

      if Operation = 'Добавить' then              // ДОБАВЛЕНИЕ
      begin
        AddEditForm(False);
      end else if Operation = 'Изменить' then     // ИЗМЕНЕНИЕ
      begin
        if CurrentRow = '' then
          Page.Add(RedText('Изменение записи: запись не выбрана!'))
        else
        begin
          if not Q.Locate('Name', CurrentRow, [loCaseInsensitive]) then
            Page.Add(RedText('Изменение записи: запись не найдена: ' + CurrentRow))
          else
          begin
            AddEditForm(True);
          end;
        end;
      end else if Operation = 'Удалить' then         // УДАЛЕНИЕ
      begin
        if CurrentRow = '' then
          Page.Add(RedText('Удаление записи: запись не выбрана!'))
        else
        begin
          AddEditForm(False, True);
        end;
      end else
        Page.Add(RedText('Операция не задана!'));
    finally
      Q.Free;
    end;         

    Page.Add('<br><a href="main">Главная страница</a>');
    
    Response.Content := Page.Text; // Окончательный результат
  finally
    Page.Free;
  end;        
end;

end.