www.pudn.com > GenerateSQL.rar > UMain.pas

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.