unitexport.~pas

一个不错的系统

unit UnitExport;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ADODB, ComCtrls, StrUtils, ComObj, OleServer,
  ADOX_TLB;

type
  TFrmExport = class(TForm)
    Label1: TLabel;
    EdtFileName: TEdit;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ProgressBar1: TProgressBar;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmExport: TFrmExport;

implementation

uses UnitDatabase;

{$R *.dfm}

procedure TFrmExport.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TFrmExport.Button3Click(Sender: TObject);
var
  StrType:String;
begin
  OpenDialog1.Filter:='Database files (*.mdb)|*.mdb|Excel files (*.xls)|*.xls';
  OpenDialog1.FileName:='Untitled';
  if OpenDialog1.Execute then begin
    EdtFileName.Text:=OpenDialog1.FileName;
    StrType:=UpperCase(RightStr(EdtFileName.Text,4));
    if (StrType<>'.MDB') and (StrType<>'.XLS') then begin
      case OpenDialog1.FilterIndex of
        1:EdtFileName.Text:=EdtFileName.Text+'.mdb';
        2:EdtFileName.Text:=EdtFileName.Text+'.xls';
      end;
    end;
  end;
end;

procedure TFrmExport.BitBtn1Click(Sender: TObject);
var
  ADOCA:TCatalog;
  i,j:Integer;
  ADOTRS1:TADOQuery;
  StrType:String;
  eclApp,WorkBook:Variant;
  xlsFileName:string;
begin
  if Trim(EdtFileName.Text)<>'' then begin
    StrType:=UpperCase(RightStr(EdtFileName.Text,4));
    if StrType='.MDB' then begin
      ADOCA:=TCatalog.Create(Self);
      try
        ADOCA.Create1('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+EdtFileName.Text+';Locale Identifier=0x0804;Jet OLEDB:Database Password=19761227');
      finally
        ADOCA.Free;
      end;
      ADOTRS1:=TADOQuery.Create(Self);
      ADOTRS1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+EdtFileName.Text+';Persist Security Info=False;Jet OLEDB:Database Password=19761227';
      try
        with ADOTRS1 do begin
          SQL.Clear;
          SQL.Add('CREATE TABLE Employee (MID INTEGER NOT NULL PRIMARY KEY,MTagNO VARCHAR(8) WITH COMPRESSION NOT NULL,MName VARCHAR(16) WITH COMPRESSION NULL,MGender VARCHAR(2) WITH COMPRESSION NULL,MBirthday DATETIME NULL,');
          SQL.Add('MMarrigae VARCHAR(4) WITH COMPRESSION NULL,MPolitics VARCHAR(8) WITH COMPRESSION NULL,MMember VARCHAR(16) WITH COMPRESSION NULL,MEducation VARCHAR(12) WITH COMPRESSION NULL,MTitle VARCHAR(16) WITH COMPRESSION NULL,');
          SQL.Add('MNative VARCHAR(20) WITH COMPRESSION NULL,MFolk VARCHAR(16) WITH COMPRESSION NULL,MProvince VARCHAR(16) WITH COMPRESSION NULL,MCity VARCHAR(16) WITH COMPRESSION NULL,MPolice VARCHAR(16) WITH COMPRESSION NULL,');
          SQL.Add('MIDCardNO VARCHAR(18) WITH COMPRESSION NULL,MTel VARCHAR(30) WITH COMPRESSION NULL,MRegAdd VARCHAR(80) WITH COMPRESSION NULL,MRegPostalcode VARCHAR(6) WITH COMPRESSION NULL,MRegArea VARCHAR(20) WITH COMPRESSION NULL,');
          SQL.Add('MCurAdd VARCHAR(80) WITH COMPRESSION NULL,MCurPostalcode VARCHAR(6) WITH COMPRESSION NULL,MCurArea VARCHAR(20) WITH COMPRESSION NULL,MInDate DATETIME NULL,MDuty VARCHAR(16) WITH COMPRESSION NULL,');
          SQL.Add('MJob VARCHAR(10) WITH COMPRESSION NULL,MStartWorkDate DATETIME NULL,MSalary MONEY NULL,MWork VARCHAR(4) WITH COMPRESSION NULL,MContract VARCHAR(2) WITH COMPRESSION NULL,MPWork VARCHAR(4) WITH COMPRESSION NULL,');
          SQL.Add('MIncome MONEY NULL,MMemo TEXT WITH COMPRESSION NULL,MFName1 VARCHAR(16) WITH COMPRESSION NULL,MFName2 VARCHAR(16) WITH COMPRESSION NULL,MFName3 VARCHAR(16) WITH COMPRESSION NULL,MFName4 VARCHAR(16) WITH COMPRESSION NULL,');
          SQL.Add('MFName5 VARCHAR(16) WITH COMPRESSION NULL,MFAppellation1 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation2 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation3 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation4 VARCHAR(10) WITH COMPRESSION NULL,');
          SQL.Add('MFAppellation5 VARCHAR(10) WITH COMPRESSION NULL,MFFactory1 VARCHAR(80) WITH COMPRESSION NULL,MFFactory2 VARCHAR(80) WITH COMPRESSION NULL,MFFactory3 VARCHAR(80) WITH COMPRESSION NULL,MFFactory4 VARCHAR(80) WITH COMPRESSION NULL,');
          SQL.Add('MFFactory5 VARCHAR(80) WITH COMPRESSION NULL,MF1 VARCHAR(60) WITH COMPRESSION NULL,MF2 VARCHAR(10) WITH COMPRESSION NULL,MF3 VARCHAR(14) WITH COMPRESSION NULL,MF4 VARCHAR(18) WITH COMPRESSION NULL,MF5 VARCHAR(10) WITH COMPRESSION NULL,');
          SQL.Add('MFType VARCHAR(8) WITH COMPRESSION NULL,MF6 TINYINT NULL,MF7 TINYINT NULL,MF8 VARCHAR(2) WITH COMPRESSION NULL)');
          ExecSQL;
          Close;
          SQL.Text:='SELECT * FROM Employee';
          Open;
        end;
      except
        raise Exception.Create('目标数据库无法打开。');
      end;
      DMMain.ADOQRS1.Close;
      DMMain.ADOQRS1.SQL.Text:='select * from Employee';
      DMMain.ADOQRS1.Open;
      ProgressBar1.Min:=0;
      ProgressBar1.Max:=DMMain.ADOQRS1.RecordCount;
      ProgressBar1.Position:=0;
      while not DMMain.ADOQRS1.Eof do begin
        ADOTRS1.Append;
        for i:=0 to ADOTRS1.Fields.Count-1 do
          ADOTRS1.Fields[i].AsString:=DMMain.ADOQRS1.Fields[i].AsString;
        ADOTRS1.Post;
        ProgressBar1.Position:=ProgressBar1.Position+1;
        DMMain.ADOQRS1.Next;
      end;
      ADOTRS1.Close;
      DMMain.ADOQRS1.Close;
      ADOTRS1.Free;
    end else begin
      xlsFileName:=EdtFileName.Text;
      try
        eclApp:=CreateOleObject('Excel.Application');
        WorkBook:=CreateOleobject('Excel.Sheet');
      except
        MessageBox(Handle,'您的机器里未安装Microsoft Excel。','系统警告',48);
        Exit;
      end;
      try
        workBook:=eclApp.workBooks.Add;
        eclApp.Cells.Select;
        eclApp.Selection.Font.Size:=10;
        eclApp.Selection.NumberFormatLocal:='@';
        DMMain.ADOQRS1.Close;
        DMMain.ADOQRS1.SQL.Text:='select * from Employee';
        DMMain.ADOQRS1.Open;
        j:=1;
        eclApp.Cells(j,1):='工号';
        eclApp.Cells(j,2):='姓名';
        eclApp.Cells(j,3):='性别';
        eclApp.Cells(j,4):='出生日期';
        eclApp.Cells(j,5):='婚否';
        eclApp.Cells(j,6):='政治面貌';
        eclApp.Cells(j,7):='健康状况';
        eclApp.Cells(j,8):='学历';
        eclApp.Cells(j,9):='职称';
        eclApp.Cells(j,10):='籍贯';
        eclApp.Cells(j,11):='民族';
        eclApp.Cells(j,12):='省';
        eclApp.Cells(j,13):='市';
        eclApp.Cells(j,14):='派出所';
        eclApp.Cells(j,15):='身份证号码';
        eclApp.Cells(j,16):='电话';
        eclApp.Cells(j,17):='户口地址';
        eclApp.Cells(j,18):='邮编';
        eclApp.Cells(j,19):='户口所属区域';
        eclApp.Cells(j,20):='居住地址';
        eclApp.Cells(j,21):='邮编';
        eclApp.Cells(j,22):='居住所属区域';
        eclApp.Cells(j,23):='入厂日期';
        eclApp.Cells(j,24):='职务';
        eclApp.Cells(j,25):='岗位';
        eclApp.Cells(j,26):='参工日期';
        eclApp.Cells(j,27):='待遇';
        eclApp.Cells(j,28):='就业状态';
        eclApp.Cells(j,29):='合同制';
        eclApp.Cells(j,30):='配偶就业情况';
        eclApp.Cells(j,31):='家庭收入';
        eclApp.Cells(j,32):='备注';
        eclApp.Cells(j,33):='家庭成员姓名1';
        eclApp.Cells(j,34):='家庭成员姓名2';
        eclApp.Cells(j,35):='家庭成员姓名3';
        eclApp.Cells(j,36):='家庭成员姓名4';
        eclApp.Cells(j,37):='家庭成员姓名5';
        eclApp.Cells(j,39):='家庭成员称谓1';
        eclApp.Cells(j,40):='家庭成员称谓2';
        eclApp.Cells(j,41):='家庭成员称谓3';
        eclApp.Cells(j,42):='家庭成员称谓4';
        eclApp.Cells(j,43):='家庭成员称谓5';
        eclApp.Cells(j,45):='家庭成员工作单位1';
        eclApp.Cells(j,46):='家庭成员工作单位2';
        eclApp.Cells(j,47):='家庭成员工作单位3';
        eclApp.Cells(j,48):='家庭成员工作单位4';
        eclApp.Cells(j,49):='家庭成员工作单位5';
        eclApp.Cells(j,51):='养老关系所在单位';
        eclApp.Cells(j,52):='单位性质';
        eclApp.Cells(j,53):='专业技术职称';
        eclApp.Cells(j,54):='专业技术等级';
        eclApp.Cells(j,55):='再就业情况';
        eclApp.Cells(j,56):='特殊工作类型';
        eclApp.Cells(j,57):='从事特殊工作年数';
        eclApp.Cells(j,58):='从事特殊工作月数';
        eclApp.Cells(j,59):='是否享受社会救助';
        Inc(j);
        ProgressBar1.Min:=0;
        ProgressBar1.Max:=DMMain.ADOQRS1.RecordCount;
        ProgressBar1.Position:=0;
        while not DMMain.ADOQRS1.Eof do begin
          for i:=1 to DMMain.ADOQRS1.Fields.Count-1 do
            eclApp.Cells(j,i):=DMMain.ADOQRS1.Fields[i].AsString;
          DMMain.ADOQRS1.Next;
          ProgressBar1.Position:=ProgressBar1.Position+1;
          Inc(j);
        end;
        DMMain.ADOQRS1.Close;
        WorkBook.saveas(xlsFileName);
        WorkBook.close;
        eclApp.Quit;
        eclApp:=Unassigned;
      except
        MessageBox(Handle,'不能正确操作Excel文件。可能是该文件已被其他程序打开, 或系统错误。','系统警告',48);
        WorkBook.close;
      end;
    end;
    MessageBox(Handle,'数据已成功导出。   ','系统信息',0);
    FrmExport.Close;
  end else begin
    MessageBox(Handle,'请选取导出数据库存放的路径工。','系统警告',48);
    EdtFileName.SetFocus;
  end;
end;

end.