2006. január 11., szerda
Utility to Generate the Stored procedures and views of a SQL Database
Problem/Question/Abstract:
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
program GenerateSp;
uses
Forms,
Main in 'Main.pas' {fmMain};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfmMain, fmMain);
Application.Run;
end.
Main.dfm file
object fmMain: TfmMain
Left = 37
Top = 103
Width = 1225
Height = 759
ActiveControl = edtsrv
Caption = 'fmMain'
Color = clBtnFace
Constraints.MinHeight = 759
Constraints.MinWidth = 1225
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 120
TextHeight = 16
object Label1: TLabel
Left = 44
Top = 12
Width = 46
Height = 16
Caption = 'Server :'
end
object Label2: TLabel
Left = 24
Top = 38
Width = 66
Height = 16
Caption = 'Database :'
end
object Label3: TLabel
Left = 15
Top = 64
Width = 75
Height = 16
Caption = 'User Name :'
end
object Label4: TLabel
Left = 24
Top = 91
Width = 66
Height = 16
Caption = 'Password :'
end
object lblConn: TLabel
Left = 98
Top = 140
Width = 3
Height = 16
end
object Label5: TLabel
Left = 3
Top = 138
Width = 89
Height = 16
Caption = 'Table Names :'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object edtsrv: TEdit
Left = 96
Top = 8
Width = 137
Height = 24
TabOrder = 0
end
object edtdb: TEdit
Left = 96
Top = 34
Width = 137
Height = 24
TabOrder = 1
end
object edtUn: TEdit
Left = 96
Top = 60
Width = 137
Height = 24
TabOrder = 2
end
object edtPw: TEdit
Left = 96
Top = 87
Width = 137
Height = 24
PasswordChar = '@'
TabOrder = 3
end
object btnConnect: TButton
Left = 96
Top = 112
Width = 75
Height = 25
Caption = 'Connect'
TabOrder = 4
OnClick = btnConnectClick
end
object pcMain: TPageControl
Left = 240
Top = 0
Width = 977
Height = 726
ActivePage = tsFields
Align = alRight
TabIndex = 0
TabOrder = 5
object tsFields: TTabSheet
Caption = 'Select Fields'
object Bevel1: TBevel
Left = 0
Top = 221
Width = 976
Height = 9
Shape = bsTopLine
end
object Bevel3: TBevel
Left = -19
Top = 440
Width = 994
Height = 9
Shape = bsTopLine
end
object Bevel4: TBevel
Left = -11
Top = 656
Width = 992
Height = 9
Shape = bsTopLine
end
object Label6: TLabel
Left = 8
Top = 0
Width = 92
Height = 16
Caption = 'Fields To Insert'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object Label7: TLabel
Left = 3
Top = 226
Width = 129
Height = 16
Caption = 'Key Fields for Update'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object Label8: TLabel
Left = 3
Top = 444
Width = 134
Height = 16
Caption = 'Key Fields for Deletion'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object lblStatus: TLabel
Left = 280
Top = 664
Width = 3
Height = 16
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object clbInsert: TCheckListBox
Left = 1
Top = 18
Width = 185
Height = 198
ItemHeight = 16
TabOrder = 0
end
object clbUpdate: TCheckListBox
Left = 1
Top = 244
Width = 185
Height = 193
ItemHeight = 16
TabOrder = 1
end
object clbDelete: TCheckListBox
Left = 1
Top = 461
Width = 185
Height = 193
ItemHeight = 16
TabOrder = 2
end
object btnOk: TBitBtn
Left = 809
Top = 664
Width = 75
Height = 25
Caption = 'Ok'
TabOrder = 3
OnClick = btnOkClick
end
object btnClose: TBitBtn
Left = 889
Top = 664
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 4
OnClick = btnCloseClick
end
object memScrInsert: TMemo
Left = 194
Top = 18
Width = 769
Height = 201
ScrollBars = ssBoth
TabOrder = 5
end
object memscrUpdate: TMemo
Left = 194
Top = 244
Width = 769
Height = 193
ScrollBars = ssBoth
TabOrder = 6
end
object memScrDelete: TMemo
Left = 194
Top = 461
Width = 769
Height = 193
ScrollBars = ssBoth
TabOrder = 7
end
object chbInsert: TCheckBox
Left = 0
Top = 668
Width = 81
Height = 17
Caption = 'Sp Insert'
Checked = True
State = cbChecked
TabOrder = 8
end
object chbUpdate: TCheckBox
Left = 80
Top = 668
Width = 88
Height = 17
Caption = 'Sp UpDate'
Checked = True
State = cbChecked
TabOrder = 9
end
object chbDelete: TCheckBox
Left = 179
Top = 668
Width = 81
Height = 17
Caption = 'Sp Delete'
Checked = True
State = cbChecked
TabOrder = 10
end
end
object tsTemplate: TTabSheet
Caption = 'Templates'
ImageIndex = 1
object Bevel2: TBevel
Left = -6
Top = 218
Width = 984
Height = 9
Shape = bsTopLine
end
object Bevel5: TBevel
Left = -24
Top = 440
Width = 1002
Height = 9
Shape = bsTopLine
end
object Bevel6: TBevel
Left = -22
Top = 665
Width = 1000
Height = 9
Shape = bsTopLine
end
object Label9: TLabel
Left = 16
Top = -2
Width = 32
Height = 16
Caption = 'Insert'
end
object Label10: TLabel
Left = 16
Top = 221
Width = 45
Height = 16
Caption = 'Update'
end
object Label11: TLabel
Left = 16
Top = 444
Width = 43
Height = 16
Caption = 'Delete '
end
object btnok1: TBitBtn
Left = 809
Top = 669
Width = 75
Height = 25
Caption = 'Ok'
TabOrder = 0
OnClick = btnok1Click
end
object btnCancel: TBitBtn
Left = 889
Top = 669
Width = 75
Height = 25
Caption = 'Cancel'
TabOrder = 1
end
object memInsert: TMemo
Left = 16
Top = 13
Width = 946
Height = 201
ScrollBars = ssBoth
TabOrder = 2
end
object memUpdate: TMemo
Left = 16
Top = 237
Width = 946
Height = 201
ScrollBars = ssBoth
TabOrder = 3
end
object memDelete: TMemo
Left = 16
Top = 461
Width = 946
Height = 201
ScrollBars = ssBoth
TabOrder = 4
end
end
object tbPrefix: TTabSheet
Caption = 'Prefixes'
ImageIndex = 2
object Label12: TLabel
Left = 24
Top = 32
Width = 38
Height = 16
Caption = 'Insert :'
end
object Label13: TLabel
Left = 16
Top = 112
Width = 46
Height = 16
Caption = 'Delete :'
end
object Label14: TLabel
Left = 11
Top = 72
Width = 51
Height = 16
Caption = 'Update :'
end
object Label15: TLabel
Left = 27
Top = 148
Width = 35
Height = 16
Caption = 'View :'
end
object edtInsert: TEdit
Left = 66
Top = 28
Width = 121
Height = 24
TabOrder = 0
end
object edtUpdate: TEdit
Left = 66
Top = 68
Width = 121
Height = 24
TabOrder = 1
end
object edtDelete: TEdit
Left = 66
Top = 108
Width = 121
Height = 24
TabOrder = 2
end
object btnOk2: TBitBtn
Left = 67
Top = 183
Width = 75
Height = 23
Caption = 'Ok'
TabOrder = 3
OnClick = btnOk2Click
end
object edtView: TEdit
Left = 66
Top = 144
Width = 121
Height = 24
TabOrder = 4
end
end
object tbViews: TTabSheet
Caption = 'Views'
ImageIndex = 3
object Label16: TLabel
Left = 4
Top = 5
Width = 151
Height = 16
Caption = 'Fields To Include in View'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object Label17: TLabel
Left = 233
Top = 5
Width = 86
Height = 16
Caption = 'Display Name'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object lblStatusView: TLabel
Left = 604
Top = 340
Width = 36
Height = 16
Caption = 'wwww'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object sgView: TStringGrid
Left = 232
Top = 24
Width = 249
Height = 665
ColCount = 2
DefaultRowHeight = 19
FixedCols = 0
RowCount = 1
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect, goEditing]
TabOrder = 0
OnSetEditText = sgViewSetEditText
ColWidths = (
243
64)
RowHeights = (
20)
end
object memView: TMemo
Left = 483
Top = 24
Width = 481
Height = 305
TabOrder = 1
end
object clbView: TCheckListBox
Left = 1
Top = 24
Width = 230
Height = 665
OnClickCheck = clbViewClickCheck
Columns = 1
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -17
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemHeight = 20
ParentFont = False
TabOrder = 2
end
object btnView: TButton
Left = 488
Top = 336
Width = 97
Height = 25
Caption = 'Create View'
TabOrder = 3
OnClick = btnViewClick
end
end
end
object lbTables: TListBox
Left = 0
Top = 160
Width = 233
Height = 559
ItemHeight = 16
TabOrder = 6
OnMouseUp = lbTablesMouseUp
end
object adoConn: TADOConnection
ConnectionString =
'Provider=SQLOLEDB.1;Password=Robotech!;Persist Security Info=Tru' +
'e;User ID=sa;Initial Catalog=Dependency;Data Source=devrequest'
Provider = 'SQLOLEDB.1'
Left = 504
Top = 72
end
object adoQry: TADOQuery
Connection = adoConn
Parameters = <>
Left = 472
Top = 72
end
end
Main.pas file
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, Menus, Buttons, ExtCtrls, CheckLst,
ComCtrls, IniFiles, StrUtils, QDialogs, Grids;
type
TfmMain = class(TForm)
adoConn: TADOConnection;
adoQry: TADOQuery;
Label1: TLabel;
edtsrv: TEdit;
Label2: TLabel;
edtdb: TEdit;
Label3: TLabel;
Label4: TLabel;
edtUn: TEdit;
edtPw: TEdit;
btnConnect: TButton;
lblConn: TLabel;
Label5: TLabel;
pcMain: TPageControl;
tsFields: TTabSheet;
tsTemplate: TTabSheet;
clbInsert: TCheckListBox;
clbUpdate: TCheckListBox;
clbDelete: TCheckListBox;
Bevel1: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
btnOk: TBitBtn;
btnClose: TBitBtn;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
lbTables: TListBox;
Bevel2: TBevel;
Bevel5: TBevel;
Bevel6: TBevel;
btnok1: TBitBtn;
btnCancel: TBitBtn;
memInsert: TMemo;
memUpdate: TMemo;
memDelete: TMemo;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
memScrInsert: TMemo;
memscrUpdate: TMemo;
memScrDelete: TMemo;
tbPrefix: TTabSheet;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
edtInsert: TEdit;
edtUpdate: TEdit;
edtDelete: TEdit;
btnOk2: TBitBtn;
lblStatus: TLabel;
chbInsert: TCheckBox;
chbUpdate: TCheckBox;
chbDelete: TCheckBox;
Label15: TLabel;
edtView: TEdit;
tbViews: TTabSheet;
sgView: TStringGrid;
memView: TMemo;
clbView: TCheckListBox;
Label16: TLabel;
Label17: TLabel;
btnView: TButton;
lblStatusView: TLabel;
procedure btnConnectClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure lbTablesMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnCloseClick(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnOk2Click(Sender: TObject);
procedure btnok1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure clbViewClickCheck(Sender: TObject);
procedure sgViewSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
procedure btnViewClick(Sender: TObject);
private
{ Private declarations }
Fini: TIniFile;
FTblDisplayName, FSelectedTable: string;
procedure GetTables;
procedure GetColumns;
procedure ScriptInsert;
procedure ScriptUpdate;
procedure ScriptDelete;
procedure ScriptView;
procedure UpDateDatabase;
procedure GenScriptView;
public
{ Public declarations }
end;
const
LengthFields = '173,175,106,62,239,108,231,165,167';
var
fmMain: TfmMain;
implementation
{$R *.dfm}
procedure TfmMain.btnConnectClick(Sender: TObject);
var
S: string;
begin
S := 'Provider=SQLOLEDB.1;Password=' + edtPw.Text + ';User ID=' + edtUn.Text +
';Initial Catalog=' + edtdb.Text + ';Data Source=' + edtsrv.Text;
adoConn.Close;
adoConn.ConnectionString := S;
lblConn.Font.Color := clGreen;
try
adoConn.Open;
lblConn.Caption := 'Connection Succeded';
except
lblConn.Font.Color := clRed;
lblConn.Caption := 'Connection Failed';
end;
GetTables;
end;
procedure TfmMain.GetTables;
begin
adoQry.SQL.Clear;
adoQry.SQL.Text := 'Select name from sysobjects where xtype = ' +
#39 + 'U' + #39 + ' order by name ';
try
adoQry.Open;
lbTables.Clear;
while (not adoQry.Eof) do
begin
if (adoQry.fieldbyname('name').AsString <> 'dtproperties') then
begin
lbTables.Items.Add(adoQry.fieldbyname('name').AsString);
end;
adoQry.Next;
end;
adoQry.Close;
except
end;
end;
procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
adoQry.Close;
adoConn.Close;
end;
procedure TfmMain.lbTablesMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
tp: TPoint;
begin
tp.X := X;
tp.Y := y;
FSelectedTable := lbTables.Items[lbTables.ItemAtPos(tp, true)];
FTblDisplayName := AnsiReplaceStr(FSelectedTable, 'tb_', '');
GetColumns;
ScriptInsert;
ScriptUpdate;
ScriptDelete;
ScriptView;
lblStatus.Caption := '';
lblStatusView.Caption := '';
end;
procedure TfmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfmMain.GetColumns;
var
vIdCol: string;
procedure FillClb(var clb: TCheckListBox);
var
I: word;
begin
adoQry.First;
clb.Clear;
while (not adoQry.Eof) do
begin
clb.Items.Add(adoQry.fieldbyname('name').AsString);
if (clb.Name = 'clbInsert') then
begin
clb.Checked[clb.Items.Count - 1] := True;
end
else
begin
end;
adoQry.Next;
end;
if (clb.Name <> 'clbInsert') then
begin
for I := 0 to (clb.Items.Count - 1) do
begin
if (pos(clb.Items[I], vIdCol) > 0) then
begin
clb.Checked[I] := True;
end;
end;
end;
end;
begin
vIdCol := '';
adoQry.Close;
adoQry.SQL.Clear;
adoQry.SQL.Text := 'select A.NAME from SYSCOLUMNS A, sysINDEXKEYS B where A.id = ' +
'( select id from sysobjects where name = ' + #39 + FSelectedTable + #39 + ' )' +
' and (a.Id = b.Id ) and ( a.ColId = b.ColId ) order by a.colid';
try
adoQry.Open;
while (not adoQry.Eof) do
begin
vIdCol := vIdCol + adoQry.fieldbyname('name').AsString + '#';
adoQry.Next;
end;
except
end;
adoQry.Close;
adoQry.SQL.Clear;
adoQry.SQL.Text := 'select name from syscolumns where id = ' +
'( select id from sysobjects where name = ' +
#39 + FSelectedTable + #39 + ' ) order by colid';
try
adoQry.Open;
FillClb(clbInsert);
FillClb(clbUpdate);
FillClb(clbDelete);
adoQry.Close;
except
end;
end;
procedure TfmMain.ScriptInsert;
var
vFields: string;
vParamsType: string;
vParams: string;
vReplace: string;
I: Integer;
vSpName: string;
begin
adoQry.Close;
adoQry.SQL.Text := 'Select a.name, b.name dt, a.xtype, a.length FROM SYSCOLUMNS a,'
+
'systypes b where a.id = ( select id from sysobjects where name = ' +
#39 + FSelectedTable + #39 + ' ) and ( b.xtype = a.xtype )';
try
adoQry.Open;
except
end;
vFields := '';
vParams := '';
vParamsType := '';
for I := 0 to (clbInsert.Items.Count - 1) do
begin
if (clbInsert.Checked[I]) then
begin
if (vFields <> '') then
vFields := vFields + ', ';
vFields := vFields + clbInsert.Items[I];
if (vParamsType <> '') then
vParamsType := vParamsType + ', ';
vParamsType := vParamsType + '@' + clbInsert.Items[I] + ' ';
if (vParams <> '') then
vParams := vParams + ', ';
vParams := vParams + '@' + clbInsert.Items[I] + ' ';
if adoQry.Locate('name', clbInsert.Items[I], [locaseinsensitive]) then
begin
vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
begin
vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString +
' )';
end
else
begin
end;
end;
end;
end;
vSpName := Fini.ReadString('Insert', 'Prefix', '');
vReplace := memInsert.Lines.Text;
vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', vFields);
vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
vReplace := AnsiReplaceStr(vReplace, '', vParams);
memScrInsert.Lines.Text := vReplace;
end;
procedure TfmMain.btnOkClick(Sender: TObject);
begin
UpDateDatabase;
end;
procedure TfmMain.FormCreate(Sender: TObject);
begin
Fini := TIniFile.Create(ExtractFileDir(Application.ExeName) + '\SpSettings.Ini');
if (not Fini.SectionExists('Insert')) then
begin
Fini.WriteString('Insert', 'Prefix', '');
end;
if (not Fini.SectionExists('Update')) then
begin
Fini.WriteString('Update', 'Prefix', '');
end;
if (not Fini.SectionExists('Delete')) then
begin
Fini.WriteString('Delete', 'Prefix', '');
end;
Fini.UpdateFile;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
begin
Fini.Free;
Fini := nil;
end;
procedure TfmMain.btnOk2Click(Sender: TObject);
begin
Fini.WriteString('Insert', 'Prefix', edtInsert.Text);
Fini.WriteString('Update', 'Prefix', edtUpdate.Text);
Fini.WriteString('delete', 'Prefix', edtDelete.Text);
Fini.WriteString('View', 'Prefix', edtView.Text);
Fini.UpdateFile;
end;
procedure TfmMain.btnok1Click(Sender: TObject);
var
I: Integer;
begin
Fini.WriteInteger('Insert', 'Lines', memInsert.Lines.Count - 1);
for I := 0 to (memInsert.Lines.Count - 1) do
begin
Fini.WriteString('Insert', 'Script' + Inttostr(I), memInsert.Lines[I]);
end;
Fini.WriteInteger('Update', 'Lines', memUpdate.Lines.Count - 1);
for I := 0 to (memUpdate.Lines.Count - 1) do
begin
Fini.WriteString('Update', 'Script' + Inttostr(I), memUpdate.Lines[I]);
end;
Fini.WriteInteger('Delete', 'Lines', memDelete.Lines.Count - 1);
for I := 0 to (memUpdate.Lines.Count - 1) do
begin
Fini.WriteString('delete', 'Script' + Inttostr(I), memDelete.Lines[I]);
end;
Fini.UpdateFile;
end;
procedure TfmMain.FormShow(Sender: TObject);
var
I: Integer;
begin
edtInsert.Text := Fini.ReadString('Insert', 'Prefix', '');
edtUpdate.Text := Fini.ReadString('Update', 'Prefix', '');
edtDelete.Text := Fini.ReadString('delete', 'Prefix', '');
edtView.Text := Fini.ReadString('View', 'Prefix', '');
memInsert.Clear;
for I := 0 to (Fini.ReadInteger('Insert', 'Lines', 0)) do
begin
memInsert.Lines.Add(Fini.ReadString('Insert', 'Script' + intTostr(I), ''));
end;
memUpdate.Clear;
for I := 0 to (Fini.ReadInteger('Update', 'Lines', 0)) do
begin
memUpdate.Lines.Add(Fini.ReadString('Update', 'Script' + intTostr(I), ''));
end;
memDelete.Clear;
for I := 0 to (Fini.ReadInteger('delete', 'Lines', 0)) do
begin
memDelete.Lines.Add(Fini.ReadString('Delete', 'Script' + intTostr(I), ''));
end;
sgView.Cells[0, 0] := 'Table Fields';
sgView.Cells[1, 0] := 'Display Name';
end;
procedure TfmMain.ScriptDelete;
var
vDeleteKey: string;
vParamsType: string;
vReplace: string;
I: Integer;
vSpName: string;
begin
vDeleteKey := '';
for I := 0 to (clbDelete.Items.Count - 1) do
begin
if (clbDelete.Checked[I]) then
begin
if (vDeleteKey <> '') then
vDeleteKey := vDeleteKey + ' and ';
vDeleteKey := vDeleteKey + ' (' + clbDelete.Items[I] + ' = @' +
clbDelete.Items[I] + ') ';
if (vParamsType <> '') then
vParamsType := vParamsType + ', ';
vParamsType := vParamsType + '@' + clbUpdate.Items[I] + ' ';
if adoQry.Locate('name', clbDelete.Items[I], [locaseinsensitive]) then
begin
vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
begin
vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString +
' )';
end
else
begin
end;
end;
end
else
begin
end;
end;
vSpName := Fini.ReadString('delete', 'Prefix', '');
vReplace := memDelete.Lines.Text;
vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', vDeleteKey);
vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
memScrDelete.Lines.Text := vReplace;
end;
procedure TfmMain.ScriptUpdate;
var
vUpdateFields: string;
vUpDateKey: string;
vFields: string;
vParamsType: string;
vParams: string;
vReplace: string;
I: Integer;
vSpName: string;
begin
vUpdateFields := '';
vUpDateKey := '';
vFields := '';
vParams := '';
vParamsType := '';
for I := 0 to (clbUpdate.Items.Count - 1) do
begin
if (clbUpdate.Checked[I]) then
begin
if (vUpDateKey <> '') then
vUpDateKey := vUpDateKey + ' and ';
vUpDateKey := vUpDateKey + ' (' + clbUpdate.Items[I] + ' = @' +
clbUpdate.Items[I] + ') ';
end
else
begin
if (vFields <> '') then
vFields := vFields + ', ';
vFields := vFields + ' ' + clbUpdate.Items[I] + ' = ' + '@' + clbUpdate.Items[I]
+ ' ';
end;
if (vParamsType <> '') then
vParamsType := vParamsType + ', ';
vParamsType := vParamsType + '@' + clbUpdate.Items[I] + ' ';
if (vParams <> '') then
vParams := vParams + ', ';
vParams := vParams + '@' + clbInsert.Items[I] + ' ';
if adoQry.Locate('name', clbInsert.Items[I], [locaseinsensitive]) then
begin
vParamsType := vParamsType + adoQry.fieldbyname('dt').AsString + ' ';
if (pos(adoQry.fieldbyname('xtype').AsString, LengthFields) > 0) then
begin
vParamsType := vParamsType + '( ' + adoQry.fieldbyname('length').AsString +
' )';
end
else
begin
end;
end;
end;
vSpName := Fini.ReadString('Update', 'Prefix', '');
vReplace := memUpdate.Lines.Text;
vReplace := AnsiReplaceStr(vReplace, '', FSelectedTable);
vReplace := AnsiReplaceStr(vReplace, '', vSpName + FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', vFields);
vReplace := AnsiReplaceStr(vReplace, '', vParamsType);
vReplace := AnsiReplaceStr(vReplace, '', FTblDisplayName);
vReplace := AnsiReplaceStr(vReplace, '', vUpDateKey);
memscrUpdate.Lines.Text := vReplace;
end;
procedure TfmMain.UpDateDatabase;
var
vSpName: string;
procedure Insert;
begin
try
adoQry.Close;
adoQry.SQL.Text := memScrInsert.Lines.Text;
adoQry.ExecSQL;
lblStatus.Caption := 'Insert Done';
except
lblStatus.Caption := 'Insert Failed';
end;
end;
procedure Update;
begin
try
adoQry.Close;
adoQry.SQL.Text := memscrUpdate.Lines.Text;
adoQry.ExecSQL;
lblStatus.Caption := lblStatus.Caption + 'Update - Done'
except
lblStatus.Caption := lblStatus.Caption + 'Update - Failed'
end;
end;
procedure Delete;
begin
try
adoQry.Close;
adoQry.SQL.Text := memScrDelete.Lines.Text;
adoQry.ExecSQL;
lblStatus.Caption := lblStatus.Caption + ', Delete - Done'
except
lblStatus.Caption := lblStatus.Caption + ', Delete - Failed'
end;
end;
begin
vSpName := Fini.ReadString('Insert', 'Prefix', '') + FTblDisplayName;
try
adoQry.Close;
adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
#39 + vSpName + #39;
adoQry.Open;
if (adoQry.FieldByName('obj').AsInteger > 0) then
begin
if (MessageDlg('Insert', 'Stored Procedure ' + vSpName +
' already Exists, Over Write it ?', mtconfirmation, [mbYes, mbNo], 0) = mrYes)
then
begin
adoQry.Close;
adoQry.SQL.Text := 'drop procedure ' + vSpName;
try
adoQry.ExecSQL;
Insert;
except
ShowMessage('Could not delete ' + vSpName);
end;
end;
end
else
Insert;
except
end;
if (lblStatus.Caption <> '') then
lblStatus.Caption := lblStatus.Caption + ', ';
vSpName := Fini.ReadString('Update', 'Prefix', '') + FTblDisplayName;
try
adoQry.Close;
adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
#39 + vSpName + #39;
adoQry.Open;
if (adoQry.FieldByName('obj').AsInteger > 0) then
begin
if (MessageDlg('Update', 'Stored Procedure ' + vSpName +
' already Exists, Over Write it ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes)
then
begin
adoQry.Close;
adoQry.SQL.Text := 'drop procedure ' + vSpName;
try
adoQry.ExecSQL;
Update;
except
ShowMessage('Could not delete ' + vSpName);
end;
end;
end
else
Update;
except
end;
if (lblStatus.Caption <> '') then
lblStatus.Caption := lblStatus.Caption + ', ';
vSpName := Fini.ReadString('Delete', 'Prefix', '') + FTblDisplayName;
try
adoQry.Close;
adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
#39 + vSpName + #39;
adoQry.Open;
if (adoQry.FieldByName('obj').AsInteger > 0) then
begin
if (MessageDlg('Delete', 'Stored Procedure ' + vSpName +
' already Exists, Over Write it ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes)
then
begin
adoQry.Close;
adoQry.SQL.Text := 'drop procedure ' + vSpName;
try
adoQry.ExecSQL;
Delete;
except
ShowMessage('Could not delete ' + vSpName);
end;
end;
end
else
Delete;
except
end;
end;
procedure TfmMain.ScriptView;
var
I: Integer;
vScr: string;
begin
vScr := '';
sgView.RowCount := 1;
sgView.Cells[0, 0] := '';
clbView.Items := clbInsert.Items;
// sgView.RowCount := ( clbInsert.Items.Count - 1 );
for I := 0 to (clbInsert.Items.Count - 1) do
begin
if (I > 0) then
sgView.RowCount := (I + 1);
sgView.Cells[0, I] := clbInsert.Items[I];
clbView.Checked[I] := true;
end;
GenScriptView;
end;
procedure TfmMain.GenScriptView;
var
I: Integer;
vScr: string;
begin
vScr := 'Create View ' + Fini.ReadString('View', 'Prefix', 'vw_') + FTblDisplayName +
' As ' + #13 +
' Select ';
for I := 0 to (clbView.Items.Count - 1) do
begin
if clbView.Checked[I] then
begin
if (I > 0) then
vScr := vScr + ', ' + #13;
if (I > 0) then
vScr := vScr + ' ';
vScr := vScr + clbView.Items[I];
if (sgView.Cells[0, I] <> clbView.Items[I]) then
begin
vScr := vScr + ' [' + sgView.Cells[0, I] + ']';
end
else
begin
end;
end;
end;
vScr := vScr + #13 + ' from ' + FSelectedTable;
memView.Lines.Text := vScr;
end;
procedure TfmMain.clbViewClickCheck(Sender: TObject);
begin
GenScriptView;
end;
procedure TfmMain.sgViewSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
begin
GenScriptView;
end;
procedure TfmMain.btnViewClick(Sender: TObject);
var
vSpName: string;
procedure ViewScript;
begin
try
adoQry.Close;
adoQry.SQL.Text := memView.Text;
adoQry.ExecSQL;
lblStatusView.Caption := 'View Created.';
except
lblStatusView.Caption := 'View Creation Failed';
end;
end;
begin
vSpName := Fini.ReadString('View', 'Prefix', '') + FTblDisplayName;
try
adoQry.Close;
adoQry.SQL.Text := 'Select count(1) obj from sysobjects where name = ' +
#39 + vSpName + #39;
adoQry.Open;
if (adoQry.FieldByName('obj').AsInteger > 0) then
begin
if (Application.MessageBox(pchar('View ' + vSpName +
' already Exists, Over Write it ?'), pchar('View'), MB_YESNO) = 6) then
begin
// if ( MessageDlg( 'View', 'View ' + vSpName + ' already Exists, Over Write it ?', mtconfirmation, [mbYes, mbNo],0 ) = mrYes ) then begin
adoQry.Close;
adoQry.SQL.Text := 'drop view ' + vSpName;
try
adoQry.ExecSQL;
ViewScript;
except
ShowMessage('Could not delete ' + vSpName);
end;
end;
end
else
ViewScript;
except
end;
end;
end.
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_
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése