Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How can I create Stored Procedures and Views with out Knowing the Scripts ? Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
17-Aug-03
Category
DB-General
Language
Delphi 2.x
Views
121
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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_ 

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC