S. D. F. - W Cat
Шрифт:
Интервал:
Закладка:
* А почему ты изменил 170 строку.
- Искл. состояние может возникнуть не только из-за dll, но и в случае если база будет не родная (не совпадает пароль и др.) т.е. это место надо переписать более тщательно, сделаем это позже.
* Нет ничего более постоянного …
- Согласен, давай изменим строку 160
160 except // в дальнейшем обработать 1. отсутствие dll. 2. несовпадение пароля 3. другие случаи
- Теперь пришла пора для вкусненького.
* Погоди, сбегаю за кетчупом.
- Боюсь, ни клаве ни монитору кетчуп не понравится.
- Открою тебе великую тайну:
- Когда мы создали пустую базу. База там уже есть.
* Я что-то подобное подозревал, файл то не очень маленький.
- Да, в этом файле есть служебная база в которой будут хранится сведения о нашей базе.
* База о базе. Логично. Ведь логичное же, что директор завода Жигулей ездит на Мерседесе.
- Переписываем ShowTables:
-
procedure ShowTables(fn:string);
begin
FMain.Caption := fn;
with FMain.ListBox1 do
begin
Clear;
PrintList('select DISTINCT R.RDB$RELATION_NAME '+
'from RDB$RELATION_FIELDS R '+
'where R.RDB$SYSTEM_FLAG = 0 order by R.RDB$RELATION_NAME');
end;
end;
* Опять нет нумерации, значит это тоже временно.
- Совершенно точно. А теперь функция PrintList:
010 function PrintList( iSQL:string):boolean;
020 begin
030 with DataModule2.IBSQL1 do
040 begin
050 result := false;
060 Close;
070 SQL.Clear;
080 SQL.Add(iSQL);
090 ExecQuery;
100 if RecordCount = 0 then
110 begin
120 FMain.ListBox1.Items.Add('Empty');
130 result := true;
140 exit;
150 end;
160 while not EOF do
170 begin
180 FMain.ListBox1.Items.Add( trim(Fields[0].AsString));
190 Next;
200 end; // while
210 end;
220 end;
- PrintList выполняет (стр. 90) наш первый SQL запрос (стр. 80). В случае, когда осмысленного ответа нет (стр. 100-150) выдается надпись - 'Empty' т.е. базы нет, а иначе (стр. 160-200) выдаем список таблиц в нашей базе.
* А что за страшную строку получает PrintList получает как параметр.
- Это тот самый запрос и есть. Пока разбирать его не будем.
- * -
(уточнение, “- * -“ равняется банке пива)
- Ну как, чего ты такой…
* Опять, не работает.
- Привыкай к тяготам лишениям нашей службы…
- Ну что там у нас
* Operation cancelled at user's request
- Н-да, и что характерно, каждый раз на этом месте…
- Так, у компонента IBDatabase1 измени свойство LoginPrompt на False. И будет тебе счастье.
- * -
* Ну, что, сразу нельзя было сказать?
- Забыл, бывает…
- Как, заработало?
* Да, но гора родила мышь. Ввели много дополнительных слов, а результат тот же.
- Ничего, скоро мышка превратится в кошку, затем в собачку а там и до крокодила недалеко.
* Не п*ди, что будем делать дальше?
- Дальше?
Готовимся выполнять SQL запросы.
- Для начала, что попроще.
- На закладке History помести TMemo – во всю ее ширину и высоту, да, назови это дело His.
- А на закладке SQL надо расположить тоже TMemo (у меня оно названо Memo1) и для начала пару кнопок “Run SQL” и “Clear SQL”.
- Теперь делаем процедуры кнопок:
procedure TFMain.Button1Click(Sender: TObject);
begin // кнопка run SQL
RunSQL( MakeSQL);
end;
* Опять временно?
- Ну, не хочу тебя сразу пугать, все по очереди.
- Обрати внимание на комментарий к слову 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('<center><p> '+ s + '</p>');
100 with DataModule2.IBSQL1 do
110 if RecordCount > 0 then
120 BEGIN
130 LHTML.Add('<h2>'+UniqueRelationName+'</h2>');
140 LHTML.Add('<center><table cellspacing=0 cellpadding=0 ><tr>');
150 S := ''; // формирование заголовка таблицы
160 for i := 0 to Current.Count-1 do
170 S := S + '<th>'+ Fields[i].Name +'</th>';
180 S := S + '</tr>'; // конец заголовка таблицы
190 LHTML.Add(S); // печать заголовка таблицы
200 while not EOF do
210 begin
220 S := '<tr>'; //
230 for i := 0 to Current.Count-1 do
240 begin // формирование строки данных
250 a := Fields[i].AsString;
260 if a = '' then a := ' - ';
270 S := S + '<td>'+a+'</td>';
280 end; // for
290 Next;
300 S := S + '</tr>';
310 LHTML.Add(S);
320 end; // while
330 LHTML.Add('</table></center>');
340 END
350 ELSE
360 LHTML.Add('<h3> EMPTY</h3>');
370 LHTML.Add('</body>');
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('<html><head>');
LHTML.add('<meta http-equiv=<Content-Type< content=<text/html; charset=windows-1251<>');
LHTML.add('<style>');
LHTML.add('table {border:1px solid #c3c3c3; border-collapse:collapse;');
LHTML.add(' text-align: center; width:90%;}');
LHTML.add('table th {background-color:#e5eecc; border:1px solid #c3c3c3;');
LHTML.add('padding:3px; vertical-align:top; }');
LHTML.add('table td {border:1px solid #c3c3c3; padding:3px; vertical-align:top;');
LHTML.add('</style></head><body>');
end;
- Тут, я ничего объяснять не буду HTML сегодня не наша тема.
- В цикле стр 200 – 320 выдается результат предшествующего запроса. Остальное все просто.
* Опять, таки не вижу, чему тут гордится.
- Мартышка, к старости, слаба глазами, стала? У меня есть предложение, после того как мы закончим разговор, отложи этот файл в далекую папку, и через пол года, напиши такую же программу самостоятельно, пользуясь справочниками, интернетом, но не этим текстом. Вот тогда, посмотрим.
* Хорошо! Спорим, что я напишу лучше!
- Вполне возможно. Я буду только рад. Выиграет только вселенский разум.
* Ладно, успокоились, что у нас еще есть неясного.
* А, что такое MakeSQL – по смыслу делается строка запроса?
- Да, это очень простая функция, и возможно это надо еще упростить…
010 function MakeSQL:string;
020 var
030 i : integer;
040 begin
050 result := '';
060 with FMain.Memo1 do
070 for i := 0 to Lines.Count - 1 do
080 if trim(Lines[i]) <> '' then
090 begin
100 FMain.His.Lines.Add(Lines[i]);
110 result := result + Lines[i] + ' ';
120 end;
130 result := trim(result);
140 end;
- Все, что находится в Memo1 записывается в одну строку(стр. 110) и одновременно сохраняется в истории(стр. 100).
* Так значит мы можем теперь выполнять SQL запросы?
- И да, и нет.
* ??
- Выполнять запросы можем, но не всегда увидим результат. Ну, еще не все готово.
* Так давай! Беги, покупай, эти тр-ан-зис-то-ры!
- Не спеши. Выполним, те SQL, что запланированы.
- Но сначала еще одна мелочь. Сделай обработчик для кнопки Show DB это на самой первой закладке.
procedure TFMain.Button3Click(Sender: TObject);
begin // Show DB
ShowTables;
end;
???????
Первые запросы
- Ну, что, давай попробуем.
- Открой или сделай новую базу и выполни следующий запрос:
CREATE TABLE Salespeople
( snum integer,
sname char (10),
city char (10),
comm decimal );
* Говорит что все OK.
- Перейди на первую закладку и нажми кнопку Show DB.
* Ура!! Заработало!!
- Рано кричать, закрой программу, включи опять и открой твою базу.
* Есть, таблица сразу отобразилась.
