home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Help / Examples / Batchmv / BATMOVE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  6.6 KB  |  244 lines
  1. unit Batmove;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Db, DBTables, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     BatchMove1: TBatchMove;
  12.     tblSource: TTable;
  13.     tblDest: TTable;
  14.     Bevel1: TBevel ;
  15.     Label6: TLabel;
  16.     cmbxDestAlias: TComboBox;
  17.     Label7: TLabel;
  18.     cmbxDestTable: TComboBox;
  19.     Label8: TLabel;
  20.     cmbxDestIndex: TComboBox;
  21.     Bevel2: TBevel;
  22.     cmbxSourceAlias: TComboBox;
  23.     cmbxSourceTable: TComboBox;
  24.     cmbxSourceIndex: TComboBox;
  25.     Label5: TLabel;
  26.     Label4: TLabel;
  27.     Label3: TLabel;
  28.     cmbxMode: TComboBox;
  29.     Button1: TButton;
  30.     Bevel3: TBevel;
  31.     chkbxAbortKey: TCheckBox;
  32.     chkbxAbortProblem: TCheckBox;
  33.     chkbxTrans: TCheckBox;
  34.     Label1: TLabel;
  35.     Label2: TLabel;
  36.     Label10: TLabel;
  37.     Label9: TLabel;
  38.     Label12: TLabel;
  39.     edtChangedTable: TEdit;
  40.     Label13: TLabel;
  41.     edtKeyVioTbl: TEdit;
  42.     Label14: TLabel;
  43.     edtProbTbl: TEdit;
  44.     Label11: TLabel;
  45.     edtRecCount: TEdit;
  46.     procedure FormCreate(Sender: TObject);
  47.     procedure cmbxSourceAliasChange(Sender: TObject);
  48.     procedure cmbxDestAliasChange(Sender: TObject);
  49.     procedure cmbxSourceTableChange(Sender: TObject);
  50.     procedure cmbxDestTableChange(Sender: TObject);
  51.     procedure cmbxSourceIndexChange(Sender: TObject);
  52.     procedure cmbxDestIndexChange(Sender: TObject);
  53.     procedure Button1Click(Sender: TObject);
  54.     procedure chkbxAbortKeyClick(Sender: TObject);
  55.     procedure chkbxAbortProblemClick(Sender: TObject);
  56.     procedure chkbxTransClick(Sender: TObject);
  57.     procedure cmbxModeChange(Sender: TObject);
  58.     procedure edtRecCountKeyPress(Sender: TObject; var Key: Char);
  59.     procedure FormShow(Sender: TObject);
  60.   private
  61.     { Private declarations }
  62.     function IsStringsEqual(const s1,s2 : string): boolean;
  63. //    simple utility function
  64.   public
  65.     { Public declarations }
  66.   end;
  67.  
  68. var
  69.   Form1: TForm1;
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74.  
  75. procedure TForm1.FormCreate(Sender: TObject); // Get alias names
  76. begin
  77.   if Session.Active = false then
  78.     Session.Open;
  79.   Session.GetAliasNames(CmbxSourceAlias.Items);
  80.   cmbxDestAlias.Items := cmbxSourceAlias.Items;
  81. end;
  82.  
  83. procedure TForm1.cmbxSourceAliasChange(Sender: TObject);
  84. begin
  85.   if cmbxSourceAlias.ItemIndex <> -1 then
  86.   begin
  87.      tblSource.DatabaseName := cmbxSourceAlias.Items[cmbxSourceAlias.ItemIndex];
  88.      Session.GetTableNames(tblSource.DatabaseName,'',true,false,cmbxSourceTable.Items);
  89.   end
  90.   else
  91.   begin
  92.     tblSource.DatabaseName := '';
  93.     cmbxSourceTable.Items.Clear;
  94.   end;
  95. end;
  96.  
  97. procedure TForm1.cmbxDestAliasChange(Sender: TObject);
  98. begin
  99.   if cmbxDestAlias.ItemIndex <> -1 then
  100.   begin
  101.      tblDest.DatabaseName := cmbxDestAlias.Items[cmbxDestAlias.ItemIndex];
  102.      Session.GetTableNames(tblDest.DatabaseName,'',true,false,cmbxDestTable.Items);
  103.   end
  104.   else
  105.   begin
  106.     tblDest.DatabaseName := '';
  107.     cmbxDestTable.Items.Clear;
  108.   end;
  109. end;
  110.  
  111. procedure TForm1.cmbxSourceTableChange(Sender: TObject);
  112. begin
  113.   if cmbxSourceTable.ItemIndex <> -1 then
  114.   begin
  115.      tblSource.TableName := cmbxSourceTable.Items[cmbxSourceTable.ItemIndex];
  116.      tblSource.GetIndexNames(cmbxSourceIndex.Items);
  117.   end
  118.   else
  119.   begin
  120.     tblSource.TableName := '';
  121.     cmbxSourceIndex.Items.Clear;
  122.   end;
  123.  
  124. end;
  125.  
  126. procedure TForm1.cmbxDestTableChange(Sender: TObject);
  127. begin
  128.   if cmbxDestTable.ItemIndex <> -1 then
  129.   begin
  130.      tblDest.TableName := cmbxDestTable.Items[cmbxDestTable.ItemIndex];
  131.      tblDest.GetIndexNames(cmbxDestIndex.Items);
  132.   end
  133.   else
  134.   begin
  135.     tblDest.TableName := '';
  136.     cmbxDestIndex.Items.Clear;
  137.   end;
  138. end;
  139.  
  140. procedure TForm1.cmbxSourceIndexChange(Sender: TObject);
  141. begin
  142.   if cmbxSourceIndex.ItemIndex <> -1 then
  143.   begin
  144.     tblSource.IndexName := cmbxSourceIndex.Items[cmbxSourceIndex.ItemIndex];
  145.   end
  146.   else
  147.   begin
  148.      tblSource.IndexName := '';
  149.   end;
  150. end;
  151.  
  152. procedure TForm1.cmbxDestIndexChange(Sender: TObject);
  153. begin
  154.   if cmbxDestIndex.ItemIndex <> -1 then
  155.   begin
  156.     tblDest.IndexName := cmbxDestIndex.Items[cmbxDestIndex.ItemIndex];
  157.   end
  158.   else
  159.   begin
  160.      tblDest.IndexName := '';
  161.   end;
  162.  
  163. end;
  164.  
  165. procedure TForm1.Button1Click(Sender: TObject);
  166. begin
  167.   if tblDest.TableName = '' then
  168.     tblDest.TableName := cmbxDestTable.Text;
  169.   if ((tblSource.DatabaseName <> '') and // test for enough input
  170.      (tblSource.TableName <> '') and
  171.      (tblDest.DatabaseName <> '') and
  172.      (tblDest.TableName <> '') and
  173.      (cmbxMode.items[cmbxMode.ItemIndex] <> '')) then
  174.   begin
  175.     BatchMove1.ChangedTableName := edtChangedTable.Text;  // more batchmove setup
  176.     BatchMove1.KeyViolTableName := edtKeyVioTbl.Text;
  177.     BatchMove1.ProblemTableName := edtProbTbl.Text;
  178.     BatchMove1.RecordCount := StrToInt(edtRecCount.Text);
  179.   end
  180.   else
  181.   begin
  182.     MessageDlg('Incomplete input.',mtError,[mbOK],0);
  183.     exit;
  184.   end;
  185.   BatchMove1.Execute;  // run the batchmove
  186.   MessageDlg('BatchMove complete. Number of records applied: '+IntToStr(BatchMove1.MovedCount),mtInformation,[mbOK],0);
  187. end;
  188.  
  189. procedure TForm1.chkbxAbortKeyClick(Sender: TObject);
  190. begin
  191.   BatchMove1.AbortOnKeyViol := chkbxAbortKey.Checked;
  192. end;
  193.  
  194. procedure TForm1.chkbxAbortProblemClick(Sender: TObject);
  195. begin
  196.   BatchMove1.AbortOnProblem := chkbxAbortProblem.Checked;
  197. end;
  198.  
  199. procedure TForm1.chkbxTransClick(Sender: TObject);
  200. begin
  201.   BatchMove1.Transliterate := chkbxTrans.Checked;
  202. end;
  203.  
  204. function TForm1.IsStringsEqual(const s1,s2 : string): boolean;
  205. begin
  206.    Result := UpperCase(s1) = UpperCase(s2);
  207. end;
  208.  
  209.  
  210. // set the batch mode
  211. procedure TForm1.cmbxModeChange(Sender: TObject);
  212. begin
  213.   if cmbxMode.ItemIndex <> -1 then
  214.   begin
  215.     if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Append') then
  216.       BatchMove1.Mode := batAppend
  217.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Copy') then
  218.       BatchMove1.Mode := batCopy
  219.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Append Update') then
  220.       BatchMove1.Mode := batAppendUpdate
  221.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Delete') then
  222.       BatchMove1.Mode := batDelete
  223.     else if IsStringsEqual(cmbxMode.Items[cmbxMode.ItemIndex],'Update') then
  224.       BatchMove1.Mode := batUpdate
  225.     else
  226.       MessageDlg('Batch mode not found',mtError,[mbOK],0);
  227.   end;
  228. end;
  229.  
  230.  
  231. // only allow numbers to be typed in
  232. procedure TForm1.edtRecCountKeyPress(Sender: TObject; var Key: Char);
  233. begin
  234.   if ((key in ['0'..'9'] = false) and (word(key) <> VK_BACK)) then
  235.     key := #0;
  236. end;
  237.  
  238. procedure TForm1.FormShow(Sender: TObject);
  239. begin
  240.     cmbxSourceAlias.SetFocus;
  241. end;
  242.  
  243. end.
  244.