Author: Yoganand Aiyadurai
How can I create Stored Procedures and Views with out Knowing the Scripts ?
Answer:
For the persons who does not have the knowledge of Databases creating the stored
procedures and views in the SQL Database was always a problem.
This utility will allow you to create the Stored procedures for Insert, Update and
delete of a table and also will create the views. You have to just connect to the
Database. All the Tables in the Database will be listed . Click on the table for
which you need to create the stored procedures. The Script will be generated
depending on the default templete. You can modify the templetes. Check or uncheck
the fields you want to include in the Stored procedure. By default the need fields
based upon the key fields will be included. Then just click, to create the stored
procedures. For views you can include the fields in the views or cange the display
names of the fields.
Copy the following codes to their respective files. Compile it and enjoy the ease
of creating stored procedures.
GenerateSp.dpr file
1 program GenerateSp;
2
3 uses
4 Forms,
5 Main in 'Main.pas' {fmMain};
6
7 {$R *.res}
8
9 begin
10 Application.Initialize;
11 Application.CreateForm(TfmMain, fmMain);
12 Application.Run;
13 end.
14
15 Main.dfm file
16
17 object fmMain: TfmMain
18 Left = 37
19 Top = 103
20 Width = 1225
21 Height = 759
22 ActiveControl = edtsrv
23 Caption = 'fmMain'
24 Color = clBtnFace
25 Constraints.MinHeight = 759
26 Constraints.MinWidth = 1225
27 Font.Charset = DEFAULT_CHARSET
28 Font.Color = clWindowText
29 Font.Height = -13
30 Font.Name = 'MS Sans Serif'
31 Font.Style = []
32 OldCreateOrder = False
33 Position = poScreenCenter
34 OnClose = FormClose
35 OnCreate = FormCreate
36 OnDestroy = FormDestroy
37 OnShow = FormShow
38 PixelsPerInch = 120
39 TextHeight = 16
40 object Label1: TLabel
41 Left = 44
42 Top = 12
43 Width = 46
44 Height = 16
45 Caption = 'Server :'
46 end
47 object Label2: TLabel
48 Left = 24
49 Top = 38
50 Width = 66
51 Height = 16
52 Caption = 'Database :'
53 end
54 object Label3: TLabel
55 Left = 15
56 Top = 64
57 Width = 75
58 Height = 16
59 Caption = 'User Name :'
60 end
61 object Label4: TLabel
62 Left = 24
63 Top = 91
64 Width = 66
65 Height = 16
66 Caption = 'Password :'
67 end
68 object lblConn: TLabel
69 Left = 98
70 Top = 140
71 Width = 3
72 Height = 16
73 end
74 object Label5: TLabel
75 Left = 3
76 Top = 138
77 Width = 89
78 Height = 16
79 Caption = 'Table Names :'
80 Font.Charset = DEFAULT_CHARSET
81 Font.Color = clWindowText
82 Font.Height = -13
83 Font.Name = 'MS Sans Serif'
84 Font.Style = [fsUnderline]
85 ParentFont = False
86 end
87 object edtsrv: TEdit
88 Left = 96
89 Top = 8
90 Width = 137
91 Height = 24
92 TabOrder = 0
93 end
94 object edtdb: TEdit
95 Left = 96
96 Top = 34
97 Width = 137
98 Height = 24
99 TabOrder = 1
100 end
101 object edtUn: TEdit
102 Left = 96
103 Top = 60
104 Width = 137
105 Height = 24
106 TabOrder = 2
107 end
108 object edtPw: TEdit
109 Left = 96
110 Top = 87
111 Width = 137
112 Height = 24
113 PasswordChar = '@'
114 TabOrder = 3
115 end
116 object btnConnect: TButton
117 Left = 96
118 Top = 112
119 Width = 75
120 Height = 25
121 Caption = 'Connect'
122 TabOrder = 4
123 OnClick = btnConnectClick
124 end
125 object pcMain: TPageControl
126 Left = 240
127 Top = 0
128 Width = 977
129 Height = 726
130 ActivePage = tsFields
131 Align = alRight
132 TabIndex = 0
133 TabOrder = 5
134 object tsFields: TTabSheet
135 Caption = 'Select Fields'
136 object Bevel1: TBevel
137 Left = 0
138 Top = 221
139 Width = 976
140 Height = 9
141 Shape = bsTopLine
142 end
143 object Bevel3: TBevel
144 Left = -19
145 Top = 440
146 Width = 994
147 Height = 9
148 Shape = bsTopLine
149 end
150 object Bevel4: TBevel
151 Left = -11
152 Top = 656
153 Width = 992
154 Height = 9
155 Shape = bsTopLine
156 end
157 object Label6: TLabel
158 Left = 8
159 Top = 0
160 Width = 92
161 Height = 16
162 Caption = 'Fields To Insert'
163 Font.Charset = DEFAULT_CHARSET
164 Font.Color = clWindowText
165 Font.Height = -13
166 Font.Name = 'MS Sans Serif'
167 Font.Style = [fsUnderline]
168 ParentFont = False
169 end
170 object Label7: TLabel
171 Left = 3
172 Top = 226
173 Width = 129
174 Height = 16
175 Caption = 'Key Fields for Update'
176 Font.Charset = DEFAULT_CHARSET
177 Font.Color = clWindowText
178 Font.Height = -13
179 Font.Name = 'MS Sans Serif'
180 Font.Style = [fsUnderline]
181 ParentFont = False
182 end
183 object Label8: TLabel
184 Left = 3
185 Top = 444
186 Width = 134
187 Height = 16
188 Caption = 'Key Fields for Deletion'
189 Font.Charset = DEFAULT_CHARSET
190 Font.Color = clWindowText
191 Font.Height = -13
192 Font.Name = 'MS Sans Serif'
193 Font.Style = [fsUnderline]
194 ParentFont = False
195 end
196 object lblStatus: TLabel
197 Left = 280
198 Top = 664
199 Width = 3
200 Height = 16
201 Font.Charset = DEFAULT_CHARSET
202 Font.Color = clBlue
203 Font.Height = -13
204 Font.Name = 'MS Sans Serif'
205 Font.Style = []
206 ParentFont = False
207 end
208 object clbInsert: TCheckListBox
209 Left = 1
210 Top = 18
211 Width = 185
212 Height = 198
213 ItemHeight = 16
214 TabOrder = 0
215 end
216 object clbUpdate: TCheckListBox
217 Left = 1
218 Top = 244
219 Width = 185
220 Height = 193
221 ItemHeight = 16
222 TabOrder = 1
223 end
224 object clbDelete: TCheckListBox
225 Left = 1
226 Top = 461
227 Width = 185
228 Height = 193
229 ItemHeight = 16
230 TabOrder = 2
231 end
232 object btnOk: TBitBtn
233 Left = 809
234 Top = 664
235 Width = 75
236 Height = 25
237 Caption = 'Ok'
238 TabOrder = 3
239 OnClick = btnOkClick
240 end
241 object btnClose: TBitBtn
242 Left = 889
243 Top = 664
244 Width = 75
245 Height = 25
246 Caption = 'Close'
247 TabOrder = 4
248 OnClick = btnCloseClick
249 end
250 object memScrInsert: TMemo
251 Left = 194
252 Top = 18
253 Width = 769
254 Height = 201
255 ScrollBars = ssBoth
256 TabOrder = 5
257 end
258 object memscrUpdate: TMemo
259 Left = 194
260 Top = 244
261 Width = 769
262 Height = 193
263 ScrollBars = ssBoth
264 TabOrder = 6
265 end
266 object memScrDelete: TMemo
267 Left = 194
268 Top = 461
269 Width = 769
270 Height = 193
271 ScrollBars = ssBoth
272 TabOrder = 7
273 end
274 object chbInsert: TCheckBox
275 Left = 0
276 Top = 668
277 Width = 81
278 Height = 17
279 Caption = 'Sp Insert'
280 Checked = True
281 State = cbChecked
282 TabOrder = 8
283 end
284 object chbUpdate: TCheckBox
285 Left = 80
286 Top = 668
287 Width = 88
288 Height = 17
289 Caption = 'Sp UpDate'
290 Checked = True
291 State = cbChecked
292 TabOrder = 9
293 end
294 object chbDelete: TCheckBox
295 Left = 179
296 Top = 668
297 Width = 81
298 Height = 17
299 Caption = 'Sp Delete'
300 Checked = True
301 State = cbChecked
302 TabOrder = 10
303 end
304 end
305 object tsTemplate: TTabSheet
306 Caption = 'Templates'
307 ImageIndex = 1
308 object Bevel2: TBevel
309 Left = -6
310 Top = 218
311 Width = 984
312 Height = 9
313 Shape = bsTopLine
314 end
315 object Bevel5: TBevel
316 Left = -24
317 Top = 440
318 Width = 1002
319 Height = 9
320 Shape = bsTopLine
321 end
322 object Bevel6: TBevel
323 Left = -22
324 Top = 665
325 Width = 1000
326 Height = 9
327 Shape = bsTopLine
328 end
329 object Label9: TLabel
330 Left = 16
331 Top = -2
332 Width = 32
333 Height = 16
334 Caption = 'Insert'
335 end
336 object Label10: TLabel
337 Left = 16
338 Top = 221
339 Width = 45
340 Height = 16
341 Caption = 'Update'
342 end
343 object Label11: TLabel
344 Left = 16
345 Top = 444
346 Width = 43
347 Height = 16
348 Caption = 'Delete '
349 end
350 object btnok1: TBitBtn
351 Left = 809
352 Top = 669
353 Width = 75
354 Height = 25
355 Caption = 'Ok'
356 TabOrder = 0
357 OnClick = btnok1Click
358 end
359 object btnCancel: TBitBtn
360 Left = 889
361 Top = 669
362 Width = 75
363 Height = 25
364 Caption = 'Cancel'
365 TabOrder = 1
366 end
367 object memInsert: TMemo
368 Left = 16
369 Top = 13
370 Width = 946
371 Height = 201
372 ScrollBars = ssBoth
373 TabOrder = 2
374 end
375 object memUpdate: TMemo
376 Left = 16
377 Top = 237
378 Width = 946
379 Height = 201
380 ScrollBars = ssBoth
381 TabOrder = 3
382 end
383 object memDelete: TMemo
384 Left = 16
385 Top = 461
386 Width = 946
387 Height = 201
388 ScrollBars = ssBoth
389 TabOrder = 4
390 end
391 end
392 object tbPrefix: TTabSheet
393 Caption = 'Prefixes'
394 ImageIndex = 2
395 object Label12: TLabel
396 Left = 24
397 Top = 32
398 Width = 38
399 Height = 16
400 Caption = 'Insert :'
401 end
402 object Label13: TLabel
403 Left = 16
404 Top = 112
405 Width = 46
406 Height = 16
407 Caption = 'Delete :'
408 end
409 object Label14: TLabel
410 Left = 11
411 Top = 72
412 Width = 51
413 Height = 16
414 Caption = 'Update :'
415 end
416 object Label15: TLabel
417 Left = 27
418 Top = 148
419 Width = 35
420 Height = 16
421 Caption = 'View :'
422 end
423 object edtInsert: TEdit
424 Left = 66
425 Top = 28
426 Width = 121
427 Height = 24
428 TabOrder = 0
429 end
430 object edtUpdate: TEdit
431 Left = 66
432 Top = 68
433 Width = 121
434 Height = 24
435 TabOrder = 1
436 end
437 object edtDelete: TEdit
438 Left = 66
439 Top = 108
440 Width = 121
441 Height = 24
442 TabOrder = 2
443 end
444 object btnOk2: TBitBtn
445 Left = 67
446 Top = 183
447 Width = 75
448 Height = 23
449 Caption = 'Ok'
450 TabOrder = 3
451 OnClick = btnOk2Click
452 end
453 object edtView: TEdit
454 Left = 66
455 Top = 144
456 Width = 121
457 Height = 24
458 TabOrder = 4
459 end
460 end
461 object tbViews: TTabSheet
462 Caption = 'Views'
463 ImageIndex = 3
464 object Label16: TLabel
465 Left = 4
466 Top = 5
467 Width = 151
468 Height = 16
469 Caption = 'Fields To Include in View'
470 Font.Charset = DEFAULT_CHARSET
471 Font.Color = clWindowText
472 Font.Height = -13
473 Font.Name = 'MS Sans Serif'
474 Font.Style = [fsUnderline]
475 ParentFont = False
476 end
477 object Label17: TLabel
478 Left = 233
479 Top = 5
480 Width = 86
481 Height = 16
482 Caption = 'Display Name'
483 Font.Charset = DEFAULT_CHARSET
484 Font.Color = clWindowText
485 Font.Height = -13
486 Font.Name = 'MS Sans Serif'
487 Font.Style = [fsUnderline]
488 ParentFont = False
489 end
490 object lblStatusView: TLabel
491 Left = 604
492 Top = 340
493 Width = 36
494 Height = 16
495 Caption = 'wwww'
496 Font.Charset = DEFAULT_CHARSET
497 Font.Color = clBlue
498 Font.Height = -13
499 Font.Name = 'MS Sans Serif'
500 Font.Style = []
501 ParentFont = False
502 end
503 object sgView: TStringGrid
504 Left = 232
505 Top = 24
506 Width = 249
507 Height = 665
508 ColCount = 2
509 DefaultRowHeight = 19
510 FixedCols = 0
511 RowCount = 1
512 FixedRows = 0
513 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
514 goRangeSelect, goEditing]
515 TabOrder = 0
516 OnSetEditText = sgViewSetEditText
517 ColWidths = (
518 243
519 64)
520 RowHeights = (
521 20)
522 end
523 object memView: TMemo
524 Left = 483
525 Top = 24
526 Width = 481
527 Height = 305
528 TabOrder = 1
529 end
530 object clbView: TCheckListBox
531 Left = 1
532 Top = 24
533 Width = 230
534 Height = 665
535 OnClickCheck = clbViewClickCheck
536 Columns = 1
537 Font.Charset = DEFAULT_CHARSET
538 Font.Color = clWindowText
539 Font.Height = -17
540 Font.Name = 'MS Sans Serif'
541 Font.Style = []
542 ItemHeight = 20
543 ParentFont = False
544 TabOrder = 2
545 end
546 object btnView: TButton
547 Left = 488
548 Top = 336
549 Width = 97
550 Height = 25
551 Caption = 'Create View'
552 TabOrder = 3
553 OnClick = btnViewClick
554 end
555 end
556 end
557 object lbTables: TListBox
558 Left = 0
559 Top = 160
560 Width = 233
561 Height = 559
562 ItemHeight = 16
563 TabOrder = 6
564 OnMouseUp = lbTablesMouseUp
565 end
566 object adoConn: TADOConnection
567 ConnectionString =
568 'Provider=SQLOLEDB.1;Password=Robotech!;Persist Security Info=Tru' +
569 'e;User ID=sa;Initial Catalog=Dependency;Data Source=devrequest'
570 Provider = 'SQLOLEDB.1'
571 Left = 504
572 Top = 72
573 end
574 object adoQry: TADOQuery
575 Connection = adoConn
576 Parameters = <>
577 Left = 472
578 Top = 72
579 end
580 end
Main.pas file
581 unit Main;
582
583 interface
584
585 uses
586 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
587 Dialogs, StdCtrls, DB, ADODB, Menus, Buttons, ExtCtrls, CheckLst,
588 ComCtrls, IniFiles, StrUtils, QDialogs, Grids;
589
590 type
591 TfmMain = class(TForm)
592 adoConn: TADOConnection;
593 adoQry: TADOQuery;
594 Label1: TLabel;
595 edtsrv: TEdit;
596 Label2: TLabel;
597 edtdb: TEdit;
598 Label3: TLabel;
599 Label4: TLabel;
600 edtUn: TEdit;
601 edtPw: TEdit;
602 btnConnect: TButton;
603 lblConn: TLabel;
604 Label5: TLabel;
605 pcMain: TPageControl;
606 tsFields: TTabSheet;
607 tsTemplate: TTabSheet;
608 clbInsert: TCheckListBox;
609 clbUpdate: TCheckListBox;
610 clbDelete: TCheckListBox;
611 Bevel1: TBevel;
612 Bevel3: TBevel;
613 Bevel4: TBevel;
614 btnOk: TBitBtn;
615 btnClose: TBitBtn;
616 Label6: TLabel;
617 Label7: TLabel;
618 Label8: TLabel;
619 lbTables: TListBox;
620 Bevel2: TBevel;
621 Bevel5: TBevel;
622 Bevel6: TBevel;
623 btnok1: TBitBtn;
624 btnCancel: TBitBtn;
625 memInsert: TMemo;
626 memUpdate: TMemo;
627 memDelete: TMemo;
628 Label9: TLabel;
629 Label10: TLabel;
630 Label11: TLabel;
631 memScrInsert: TMemo;
632 memscrUpdate: TMemo;
633 memScrDelete: TMemo;
634 tbPrefix: TTabSheet;
635 Label12: TLabel;
636 Label13: TLabel;
637 Label14: TLabel;
638 edtInsert: TEdit;
639 edtUpdate: TEdit;
640 edtDelete: TEdit;
641 btnOk2: TBitBtn;
642 lblStatus: TLabel;
643 chbInsert: TCheckBox;
644 chbUpdate: TCheckBox;
645 chbDelete: TCheckBox;
646 Label15: TLabel;
647 edtView: TEdit;
648 tbViews: TTabSheet;
649 sgView: TStringGrid;
650 memView: TMemo;
651 clbView: TCheckListBox;
652 Label16: TLabel;
653 Label17: TLabel;
654 btnView: TButton;
655 lblStatusView: TLabel;
656 procedure btnConnectClick(Sender: TObject);
657 procedure FormClose(Sender: TObject; var Action: TCloseAction);
658 procedure lbTablesMouseUp(Sender: TObject; Button: TMouseButton;
659 Shift: TShiftState; X, Y: Integer);
660 procedure btnCloseClick(Sender: TObject);
661 procedure btnOkClick(Sender: TObject);
662 procedure FormCreate(Sender: TObject);
663 procedure FormDestroy(Sender: TObject);
664 procedure btnOk2Click(Sender: TObject);
665 procedure btnok1Click(Sender: TObject);
666 procedure FormShow(Sender: TObject);
667 procedure clbViewClickCheck(Sender: TObject);
668 procedure sgViewSetEditText(Sender: TObject; ACol, ARow: Integer;
669 const Value: string);
670 procedure btnViewClick(Sender: TObject);
671 private
672 { Private declarations }
673 Fini: TIniFile;
674 FTblDisplayName, FSelectedTable: string;
675 procedure GetTables;
676 procedure GetColumns;
677 procedure ScriptInsert;
678 procedure ScriptUpdate;
679 procedure ScriptDelete;
680 procedure ScriptView;
681 procedure UpDateDatabase;
682 procedure GenScriptView;
683 public
684 { Public declarations }
685 end;
686
687 const
688 LengthFields = '173,175,106,62,239,108,231,165,167';
689
690 var
691 fmMain: TfmMain;
692
693 implementation
694
695 {$R *.dfm}
696
697 procedure TfmMain.btnConnectClick(Sender: TObject);
698 var
699 S: string;
700 begin
701 S := 'Provider=SQLOLEDB.1;Password=' + edtPw.Text + ';User ID=' + edtUn.Text +
702 ';Initial Catalog=' + edtdb.Text + ';Data Source=' + edtsrv.Text;
703 adoConn.Close;
704 adoConn.ConnectionString := S;
705 lblConn.Font.Color := clGreen;
706 try
707 adoConn.Open;
708 lblConn.Caption := 'Connection Succeded';
709 except
710 lblConn.Font.Color := clRed;
711 lblConn.Caption := 'Connection Failed';
712 end;
713 GetTables;
714 end;
715
716 procedure TfmMain.GetTables;
717 begin
718 adoQry.SQL.Clear;
719 adoQry.SQL.Text := 'Select name from sysobjects where xtype = ' +
720 #39 + 'U' + #39 + ' order by name ';
721 try
722 adoQry.Open;
723 lbTables.Clear;
724 while (not adoQry.Eof) do
725 begin
726 if (adoQry.fieldbyname('name').AsString <> 'dtproperties') then
727 begin
728 lbTables.Items.Add(adoQry.fieldbyname('name').AsString);
729 end;
730 adoQry.Next;
731 end;
732 adoQry.Close;
733 except
734 end;
735 end;
736
737 procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
738 begin
739 adoQry.Close;
740 adoConn.Close;
741 end;
742
743 procedure TfmMain.lbTablesMouseUp(Sender: TObject; Button: TMouseButton;
744 Shift: TShiftState; X, Y: Integer);
745 var
746 tp: TPoint;
747 begin
748 tp.X := X;
749 tp.Y := y;
750 FSelectedTable := lbTables.Items[lbTables.ItemAtPos(tp, true)];
751 FTblDisplayName := AnsiReplaceStr(FSelectedTable, 'tb_', '');
752 GetColumns;
753 ScriptInsert;
754 ScriptUpdate;
755 ScriptDelete;
756 ScriptView;
757 lblStatus.Caption := '';
758 lblStatusView.Caption := '';
759 end;
760
761 procedure TfmMain.btnCloseClick(Sender: TObject);
762 begin
763 Close;
764 end;
765
766 procedure TfmMain.GetColumns;
767 var
768 vIdCol: string;
769 procedure FillClb(var clb: TCheckListBox);
770 var
771 I: word;
772 begin
773 adoQry.First;
774 clb.Clear;
775 while (not adoQry.Eof) do
776 begin
777 clb.Items.Add(adoQry.fieldbyname('name').AsString);
778 if (clb.Name = 'clbInsert') then
779 begin
780 clb.Checked[clb.Items.Count - 1] := True;
781 end
782 else
783 begin
784 end;
785 adoQry.Next;
786 end;
787 if (clb.Name <> 'clbInsert') then
788 begin
789 for I := 0 to (clb.Items.Count - 1) do
790 begin
791 if (pos(clb.Items[I], vIdCol) > 0) then
792 begin
793 clb.Checked[I] := True;
794 end;
795 end;
796 end;
797 end;
798 begin
799 vIdCol := '';
800 adoQry.Close;
801 adoQry.SQL.Clear;
802 adoQry.SQL.Text := 'select A.NAME from SYSCOLUMNS A, sysINDEXKEYS B where A.id =
803 '+
804 '( select id from sysobjects where name = ' + #39 + FSelectedTable + #39 + ' )'
805 +
806 ' and (a.Id = b.Id ) and ( a.ColId = b.ColId ) order by a.colid';
807 try
808 adoQry.Open;
809 while (not adoQry.Eof) do
810 begin
811 vIdCol := vIdCol + adoQry.fieldbyname('name').AsString + '#';
812 adoQry.Next;
813 end;
814 except
815 end;
816
817 adoQry.Close;
818 adoQry.SQL.Clear;
819 adoQry.SQL.Text := 'select name from syscolumns where id = ' +
820 '( select id from sysobjects where name = ' +
821 #39 + FSelectedTable + #39 + ' ) order by colid';
822 try
823 adoQry.Open;
824 FillClb(clbInsert);
825 FillClb(clbUpdate);
826 FillClb(clbDelete);
827 adoQry.Close;
828 except
829 end;
830 end;
831
832 procedure TfmMain.ScriptInsert;
833 var
834 vFields: string;
835 vParamsType: string;
836 vParams: string;
837 vReplace: string;
838 I: Integer;
839 vSpName: string;
840 begin
841 adoQry.Close;
842 adoQry.SQL.Text := 'Select a.name, b.name dt, a.xtype, a.length FROM SYSCOLUMNS
843 a,'
844 +
845 'systypes b where a.id = ( select id from sysobjects where name = ' +
846 #39 + FSelectedTable + #39 + ' ) and ( b.xtype = a.xtype )';
847 try
848 adoQry.Open;
849 except
850 end;
851 vFields := '';
852 vParams := '';
853 vParamsType := '';
854 for I := 0 to (clbInsert.Items.Count - 1) do
855 begin
856 if (clbInsert.Checked[I]) then
857 begin
858 if (vFields <> '') then
859 vFields := vFields + ', ';
860 vFields := vFields + clbInsert.Items[I];
861 if (vParamsType <> '') then
862 vParamsType := vParamsType + ', ';
863 vParamsType := vParamsType + '@' + clbInsert.Items[I] + ' ';
864 if (vParams <> '') then
865 vParams := vParams + ', ';
866 vParams := vParams + '@' + clbInsert.Items[I] + ' ';
867 if adoQry.Locate('name', clbInsert.Items[I], [locaseinsensitive]) then
868 begin
869 vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
870 if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
871 begin
872 vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString
873 +
874 ' )';
875 end
876 else
877 begin
878 end;
879 end;
880 end;
881 end;
882 vSpName := Fini.ReadString('Insert', 'Prefix', '');
883 vReplace := memInsert.Lines.Text;
884 vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
885 vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
886 vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
887 vReplace := AnsiReplaceStr(vReplace, '', vFields);
888 vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
889 vReplace := AnsiReplaceStr(vReplace, '', vParams);
890 memScrInsert.Lines.Text := vReplace;
891 end;
892
893 procedure TfmMain.btnOkClick(Sender: TObject);
894 begin
895 UpDateDatabase;
896 end;
897
898 procedure TfmMain.FormCreate(Sender: TObject);
899 begin
900 Fini := TIniFile.Create(ExtractFileDir(Application.ExeName) + '\SpSettings.Ini');
901 if (not Fini.SectionExists('Insert')) then
902 begin
903 Fini.WriteString('Insert', 'Prefix', '');
904 end;
905 if (not Fini.SectionExists('Update')) then
906 begin
907 Fini.WriteString('Update', 'Prefix', '');
908 end;
909 if (not Fini.SectionExists('Delete')) then
910 begin
911 Fini.WriteString('Delete', 'Prefix', '');
912 end;
913 Fini.UpdateFile;
914 end;
915
916 procedure TfmMain.FormDestroy(Sender: TObject);
917 begin
918 Fini.Free;
919 Fini := nil;
920 end;
921
922 procedure TfmMain.btnOk2Click(Sender: TObject);
923 begin
924 Fini.WriteString('Insert', 'Prefix', edtInsert.Text);
925 Fini.WriteString('Update', 'Prefix', edtUpdate.Text);
926 Fini.WriteString('delete', 'Prefix', edtDelete.Text);
927 Fini.WriteString('View', 'Prefix', edtView.Text);
928 Fini.UpdateFile;
929 end;
930
931 procedure TfmMain.btnok1Click(Sender: TObject);
932 var
933 I: Integer;
934 begin
935 Fini.WriteInteger('Insert', 'Lines', memInsert.Lines.Count - 1);
936 for I := 0 to (memInsert.Lines.Count - 1) do
937 begin
938 Fini.WriteString('Insert', 'Script' + Inttostr(I), memInsert.Lines[I]);
939 end;
940 Fini.WriteInteger('Update', 'Lines', memUpdate.Lines.Count - 1);
941 for I := 0 to (memUpdate.Lines.Count - 1) do
942 begin
943 Fini.WriteString('Update', 'Script' + Inttostr(I), memUpdate.Lines[I]);
944 end;
945 Fini.WriteInteger('Delete', 'Lines', memDelete.Lines.Count - 1);
946 for I := 0 to (memUpdate.Lines.Count - 1) do
947 begin
948 Fini.WriteString('delete', 'Script' + Inttostr(I), memDelete.Lines[I]);
949 end;
950 Fini.UpdateFile;
951 end;
952
953 procedure TfmMain.FormShow(Sender: TObject);
954 var
955 I: Integer;
956 begin
957 edtInsert.Text := Fini.ReadString('Insert', 'Prefix', '');
958 edtUpdate.Text := Fini.ReadString('Update', 'Prefix', '');
959 edtDelete.Text := Fini.ReadString('delete', 'Prefix', '');
960 edtView.Text := Fini.ReadString('View', 'Prefix', '');
961 memInsert.Clear;
962 for I := 0 to (Fini.ReadInteger('Insert', 'Lines', 0)) do
963 begin
964 memInsert.Lines.Add(Fini.ReadString('Insert', 'Script' + intTostr(I), ''));
965 end;
966 memUpdate.Clear;
967 for I := 0 to (Fini.ReadInteger('Update', 'Lines', 0)) do
968 begin
969 memUpdate.Lines.Add(Fini.ReadString('Update', 'Script' + intTostr(I), ''));
970 end;
971 memDelete.Clear;
972 for I := 0 to (Fini.ReadInteger('delete', 'Lines', 0)) do
973 begin
974 memDelete.Lines.Add(Fini.ReadString('Delete', 'Script' + intTostr(I), ''));
975 end;
976 sgView.Cells[0, 0] := 'Table Fields';
977 sgView.Cells[1, 0] := 'Display Name';
978 end;
979
980 procedure TfmMain.ScriptDelete;
981 var
982 vDeleteKey: string;
983 vParamsType: string;
984 vReplace: string;
985 I: Integer;
986 vSpName: string;
987 begin
988 vDeleteKey := '';
989 for I := 0 to (clbDelete.Items.Count - 1) do
990 begin
991 if (clbDelete.Checked[I]) then
992 begin
993 if (vDeleteKey <> '') then
994 vDeleteKey := vDeleteKey + ' and ';
995 vDeleteKey := vDeleteKey + ' (' + clbDelete.Items[I] + ' = @' +
996 clbDelete.Items[I] + ') ';
997 if (vParamsType <> '') then
998 vParamsType := vParamsType + ', ';
999 vParamsType := vParamsType + '@' + clbUpdate.Items[I] + ' ';
1000 if adoQry.Locate('name', clbDelete.Items[I], [locaseinsensitive]) then
1001 begin
1002 vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
1003 if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
1004 begin
1005 vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString
1006+
1007 ' )';
1008 end
1009 else
1010 begin
1011 end;
1012 end;
1013 end
1014 else
1015 begin
1016 end;
1017 end;
1018 vSpName := Fini.ReadString('delete', 'Prefix', '');
1019 vReplace := memDelete.Lines.Text;
1020 vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
1021 vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
1022 vReplace := AnsiReplaceStr(vReplace, '', vDeleteKey);
1023 vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
1024 vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
1025 memScrDelete.Lines.Text := vReplace;
1026end;
1027
1028procedure TfmMain.ScriptUpdate;
1029var
1030 vUpdateFields: string;
1031 vUpDateKey: string;
1032 vFields: string;
1033 vParamsType: string;
1034 vParams: string;
1035 vReplace: string;
1036 I: Integer;
1037 vSpName: string;
1038begin
1039 vUpdateFields := '';
1040 vUpDateKey := '';
1041 vFields := '';
1042 vParams := '';
1043 vParamsType := '';
1044 for I := 0 to (clbUpdate.Items.Count - 1) do
1045 begin
1046 if (clbUpdate.Checked[I]) then
1047 begin
1048 if (vUpDateKey <> '') then
1049 vUpDateKey := vUpDateKey + ' and ';
1050 vUpDateKey := vUpDateKey + ' (' + clbUpdate.Items[I] + ' = @' +
1051 clbUpdate.Items[I] + ') ';
1052 end
1053 else
1054 begin
1055 if (vFields <> '') then
1056 vFields := vFields + ', ';
1057 vFields := vFields + ' ' + clbUpdate.Items[I] + ' = ' + '@' +
1058clbUpdate.Items[I]
1059 + ' ';
1060 end;
1061 if (vParamsType <> '') then
1062 vParamsType := vParamsType + ', ';
1063 vParamsType := vParamsType + '@' + clbUpdate.Items[I] + ' ';
1064 if (vParams <> '') then
1065 vParams := vParams + ', ';
1066 vParams := vParams + '@' + clbInsert.Items[I] + ' ';
1067 if adoQry.Locate('name', clbInsert.Items[I], [locaseinsensitive]) then
1068 begin
1069 vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
1070 if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
1071 begin
1072 vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString +
1073 ' )';
1074 end
1075 else
1076 begin
1077 end;
1078 end;
1079 end;
1080 vSpName := Fini.ReadString('Update', 'Prefix', '');
1081 vReplace := memUpdate.Lines.Text;
1082 vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
1083 vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
1084 vReplace := AnsiReplaceStr(vReplace, '', vFields);
1085 vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
1086 vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
1087 vReplace := AnsiReplaceStr(vReplace, '', vUpDateKey);
1088 memscrUpdate.Lines.Text := vReplace;
1089end;
1090
1091procedure TfmMain.UpDateDatabase;
1092var
1093 vSpName: string;
1094 procedure Insert;
1095 begin
1096 try
1097 adoQry.Close;
1098 adoQry.SQL.Text := memScrInsert.Lines.Text;
1099 adoQry.ExecSQL;
1100 lblStatus.Caption := 'Insert Done';
1101 except
1102 lblStatus.Caption := 'Insert Failed';
1103 end;
1104 end;
1105 procedure Update;
1106 begin
1107 try
1108 adoQry.Close;
1109 adoQry.SQL.Text := memscrUpdate.Lines.Text;
1110 adoQry.ExecSQL;
1111 lblStatus.Caption := lblStatus.Caption + 'Update - Done'
1112 except
1113 lblStatus.Caption := lblStatus.Caption + 'Update - Failed'
1114 end;
1115 end;
1116 procedure Delete;
1117 begin
1118 try
1119 adoQry.Close;
1120 adoQry.SQL.Text := memScrDelete.Lines.Text;
1121 adoQry.ExecSQL;
1122 lblStatus.Caption := lblStatus.Caption + ', Delete - Done'
1123 except
1124 lblStatus.Caption := lblStatus.Caption + ', Delete - Failed'
1125 end;
1126 end;
1127begin
1128 vSpName := Fini.ReadString('Insert', 'Prefix', '') + FTblDisplayName;
1129 try
1130 adoQry.Close;
1131 adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
1132 #39 + vSpName + #39;
1133 adoQry.Open;
1134 if (adoQry.FieldByName('obj').AsInteger > 0) then
1135 begin
1136 if (MessageDlg('Insert', 'Stored Procedure ' + vSpName +
1137 ' already Exists, Over Write it ?', mtconfirmation, [mbYes, mbNo], 0) =
1138mrYes)
1139 then
1140 begin
1141 adoQry.Close;
1142 adoQry.SQL.Text := 'drop procedure ' + vSpName;
1143 try
1144 adoQry.ExecSQL;
1145 Insert;
1146 except
1147 ShowMessage('Could not delete ' + vSpName);
1148 end;
1149 end;
1150 end
1151 else
1152 Insert;
1153 except
1154 end;
1155
1156 if (lblStatus.Caption <> '') then
1157 lblStatus.Caption := lblStatus.Caption + ', ';
1158 vSpName := Fini.ReadString('Update', 'Prefix', '') + FTblDisplayName;
1159 try
1160 adoQry.Close;
1161 adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
1162 #39 + vSpName + #39;
1163 adoQry.Open;
1164 if (adoQry.FieldByName('obj').AsInteger > 0) then
1165 begin
1166 if (MessageDlg('Update', 'Stored Procedure ' + vSpName +
1167 ' already Exists, Over Write it ?', mtConfirmation, [mbYes, mbNo], 0) =
1168mrYes)
1169 then
1170 begin
1171 adoQry.Close;
1172 adoQry.SQL.Text := 'drop procedure ' + vSpName;
1173 try
1174 adoQry.ExecSQL;
1175 Update;
1176 except
1177 ShowMessage('Could not delete ' + vSpName);
1178 end;
1179 end;
1180 end
1181 else
1182 Update;
1183 except
1184 end;
1185
1186 if (lblStatus.Caption <> '') then
1187 lblStatus.Caption := lblStatus.Caption + ', ';
1188 vSpName := Fini.ReadString('Delete', 'Prefix', '') + FTblDisplayName;
1189 try
1190 adoQry.Close;
1191 adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
1192 #39 + vSpName + #39;
1193 adoQry.Open;
1194 if (adoQry.FieldByName('obj').AsInteger > 0) then
1195 begin
1196 if (MessageDlg('Delete', 'Stored Procedure ' + vSpName +
1197 ' already Exists, Over Write it ?', mtConfirmation, [mbYes, mbNo], 0) =
1198mrYes)
1199 then
1200 begin
1201 adoQry.Close;
1202 adoQry.SQL.Text := 'drop procedure ' + vSpName;
1203 try
1204 adoQry.ExecSQL;
1205 Delete;
1206 except
1207 ShowMessage('Could not delete ' + vSpName);
1208 end;
1209 end;
1210 end
1211 else
1212 Delete;
1213 except
1214 end;
1215end;
1216
1217procedure TfmMain.ScriptView;
1218var
1219 I: Integer;
1220 vScr: string;
1221begin
1222 vScr := '';
1223 sgView.RowCount := 1;
1224 sgView.Cells[0, 0] := '';
1225 clbView.Items := clbInsert.Items;
1226 // sgView.RowCount := ( clbInsert.Items.Count - 1 );
1227 for I := 0 to (clbInsert.Items.Count - 1) do
1228 begin
1229 if (I > 0) then
1230 sgView.RowCount := (I + 1);
1231 sgView.Cells[0, I] := clbInsert.Items[I];
1232 clbView.Checked[I] := true;
1233 end;
1234 GenScriptView;
1235end;
1236
1237procedure TfmMain.GenScriptView;
1238var
1239 I: Integer;
1240 vScr: string;
1241begin
1242 vScr := 'Create View ' + Fini.ReadString('View', 'Prefix', 'vw_') +
1243FTblDisplayName +
1244 ' As ' + #13 +
1245 ' Select ';
1246 for I := 0 to (clbView.Items.Count - 1) do
1247 begin
1248 if clbView.Checked[I] then
1249 begin
1250 if (I > 0) then
1251 vScr := vScr + ', ' + #13;
1252 if (I > 0) then
1253 vScr := vScr + ' ';
1254 vScr := vScr + clbView.Items[I];
1255 if (sgView.Cells[0, I] <> clbView.Items[I]) then
1256 begin
1257 vScr := vScr + ' [' + sgView.Cells[0, I] + ']';
1258 end
1259 else
1260 begin
1261 end;
1262 end;
1263 end;
1264 vScr := vScr + #13 + ' from ' + FSelectedTable;
1265 memView.Lines.Text := vScr;
1266end;
1267
1268procedure TfmMain.clbViewClickCheck(Sender: TObject);
1269begin
1270 GenScriptView;
1271end;
1272
1273procedure TfmMain.sgViewSetEditText(Sender: TObject; ACol, ARow: Integer;
1274 const Value: string);
1275begin
1276 GenScriptView;
1277end;
1278
1279procedure TfmMain.btnViewClick(Sender: TObject);
1280var
1281 vSpName: string;
1282 procedure ViewScript;
1283 begin
1284 try
1285 adoQry.Close;
1286 adoQry.SQL.Text := memView.Text;
1287 adoQry.ExecSQL;
1288 lblStatusView.Caption := 'View Created.';
1289 except
1290 lblStatusView.Caption := 'View Creation Failed';
1291 end;
1292 end;
1293begin
1294 vSpName := Fini.ReadString('View', 'Prefix', '') + FTblDisplayName;
1295 try
1296 adoQry.Close;
1297 adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
1298 #39 + vSpName + #39;
1299 adoQry.Open;
1300 if (adoQry.FieldByName('obj').AsInteger > 0) then
1301 begin
1302 if (Application.MessageBox(pchar('View ' + vSpName +
1303 ' already Exists, Over Write it ?'), pchar('View'), MB_YESNO) = 6) then
1304 begin
1305 // if ( MessageDlg( 'View', 'View ' + vSpName + ' already Exists, Over
1306write it ?', mtconfirmation, [mbYes, mbNo],0 ) = mrYes ) then begin
1307 adoQry.Close;
1308 adoQry.SQL.Text := '
1309 try
1310 adoQry.ExecSQL;
1311 ViewScript;
1312 except
1313 ShowMessage('Could not delete ' + vSpName);
1314 end;
1315 end;
1316 end
1317 else
1318 ViewScript;
1319 except
1320 end;
1321
1322end;
1323
1324end.
SpSettings.ini
[Insert]
Prefix=spIns_
Lines=16
Script0=CREATE PROCEDURE
Script1=AS
Script2=DECLARE @Err int, @RowC int
Script3=BEGIN TRAN
Script4=SET NOCOUNT ON
Script5=Insert into () values ( )
Script6=
Script7=Select @Err=@@Error,@RowC=@@RowCount
Script8=IF @Err <> 0
Script9=BEGIN
Script10=ROLLBACK TRAN
Script11=RAISERROR('Could not Add Information into ',16,-1)
Script12=RETURN
Script13=END
Script14=SET NOCOUNT OFF
Script15=COMMIT TRAN
Script16=GO
[Update]
Prefix=spUpd_
Lines=25
Script0=CREATE PROCEDURE
Script1=AS
Script2=DECLARE @Err int, @RowC int
Script3=BEGIN TRAN
Script4=SET NOCOUNT ON
Script5=Update set
Script6=where
Script7=
Script8=Select @Err=@@Error,@RowC=@@RowCount
Script9=
Script10=IF @RowC = 0
Script11=BEGIN
Script12=ROLLBACK TRAN
Script13=RAISERROR(' Information does not exist in ',16,-1)
Script14=RETURN
Script15=END
Script16=
Script17=IF @Err <> 0
Script18=BEGIN
Script19=ROLLBACK TRAN
Script20=RAISERROR('Could not Update Information in ',16,-1)
Script21=RETURN
Script22=END
Script23=SET NOCOUNT OFF
Script24=COMMIT TRAN
Script25=GO
Script26=GO
[Delete]
Prefix=spDel_
Lines=24
Script0=CREATE PROCEDURE
Script1=AS
Script2=DECLARE @Err int, @RowC int
Script3=BEGIN TRAN
Script4=SET NOCOUNT ON
Script5=Delete from where
Script6=
Script7=Select @Err=@@Error,@RowC=@@RowCount
Script8=
Script9=IF @RowC = 0
Script10=BEGIN
Script11=ROLLBACK TRAN
Script12=RAISERROR('Information does not exist in ',16,-1)
Script13=RETURN
Script14=END
Script15=
Script16=IF @Err <> 0
Script17=BEGIN
Script18=ROLLBACK TRAN
Script19=RAISERROR('Could not Delete Information from ',16,-1)
Script20=RETURN
Script21=END
Script22=SET NOCOUNT OFF
Script23=COMMIT TRAN
Script24=GO
Script25=
Script26=
[View]
Prefix=vw_
|
