u_frmimports.pas

数据表对拷程序。 做这个程序的本意是

{ By Cable Fan. 2004-09-18 }

unit u_frmImports;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, ExtCtrls, Buttons, ComCtrls, JvHLEditor,
  Menus, ActnList, ADODb, DB, IniFiles;

type
  TfrmImports = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    gpbSQL: TGroupBox;
    GroupBox1: TGroupBox;
    Panel6: TPanel;
    Panel7: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    cmbDescTB: TComboBox;
    Panel2: TPanel;
    sbnDescDown: TSpeedButton;
    sbnDescUp: TSpeedButton;
    clbDesc: TCheckListBox;
    GroupBox2: TGroupBox;
    Panel3: TPanel;
    Panel4: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    cmbSourceTB: TComboBox;
    Panel5: TPanel;
    sbnSourceDown: TSpeedButton;
    sbnSourceUp: TSpeedButton;
    clbSource: TCheckListBox;
    Panel8: TPanel;
    btnCreate: TButton;
    btnLoad: TButton;
    btnSave: TButton;
    btnExecute: TButton;
    StatusBar1: TStatusBar;
    btnSaveAs: TButton;
    sbnSourceConnect: TSpeedButton;
    sbnDescConnect: TSpeedButton;
    ActionList2: TActionList;
    Undo: TAction;
    Redo: TAction;
    Copy: TAction;
    Cut: TAction;
    Paste: TAction;
    Delete: TAction;
    SelectAll: TAction;
    PopupMenu1: TPopupMenu;
    Undo1: TMenuItem;
    R2: TMenuItem;
    N6: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    Delete1: TMenuItem;
    N12: TMenuItem;
    Paste1: TMenuItem;
    N7: TMenuItem;
    SelectAll1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ADOSource: TADOConnection;
    quySource: TADOQuery;
    edtSource: TEdit;
    edtDesc: TEdit;
    ADODesc: TADOConnection;
    quyDesc: TADOQuery;
    sbnSourceFirst: TSpeedButton;
    sbnSourceLast: TSpeedButton;
    sbnDescFist: TSpeedButton;
    sbnDescLast: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure UndoExecute(Sender: TObject);
    procedure RedoExecute(Sender: TObject);
    procedure CopyExecute(Sender: TObject);
    procedure CutExecute(Sender: TObject);
    procedure DeleteExecute(Sender: TObject);
    procedure SelectAllExecute(Sender: TObject);
    procedure SelectAllUpdate(Sender: TObject);
    procedure DeleteUpdate(Sender: TObject);
    procedure CutUpdate(Sender: TObject);
    procedure CopyUpdate(Sender: TObject);
    procedure RedoUpdate(Sender: TObject);
    procedure UndoUpdate(Sender: TObject);
    procedure PasteExecute(Sender: TObject);
    procedure PasteUpdate(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnSaveAsClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnExecuteClick(Sender: TObject);
    procedure sbnSourceUpClick(Sender: TObject);
    procedure sbnSourceDownClick(Sender: TObject);
    procedure sbnDescUpClick(Sender: TObject);
    procedure sbnDescDownClick(Sender: TObject);
    procedure sbnSourceConnectClick(Sender: TObject);
    procedure sbnDescConnectClick(Sender: TObject);
    procedure edtSourceChange(Sender: TObject);
    procedure edtDescChange(Sender: TObject);
    procedure cmbSourceTBChange(Sender: TObject);
    procedure cmbDescTBChange(Sender: TObject);
    procedure sbnSourceFirstClick(Sender: TObject);
    procedure sbnSourceLastClick(Sender: TObject);
    procedure sbnDescLastClick(Sender: TObject);
    procedure sbnDescFistClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    HLEditor: TJvHLEditor;
    SQLFileName: string;
    SourceCnStr, DescCnStr: string;
    function CheckModify: boolean;
    function SaveSQL(S: string): boolean;
    function GetConnectProperty(ConnectionString, PropertyName: string): string;
    function GetFieldList(CheckList: TCheckListBox): string;
    procedure CreateSQL(S: TStrings); 
    procedure HLEditorChangeStatus(Sender: TObject);
    procedure LoadSetting;
    procedure SaveSetting;
  public
    { Public declarations }
  end;

var
  frmImports: TfrmImports;

implementation

{$R *.dfm}

procedure TfrmImports.FormCreate(Sender: TObject);
begin
  HLEditor:= TJvHLEditor.Create(gpbSQL);
  HLEditor.Parent:= gpbSQL;
  HLEditor.Align:= alClient;
  //HLEditor.OnKeyDown:= SMKeyDown;
  HLEditor.PopupMenu:= PopupMenu1;
  //SM.ParentFont:= False;
  HLEditor.HighLighter:= hlSql;
  HLEditor.Visible:= True;
  HLEditor.OnChangeStatus:= HLEditorChangeStatus;

  LoadSetting;
end;

procedure TfrmImports.UndoExecute(Sender: TObject);
begin
//
  HLEditor.UndoBuffer.Undo;
end;

procedure TfrmImports.RedoExecute(Sender: TObject);
begin
//
  HLEditor.UndoBuffer.Redo;
end;

procedure TfrmImports.CopyExecute(Sender: TObject);
begin
//
  HLEditor.ClipboardCopy;
end;

procedure TfrmImports.CutExecute(Sender: TObject);
begin
//
  HLEditor.ClipboardCut;
end;

procedure TfrmImports.DeleteExecute(Sender: TObject);
begin
//
  HLEditor.DeleteSelected;
end;

procedure TfrmImports.SelectAllExecute(Sender: TObject);
begin
//
  HLEditor.SelectAll;
end;

procedure TfrmImports.SelectAllUpdate(Sender: TObject);
begin
//
  // Do nothing.
end;

procedure TfrmImports.DeleteUpdate(Sender: TObject);
begin
//
  Delete.Enabled:= HLEditor.CanCut;
end;

procedure TfrmImports.CutUpdate(Sender: TObject);
begin
//
  Cut.Enabled:= HLEditor.CanCut;
end;

procedure TfrmImports.CopyUpdate(Sender: TObject);
begin
//
  Copy.Enabled:= HLEditor.CanCopy;
end;

procedure TfrmImports.RedoUpdate(Sender: TObject);
begin
//
  //Redo.Enabled:= HLEditor.UndoBuffer.Count > 0;
  Redo.Enabled:= False;
end;

procedure TfrmImports.UndoUpdate(Sender: TObject);
begin
//
  Undo.Enabled:= HLEditor.UndoBuffer.CanUndo;
end;

procedure TfrmImports.PasteExecute(Sender: TObject);
begin
//
  HLEditor.ClipboardPaste;
end;

procedure TfrmImports.PasteUpdate(Sender: TObject);
begin
//
  Paste.Enabled:= HLEditor.CanPaste;
end;

procedure TfrmImports.btnCreateClick(Sender: TObject);
begin
  { 检查有效性 }
  if GetConnectProperty(ADOSource.ConnectionString, 'Data Source')
        <> GetConnectProperty(ADODesc.ConnectionString, 'Data Source') then
  begin
    MessageBox(Handle, PChar('不在同一个服务器(数据库)，无法生成SQL！'),
        PChar('无法生成SQL'), MB_ICONSTOP);
    exit;
  end;

  { 提示保存 }
  if (not HLEditor.Modified) or (HLEditor.Modified and CheckModify) then
  begin
    SQLFileName:= '';
    // Create the SQL sentence.
    CreateSQL(HLEditor.Lines);
  end;
end;

function TfrmImports.CheckModify: boolean;
var
  R: integer;
begin
  Result:= False;
  if HLEditor.Modified then
  begin
    R:= MessageBox(Handle, PChar('SQL语句已被修改，是否保存？'),
        PChar('保存确认'), MB_ICONQUESTION + MB_YESNOCANCEL);
    if R = ID_YES then
    begin
      btnSave.Click;
      Result:= True;
    end
    else if R = ID_NO then
    begin
      HLEditor.Modified:= False;
      Result:= True;
    end;
  end;
end;

procedure TfrmImports.btnLoadClick(Sender: TObject);
begin
  { 提示保存 }
  if (not HLEditor.Modified) or (HLEditor.Modified and CheckModify) then
  begin
    // Load SQL sentence
    try
      OpenDialog1.InitialDir:= ExtractFileDir(SQLFileName);
      if OpenDialog1.Execute then
      begin
        SQLFileName:= OpenDialog1.FileName;
        HLEditor.Lines.LoadFromFile(SQLFileName);
      end;
    except
      on e: exception do
        StatusBar1.SimpleText:= '错误：' + e.Message;
    end;
  end;
end;

procedure TfrmImports.btnSaveClick(Sender: TObject);
begin
  SaveSQL(SQLFileName);
end;

function TfrmImports.SaveSQL(S: string): boolean;
begin
  // Save SQL sentence
  Result:= False;
  try
    if S = '' then
    begin
      if not SaveDialog1.Execute then
      begin
        Result:= False;
        exit;
      end;
      SQLFileName:= SaveDialog1.FileName;
    end;

    HLEditor.Lines.SaveToFile(SQLFileName);
    HLEditor.Modified:= False;
    Result:= True;
  except
    on e: exception do
      StatusBar1.SimpleText:= '错误：' + e.Message;
  end;
end;

procedure TfrmImports.btnSaveAsClick(Sender: TObject);
begin
  SaveSQL('');
end;

procedure TfrmImports.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  { 提示保存 }
  if (HLEditor.Modified) and (not CheckModify) then
    CanClose:= False;
end;

procedure TfrmImports.btnExecuteClick(Sender: TObject);
begin
  { 检查有效性 }

  end;

procedure TfrmImports.HLEditorChangeStatus(Sender: TObject);
var
  S: string;
begin
  if HLEditor.Modified then
    S:= '*';
  Caption:= '数据表对拷程序' + S;
end;

{ Move source item up }
procedure TfrmImports.sbnSourceUpClick(Sender: TObject);
var
  i: integer;
begin
  { Move the selected item up 1 step }
  i:= clbSource.ItemIndex;
  if i > 0 then
  begin
    clbSource.Items.Move(i, i -1);
    clbSource.ItemIndex:= i -1; // Selected the item right
  end;
end;

{ Move source item down }
procedure TfrmImports.sbnSourceDownClick(Sender: TObject);
var
  i: integer;
begin
  { Move the selected item down 1 step }
  i:= clbSource.ItemIndex;
  if i < clbSource.Count -1 then
  begin
    clbSource.Items.Move(i, i +1);
    clbSource.ItemIndex:= i +1;
  end;
end;


{ Move destination item up }
procedure TfrmImports.sbnDescUpClick(Sender: TObject);
var
  i: integer;
begin
  { Move the selected item up 1 step }
  i:= clbDesc.ItemIndex;
  if i > 0 then
  begin
    clbDesc.Items.Move(i, i -1);
    clbDesc.ItemIndex:= i -1; // Selected the item right
  end;
end;

{ Move destination item down }
procedure TfrmImports.sbnDescDownClick(Sender: TObject);
var
  i: integer;
begin
  { Move the selected item down 1 step }
  i:= clbDesc.ItemIndex;
  if i < clbDesc.Count -1 then
  begin
    clbDesc.Items.Move(i, i +1);
    clbDesc.ItemIndex:= i +1;
  end;
end;

procedure TfrmImports.sbnSourceConnectClick(Sender: TObject);
var
  S: string;
begin
  S:= PromptDataSource(Application.Handle, SourceCnStr);
  if S <> '' then
  begin
    try
      SourceCnStr:= S;
      ADOSource.Close;
      ADOSource.ConnectionString:= SourceCnStr;
      ADOSource.Open;
      edtSource.Text:= GetConnectProperty(SourceCnStr, 'Data Source') + '\'
        + GetConnectProperty(SourceCnStr, 'Initial Catalog');
      ADOSource.GetTableNames(cmbSourceTB.Items);
    except
      on e: Exception do
      begin
        StatusBar1.SimpleText:= '错误：' + e.Message;
        edtSource.Text:= '';
      end;
    end;
  end;
end;

function TfrmImports.GetConnectProperty(ConnectionString, PropertyName: string): string;
var
  i, j: integer;
  S: string;
begin
  Result:= '';
  i:= pos(PropertyName, ConnectionString);
  if i > 0 then
  begin
    S:= system.copy(ConnectionString, i, length(ConnectionString));
    i:= pos('=', S);
    j:= pos(';', S);
    if j > 0 then
      Result:= system.copy(S, i + 1, j - i - 1)
    else        
      Result:= system.copy(S, i + 1, Length(S));
  end;
end;

procedure TfrmImports.sbnDescConnectClick(Sender: TObject);
var
  S: string;
begin
  S:= PromptDataSource(Application.Handle, DescCnStr);
  if S <> '' then
  begin
    try
      DescCnStr:= S;
      ADODesc.Close;
      ADODesc.ConnectionString:= DescCnStr;
      ADODesc.Open;
      edtDesc.Text:= GetConnectProperty(DescCnStr, 'Data Source') + '\'
        + GetConnectProperty(DescCnStr, 'Initial Catalog');
      ADODesc.GetTableNames(cmbDescTB.Items, False);
    except
      on e: Exception do
      begin
        StatusBar1.SimpleText:= '错误：' + e.Message;
        edtDesc.Text:= '';
      end;
    end;
  end;
end;

procedure TfrmImports.edtSourceChange(Sender: TObject);
begin
  cmbSourceTB.Enabled:= edtSource.Text <> '';
end;

procedure TfrmImports.edtDescChange(Sender: TObject);
begin
  cmbDescTB.Enabled:= edtDesc.Text <> '';
end;

procedure TfrmImports.cmbSourceTBChange(Sender: TObject);
begin
  with quySource do
  begin
    Close;
    SQL.Text:= 'select top 1 * from ' + cmbSourceTB.Text;
    Open;
    GetFieldNames(clbSource.Items);
  end;
end;

procedure TfrmImports.cmbDescTBChange(Sender: TObject);
begin
  with quyDesc do
  begin
    Close;
    SQL.Text:= 'select top 1 * from ' + cmbDEscTB.Text;
    Open;
    GetFieldNames(clbDesc.Items);
  end;
end;

function TfrmImports.GetFieldList(CheckList: TCheckListBox): string;
var
  i: integer;
begin
  for i:= 0 to CheckList.Count -1 do
  begin
    if CheckList.Checked[i] then
      Result:= Result + '[' + CheckList.Items[i] + '],';
  end;
  Result:= System.copy(Result, 1, Length(Result) -1);
end;

procedure TfrmImports.CreateSQL(S: TStrings);
begin
  S.Clear;
  S.Add('INSERT INTO ' + cmbDescTB.Text + '(');
  S.Add(#9 + GetFieldList(clbDesc));
  S.Add(#9 + ')');
  S.Add('SELECT');
  S.Add(#9 + GetFieldList(clbSource));
  S.Add('FROM ' + cmbSourceTB.Text);
end;

procedure TfrmImports.sbnSourceFirstClick(Sender: TObject);
var
  i: integer;
begin
  i:= clbSource.ItemIndex;
  if i > 0 then
  begin
    clbSource.Items.Move(i, 0);
    clbSource.ItemIndex:= 0;
  end;
end;


procedure TfrmImports.sbnSourceLastClick(Sender: TObject);
var
  i: integer;
begin
  i:= clbSource.ItemIndex;
  if i < clbSource.Count -1 then
  begin
    clbSource.Items.Move(i, clbSource.Count -1);
    clbSource.ItemIndex:= clbSource.Count -1;
  end;
end;

procedure TfrmImports.sbnDescLastClick(Sender: TObject);
var
  i: integer;
begin
  i:= clbDesc.ItemIndex;
  if i < clbDesc.Count -1 then
  begin
    clbDesc.Items.Move(i, clbDesc.Count -1);
    clbDesc.ItemIndex:= clbDesc.Count -1;
  end;
end;

procedure TfrmImports.sbnDescFistClick(Sender: TObject);
var
  i: integer;
begin
  i:= clbDesc.ItemIndex;
  if i > 0 then
  begin
    clbDesc.Items.Move(i, 0);
    clbDesc.ItemIndex:= 0;
  end;
end;

{ Load setting from INI file }
procedure TfrmImports.SaveSetting;
var
  S: string;
begin
  S:= ExtractFilePath(Application.ExeName) + '\Setting.INI';
  with TIniFile.Create(S) do
  begin
    try
      //Showmessage(S);
      WriteString('Setting', 'SourceCnStr', SourceCnStr);
      WriteString('Setting', 'DescCnStr', DescCnStr);
    finally
      Free;
    end;
  end;
end;

{ Save setting to INI file }
procedure TfrmImports.LoadSetting;
var
  S: string;
begin
  S:= ExtractFilePath(Application.ExeName) + '\Setting.INI';
  with TIniFile.Create(GetCurrentDir + '\Setting.INI') do
  begin
    try
      SourceCnStr:= ReadString('Setting', 'SourceCnStr', '');
      DescCnStr:= ReadString('Setting', 'DescCnStr', '');
    finally
      Free;
    end;
  end;
end;

procedure TfrmImports.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveSetting;
end;

end.