...

Arsip: ToOl Is3ng BuaT mIndahIn dAta

 
user image
more 18 years ago

cyber_hecker

kekekeke.. :P, udah lama neh gak posting. hari ini mo posting satu biji ah :), sekaligus mo curhat-curhat :D kekekeke.... mungkin diantara temen-temen yang berprofesi sebagai freelance programmer pernah ngalamin kejadian waktu mbikin program dan program belum selesai (masih dalam tahap pembuatan) tapi program tersebut sudah dipakai. jadi kalo ada penambahan atau pengurangan field, tabel atau data, kita harus membackup databasenya, trus pindahin data dari database yang lama ke database baru yang sudah kita tambahin atau perbaharui tabel / fieldnya biar data yang ada didatabase adalah data terbaru. nah.. ini dia kerjaan yang paling bikin bete diriku. karena waktu mo mindahin datanya kan pertama harus di hapus dulu. iya kalo berjalan lancar. tapi paling sering data gak bisa dihapus begitu aja. tapi harus make urutan tertentu gara-gara ketabrak ama foreign key (constraint-nya).. gileeee bener.. kesel habis bro. udah itu waktu mindahin atau ngopy datanya juga begitu harus pake urutan. ihhh bikin kesel :(. walau sebenernya kita bisa melakukan semua proses tersebut make DTS, tapi ya gitu kadang-kadang males milih tabelnya. harus dipilih satu-satu dan cara milihnya repod... :P nah... iseng-iseng tadi malem mbikin tools yang fungsinya ya kayak gitu. kita milih tabelnya truz otomatis penghapusan dan pemindahan data. berikut ini listing lengkapnya : 

unit uPindahData;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, Buttons, ExtCtrls, Grids, DBGrids,
  SMDBGrid, ComCtrls;
type
  TFPindahData = class(TForm)
    svrSour: TADOConnection;
    svrDest: TADOConnection;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    gridList: TSMDBGrid;
    SMDBGrid3: TSMDBGrid;
    Panel1: TPanel;
    btnLoad: TBitBtn;
    qProsesSour: TADOQuery;
    qRefer: TADOQuery;
    qTableList: TADOQuery;
    qTableListTABLE_NAME: TStringField;
    qTableListURUT: TIntegerField;
    dsTableList: TDataSource;
    qReferREFE_ID: TIntegerField;
    qReferTABLE_R: TWideStringField;
    qReferFORE_ID: TIntegerField;
    qReferTABLE_F: TWideStringField;
    qReferID: TIntegerField;
    qReferKEY_NAME: TWideStringField;
    dsRefer: TDataSource;
    memLog: TMemo;
    optProcess: TRadioGroup;
    qColumnList: TADOQuery;
    qSourData: TADOQuery;
    qDestData: TADOQuery;
    dsSourData: TDataSource;
    dsDestData: TDataSource;
    ProgressBar1: TProgressBar;
    qProsesDest: TADOQuery;
    btnExecute: TBitBtn;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure btnLoadClick(Sender: TObject);
    procedure gridListDblClick(Sender: TObject);
    procedure SMDBGrid3DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    function myGetColumnList(const sTable: String): String;
    function myGetColumnAll(const sTable: String; var HaveInc: Integer):String;
    function myCreaExpoDelTempView(const qProses: TADOQuery): Boolean;
    function myCreaImpoDelTempView(const qProses: TADOQuery): Boolean;
    procedure myDelTableAndView(const qProses: TADOQuery);
    procedure myCreTableAndView(const qProses: TADOQuery);
    procedure myInsTable(const sDBase: String; const qProses: TADOQuery);
    procedure myOpenList;
    procedure myOpenRef(isDel: Boolean);
    procedure myAppendLog(sMessage: String);
    procedure myCheckChild;
    procedure myDelData(const qProses: TADOQuery);
    procedure myDelChild(const qProses: TADOQuery);
    procedure myMoveAll;
//  function myMoveData(sTable: String; const qSour, qDest: TADOQuery): Boolean;
  public
    { Public declarations }
  end;
var
  FPindahData: TFPindahData;
  sSourCon : WideString = 'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=RSUD;Data Source=GRAHA-03';
  sDestCon : WideString = 'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=RSUD;Data Source=GRAHA-05';
  fbpc : String = 'C:\Program Files\Microsoft SQL Server\80\Tools\Binn\bcp.exe';
  sDatabase : String = 'RSUD';
  sSourSvr : String = 'GRAHA-03';
  sDestSvr : String = 'GRAHA-05';
implementation
{$R .dfm}
{ fungsi ini adalah untuk menjalankan program eksternal / pengganti procedure WinExec,
  kelebihannya adalah ada fungsi wait. jadi sebelum proses selesai program tidak
  akan menjalankan perintah pada baris berikutnya ..............................}
function WinExecAndWait(const Path:  pCHAR;
                        const Visibility:  WORD;
                        const Wait:  BOOLEAN):  BOOLEAN;
  var
    ProcessInformation:  TProcessInformation;
    StartupInfo       :  TStartupInfo;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do begin
    cb          := SizeOf(TStartupInfo);
    lpReserved  := NIL;
    lpDesktop   := NIL;
    lpTitle     := NIL;
    dwFlags     := STARTF_USESHOWWINDOW;
    wShowWindow := Visibility;
    cbReserved2 := 0;
    lpReserved2 := NIL
  end;
  RESULT := CreateProcess(NIL,       {address of module name}
                          Path,      {address of command line}
                          NIL,       {address of process security attributes}
                          NIL,       {address of thread security attributes}
                          FALSE,     {new process inherits handle}
                          NORMAL_PRIORITY_CLASS,   {creation flags}
                          NIL,       {address of new environment block}
                          NIL,       {address of current directory name}
                          StartupInfo,
                          ProcessInformation);
  if RESULT then begin
    with ProcessInformation do begin
      if Wait then WaitForSingleObject(hProcess, INFINITE);
      CloseHandle(hThread);
      CloseHandle(hProcess)
    end
  end
end;
{ form create ..................................................................}
procedure TFPindahData.FormCreate(Sender: TObject);
begin
  svrSour.ConnectionString := sSourCon;
  svrDest.ConnectionString := sDestCon;
  Caption := 'Tools Server Moving And Deleteing !';
  memLog.Clear;
end;
{ membuat table dan view temporari untuk daftar list tabel yang ada ............}
procedure TFPindahData.myCreTableAndView(const qProses: TADOQuery);
begin
  with qProses do begin
    // buat table _foreign_key
    SQL.Clear;
    SQL.Append(
      'CREATE TABLE [dbo].[_FOREIGN_KEY] ( '+
      '  [TABLE_NAME] [varchar] (50) NULL , '+
      '  [CONSTRAINT_NAME] [varchar] (50) NULL , '+
      '  [URUT] [int] IDENTITY(1,1) PRIMARY KEY CLUSTERED NOT NULL '+
      ') ON [PRIMARY]'
    );
    ExecSQL;
    // buat table _table_list
    SQL.Clear;
    SQL.Append(
      'CREATE TABLE [dbo].[_TABLE_LIST] ( '+
      '  [TABLE_NAME] [varchar] (50) NULL , '+
      '  [TABLE_TYPE] [varchar] (50) NULL , '+
      '  [URUT] [int] IDENTITY(1,1) PRIMARY KEY CLUSTERED NOT NULL '+
      ') ON [PRIMARY] '
    );
    ExecSQL;
    // buat view _vw_table_list
    SQL.Clear;
    SQL.Append(
      'CREATE VIEW _VW_TABLE_LIST AS '+
      'SELECT TABLE_NAME, MAX(URUT) AS URUT '+
      'FROM '+
      '( '+
      '  SELECT '+
      '  _TABLE_LIST.TABLE_NAME, _FOREIGN_KEY.CONSTRAINT_NAME, _FOREIGN_KEY.URUT, _TABLE_LIST.TABLE_TYPE '+
      '  FROM '+
      '  _TABLE_LIST LEFT OUTER JOIN '+
      '  _FOREIGN_KEY ON _TABLE_LIST.TABLE_NAME = _FOREIGN_KEY.TABLE_NAME '+
      ') Q1 '+
      'GROUP BY TABLE_NAME'
    );
    ExecSQL;
    // buat view _vw_refered
    SQL.Clear;
    SQL.Append(
      'CREATE VIEW _VW_REFERED AS '+
      'SELECT '+
      'sysforeignkeys.constid AS ID, sysforeignkeys.fkeyid AS FORE_ID, sysforeignkeys.rkeyid AS REFE_ID, '+
      'VW_FOREIGN.name AS KEY_NAME, VW_TABLE_1.name AS TABLE_F, VW_TABLE_2.name AS TABLE_R '+
      'FROM '+
      '( '+
      '  SELECT       '+
      '  FROM          SYSOBJECTS '+
      '  WHERE      TYPE = '+QuotedStr('F')+' '+
      ') VW_FOREIGN '+
      'INNER JOIN sysforeignkeys ON VW_FOREIGN.id = sysforeignkeys.constid INNER JOIN '+
      '( '+
      '  SELECT      '+
      '  FROM          SYSOBJECTS '+
      '  WHERE      TYPE = '+QuotedStr('U')+' '+
      ') VW_TABLE_1 '+
      'ON sysforeignkeys.fkeyid = VW_TABLE_1.id INNER JOIN '+
      '( '+
      '  SELECT       '+
      '  FROM          SYSOBJECTS '+
      '  WHERE      TYPE = '+QuotedStr('U')+' '+
      ') VW_TABLE_2 ON sysforeignkeys.rkeyid = VW_TABLE_2.id '
    );
    ExecSQL;
  end;
end;
{ menghapus table dan view table list ..........................................}
procedure TFPindahData.myDelTableAndView(const qProses: TADOQuery);
begin
  with qProses do begin
    // table _table_list
    SQL.Clear;
    SQL.Append(
      'if EXISTS (SELECT  FROM dbo.sysobjects '+
      'WHERE id = object_id(N'+QuotedStr('[dbo].[_TABLE_LIST]')+') '+
      'and OBJECTPROPERTY(id, N'+QuotedStr('IsUserTable')+') = 1) '+
      '  DROP TABLE [dbo].[_TABLE_LIST] '
    );
    ExecSQL;
    // table _foreign_key
    SQL.Clear;
    SQL.Append(
      'if EXISTS (SELECT   FROM dbo.sysobjects '+
      'WHERE id = object_id(N'+QuotedStr('[dbo].[_FOREIGN_KEY]')+') '+
      'and OBJECTPROPERTY(id, N'+QuotedStr('IsUserTable')+') = 1) '+
      '  DROP TABLE [dbo].[_FOREIGN_KEY] '
    );
    ExecSQL;
    // view _vw_table_list
    SQL.Clear;
    SQL.Append(
      'IF EXISTS (SELECT TABLE_NAME FROM INFORMATION_SCHEMA.VIEWS '+
      'WHERE TABLE_NAME = '+QuotedStr('_VW_TABLE_LIST')+') '+
      '  DROP VIEW _VW_TABLE_LIST '
    );
    ExecSQL;
    SQL.Clear;
    SQL.Append(
      'IF EXISTS (SELECT TABLE_NAME FROM INFORMATION_SCHEMA.VIEWS '+
      'WHERE TABLE_NAME = '+QuotedStr('_VW_REFERED')+') '+
      '  DROP VIEW _VW_REFERED '
    );
    ExecSQL;
  end;
end;
{ memasukkan data table list ...................................................}
procedure TFPindahData.myInsTable(const sDBase: String; const qProses: TADOQuery);
begin
  with qProses do begin
    SQL.Clear;
    SQL.Append(
      'INSERT INTO _FOREIGN_KEY(TABLE_NAME, CONSTRAINT_NAME) '+
      'SELECT TABLE_NAME, CONSTRAINT_NAME '+
      'FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS '+
      'WHERE CONSTRAINT_TYPE = '+QuotedStr('FOREIGN KEY')+
      ' AND TABLE_CATALOG = '+QuotedStr(sDBase)
    );
    ExecSQL;
    SQL.Clear;
    SQL.Append(
      'INSERT INTO _TABLE_LIST(TABLE_NAME, TABLE_TYPE) '+
      'SELECT TABLE_NAME, TABLE_TYPE '+
      'FROM INFORMATION_SCHEMA.TABLES '+
      'WHERE TABLE_CATALOG = '+QuotedStr(sDBase)+
      ' AND TABLE_TYPE = '+QuotedStr('BASE TABLE')
    );
    ExecSQL;
  end;
end;
{ membuka table list ...........................................................}
procedure TFPindahData.myOpenList;
begin
  try
    // buka _vw_table_list
    with qTableList do begin
      SQL.Clear;
      SQL.Append(
        'SELECT     TABLE_NAME, URUT '+
        'FROM         _VW_TABLE_LIST '+
        'ORDER BY URUT'
      );
      Open;
    end;
  except
    on e: Exception do begin
          MessageDlg(e.ClassName + ' - ' + e.Message, mtError, [mbOK], 0);
    end;
  end;
end;
{ tombol load ditekan ..........................................................}
procedure TFPindahData.btnLoadClick(Sender: TObject);
begin
  myDelTableAndView(qProsesSour);
  myCreTableAndView(qProsesSour);
  myInsTable('RSUD', qProsesSour);
  myOpenList;
end;
{ membuka table anak referensi .................................................}
procedure TFPindahData.myOpenRef(isDel: Boolean);
begin
   try
    { membuka tabel referensi dengan 2 pilihan, yaitu delete atau append.
      karena apabila delete, gunakan referensi TABLE_R
      apabila append, gunakan referensi TABLE_F }
    with qRefer do begin
      SQL.Clear;
      SQL.Append(
        'SELECT     REFE_ID, TABLE_R, FORE_ID, TABLE_F, ID, KEY_NAME '+
        'FROM         _VW_REFERED '
      );
      case optProcess.ItemIndex of
        0 : SQL.Append('WHERE TABLE_R = :TABLE_NAME ');
        1 : SQL.Append('WHERE TABLE_F = :TABLE_NAME ');
      end;
      Parameters[0].Value := qTableList.FieldByName('TABLE_NAME').AsString;
      Open;
      Sleep(100);
    end;
   except
     on e: Exception do begin
           MessageDlg(e.ClassName + ' - ' + e.Message, mtError, [mbOK], 0);
     end;
   end;
end;
{ gridList doble klik ..........................................................}
procedure TFPindahData.gridListDblClick(Sender: TObject);
begin
  case optProcess.ItemIndex of
    0 : myOpenRef(True);
    1 : myOpenRef(False);
  end;
end;
{ fungsi untuk mendapatkan list column non autoinc -----------------------------}
function TFPindahData.myGetColumnList(const sTable: String): String;
begin
  with qColumnList do begin
    SQL.Clear;
    SQL.Append(
      'SELECT  '+
      'VW_TABLE_1.name AS TABLE_NAME, VW_TABLE_1.id AS ID, dbo.syscolumns.name AS FIELD_NAME, '+
      'dbo.syscolumns.xtype AS XTYPE, dbo.syscolumns.typestat AS TYPE_STAT, '+
      'dbo.syscolumns.xusertype AS TYPE_USER, dbo.syscolumns.length AS LENGTH '+
      'FROM '+
      '( '+
      '  SELECT      '+
      '  FROM          SYSOBJECTS '+
      '  WHERE      TYPE = '+QuotedStr('U')+' '+
      ') VW_TABLE_1 INNER JOIN '+
      'dbo.syscolumns ON VW_TABLE_1.id = dbo.syscolumns.id '
    );
    SQL.Append('WHERE VW_TABLE_1.name = :XTABLE AND AUTOVAL IS NULL');
    Parameters[0].Value := sTable;
    Prepared;
    Open;
    if RecordCount > 0 then begin
      Result := Result + FieldByName('FIELD_NAME').AsString;
      Next;
    end;
    if RecordCount > 1 then begin
      repeat
        Result := Result + ', '+ FieldByName('FIELD_NAME').AsString;
        Next;
      until Eof;
    end;
  end;
end;
{ buka query, dan pindah data.
  peringatan, proses ini benar-benar membutuhkan sumber daya yang besar ! ......
function TFPindahData.myMoveData(sTable: String; const qSour, qDest: TADOQuery): Boolean;
var
  lColumn: String;
  lSQL: WideString;
  i, n: Integer;
begin
  Result := False;
  Caption := 'Tools Server Moving And Deleteing !';
  lColumn := myGetColumnList(sTable);
  lSQL := 'SELECT '+lColumn+' FROM '+sTable;
  with qSourData do begin
    SQL.Clear;
    SQL.Append(lSQL);
    Open;
  end;
  with qDestData do begin
    SQL.Clear;
    SQL.Append(lSQL);
    Open;
  end;
  Sleep(100);
  n := qSour.RecordCount;
  if qDest.RecordCount > 0 then Exit;  // jika sudah ada data, lewatkan
  if qSour.RecordCount < 1 then Exit;
  Caption := 'Processing '+sTable;
  ProgressBar1.Max := n;
  ProgressBar1.Position := 0;
  qSour.First;
  try
    repeat
      qDest.Append;
      for i:= 0 to qSour.FieldCount - 1 do begin
        qDest.Fields[i].Value := qSour.Fields[i].Value;
      end;
      qDest.Post;
      ProgressBar1.StepBy(1);
      qSour.Next;
    until qSour.Eof;
    ProgressBar1.Position := 0;
    myAppendLog('Append '+FormatFloat('0',n)+' Data Of '+QuotedStr(sTable)+' Done !');
    Result := True;
  except
    on e: Exception do begin
      myAppendLog(e.Message);
      Exit;
    end;
  end;
  Caption := 'Tools Server Moving And Deleteing !';
end;
}
procedure TFPindahData.myAppendLog(sMessage: String);
begin
  with memLog do begin
    Lines.Append(FormatDateTime('dd.MM.yy hh:nn:ss',Now)+#9+sMessage);
  end;
end;
procedure TFPindahData.SMDBGrid3DblClick(Sender: TObject);
var
  bm: TBookMark;
begin
  if not qTableList.Active then Exit;
  bm := qTableList.GetBookmark;
  myCheckChild;
  qTableList.GotoBookmark(bm);
  gridList.SelectOneClick(gridList);
end;
procedure TFPindahData.myDelData(const qProses: TADOQuery);
var
  nDone, nError: Integer;
  sLog: String;
begin
  if not qTableList.Active then Exit;
  nError := 0; nDone := 0;
  with qTableList do begin
    Last;
    repeat
      myOpenRef(True);
      { table ini dilewatkan }
      if (FieldByName('TABLE_NAME').AsString = '_VW_TABLE_LIST') or
        (FieldByName('TABLE_NAME').AsString = '_FOREIGN_KEY') or
        (FieldByName('TABLE_NAME').AsString = '_VW_REFERED') or
        (FieldByName('TABLE_NAME').AsString =  '_TABLE_LIST') then begin
        Prior;
        Continue;
      end;
      try
        if gridList.SelectedRows.CurrentRowSelected then begin
          myCheckChild;
          myDelChild(qProses);
          qProses.SQL.Clear;
          qProses.SQL.Append('DELETE FROM '+FieldByName('TABLE_NAME').AsString);
          qProses.ExecSQL;
          Inc(nDone);
          sLog := FieldByName('TABLE_NAME').AsString+' deleted';
          myAppendLog(sLog);
        end;
      except
        on e: Exception do begin
              myAppendLog(e.Message);
              Inc(nError);
              Prior;
              Continue;
        end;
      end;
      Prior;
    until Bof;
    memLog.Lines.Append('----------------------------------------------');
    myAppendLog(Format('Done With %d Done And %d Error',[nDone, nError]));
  end;
end;
{ men-checklist table refer ....................................................}
procedure TFPindahData.myCheckChild;
var
  lValue : String;
  bm : TBookmark;
begin
  if not qRefer.Active then Exit;
  bm := qTableList.GetBookMark;
  with qRefer do begin
    First;
    repeat
      case optProcess.ItemIndex of
        0 : lValue := qRefer.FieldByName('TABLE_F').AsString;
        1 : lValue := qRefer.FieldByName('TABLE_R').AsString;
      end;
      qTableList.Locate('TABLE_NAME',lValue,[loCaseInsensitive]);
      gridList.SelectOneClick(gridList);
      Next;
    until Eof;
  end;
  qTableList.GotoBookmark(bm);
end;
procedure TFPindahData.myDelChild(const qProses: TADOQuery);
begin
  if not qRefer.Active then Exit;
  with qRefer do begin
    if RecordCount < 1 then Exit;
    First;
    repeat
      qProses.SQL.Clear;
      case optProcess.ItemIndex of
        0 : qProses.SQL.Append('DELETE FROM '+FieldByName('TABLE_F').AsString);
        1 : qProses.SQL.Append('DELETE FORM '+FieldByName('TABLE_R').AsString);
      end;
      qProses.ExecSQL;
      Next;
    until Eof;
  end;
end;
procedure TFPindahData.btnExecuteClick(Sender: TObject);
begin
  case optProcess.ItemIndex of
    0 : myDelData(qProsesDest);
    1 : myMoveAll;
  end;
end;
procedure TFPindahData.SpeedButton1Click(Sender: TObject);
begin
  if not qTableList.Active then Exit;
  gridList.SelectAllClick(gridList);
end;
procedure TFPindahData.SpeedButton2Click(Sender: TObject);
begin
  if not qTableList.Active then Exit;
  gridList.UnSelectAllClick(gridList);
end;
procedure TFPindahData.myMoveAll;
var
  nDone, nError: Integer;
begin
  if not qTableList.Active then Exit;
  nError := 0; nDone := 0;
  with qTableList do begin
    First;
    repeat
//      myOpenRef(True);
      { table ini dilewatkan }
      if (FieldByName('TABLE_NAME').AsString = '_VW_TABLE_LIST') or
        (FieldByName('TABLE_NAME').AsString = '_FOREIGN_KEY') or
        (FieldByName('TABLE_NAME').AsString = '_VW_REFERED') or
        (FieldByName('TABLE_NAME').AsString =  '_TABLE_LIST') then begin
        Next;
        Continue;
      end;
      try
        if gridList.SelectedRows.CurrentRowSelected then begin
//          if myMoveData(qTableList.FieldByName('TABLE_NAME').AsString, qDestData, qSourData) then
          myCreaExpoDelTempView(qProsesSour);
          myCreaImpoDelTempView(qProsesDest);
          Inc(nDone);
        end;
      except
        on e: Exception do begin
              Inc(nError);
              Next;
              Continue;
        end;
      end;
      Next;
    until Eof;
    memLog.Lines.Append('----------------------------------------------');
    myAppendLog(Format('Done With %d Done And %d Error',[nDone, nError]));
  end;
end;

{ fungsi mendapatkan semua column pada source, termasuk autoinc field. bila ada
  autoinc, maka HaveInc = 1 jika tidak HaveInc = 0 .............................}
function TFPindahData.myGetColumnAll(const sTable: String; var HaveInc: Integer): String;
begin
  Result  := '';
  HaveInc := 0;
  // buka daftar list field
  with qColumnList do begin
    SQL.Clear;
    SQL.Append(
      'SELECT  '+
      'VW_TABLE_1.name AS TABLE_NAME, VW_TABLE_1.id AS ID, dbo.syscolumns.name AS FIELD_NAME, '+
      'dbo.syscolumns.xtype AS XTYPE, dbo.syscolumns.typestat AS TYPE_STAT, '+
      'dbo.syscolumns.xusertype AS TYPE_USER, dbo.syscolumns.length AS LENGTH, autoval '+
      'FROM '+
      '( '+
      '  SELECT       '+
      '  FROM          SYSOBJECTS '+
      '  WHERE      TYPE = '+QuotedStr('U')+' '+
      ') VW_TABLE_1 INNER JOIN '+
      'dbo.syscolumns ON VW_TABLE_1.id = dbo.syscolumns.id '
    );
    SQL.Append('WHERE VW_TABLE_1.name = :XTABLE');
    Parameters[0].Value := sTable;
    Prepared;
    Open;
    // jika field hanya berjumlah satu, ya udah ambil yang itu aja
    if RecordCount > 0 then begin
      Result := Result + FieldByName('FIELD_NAME').AsString;
      if FieldByName('AutoVal').AsString <> '' then HaveInc := 1;
      Next;
    end;
    // tapi kalo lebih, ditambah koma didepannya, karena nanti buat query
    if RecordCount > 1 then begin
      repeat
        Result := Result + ', '+ FieldByName('FIELD_NAME').AsString;
        if FieldByName('AutoVal').AsString <> '' then HaveInc := 1;
        Next;
      until Eof;
    end;
  end;
end;
{ fungsi mengeksport dari server ke file teks ..................................}
function TFPindahData.myCreaExpoDelTempView(const qProses: TADOQuery): Boolean;
  { hapus view temporari }
  procedure myDeleteView;
  begin
    with qProses do begin
      SQL.Clear;
      SQL.Append(
          'IF EXISTS (SELECT TABLE_NAME FROM INFORMATION_SCHEMA.VIEWS '+
          'WHERE TABLE_NAME = '+QuotedStr('_VW_TEMPORARI')+') '+
          '  DROP VIEW _VW_TEMPORARI '
        );
      ExecSQL;
    end;
  end;
  { buat view temporari }
  procedure myCreateView;
  var
    lColumn, lTable : String;
    lSQL: WideString;
    i: Integer;
  begin
    lTable := qTableList.FieldByName('TABLE_NAME').AsString;
    lColumn := myGetColumnAll(lTable, i);
    lSQL := 'CREATE VIEW _VW_TEMPORARI AS SELECT '+lColumn+' FROM '+lTable;
      with qProses do begin
        SQL.Clear;
        SQL.Append(lSQL);
        ExecSQL;
    end;
  end;
var
  sCommand: String;
  pCommand: array of char;
  lTable : String;
begin
  Result := False;
  if not qTableList.Active then Exit;
  lTable := qTableList.FieldByName('TABLE_NAME').AsString;
  try
    // buat view temporari
    myDeleteView;
    myCreateView;
    // export ke file text
    sCommand := fbpc+' '+sDatabase+'.._VW_TEMPORARI out "c:\data_expo.txt" -c -t "|" -r "^" '+
       '-S'+sSourSvr+' -Usa -Psa';
    StrPCopy(pCommand, sCommand);
    WinExecAndWait(pCommand,SW_HIDE,True);
    // hapus view temporari
    myDeleteView;
    Result := True;
  except
    on e: Exception do begin
          myAppendLog(e.Message);
    end;
  end;
end;
{ fungsi untuk meng-import file text ke server tujuan ..........................}
function TFPindahData.myCreaImpoDelTempView(
  const qProses: TADOQuery): Boolean;
  { hapus view temporari }
  procedure myDeleteView;
  begin
    with qProses do begin
      SQL.Clear;
      SQL.Append(
          'IF EXISTS (SELECT TABLE_NAME FROM INFORMATION_SCHEMA.VIEWS '+
          'WHERE TABLE_NAME = '+QuotedStr('_VW_TEMPORARI')+') '+
          '  DROP VIEW _VW_TEMPORARI '
        );
      ExecSQL;
    end;
  end;
  { buat view temporari }
  function myCreateView: Boolean;
  var
    lColumn, lTable : String;
    lSQL: WideString;
    i: Integer;
  begin
    Result := False;
    lTable := qTableList.FieldByName('TABLE_NAME').AsString;
    lColumn := myGetColumnAll(lTable, i);
    lSQL := 'CREATE VIEW _VW_TEMPORARI AS SELECT '+lColumn+' FROM '+lTable;
      with qProses do begin
        SQL.Clear;
        SQL.Append(lSQL);
        ExecSQL;
    end;
    if i = 1 then Result := True;
  end;
var
  sCommand: String;
  pCommand: array of char;
  lTable : String;
begin
  Result := False;
  if not qTableList.Active then Exit;
  lTable := qTableList.FieldByName('TABLE_NAME').AsString;
  if not FileExists('c:\data_expo.txt') then begin
    myAppendLog(lTable + ' file temporari export not found');
    Exit;
  end;
  try
    // buat view temporari dan import
    myDeleteView;
    if myCreateView then
      sCommand := fbpc+' '+sDatabase+'.._VW_TEMPORARI in "c:\data_expo.txt" -c -t "|" -r "^" '+
        '-S'+sDestSvr+' -E -Usa -Psa' else
      sCommand := fbpc+' '+sDatabase+'.._VW_TEMPORARI in "c:\data_expo.txt" -c -t "|" -r "^" '+
        '-S'+sDestSvr+' -Usa -Psa';
    StrPCopy(pCommand, sCommand);
    // check data, jika masih ada data lewatkan
    with qProses do begin
      SQL.Clear;
      SQL.Append('SELECT * FROM _VW_TEMPORARI');
      Open;
      if RecordCount > 0 then begin
        myAppendLog(lTable + ' tidak kosong');
        Close;
        Exit;
      end;
      Close;
    end;
    WinExecAndWait(pCommand,SW_HIDE,True);
    // hapus view temporari
    myDeleteView;
    Result := True;
    myAppendLog(lTable + ' import done');
  except
    on e: Exception do begin
          myAppendLog(e.Message);
    end;
  end;
end;
end.
keterangan code, harap dipelajari sendiri deh. diriku males mo nerangin fungsi masing-masing prosedur. cara kerja programnya : 1. terdiri dari 2 SERVER pada SQL. 2. source adalah SERVER database lama yang terdapat data baru. 3. destination adalah SERVER database baru yang sudah diperbaharui tapi datanya masih lama. 4. hapus data baru melakukan proses append tapi tools diatas masih banyak banget kelemahan. antara lain : - berhasil atau tidaknya pengcopyan data tidak diketahui. karena ngerjainnya lewat program luar. - hanya berlaku untuk SQL Server 2000. - penghapusan masih terlalu manual, alias perintah SQL langsung. gak elite banget :P - masih banyak proses yang boros dan sia-sia nah semoga temen-temen para senior dan expert disini bisa mberi masukan, ide dan saran buat diriku. terutama code snippet yang berguna untuk menggantikan proses-proses yang amat sangat mumbazir diatas :P. catatan : program belum diuji secara detail. karena baru mbikin tadi malam dan baru dicoba beberapa kali. berhasil seh.. tapi kadang-kadang waktu ndelete ketabarak lagi ama constraint, jadi proses deletenya di ulangi aja. karena pemeriksaan constraint hanya dilakukan 1 kali, bila ada tabel yang bertingkat-tingkat, ya terpaksa deh error :). semoga sedikit listing diatas bisa memberi sedikit wawasan bagi para pemula, dan menggerakan hati yang ahli untuk membantu diriku mengembangkannya lebih baik. kekekek (padahal maksudnya minta tolong dibuatin yang lebih baik) :P warnet lagi bosok, jadi gak bisa upload scr shoot hik..hikk... = try and error, never give up =
user image
more 18 years ago

tox2wow

ASTAGFIRULLAHALAZIM ... Gile bener ... tuh coding apa coding ??? :D .. BTW , ko ada yg kaga jadi dipake tuh coding Ber ??? 8)
user image
more 18 years ago

cyber_hecker

ah mosok seh ? oh ya gue ada make 3rd component juga tuh. SMDBGrid namanya :P. habis kalo pake grid biasa gak bisa beri checkbox untuk multiselect :D. jadi make grid yang udah ada fasilitas gituan. by the way koding sebelah mana yang gak jalan ? ya udah sini di terangin satu-satu fungsi prosedurnya :P 
var
  FPindahData: TFPindahData;
  sSourCon : WideString = 'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=RSUD;Data Source=GRAHA-03';
  sDestCon : WideString = 'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=RSUD;Data Source=GRAHA-05';
  fbpc : String = 'C:\Program Files\Microsoft SQL Server\80\Tools\Binn\bcp.exe';
  sDatabase : String = 'RSUD';
  sSourSvr : String = 'GRAHA-03';
  sDestSvr : String = 'GRAHA-05';
ini buat ngeset nilai defaultnya. sDestCon dan sSourCon ini nanti dipasang pada komponen ADOConnection. jadi kita make 2 buah koneksi. sDatabase untuk tujuan dari database yang dipindah-pindahin. namanya mindah data antar server jadi databasenya pasti sama. fbpc ini adalah program tambahan milik SQLServer. check aja di folder binn nya itu, pasti ada deh bpc.exe nya. 
function WinExecAndWait(const Path:  pCHAR;
                        const Visibility:  WORD;
                        const Wait:  BOOLEAN):  BOOLEAN;
kalo ini fungsi buat pengganti winExec. yang ada fungsi waitnya. kalo pake winExec biasa kan gak bisa wait. proses belon selesai udah melanjutkan ke baris kode berikutnya. 
pro cedure TFPindahData.FormCreate(Sender: TObject);
waktu form create, kita set koneksi stringnya sekaligus kalo ada nilai default lain yang ingin di set. 
procedure TFPindahData.myCreTableAndView(const qProses: TADOQuery);
ini untuk mbuat tabel dan view temporari. yaitu tabel yang digunakan untuk menyimpan semua daftar nama tabel user yang ada di MsSQL. jadi nanti user tinggal milih tabel apa aja yang mau dihapus atau dipindahkan datanya. 
procedure TFPindahData.myDelTableAndView(const qProses: TADOQuery);
kalo ini buat ngapus tabel dan view temporarinya. kalo udah gak dipake, ya di hapus aja tuh tabel / viewnya. 
procedure TFPindahData.myInsTable(const sDBase: String; const qProses: TADOQuery);
nah bagian ini buat mindahin data nama-nama tabel yang ada di suatu database di msSQL. juga daftar tabel konstraintnya. yaitu tabel yang kalo mau di hapus, harus di hapus dulu tabel-tabel yang punya relasi dengannya :P 
procedure TFPindahData.myOpenList;
ini hanya prosedur biasa buat mbuka query nya. jadi nanti query tersebut dibuka, maka tampil daftar tabel yang ada di database. trus user tinggal milih deh. nah data ini yang ditampilkan lewat SMDBGrid. 
procedure TFPindahData.btnLoadClick(Sender: TObject);
nah ini waktu tombol load ditekan (komponen bitBtn), jadi waktu tombol load ditekan, kita hapus dulu tabel / view temporari jika masih ada. truz bikin yang baru, biar data tabel yang ada di dalem selalu uptodate. 
procedure TFPindahData.myOpenRef(isDel: Boolean);
nah ini prosedur buat mbuka query yang isinya daftar tabel depend / constraint nya. kalo tabel-tabel ini belum dihapus datanya, maka tabel yang tampil pada list tabel belum bisa dihapus. 
procedure TFPindahData.gridListDblClick(Sender: TObject);
kalo ini waktu SMDBGrid yang isinya daftar tabel di doble klik, maka pada bagian SMDBGrid yang isinya tabel constraint ditampilkan. buat ngirit koneksi jadi nunggu doble klik baru daftar tabel konstraint ditampilkan :P 
function TFPindahData.myGetColumnList(const sTable: String): String;
fungsi ini untuk mendapatkan nama field yang ada pada suatu tabel di msSQL. misalnya ada tabel karyawan pengen diambil nama fieldnya apa aja seh, ya make fungsi ini aja. 
procedure TFPindahData.myAppendLog(sMessage: String);
buat nampilin data log pada memo 
procedure TFPindahData.SMDBGrid3DblClick(Sender: TObject);
kalo prosedur ini adalah waktu grid yang isinya daftar tabel konstrain di doble klik maka pada grid yang isinya daftar tabel harus di beri check box alias di pilih 
procedure TFPindahData.myDelData(const qProses: TADOQuery);
prosedur ini buat ngapus data pada suatu tabel 
procedure TFPindahData.myCheckChild;
ini buat mberi tanda check pada list tabel sesuai dengan semua tabel yang tampil pada grid konstrainnya. jadi nanti waktu kita mindah data, data konstraint yang sudah kita hapus ikut dipindahkan kembali datanya walau pada waktu pemilihan pertama belum kita check list atau pilih. 
procedure TFPindahData.myDelChild(const qProses: TADOQuery);
ngapus semua data pada daftar tabel konstraintnya. misalnya untuk menghapus master_data_pasien, kita harus terlebih dahulu menghapus data pada tabel pasien_registrasi, pasien_tindakan, pasien_morbiditas, dsb.. dsb.. :P 
procedure TFPindahData.myMoveAll;
nah ini dia yang paling utama, memindahkan data dari server source ke server destination. disini kita membutuhkan program luar tadi (fpbc). untuk cara make fbp ini, liat aja pada help msSQL pasti ada. ya udah baca lagi ulang kodingnya. kalo ada yang salah beri tau aja. eh para senior, mosok gak ada cara yang lebih simple neh :(. mosok koding berantakan gini akan terus ku pake. hik.. hik.. :( ada cara yang lebih gampang gak ya ?
user image
more 18 years ago

bosenjadiprogrammer

ya ampun parah bener codingnya.
more ...
  • Pages:
  • 1
|
Share to

AI Forward

🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now: https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD

Last Articles

Last Topic

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com