S. D. F. - страница 4

Шрифт

Интервал

- Обрати внимание на комментарий к слову begin – рекомендую так подписывать процедуру, если название ее мало информативно.

* А вторая кнопка?

- Ну, даже неудобно…

procedure TFMain.Button2Click(Sender: TObject);

begin

Memo1.Clear;

end;

* Да, проще некуда. Так теперь по очереди RunSQL( MakeSQL);

- Недавно переделал, довольно много повкалывал с этими 30 строками…

010 function RunSQL( S:string):boolean;

020 var

030 b : boolean; // отслеживание ошибки

040 Mistake : string; // сообщение ошибки

050 begin

060 with DataModule2.IBSQL1 do

070 begin

080 Close;

090 SQL.Clear;

100 SQL.Add(S);

110 try

120 ExecQuery; // попытка выполнения запроса

130 b := true; // ошибки нет

140 except // Обработка ошибки

150 on E: Exception do

160 begin

170 b := false; // к сожалению, ошибка

180 Mistake := E.ClassName+' raised exception: '+E.Message;

190 end;

200 end; // try

210 end; // with DataModule2

220 result := not b;

230 if b

240 then

250 begin // запрос выполнен

260 Hi.Lines.Add('ok');

270 Memo1.Clear; // и переход на закладку History

280 if DataModule2.IBSQL1.SQLType = SQLSelect

290 then PrintSELECT(S) // распечатка результата запроса SELECT

300 else PageControl1.ActivePageIndex := 3;

310 end

320 else

330 begin // была ошибка

340 ShowMessage(Mistake); // сообщение об ошибке

350 Hi.Lines.Add('Error');

360 Hi.Lines.Add(Mistake); // запись в историю

370 end;

380 Hi.Lines.Add('------------');

390 end;

- Самое интересное происходит, когда запрос НЕ выполняется.

* Прочитал, все понятно, и над чем тут было биться?

- Все понятно? Отлично, объясни тогда строки 280, 290.

* Так, интересно. Определяется тип запроса и если это SELECT. Нечестно, ты еще ничего не сказал о PrintSELECT.

- Давай, это исправим:

010 procedure PrintSELECT(S:string);

020 var

030 i : integer;

040 a : string;

050 LHTML : TStringList;

060 begin

070 LHTML := TStringList.Create;

080 HTMLHead(LHTML);

090 LHTML.Add('

'+ s + '

');

100 with DataModule2.IBSQL1 do

110 if RecordCount > 0 then

120 BEGIN

130 LHTML.Add('

'+UniqueRelationName+'

');

140 LHTML.Add('

');

150 S := ''; // формирование заголовка таблицы

160 for i := 0 to Current.Count-1 do

170 S := S + '

180 S := S + '

'; // конец заголовка таблицы

190 LHTML.Add(S); // печать заголовка таблицы

200 while not EOF do

210 begin

220 S := '

'; //

230 for i := 0 to Current.Count-1 do

240 begin // формирование строки данных

250 a := Fields[i].AsString;

260 if a = '' then a := ' - ';

270 S := S + '

280 end; // for

290 Next;

300 S := S + '

310 LHTML.Add(S);

320 end; // while

330 LHTML.Add('

'+ Fields[i].Name +'
'+a+'

');

340 END

350 ELSE

360 LHTML.Add('

EMPTY

');

370 LHTML.Add('');

380 LHTML.SaveToFile(Path+'~.htm');

390 Web.Navigate(Path+'~.htm');

400 PageControl1.ActivePageIndex := 2;

410 LHTML.Free;

420 end;

* Не маленький кусочек.

- Но очень важный кусочек, пожалуй, это сердце программы. Я его многократно переписывал, теперь стыдно показать ранние версии, а сейчас я горжусь написанным. Только, некомпетентные люди считают труд программиста скучным, безэмоциональным, нет эмоции, под внешним спокойствием, бушуют…

* Да ладно, расхвастался, к делу. В начале готовится заголовок HTML.

- Ну это просто:

procedure HTMLHead(LHTML : TStringList);

begin

LHTML.add('');