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_

Nincsenek megjegyzések:

Megjegyzés küldése