deltovb.pas

delphi 自动生成 vb 数据窗体

unit deltovb;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ExtCtrls,ComObj, DBTables,StrUtils;

type
  TForm1 = class(TForm)
    P_dtype: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    Button1: TButton;
    OD: TOpenDialog;
    SD: TSaveDialog;
    AC: TADOConnection;
    AQ: TADOQuery;
    ComboBox2: TComboBox;
    TB: TTable;
    GB1: TGroupBox;
    Label3: TLabel;
    ComboBox3: TComboBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    GB2: TGroupBox;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    ListBox2: TListBox;
    ComboBox4: TComboBox;
    Label4: TLabel;
    Button6: TButton;
    Label5: TLabel;
    ComboBox5: TComboBox;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox2Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ComboBox3Click(Sender: TObject);
    procedure ComboBox4Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ComboBox5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
   
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  strcnn:string;
implementation

{$R *.dfm}
function GetPath(Lpath:string):string;
var i:integer;
begin
    for i:=5 to length(lpath) do
        if AnsiContainsStr(midstr(ReverseString(lpath),1,i),'\') then
              begin
              getpath:=midstr(lpath,1,length(lpath)-i);
              break;
              end;
end;
function GetDname(Lpath:string):string;
var i:integer;
begin
     for i:=5 to length(Lpath) do
        if AnsiContainsStr(midstr(ReverseString(lpath),1,i),'\') then
            begin
            GetDname:=midstr(Lpath,length(Lpath)-i+2,i);
            break;
            end;
end;
//+++++++++++++添加按钮 ++++++++++++++++
function AddButton(cap:string;ind:string;lef:string;tab:string;top:string;memo:tmemo):Boolean;
begin
with memo.lines do
begin
Add('   Begin Vb.CommandButton command1');
Add('      Caption          =   "'+cap +'"');
Add('      Height           =   375' );
add('      Index            =   '+ ind);
add('      Left             =   ' +lef);
add('      TabIndex         =   '+tab);
add('      Top              =   '+top);
add('      Width            =   975');
add('   End');
end;
AddButton:=true;
end;
//+++++++++++++++++添加文本框+++++++++++++
function addtext(name:string;lef:string;tab:string;txt:string;top:string;memo:tmemo):Boolean;
begin
with memo.Lines do
begin
add('   Begin Vb.TextBox txt'+ name);
add('      Height           =   270');
add('      Left             =   '+lef);
add('      TabIndex         =   '+tab);
add('      Text             =   "' + txt +'"');
add('      Top              =   '+top);
add('      Width            =   1815');
add('   End');
end;
addtext:=true;
end;
// +++++++++++++++添加标签++++++++++++++++
function addlabel(name:string;lef:string;tab:string;cap:string;top:string;memo:tmemo):Boolean;
begin
with memo.Lines do
begin
add('   Begin Vb.label leb'+name);
add('      Caption          =   "' +cap +'"');
add('      Height           =   255');
add('      Left             =   '+lef);
add('      TabIndex         =   '+tab);
add('      Top              =   '+top);
add('      Width            =   855');
add('   End');
end;
addlabel:=true;
end;
function adddata(name:string;memo:tmemo):boolean;
begin
with memo.Lines do
begin
add('   Begin VB.Data '+ name);
add('      Caption         =   "Data1"');
add('      Connect         =   "Access"');
add('      DatabaseName    =   ""');
add('      DefaultCursorType=   0  '#39'缺省游标');
add('      DefaultType     =   2  '#39'使用 ODBC ');
add('      Exclusive       =   0   '#39'False');
add('      Height          =   285');
add('      Left            =   840');
add('      Options         =   0');
add('      ReadOnly        =   0   '#39'False');
add('      RecordsetType   =   1  '#39'Dynaset');
add('      RecordSource    =   "" ');
add('      Top             =   1680');
add('      Visible         =   0   '#39'False');
add('      Width           =   1140');
add('      End ');
end;
adddata:=true;
end;
//++++++++++++++++Access 表格的连接操作 ++++++++++++++++++
function accesslink(list:tlistbox;list1:tlistbox;table:string;memo:tmemo):Boolean;
var i,j:integer;
    Filed:string;
    Fstr:string;
    sine:boolean;
begin
with memo.Lines do
  begin
        Add('Dim con as new adodb.connection');
        Add('Private Sub Command1_Click(Index As Integer)');
        Add('Dim str as string');
        Add('Dim ret As New ADODB.Recordset');
        Add('select case index ');
        Filed:='';
        Fstr:='';
        for i:=0 to list.Items.Count-2 do
                begin
                Filed:=Filed +','+ list.Items.strings[i] ;
                Fstr:=Fstr +','#39'" & txt' + list.Items.Strings[i]+'.text & "'#39'';
                end;
        Filed:=list.Items.Strings[list.Items.count-1] + Filed;
        Fstr:=''#39'" & txt' + list.Items.Strings[list.Items.count-1]+'.text & "'#39'' +Fstr;
        Add('case 0:str=" insert into ' + table +'(' + Filed +') values ('+ Fstr + ')"' );
        Add('       ret.open str,con,adOpenKeyset,adLockPessimistic ');
        Filed:='';

        for i:=0 to list.Items.Count-2 do
        begin
                sine:=false;
                for j:=0 to list1.Items.Count -1 do
                        if list.Items.Strings[i]=list1.Items.Strings[j] then
                                sine:=true;
                if not sine then
                Filed:=Filed +','+ list.Items.strings[i]+'='#39'" & txt'+ list.Items.strings[i]+'.text & "'#39'' ;
        end;
        filed:=MidStr(filed,2,length(filed)-1);
        Add('case 1: str=" update '+ table +' set '+ Filed + ' where '+ list1.Items.Strings[0]+'='#39'" & txt'+ list1.Items.Strings[0] + '.text & "'#39'"');
        Add('        ret.open str,con,adOpenKeyset,adLockPessimistic');
        Add('case 2:str="delete from '+table +' where '+ list1.Items.Strings[0]+'='#39'" & txt'+ list1.Items.Strings[0] + '.text & "'#39'"');
        Add('        ret.open str,con,adOpenKeyset,adLockPessimistic');
        Add('case 3:unload me ');
        Add('end select');
        Add('If Index <> 3 Then:mfglink');
        Add('End Sub');
        Add('Function mfglink()');
        Add('Dim ret As New ADODB.Recordset');
        fstr:='';
        for i:=0 to list.Items.Count-2 do
                fstr:= fstr+',' + list.Items.Strings[i] ;
        fstr:= list.Items.Strings[list.Items.count-1]+ fstr ;
        Add('ret.Open "select ' + fstr + ' from jzmmc ", con, adOpenKeyset, adLockPessimistic');
        Add('Set Mfg.Recordset = Nothing');
        Add('Set Mfg.Recordset = ret');
        Add('End Function');
        Add('Private Sub mfg_Click()');
        Add('Dim i As Integer');
        Add('With mfg');
        for i:=0 to list.Count  -2 do
        Add('txt'+list.Items.Strings[i]+'.text=.TextMatrix(.row,'+inttostr(i+1)+')');
        Add('txt'+ list.Items.strings[list.Count -1] +'.text=.textmatrix(.row,0)');
        Add('end with');
        Add('End Sub');
        Add('Private Sub Form_Load()');
        Add('con.open "'+strcnn +'"');
        Add('mfglink');
        Add('End Sub');
  end;
accesslink:=true;
end;
//++++++++++++++++++++++++++dBase Access 表格的连接操作+++++++++++++++++++++
function dBaselink(list:tlistbox;list1:tlistbox;table:string;memo:tmemo):boolean;
var Filstr,Path,dName :string;
    i,j:integer;
    sine:boolean;
begin
with memo.Lines  do
 begin
        Add('Private Sub Command1_Click(Index As Integer)');
        Add('dim i as integer');
        Add('dt1.Connect = "dBASE 5.0;"');
        path:=getpath(table);
        dName:=getdname(table);
        dname:=AnsiReplaceText(dname,'.dbf','');
        dname:=AnsiReplaceText(dname,'.DBF','');
        Add('dt1.DatabaseName = "' + table +'"');
        Add('dt1.RecordsetType = 1 ');
        Add('select case index');
        filstr:=list.Items.Strings[0];
        //valstr:=''#39'" & txt' + list.Items.Strings[0] + '.text & "'#39'';
        add('case 0: dt1.Recordset.AddNew');
        for i:=0 to list.Items.Count-1 do
        begin
                Filstr:=Filstr + ',' + list.Items.Strings[i];
                sine:=false;
                for j:=0 to list1.Items.Count -1 do
                        if list.Items.Strings[i]=list1.Items.Strings[j] then
                                sine:=true;
                if not sine then
                add('dt1.Recordset!' + list.Items.Strings[i]+ '=txt'+ list.Items.Strings[i] + '.text');
        end;

                //valstr:=valstr + ','#39'" & txt' + list.Items.Strings[i]+'.text & "'#39'';
                add('dt1.Recordset.Update');
        //Add('case 0:dt1.RecordSource = "insert into ' + dname + '(' + Filstr + ')' +' values ' + '(' + valstr + ')' + '"');

        add('case 1:dt1.recordsource ="select * from ' + dname + ' where ' + list1.Items.Strings[0]+ '='#39'" & txt'+list1.Items.Strings[0]+'.text & "'#39'"');
        Add('dt1.Refresh');
        add('dt1.Recordset.edit');
                for i:=0 to list.Items.Count-1do
        begin
                sine:=false;
                for j:=0 to list1.Items.Count -1 do
                        if list.Items.Strings[i]=list1.Items.Strings[j] then
                                sine:=true;
                if not sine then
                       add('dt1.Recordset!' + list.Items.Strings[i]+ '=txt'+ list.Items.Strings[i] + '.text & ""');
        end;