untimportdata.pas

简要说明:对医院幼儿心理情况做的一个调查,统计系统.

unit untImportData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, CheckLst, Buttons, ExtCtrls, Excel2000,
  OleServer, DB, ADODB, untGlobalVar, Excel97, jpeg, fcButton, fcImgBtn;

type
  TfrmImportData = class(TfrmBaseDialog)
    dlgOpenExcel: TOpenDialog;
    Notebook1: TNotebook;
    rgType: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    edtDataFile: TEdit;
    SpeedButton1: TSpeedButton;
    clbSheet: TCheckListBox;
    Label3: TLabel;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    Label4: TLabel;
    rgBirth: TRadioGroup;
    connExcel: TADOConnection;
    adsCommon: TADODataSet;
    btnPrior: TfcImageBtn;
    btnNext: TfcImageBtn;
    procedure FormShow(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure rgTypeClick(Sender: TObject);
    procedure rgBirthClick(Sender: TObject);
  private
    { Private declarations }
    FOpened: Boolean;
    FDataType: Integer;
    FBirthType: Integer;
    FADODataSet: TADODataSet;
    procedure LoadXLSFile(strFileName: string);
    procedure LoadData;
    procedure LoadSheetData(SheetIndex: Integer);
    //procedure CreateADODataSet;
    procedure TransetData;
    procedure CalcData(recChildren: TChildren);
    function GetSchoolID(SchoolName: string): Integer;
    function GetClassID(SchoolID: Integer; ClassYear, ClassName: string): Integer;
    procedure GetChildrenID(ClassID: Integer; var recChildren: TChildren);
  public
    { Public declarations }
  end;

var
  frmImportData: TfrmImportData;

implementation

uses untGlobalFun, untMessage, untDM;

{$R *.dfm}

procedure TfrmImportData.FormShow(Sender: TObject);
begin
  inherited;
  Notebook1.PageIndex := 0;
  FOpened := false;
  FDataType := 0;
  FBirthType := 0;
end;

procedure TfrmImportData.btnNextClick(Sender: TObject);
begin
  inherited;
  if (not FOpened) and (Notebook1.PageIndex = 0) then
    LoadXLSFile(edtDataFile.Text);
  if Notebook1.PageIndex < Notebook1.Pages.Count - 1 then
    Notebook1.PageIndex := Notebook1.PageIndex + 1
  else if btnNext.Caption <> '完成' then begin
    LoadData;
  end else begin  
    Close;
  end;
end;

procedure TfrmImportData.btnPriorClick(Sender: TObject);
begin
  inherited;
  if Notebook1.PageIndex > 0 then
    Notebook1.PageIndex := Notebook1.PageIndex - 1;
end;

procedure TfrmImportData.SpeedButton1Click(Sender: TObject);
begin
  inherited;
  if dlgOpenExcel.Execute then begin
    edtDataFile.Text := dlgOpenExcel.FileName;
    FOpened := false;
  end;
end;

procedure TfrmImportData.LoadXLSFile(strFileName: string);
var
  sltSheet: TStringList;
  i: Integer;
begin
  if strFileName = '' then
    raise Exception.Create('请选择EXCEL文件');
  if not FileExists(strFileName) then
    raise Exception.Create('EXCEL文件不存在');
  with connExcel do begin
    Connected := False;
    LoginPrompt := False;
    ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      +'Data Source=' + strFileName + ';Extended Properties="Excel 8.0;'
      +'IMEX=1";Persist Security Info=False';
    Connected := True;
    sltSheet := TStringList.Create;
    GetTableNames(sltSheet);
  end;
  clbSheet.Items.Clear;
  for i:=0 to sltSheet.Count-1 do begin
    if Pos('$', sltSheet[i])>0 then
      clbSheet.Items.Add('['+sltSheet[i]+']')
    else
      clbSheet.Items.Add(sltSheet[i]);
  end;

  {ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.Text := 'SELECT * FROM ' + sTableName;
  ADOQuery1.Open;
  sl.Free;}

end;

{procedure TfrmImportData.LoadXLSFile(strFileName: string);
var
  i: Integer;
begin
  frmMessage := TfrmMessage.Create(Application);
  with frmMessage do begin
    pbMessage.Visible := false;
    lblMessage.Caption := '正在打开EXCEL文件，请稍候......';
    Show;
    Application.ProcessMessages;
  end;
  if strFileName = '' then Exit;
  if not FileExists(strFileName) then begin
    MsgOK('EXCEL文件不存在，请重新选择文件！');
    Exit;
  end;
  try
    ExcelApplication1.Connect;
  except
    MsgOK('对不起，您的机器上尚未安装EXCEL软件，无法导入数据。');
    Abort;
  end;
  ExcelApplication1.Visible[0] := false;
  try
    //打开指定的EXCEL 文件
    ExcelApplication1.Workbooks.Open(strFileName,
    null,null,null,null,null,null,null,null,null,null,null,null,0);
  except
    begin
      //出现异常情况时关闭
      ExcelApplication1.Disconnect;
      ExcelApplication1.Quit;
      MsgOK('请选择EXCEL电子表格!');
      exit;
    end;
  end;
  //ExcelWorkbook1与Eexcelapplication1建立连接
  ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  clbSheet.Items.Clear;
  for i:=1 to ExcelWorkbook1.Worksheets.Count do begin
    clbSheet.Items.Add((ExcelWorkbook1.Worksheets[i] as _WorkSheet).Name);
  end;
  FOpened := true;
  frmMessage.Hide;
end;}

procedure TfrmImportData.LoadData;
var
  bSelected: Boolean;
  i: Integer;
begin
  btnPrior.Enabled := False;
  btnNext.Enabled := false;
  btnCancel.Enabled := false;
  bSelected := false;
  for i:=0 to clbSheet.Items.Count -1 do begin
    if clbSheet.Checked[i] then begin
      bSelected := true;
      Break;
    end;
  end;
  if not bSelected then begin
    MsgOK('请选择EXCEL工作表！');
    Exit;
  end;
  //CreateADODataSet;
  if not DM.cnn.Connected then dm.cnn.Connected := TRUE;
  DM.cnn.BeginTrans;
  try
    for i:=0 to clbSheet.Items.Count - 1 do begin
      if clbSheet.Checked[i] then begin
        if frmMessage = nil then
          frmMessage := TfrmMessage.Create(Application);
        with frmMessage do begin
          pbMessage.Visible := false;
          lblMessage.Caption := '正在导入工作表 '+clbsheet.Items[i]+' 的数据，请稍候......';
          Show;
          Application.ProcessMessages;
        end;
        //LoadSheetData(i+1);
        LoadSheetData(i);
        TransetData;
      end;
    end;
    DM.cnn.CommitTrans;
  except ON e: Exception do
    begin
      DM.cnn.RollbackTrans;
      MsgOK(e.message);
    end;
  end;
  FADODataSet.Free;
  FreeAndNil(frmMessage);
  btnNext.Caption := '完成';
  btnNext.Enabled := true;
  btnPrior.Visible := False;
  btnCancel.Visible := false;
end;

{procedure TfrmImportData.LoadData;
var
  bSelected: Boolean;
  i: Integer;
begin
  btnPrior.Enabled := False;
  btnNext.Enabled := false;
  btnCancel.Enabled := false;
  bSelected := false;
  for i:=0 to clbSheet.Items.Count -1 do begin
    if clbSheet.Checked[i] then begin
      bSelected := true;
      Break;
    end;
  end;
  if not bSelected then begin
    MsgOK('请选择EXCEL工作表！');
    Exit;
  end;
  CreateADODataSet;
  for i:=0 to clbSheet.Items.Count - 1 do begin
    if clbSheet.Checked[i] then begin
      if frmMessage = nil then
        frmMessage := TfrmMessage.Create(Application);
      with frmMessage do begin
        pbMessage.Visible := false;
        lblMessage.Caption := '正在导入工作表 '+clbsheet.Items[i]+' 的数据，请稍候......';
        Show;
        Application.ProcessMessages;
      end;
      LoadSheetData(i+1);
    end;
  end;
  FADODataSet.Free;
  btnNext.Caption := '完成';
  btnNext.Enabled := true;
  btnPrior.Visible := False;
  btnCancel.Visible := false;
end;}

procedure TfrmImportData.LoadSheetData(SheetIndex: Integer);
begin
  with adsCommon do begin
    if Active then Active := false;
    CommandText := 'select * from '+clbSheet.Items[SheetIndex];
    Active := true;
  end;
end;

{procedure TfrmImportData.LoadSheetData(SheetIndex: Integer);
var
  ClassYear, strSchool, strClass: string;
  ads: TADODataSet;
  iRowCount,iColCount, i, j, k, iYear, iMonth: Integer;