umain.pas

将数据库中的记录生成Insert或Update语句

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, se_controls, KsSkinCheckBoxs, KsSkinEdits, KsSkinLabels,
  StdCtrls, ksskinstdcontrol, ExtCtrls, KsSkinListBoxs, KsSkinButtons,
  KsSkinProgress, KsSkinPanels, KsSkinEngine, DB, ADODB,strUtils;

type

  TfrmMain = class(TForm)
    SeSkinEngine1: TSeSkinEngine;
    plBottom: TSeSkinPanel;
    Progress: TSeSkinProgressBar;
    btnGenerate: TSeSkinButton;
    btnSave: TSeSkinButton;
    btnClose: TSeSkinButton;
    plClient: TSeSkinPanel;
    plLeft: TSeSkinPanel;
    lbTables: TSeSkinListBox;
    Splitter1: TSplitter;
    txtSQLS: TSeSkinMemo;
    plTop: TSeSkinPanel;
    plOracle: TSeSkinPanel;
    lblAuthentication: TSeSkinLabel;
    Label1: TSeSkinLabel;
    Label2: TSeSkinLabel;
    Label3: TSeSkinLabel;
    lblDatabase: TSeSkinLabel;
    rbWindows: TSeSkinRadioButton;
    rbMix: TSeSkinRadioButton;
    txtServer: TSeSkinEdit;
    txtUser: TSeSkinEdit;
    txtPassword: TSeSkinEdit;
    txtDatabase: TSeSkinEdit;
    rbOracle: TSeSkinRadioButton;
    rbSQLServer: TSeSkinRadioButton;
    chkUpdate: TSeSkinCheckBox;
    lblOrderBy: TSeSkinLabel;
    lblWhere: TSeSkinLabel;
    txtOrderby: TSeSkinEdit;
    txtWhere: TSeSkinEdit;
    btnConnect: TSeSkinButton;
    SaveDialog1: TSaveDialog;
    ADOConn: TADOConnection;
    qryData: TADOQuery;
    chkIncream: TSeSkinCheckBox;
    procedure rbOracleClick(Sender: TObject);
    procedure rbSQLServerClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure chkUpdateClick(Sender: TObject);
    procedure lbTablesDblClick(Sender: TObject);
    procedure txtOrderbyEnter(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSaveClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    cancel:boolean;

    function  ConnectToDatabase:boolean;
    function  GetFields:string;

    procedure LoadTables;
    procedure GenerateInsert;
    procedure GenerateUpdate;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function TfrmMain.ConnectToDatabase: boolean;
var
  ConnectString:string ;
begin
  if rbOracle.Checked then
   ConnectString := 'Provider=OraOLEDB.Oracle.1;Persist Security Info=True;'+
   'Data Source=(DESCRIPTION =(ADDRESS_LIST =(ADDRESS = (PROTOCOL = TCP)(HOST = '+
   txtserver.Text+')(PORT = 1521)))(CONNECT_DATA =(SERVICE_NAME = '+txtdatabase.Text+
   ')));User ID='+txtuser.Text+';Password='+txtpassword.Text
  else if rbSQLServer.Checked then
  If rbwindows.Checked Then
    ConnectString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=' + txtdatabase.text + ';Data Source=' + txtserver.text
  Else
    ConnectString := 'Provider=SQLOLEDB.1;Persist Security Info=True;User ID=' + txtuser.text + ';PASSWORD=' + txtpassword.text + ';Initial Catalog=' + txtdatabase.text + ';Data Source=' + txtserver.text;

  ADOConn.Close;
  ADOConn.ConnectionString :=ConnectString;
  ADOConn.ConnectionTimeout :=30;
  try
    ADOConn.Connected := true;
  except
    result:=false;
    exit;
  end;
  result:=true;
end;

procedure TfrmMain.rbOracleClick(Sender: TObject);
begin
  lblAuthentication.Visible := false;
  rbWindows.Visible         := false;
  rbMix.Visible             := false;
end;

procedure TfrmMain.rbSQLServerClick(Sender: TObject);
begin
  lblAuthentication.Visible := true;
  rbWindows.Visible         := true;
  rbMix.Visible             := true;
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
  if ConnectToDatabase=false then
  begin
    MessageDlg('连接数据库失败！',mtwarning,[mbok],0);
    exit;
  end;
  LoadTables;
end;

procedure TfrmMain.LoadTables;
var
  ds:TAdoDataSet;
  i:integer;
begin
  lbTables.Clear;

  ds:=TAdoDataSet.Create(self);
  ADOConn.OpenSchema(siTables,emptyparam,emptyparam,ds);

  for i:=1 to ds.RecordCount do
  begin
    if (ds.FieldByName('TABLE_TYPE').AsString = 'TABLE') or
       (ds.FieldByName('TABLE_TYPE').AsString = 'VIEW') then
    lbTables.Items.Add(ds.fieldbyname('TABLE_NAME').AsString);
    ds.Next ;
  end;
  ds.Close ;
  ds.Destroy ;
end;

procedure TfrmMain.chkUpdateClick(Sender: TObject);
begin
  If chkUpdate.Checked = false Then
  begin
    lblWhere.Caption   := 'Where ' ;
    lblOrderBy.Caption := 'Order By';
  end
  Else
  begin
    lblWhere.Caption   := 'Primary Key';
    lblOrderBy.Caption := 'Where';
  End;

end;

procedure TfrmMain.lbTablesDblClick(Sender: TObject);
begin
  txtSQLS.Clear;
  if lbTables.ItemIndex = -1 then exit;

  cancel := false;
  if chkUpdate.Checked = false then
    GenerateInsert
  else
    GenerateUpdate;
end;

function TfrmMain.GetFields: string;
var
  rs:_RecordSet;
  TableName:string;
  Fields:string;
  i:integer;
begin
  if lbTables.ItemIndex = -1 then exit;
  TableName := lbTables.Items[lbTables.ItemIndex];

  rs := AdoConn.Execute('select * from '+TableName+' where 1=2');

  Fields := '';

  For i := 0 To rs.Fields.Count -1 do
  begin
    If i <> rs.Fields.Count - 1 Then
      Fields := Fields + rs.Fields[i].Name + ','
    Else
      Fields := Fields + rs.Fields[i].Name ;
  end;
  result := Fields;
  rs.Close;
end;

procedure TfrmMain.txtOrderbyEnter(Sender: TObject);
begin
  txtOrderby.Text := GetFields;
end;

procedure TfrmMain.GenerateUpdate;
var
  TableName:string;
  i,j:integer;
  s,strSQL,where:string;
  varValue:Variant;
begin
  if lbTables.ItemIndex = -1 then exit;
  If Trim(txtWhere.Text) = '' Then
  begin
    MessageDlg('请输入PrimaryKey.',mtwarning,[mbok],0);
    Exit;
  End;

  TableName := lbTables.Items[lbTables.ItemIndex];

  If(Trim(txtOrderBy.Text)='') then
    where := ''
  else
    where := ' where '+Trim(txtOrderBy.Text);

  strSQL := 'select * from ' + TableName +where;
  qryData.Close;
  qryData.SQL.Text := strsql;
  qryData.Open ;

  If qryData.RecordCount = 0 Then exit;
  
  Progress.Max := qryData.RecordCount;
  For i := 1 To qryData.RecordCount do
  begin
    Application.ProcessMessages ;
    If cancel = True Then
    begin
      cancel := False;
      Exit;
    end;

    Progress.position := i;

    s := 'Update ' + TableName + ' set ';
    For j := 0 To qryData.Fields.Count - 1 do

      If (qryData.Fields[j].IsBlob=false) And
         (UpperCase(txtWhere.Text) <> UpperCase(qryData.Fields[j].FieldName)) Then
      begin
          varValue := qryData.Fields[j].Value;
          
          Case qryData.Fields[j].DataType of
            ftString, ftFixedChar, ftWideString:
              If varIsNull(varValue) Then
                s := s + qryData.Fields[j].FieldName + '=Null,'
              Else
                s := s + qryData.Fields[j].FieldName + '=''' + vartostr(varValue) +''',';
            ftBoolean: //Bool
              If varIsNull(varValue) Then
                s := s + qryData.Fields[j].FieldName + '=Null,'
              Else
                if qryData.Fields[j].AsBoolean then
                  s := s + qryData.Fields[j].FieldName + '=1,'
                else
                  s := s + qryData.Fields[j].FieldName + '=0,';
            ftDateTime,ftDate,ftTime: //datetime
              If varIsNull(varValue) Then
                s := s + qryData.Fields[j].FieldName + '=Null,'
              else
                If rbOracle.checked Then
                  s := s + qryData.Fields[j].FieldName + '=to_date('''+varvalue+''',''yyyy-mm-dd hh24:mi:ss''),'
                else
                  s := s + qryData.Fields[j].FieldName + '='''+varvalue+''',';
            Else
              If varIsNull(varValue) Then
                s := s + qryData.Fields[j].FieldName + '=Null,'
              Else
                s := s + qryData.Fields[j].FieldName + '=' +varValue +',';
          End ;
                 
      End;

    s := Leftstr(s, Length(widestring(s)) - 1) + ' where ' + txtWhere.Text +
    '='''+qrydata.Fieldbyname(txtWhere.Text).asstring + ''';';
    txtSQLS.lines.add(s);
    qrydata.Next;   
  end;

  txtOrderby.Text   := '';
  txtWhere.Text     := '';
  Progress.position := 0;
end;

procedure TfrmMain.GenerateInsert;
var
  strLineHeader:string;  //用来保存 "Insert into tblXXX (fieldlist , ...) Values"
  i,j:integer;
  s,strsql,TableName,where,orderby,str1:string;
  varValue : Variant;
begin

  TableName     := lbTables.Items[lbTables.ItemIndex];

  if trim(txtWhere.Text)='' then
    where := ''
  else
    If pos('where',txtWhere.Text) =0 Then
    where := ' where '+ trim(txtWhere.Text)
    else
    where := txtWhere.Text;

  if Trim(txtOrderBy.Text)='' then
    orderby := ''
  else
    orderby := ' Order by '+Trim(txtOrderBy.Text);

  strSQL := 'select * from ' + TableName + where + orderby;
  qryData.Close;
  qryData.SQL.Text := strSQL;
  qryData.Open;

  s := '';
  If qryData.RecordCount = 0 Then  exit;

  Progress.Max := qryData.RecordCount;

  s := 'Insert into ' +TableName+ '(';
  For j := 0 To qryData.Fields.Count - 1 do
  begin
    if (chkIncream.Checked  = true ) and
       (qrydata.Recordset.Fields[j].Properties['ISAUTOINCREMENT'].Value = true ) then continue;

    If (qryData.Fields[j].IsBlob ) Then continue;

    s := s + qryData.Fields[j].FieldName + ',';
  end;
  s := Leftstr(s, Length(s) - 1) ;
  s := s + ') values(';
  strLineHeader := s;

  For i := 1 To qryData.RecordCount do
  BEGIN
    Application.ProcessMessages;
    If cancel = True Then
    begin
      cancel := False ;
      Exit;
    End;

    Progress.Position := i;
    s := strLineHeader;
    For j := 0 To qryData.Fields.Count - 1 do
    begin

      if (chkIncream.Checked  = true ) and
       (qrydata.Recordset.Fields[j].Properties['ISAUTOINCREMENT'].Value = true) then continue;

      If (qryData.Fields[j].IsBlob ) Then continue;

      varValue := qryData.Fields[j].Value;

      Case qryData.Fields[j].DataType  of
        ftString, ftFixedChar, ftWideString,ftGuid	:
        begin
          If varIsNull(varValue) Then
            s := s + 'Null,'
          Else
          begin
            If varIsNull(varValue) Then
              str1 := ''
            else
              str1 := vartostr(varValue);
            s := s + '''' + str1 + ''',';
          End;
        end;

        ftDateTime,ftDate,ftTime: //datetime
          If varIsNull(varValue) Then
            s := s + 'Null,'
          Else
            If rbOracle.checked Then
              s := s + 'to_date(''' + vartostr(varValue)+''',''yyyy-mm-dd hh24:mi:ss''),'
            Else
              s := s + '''' + vartostr(varValue) + ''',';

        ftBoolean: //Bool
          If varIsNull(varValue) Then
            s := s + 'Null,'
          Else
            if qryData.Fields[j].asboolean then
              s := s + '1,'
            else
              s := s + '0,';
        Else
          If varIsNull(varValue) Then
            s := s + 'Null,'
          Else
            s := s + vartostr(varValue)+',';
      End;   //end case
     End; //end for fields
    s := Leftstr(s, length(widestring(s)) - 1) + ');' ;
    txtSQLS.lines.add(s);

    qryData.next;
  end;     //end for recordcount

  txtOrderBy.Text := '';
  txtWhere.Text := '';
  Progress.Position := 0;

end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
 close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 qryData.Close;
 AdoConn.Close;
end;

procedure TfrmMain.btnSaveClick(Sender: TObject);
var
  TableName:string;
begin
  if lbTables.ItemIndex = -1 then exit;
  TableName := lbTables.Items[lbTables.ItemIndex];

  SaveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
  SaveDialog1.FileName   := TableName+'.txt';

  if SaveDialog1.Execute = false then exit;

  txtSQLS.Lines.SaveToFile(SaveDialog1.FileName);  
end;

procedure TfrmMain.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then Cancel:=true;
end;

end.