unit1.pas

该源码程序使用DELPHI连接EXCEL数据表并查询生成新的表单及一些EXCEL调用函数

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, Buttons, ExtCtrls, DBCtrls, Grids, DBGrids,
  ExcelXP,comobj,Tlhelp32, XPMan, ComCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    BitBtn1: TBitBtn;
    ADOQuery1: TADOQuery;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    XPManifest1: TXPManifest;
    ComboBox1: TComboBox;
    Button4: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    ComboBox2: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox3: TComboBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
type strarray=array of string;
type strGDarray=array[0..1] of string;
{$R *.dfm}
var
excelApp,excelApp1:variant;
columnsum,sheetsum,sheetsum1,sheetrow:integer;
sheetNames:strarray;
DBfieldtitle:strarray;
//结束进程 ********************************************
function KillTask(ExeFileName: string): Integer;
const
 PROCESS_TERMINATE = $0001;
var
 ContinueLoop: BOOL;
 FSnapshotHandle: THandle;
 FProcessEntry32: TProcessEntry32;
begin
 Result := 0;
 FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
 ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

 while Integer(ContinueLoop) <> 0 do
 begin
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
     UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
     UpperCase(ExeFileName))) then
     Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,
       BOOL(0),FProcessEntry32.th32ProcessID),0));
   ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
 end;
 CloseHandle(FSnapshotHandle);
end;

//提权****************************************************
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable:Boolean): Boolean;
var
 TP: TOKEN_PRIVILEGES;
 Dummy: Cardinal;
begin
 TP.PrivilegeCount := 1;
 LookupPrivilegevalue(nil, pchar(PrivName), TP.Privileges[0].Luid);
 if bEnable then
   TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
 else
   TP.Privileges[0].Attributes := 0;
 AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
 Result := GetLastError = ERROR_SUCCESS;
end;  
//***************************************************
//获得工作簿中所有工作表的名字************************
function GetSheetnameTabulate(strlb:strarray):string;
var
strpp:string;
jj:integer;
begin
strpp:='';
for jj:=0 to sheetsum -1 do
  begin
    if jj<>sheetsum-1 then
    strpp:=strpp + '[' + strlb[jj] + '$]'+','
    else
    strpp:=strpp + '[' + strlb[jj] + '$]';
  end;
  result:=strpp;
end;

function AddsheetNameMark(strsheetname:string):string;
begin
result:='[' + strsheetname +'$]';
end;


//拷贝DBGrid当前行 ************************************


function CopyCurrentDBLine(DBGridC: TDBGrid):string;
var
  i: Integer;
  Line: String;
begin
  line:='';
  for i := 0 to DBGridC.Columns.Count - 1 do begin
    if Assigned(DBGridC.Columns.Grid.Fields[i]) then
      if i = 0 then
        Line := DBGridC.Columns.Grid.Fields[i].Text
      else
        Line := Line + ',' + DBGridC.Columns.Grid.Fields[i].Text;
  end;
  //Clipboard.SetTextBuf(pchar(Line));
  result:=line;
end;

//***************************************************

function GetZStrfrMstr(strM,strmark:string):strgdarray;
var
bjwz,lg:integer;
begin
lg:=length(strM);
bjwz:=pos(strmark,strM);
GetZstrfrMstr[0]:=copy(strM,1,bjwz-1);
getZstrfrMstr[1]:=copy(strM,bjwz+1,lg);
end;


procedure NewExcel();
begin
excelapp1:=createoleobject('excel.application');
excelapp1.workbooks.add;
excelapp1.caption:='Microsoft Excel';
//excelapp1.windowState:=wsNormal;
sheetsum1:=excelapp1.worksheets.count;
excelapp1.visible:=true;
end;

function getDayofWeek:string;
  begin   
      case   dayofweek(date)   of   
          1:result:='星期日';   
          2:result:='星期一';   
          3:result:='星期二';   
          4:result:='星期三';   
          5:result:='星期四';   
          6:result:='星期五';   
          7:result:='星期六';   
      end;   
  end;

procedure OpenExcel(excelpath:string);
begin
excelapp1:=createoleobject('excel.application');
excelapp1.workbooks.open(excelpath);
sheetsum1:=excelapp1.worksheets.count;
excelapp1.visible:=true;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
FilePath:string;
str1,str2,str3,str4,str5,str6,str7,str8,str9 :string;
ii:integer;
begin
str1:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=';
str2:=';Mode=Share Deny None;Extended Properties=Excel 8.0;';
str3:='Jet OLEDB:System database="";Jet OLEDB:Registry Path="";';
str4:='Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=35;';
str5:='Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;';
str6:='Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";';
str7:='Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;';
str8:='Jet OLEDB:Don''t Copy Locale on Compact=False;';
str9:='Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
adoconnection1.Connected :=false;
//adoconnection1.Connected :=true;
try
excelApp:=CreateOleObject('excel.application');
if opendialog1.Execute then
    begin
    filepath:=opendialog1.FileName ;
    excelApp.workbooks.open(filepath);
    //excelApp.visible:=true;

    sheetsum:=ExcelApp.WorkSheets.Count;
    setlength(sheetNames,sheetsum);
    for ii:=0 to sheetsum-1 do
      begin
        sheetNames[ii]:=excelApp.worksheets[ii+1].name;
        combobox2.Items.Add(sheetNames[ii]);
      end;
    combobox2.Text :=combobox2.Items.Strings[0];
    adoconnection1.ConnectionString :=str1 + filepath + str2 + str3 + str4 + str5 + str6 + str7 + str8 + str9 ;
    //adoquery1.Active :=true;
    button1.Enabled :=true;
    button2.Enabled :=true;
end;
except
showmessage('系统中没有安装Excel或者Excel损坏了!');
end;
excelApp.quit;
killtask('excel.exe');
form1.Button2Click(sender);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
pamstr,pamstr1,sheetname2:string;
i:integer;
begin
    pamstr:=edit1.Text ;
    pamstr1:=combobox1.Text ;
    sheetname2:=Addsheetnamemark(combobox2.Text);
    adoquery1.Active :=false;
    adoquery1.Close;
    adoquery1.SQL.Clear ;
    if pamstr<>'' then
    adoquery1.SQL.Add ('select * from ' + sheetname2 + ' where ' + pamstr1 + ' like' + '''%' + pamstr +'%''')
    //adoquery1.SQL.Add ('select * from ' + sheetname2 + ' where 存货编码 = ''' + pamstr +'''');
    else
    adoquery1.SQL.Add ('select * from ' + sheetname2 + ' where 存货编码 is null');

    //首先判断是否为空   OR   NULL？
    //NULL
    //select   *   from   客户管理   where  字段  Is Null
    //空
    //select   *   from   客户管理   where   LEN(TRIM(A))=0

  try
    adoquery1.Active :=true  ;
    //dbgrid1.DataSource :=datasource1;
    for i:=0 to columnsum-1 do
    begin
    dbgrid1.Columns.Items[i].Width :=130;
    end;
    dbgrid1.Refresh ;
   // edit2.Text := copycurrentdbline(dbgrid1);
  except
    showmessage('查询数据出错,程序返回！');
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
sheetname1:string;
SheetRowSum :integer;
begin
    sheetname1:=AddSheetnamemark(combobox2.Text);
    adoquery1.Active :=false;
    adoquery1.Close ;
    adoquery1.SQL.Clear ;
    //select cast(field1 as decimal(18,3)) as field1 from table1
    adoquery1.SQL.Add('select * from ' + sheetname1);
    //adoquery1.SQL.Add('select * from ')
    //adoquery1.SQL.Add('select cast(djbhs as decimal(18,3)) as djbhs from' + sheetname1);
    adoquery1.Active :=true;
    sheetrowsum:=adoquery1.RecordCount ;
    columnsum:=adoquery1.FieldCount;
    setlength(DBfieldtitle,columnsum);
    dbgrid1.DataSource :=datasource1;
    for i:=0 to columnsum-1 do
    begin
    dbgrid1.Columns.Items[i].Width :=130;
    dbfieldtitle[i]:=dbgrid1.Fields[i].FieldName;
    combobox1.Items.Add(dbfieldtitle[i]);
    end;
    dbgrid1.Refresh ;
    combobox1.Text :=combobox1.Items.Strings[0];
    button3.Enabled :=true;
    button4.Enabled :=true;
    statusbar1.Panels[0].Text :='此工作表共有数据'+ inttostr(sheetrowsum) +'条';
    
end;


procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
strjj:strarray;
temp_str,temp_str1:string;
i,j:integer;
begin
temp_str1 :=copycurrentDBline(dbgrid1);
sheetrow:=sheetrow + 1;
setlength(strjj,columnsum);
for i:=0 to columnsum-2 do
  begin
    strjj[i]:=GetZstrfrMstr(temp_str1,',')[0];
    temp_str:=GetZstrfrMstr(temp_str1,',')[1];
    temp_str1 :=temp_str;
  end;
    strjj[columnsum-1]:=temp_str;
    try
    for j:=0 to columnsum-1 do
    excelapp1.worksheets[combobox3.Text].cells[sheetrow,j+1].value:=strjj[j];
    except
    showmessage('你没有打开或者新建Excel，请按打开或者新建Excel按钮');
    exit;
    end;

end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
form1.Button1Click(sender);
dbgrid1.SetFocus ;
end;
end;


procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
var
strjj:strarray;
temp_str,temp_str1:string;
i,j:integer;
begin
if key=#13 then
begin
temp_str1 :=copycurrentdbline(dbgrid1);
sheetrow:=sheetrow + 1;
setlength(strjj,columnsum);
for i:=0 to columnsum-2 do
  begin
    strjj[i]:=GetZstrfrMstr(temp_str1,',')[0];
    temp_str:=GetZstrfrMstr(temp_str1,',')[1];
    temp_str1 :=temp_str;
  end;
    strjj[columnsum-1]:=temp_str;
  try
  for j:=0 to columnsum-1 do
  excelapp1.worksheets[combobox3.Text].cells[sheetrow,j+1].value:=strjj[j];
  except
  showmessage('你没有打开或者新建Excel，请按打开或者新建Excel按钮');
  exit;
  end;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
i,j:integer;
begin
if opendialog1.Execute then
begin
    openexcel(opendialog1.FileName);
    for j:=0 to sheetsum1-1 do
    begin
        combobox3.Items.Add(excelapp1.worksheets[j+1].name);
    end;
    combobox3.Text :=combobox3.Items.Strings[0];
    excelapp1.worksheets[combobox3.Text].activate;
    sheetrow:=excelapp1.worksheets[combobox3.text].usedrange.rows.count;
    if sheetrow< 1 then
    begin
        for i:=0 to columnsum-1 do
        excelapp1.worksheets[combobox3.Text].cells[1,i+1].value:=dbfieldtitle[i];
        sheetrow:=1;
    end;

end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
i,j:integer;
drbm:string;
begin
    Newexcel();
    for j:=0 to sheetsum1-1 do
    begin
    combobox3.Items.Add(excelapp1.worksheets[j+1].name);
    end;
    combobox3.Text :=combobox3.Items.Strings[0];
    drbm:=addsheetnamemark(combobox3.Text );
    excelapp1.worksheets[combobox3.Text].activate;
    for i:=0 to columnsum-1 do
    begin
        excelapp1.worksheets[combobox3.Text].cells[1,i+1].value:=dbfieldtitle[i];
    end;
    sheetrow:=1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
strYear,strweek:string;
begin
stryear:=datetostr(now);
strweek:=getdayofweek;
statusbar1.Panels[1].Text:=stryear;
Statusbar1.Panels[2].Text:=strweek;
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
if combobox3.Text <>'' then
  begin
    excelapp1.worksheets[combobox3.Text].activate;
  end;

end;

end.