www.pudn.com > 邮件群发程序1.2.rar > DataOuput.pas

unit DataOuput; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, Buttons, DB, ADODB; 
 
type 
  TfrmOuput = class(TForm) 
    GroupBox1: TGroupBox; 
    chk2: TRadioButton; 
    chk1: TRadioButton; 
    Label1: TLabel; 
    Edit1: TEdit; 
    SpeedButton1: TSpeedButton; 
    BitBtn1: TBitBtn; 
    SaveDialog1: TSaveDialog; 
    ADODataSet1: TADODataSet; 
    BitBtn2: TBitBtn; 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure SpeedButton1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure BitBtn1Click(Sender: TObject); 
    procedure BitBtn2Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    procedure saveTxt(); 
    procedure saveExcel(); 
    procedure createDB(); 
  end; 
 
var 
  frmOuput: TfrmOuput; 
  valid:integer; 
  ConnectString:string; 
  sCont:TStringList; 
 
const pw='820745'; 
 
implementation 
 
uses ComObj,mail; 
 
{$R *.dfm} 
 
procedure TfrmOuput.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
sCont.Free; 
clearSta; 
free; 
end; 
 
procedure TfrmOuput.SpeedButton1Click(Sender: TObject); 
var 
    str:string; 
begin 
    if chk1.Checked then 
    begin 
        SaveDialog1.Filter:='文本文件(*.txt)|*.txt'; 
        str:='.txt'; 
        valid:=1; 
    end 
    else if chk2.Checked then 
    begin 
        SaveDialog1.Filter:='*.xls(*.xls)|*.xls'; 
        str:='.xls'; 
        valid:=2; 
    end; 
    if SaveDialog1.Execute then 
        Edit1.Text:=SaveDialog1.FileName+str; 
end; 
 
procedure TfrmOuput.saveTxt(); 
var 
    //sql0:string; 
    ff:TextFile; 
    fn,text:string; 
    n:integer; 
begin 
    //createDB; 
    if trim(Edit1.Text)='' then exit; 
    frmMain.StatusBar1.Panels[0].Text:='正在导出数据...'; 
    fn:=edit1.Text; 
    AssignFile(ff,fn); 
    Rewrite(ff); 
    Append(ff); 
    for n:=0 to sCont.Count-1 do 
    begin 
        text:=sCont.Strings[n]; 
        Writeln(ff,text); 
    end; 
    {sql0:='select * from email'; 
    ADODataSet1.Close; 
    ADODataSet1.ConnectionString:=ConnectString; 
    ADODataSet1.CommandType:=cmdText; 
    ADODataSet1.CommandText:=sql0; 
    ADODataSet1.Open; 
    ADODataSet1.First; 
    while (not ADODataSet1.Eof) do 
    begin 
        text:=ADODataSet1.FieldByName('mails').AsString; 
        Writeln(ff,text); 
        ADODataSet1.Next; 
        frmMain.StatusBar1.Panels[1].Text:='导出记录:'+IntToStr(ADODataSet1.RecNo); 
    end; 
    ADODataSet1.Close; } 
    closefile(ff); 
    sCont.Free; 
    Application.MessageBox('邮件成功导出','确认',MB_OKCANCEL); 
    frmMain.StatusBar1.Panels[0].Text:='已经导出邮件'; 
end; 
 
procedure TfrmOuput.saveExcel(); 
var 
    excelApp,wrkBook:variant; 
    n,k:integer; 
    text:string; 
begin 
    n:=1; 
    if trim(edit1.Text)='' then exit; 
    frmMain.StatusBar1.Panels[0].Text:='正在导出数据...'; 
    excelApp:=CreateOleObject('Excel.Application'); 
    wrkBook:=excelApp.WorkBooks.Add; 
    for k:=0 to sCont.Count-1 do 
    begin 
        text:=sCont.Strings[k]; 
        excelApp.workSheets[1].cells[n,1].value:=text; 
        Inc(n); 
    end; 
    excelApp.ActiveWorkBook.SaveAs(edit1.Text); 
    wrkBook.close; 
    excelApp.quit; 
    sCont.Free; 
    Application.MessageBox('邮件成功导出','确认',MB_OKCANCEL); 
    frmMain.StatusBar1.Panels[0].Text:='已经导出数据'; 
end; 
 
procedure TfrmOuput.FormCreate(Sender: TObject); 
//var 
//    sql0:string; 
begin 
    createDB; 
    BorderIcons:=BorderIcons-[biMaximize]; 
{    frmMain.StatusBar1.Panels[0].Text:='正在连接邮件库...'; 
    ConnectString:='Provider=Microsoft.Jet.OLEDB.4.0; Data Source='+ 
        ExtractFilePath(Paramstr(0))+'db\GroupMail.mdb; Jet OLEDB:Database Password='+pw; 
    sCont:=TStringList.Create; 
    sql0:='select * from email'; 
    ADODataSet1.Close; 
    ADODataSet1.ConnectionString:=ConnectString; 
    ADODataSet1.CommandType:=cmdText; 
    ADODataSet1.CommandText:=sql0; 
    ADODataSet1.Open; 
    ADODataSet1.First; 
    while (not ADODataSet1.Eof) do 
    begin 
        text:=ADODataSet1.FieldByName('mails').AsString; 
        sCont.Add(text); 
        ADODataSet1.Next; 
    end; 
    ADODataSet1.Close; 
    frmMain.StatusBar1.Panels[0].Text:='已经打开邮件库'; 
} 
end; 
 
procedure TfrmOuput.BitBtn1Click(Sender: TObject); 
begin 
    if valid=1 then 
        saveTxt 
    else if valid=2 then 
        saveExcel; 
end; 
 
procedure TfrmOuput.createDB(); 
var 
    sql0:string; 
begin 
    frmMain.StatusBar1.Panels[0].Text:='正在连接邮件库...'; 
    ConnectString:='Provider=Microsoft.Jet.OLEDB.4.0; Data Source='+ 
        ExtractFilePath(Paramstr(0))+'db\GroupMail.mdb; Jet OLEDB:Database Password='+pw; 
    sCont:=TStringList.Create; 
    sql0:='select * from email'; 
    ADODataSet1.Close; 
    ADODataSet1.ConnectionString:=ConnectString; 
    ADODataSet1.CommandType:=cmdText; 
    ADODataSet1.CommandText:=sql0; 
    ADODataSet1.Open; 
    if ADODataSet1.RecordCount<1 then exit; 
    ADODataSet1.First; 
    while (not ADODataSet1.Eof) do 
    begin 
        text:=ADODataSet1.FieldByName('mails').AsString; 
        sCont.Add(text); 
        ADODataSet1.Next; 
    end; 
    ADODataSet1.Close; 
    frmMain.StatusBar1.Panels[0].Text:='已经打开邮件库'; 
end; 
 
procedure TfrmOuput.BitBtn2Click(Sender: TObject); 
begin 
    Close; 
end; 
 
end.