监控系统文件操作,语句中使用字符串
分类:多线程

uses ComObj;
   
procedure CrnPinAppToWin7Taskbar(strPath, strApp: string);
var
  vShell, vFolder, vFolderItem, vItemVerbs: Variant;
  vPath, vApp: Variant;
  i: Integer;
  str, strPinName: String;
begin
  vShell := CreateOleObject('Shell.Application');
  vPath := strPath;
  vFolder := vShell.NameSpace(vPath);
  vApp := strApp;
  vFolderItem := vFolder.ParseName(vApp);
  vItemVerbs := vFolderItem.Verbs;
   
  // 以下的PinName只适用于中文版的系统
  // 英文版的系统要用'Pin to Tas&kbar'
  // strPinName :='Pin to Tas&kbar';
  strPinName :='锁定到任务栏(&K)';
   
  for i :=1to vItemVerbs.Count do
  begin
    str := vItemVerbs.Item(i).Name;
   
    if SameText(str, strPinName) then
    begin
      //63637275 6E 2E 63 6F 6D
      vItemVerbs.Item(i).DoIt;
    end;
  end;
end;
   
procedure TForm1.Button1Click(Sender: TObject);
begin
  CrnPinAppToWin7Taskbar('C:windows', 'regedit.exe');
end;

非常遗憾 Delphi 的 case 语句不支持字符串, 但我觉得这也可能是基于效率的考量;
如果非要在 case 中使用字符串, 也不是不可以变通, 这里提供了五种方法.

(一) 使用动态创建的方法
首先创建 Excel 对象,使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject( 'Excel.Application' );
1) 显示当前窗口:
ExcelApp.Visible := True;
2) 更改 Excel 标题栏:
ExcelApp.Caption := '应用程序调用 Microsoft Excel';
3) 添加新工作簿:
ExcelApp.WorkBooks.Add;
4) 打开已存在的工作簿:
ExcelApp.WorkBooks.Open( 'C:/Excel/Demo.xls' );
5) 设置第2个工作表为活动工作表:
ExcelApp.WorkSheets[2].Activate;  或 ExcelApp.WorksSheets[ 'Sheet2' ].Activate;
6) 给单元格赋值:
ExcelApp.Cells[1,4].Value := '第一行第四列';
7) 设置指定列的宽度(单位:字符个数),以第一列为例:
ExcelApp.ActiveSheet.Columns[1].ColumnsWidth := 5;
8) 设置指定行的高度(单位:磅)(1磅=0.035厘米),以第二行为例:
ExcelApp.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
9) 在第8行之前插入分页符:
ExcelApp.WorkSheets[1].Rows.PageBreak := 1;
10) 在第8列之前删除分页符:ExcelApp.ActiveSheet.Columns[4].PageBreak := 0;
11) 指定边框线宽度:
ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左    2-右   3-顶    4-底   5-斜( / )     6-斜( / )
12) 清除第一行第四列单元格公式:
ExcelApp.ActiveSheet.Cells[1,4].ClearContents;
13) 设置第一行字体属性:ExcelApp.ActiveSheet.Rows[1].Font.Name := '隶书';
ExcelApp.ActiveSheet.Rows[1].Font.Color  := clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold   := True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;
14) 进行页面设置:
a.页眉:
   ExcelApp.ActiveSheet.PageSetup.CenterHeader := '报表演示';
b.页脚:
   ExcelApp.ActiveSheet.PageSetup.CenterFooter := '第&P页';
c.页眉到顶端边距2cm:
   ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.页脚到底端边距3cm:
   ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.顶边距2cm:
   ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底边距2cm:
   ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左边距2cm:
   ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右边距2cm:
   ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.页面水平居中:
   ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.页面垂直居中:
   ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印单元格网线:
   ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;
15) 拷贝操作:
a.拷贝整个工作表:   ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域:   ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴:   ExcelApp.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴:   ExcelApp.ActiveSheet.Range.PasteSpecial;
16) 插入一行或一列:
a. ExcelApp.ActiveSheet.Rows[2].Insert;
b. ExcelApp.ActiveSheet.Columns[1].Insert;
17) 删除一行或一列:
a. ExcelApp.ActiveSheet.Rows[2].Delete;
b. ExcelApp.ActiveSheet.Columns[1].Delete;
18) 打印预览工作表:
ExcelApp.ActiveSheet.PrintPreview;
19) 打印输出工作表:
ExcelApp.ActiveSheet.PrintOut;
20) 工作表保存:
if not ExcelApp.ActiveWorkBook.Saved then
  ExcelApp.ActiveSheet.PrintPreview;
21) 工作表另存为:
ExcelApp.SaveAs( 'C:/Excel/Demo1.xls' );
22) 放弃存盘:
ExcelApp.ActiveWorkBook.Saved := True;
23) 关闭工作簿:
ExcelApp.WorkBooks.Close;
24) 退出 Excel:
ExcelApp.Quit;
(二) 使用Delphi 控件方法
在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。 
1)  打开Excel 
ExcelApplication1.Connect;
2) 显示当前窗口:
ExcelApplication1.Visible[0]:=True;
3) 更改 Excel 标题栏:
ExcelApplication1.Caption := '应用程序调用 Microsoft Excel';
4) 添加新工作簿:
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
5) 添加新工作表:
var Temp_Worksheet: _WorkSheet;
begin
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);End;
6) 打开已存在的工作簿:
ExcelApplication1.Workbooks.Open (c:/a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
   EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)
7) 设置第2个工作表为活动工作表:
ExcelApplication1.WorkSheets[2].Activate;  或
ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;
8) 给单元格赋值:
ExcelApplication1.Cells[1,4].Value := '第一行第四列';
9) 设置指定列的宽度(单位:字符个数),以第一列为例:
ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;
10) 设置指定行的高度(单位:磅)(1磅=0.035厘米),以第二行为例:
ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
11) 在第8行之前插入分页符:
ExcelApplication1.WorkSheets[1].Rows.PageBreak := 1;
12) 在第8列之前删除分页符:
ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;
13) 指定边框线宽度:
ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左    2-右   3-顶    4-底   5-斜( / )     6-斜( / )
14) 清除第一行第四列单元格公式:
ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;
15) 设置第一行字体属性:
ExcelApplication1.ActiveSheet.Rows[1].Font.Name := '隶书';
ExcelApplication1.ActiveSheet.Rows[1].Font.Color  := clBlue;
ExcelApplication1.ActiveSheet.Rows[1].Font.Bold   := True;
ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True;
16) 进行页面设置:
a.页眉:
   ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := '报表演示';
b.页脚:
   ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := '第&P页';
c.页眉到顶端边距2cm:
   ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.页脚到底端边距3cm:
   ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.顶边距2cm:
   ExcelApplication1.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底边距2cm:
   ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左边距2cm:
   ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右边距2cm:
   ExcelApplication1.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.页面水平居中:
   ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.页面垂直居中:
   ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印单元格网线:
   ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;
17) 拷贝操作:
a.拷贝整个工作表:
   ExcelApplication1.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域:
   ExcelApplication1.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴:
   ExcelApplication1.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴:
   ExcelApplication1.ActiveSheet.Range.PasteSpecial;
18) 插入一行或一列:
a. ExcelApplication1.ActiveSheet.Rows[2].Insert;
b. ExcelApplication1.ActiveSheet.Columns[1].Insert;
19) 删除一行或一列:
a. ExcelApplication1.ActiveSheet.Rows[2].Delete;
b. ExcelApplication1.ActiveSheet.Columns[1].Delete;
20) 打印预览工作表:
ExcelApplication1.ActiveSheet.PrintPreview;
21) 打印输出工作表:
ExcelApplication1.ActiveSheet.PrintOut;
22) 工作表保存:
if not ExcelApplication1.ActiveWorkBook.Saved then
  ExcelApplication1.ActiveSheet.PrintPreview;
23) 工作表另存为:
ExcelApplication1.SaveAs( 'C:/Excel/Demo1.xls' );
24) 放弃存盘:
ExcelApplication1.ActiveWorkBook.Saved := True;
25) 关闭工作簿:
ExcelApplication1.WorkBooks.Close;
26) 退出 Excel:
ExcelApplication1.Quit;
ExcelApplication1.Disconnect;
本人 收藏


对不起我还需要一个锁定功能啊,就是输出到EXCEL后只能看,不能进行手工修改

你是否想为你的Windows加上一双眼睛,察看使用者在机器上所做的各种操作(例如建立、删除文件;改变文件或目录名字)呢?

本例效果图:

Xl.Cells.Select;//Select All Cells
Xl.Selection.Locked = True;// Lock Selected Cells

    这里介绍一种利用Windows未公开函数实现这个功能的方法。

图片 1

//Xl:=CreateOleObject('Excel.Application');

    在Windows下有一个未公开函数SHChangeNotifyRegister可以把你的窗口添加到系统的系统消息监视链中,该函数在Delphi中的定义如下:

代码文件:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
RadioGroup1: TRadioGroup;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure FormCreate(Sender: TObject,',',');
procedure Button1Click(Sender: TObject,',',');
procedure Button2Click(Sender: TObject,',',');
procedure Button3Click(Sender: TObject,',',');
procedure Button4Click(Sender: TObject,',',');
procedure Button5Click(Sender: TObject,',',');
procedure Button6Click(Sender: TObject,',',');
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses TypInfo; {操作枚举用}

{初始化一个单选组, 用于测试}
procedure TForm1.FormCreate(Sender: TObject,',',');
begin
RadioGroup1.Items.CommaText := 'a,bb,ccc,dddd';
RadioGroup1.ItemIndex := 0;
end;

{这是 case 语句比较常规的用法}
procedure TForm1.Button1Click(Sender: TObject,',',');
begin
case RadioGroup1.ItemIndex of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;
end;

{方法一: 假如要 case 的字符串的长度不同}
procedure TForm1.Button2Click(Sender: TObject,',',');
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case Length(str) of
1 : Color := clRed;
2 : Color := clYellow;
3 : Color := clLime;
4 : Color := clBlue;
end;
end;

{方法二: 假如要 case 的字符串的第一个字母不同, case 是支持字符的}
procedure TForm1.Button3Click(Sender: TObject,',',');
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case str[1] of
'a': Color := clRed;
'b': Color := clYellow;
'c': Color := clLime;
'd': Color := clBlue;
end;
end;

{方法三: 借用 TStringList}
procedure TForm1.Button4Click(Sender: TObject,',',');
var
List: TStringList;
str: string;
begin
List := TStringList.Create;
List.Text := RadioGroup1.Items.Text;

str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case List.IndexOf(str) of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;

List.Free;
end;

{方法四: 借用枚举}
type
TMyEnum = (a, bb, ccc, dddd,',',');

procedure TForm1.Button5Click(Sender: TObject,',',');
var
MyEnum: TMyEnum;
str: String;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];

MyEnum := TMyEnum(GetEnumvalue(TypeInfo(TMyEnum), str),',',');
case MyEnum of
a : Color := clRed;
bb : Color := clYellow;
ccc : Color := clLime;
dddd : Color := clBlue;
end;
end;

{方法五: 利用对比字符串返回的整数, 这种方法并不太可靠, 但在某种情况下会更灵活}
procedure TForm1.Button6Click(Sender: TObject,',',');
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case CompareStr(str, 'a') of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;
end;

end.


    Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
    lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;

 

    其中参数hWnd定义了监视系统操作的窗口得句柄,参数uFlags dwEventID定义监视操作参数,参数uMsg定义操作消息,参数cItems定义附加参数,参数lpps指定一个PIDLSTRUCT结构,该结构指定监视的目录。

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  ExcelApp, Sheet: Variant;
begin
  if OpenDialog1.Execute then
  begin
    ExcelApp := CreateOleObject( 'Excel.Application' );
    ExcelApp.Workbooks.Open(OpenDialog1.FileName);
    Sheet    := ExcelApp.ActiveSheet;
    Caption  := 'Row Count: ' + IntToStr(Sheet.UsedRange.Rows.Count);
    ExcelApp.Quit;
    Sheet    := Unassigned;
    ExcelApp := Unassigned;
  end;
end;

    当函数调用成功之后,函数会返回一个监视操作句柄,同时系统就会将hWnd指定的窗口加入到操作监视链中,当有文件操作发生时,系统会向hWnd发送uMsg指定的消息,我们只要在程序中加入该消息的处理函数就可以实现对系统操作的监视了。


    如果要退出程序监视,就要调用另外一个未公开得函数SHChangeNotifyDeregister来取消程序监视。

 

    下面是使用Delphi编写的具体程序实现范例,首先建立一个新的工程文件,然后在Form1中加入一个Button控件和一个Memo控件,

procedure CopyDbDataToExcel(Target: TDbgrid);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;
  //通过ole创建Excel对象
  try
    XLApp := CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;
  XLApp.WorkBooks.Add[XLWBatWorksheet];
  XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
  Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];
  if not Target.DataSource.DataSet.Active then
  begin
     Screen.Cursor := crDefault;
     Exit;
  end;
  Target.DataSource.DataSet.first;

    程序的代码如下:

  for iCount := 0 to Target.Columns.Count - 1 do
  begin
     Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
  end;
  jCount := 1;
  while not Target.DataSource.DataSet.Eof do
  begin
     for iCount := 0 to Target.Columns.Count - 1 do
     begin
       Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
     end;
     Inc(jCount);
     Target.DataSource.DataSet.Next;
  end;
  XlApp.Visible := True;
  Screen.Cursor := crDefault;
end;

unit ufrmMain;

 

interface

看看我的函数
function ExportToExcel(Header: String;
  vDataSet: TDataSet): Boolean;
var
  I,VL_I,j: integer;
  S,SysPath: string;
  MsExcel:Variant;
begin
  Result:=true;
  if Application.MessageBox('您确信将数据导入到Excel吗?','提示!',MB_OKCANCEL

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs ,shlobj, Activex, StdCtrls,
  Menus,
  uTbLogFile;

  • MB_DEFBUTTON1) = IDOK then
      begin
          SysPath:=ExtractFilePath(application.exename);
          with TStringList.Create do
          try
            vDataSet.First ;
            S:=S+Header;
        //    system.Delete(s,1,1);
            add(s);
            s:=';
            For I:=0 to vDataSet.fieldcount-1 do
              begin
                If vDataSet.fields[I].visible=true then
                   S:=S+#9+vDataSet.fields[I].displaylabel;
              end;
            system.Delete(s,1,1);
            add(s);
            while not vDataSet.Eof do
            begin
              S := ';
              for I := 0 to vDataSet.FieldCount -1 do
                begin
                  If vDataSet.fields[I].visible=true then
                     S := S + #9 + vDataSet.Fields[I].AsString;
                end;
              System.Delete(S, 1, 1);
              Add(S);
              vDataSet.Next;
            end;
            Try
              SaveToFile(SysPath+'/Tem.xls');
            Except
              ShowMessage('写文件时发生保护性错误,Excel 如在运行,请先关闭!');
              Result:=false;
              exit;
            end;
          finally
            Free;
          end;
          Try
            MSExcel:=CreateOleObject('Excel.Application');
          Except
            ShowMessage('Excel 没有安装,请先安装!');
            Result:=false;
            exit;
          end;
          Try
            MSExcel.workbooks.open(SysPath+'/Tem.xls');
          Except
            ShowMessage('打开临时文件时出错,请检查'+SysPath+'/Tem.xls');
            Result:=false;
            exit;
          end;
            MSExcel.visible:=True;
            for VL_I :=1 to 4 do
            MSExcel.Selection.Borders[VL_I].LineStyle := 0;
            MSExcel.cells.select;
            MSExcel.Selection.HorizontalAlignment :=3;
            MSExcel.Selection.Borders[1].LineStyle := 0;

const 
  SHCNE_RENAMEITEM = $1;
  SHCNE_CREATE = $2;
  SHCNE_DELETE = $4; 
  SHCNE_MKDIR = $8; 
  SHCNE_RMDIR = $10; 
  SHCNE_MEDIAINSERTED = $20; 
  SHCNE_MEDIAREMOVED = $40; 
  SHCNE_DRIVEREMOVED = $80; 
  SHCNE_DRIVEADD = $100; 
  SHCNE_NETSHARE = $200;
  SHCNE_NETUNSHARE = $400;
  SHCNE_ATTRIBUTES = $800; 
  SHCNE_UPDATEDIR = $1000;
  SHCNE_UPDATEITEM = $2000; 
  SHCNE_SERVERDISCONNECT = $4000;
  SHCNE_UPDATEIMAGE = $8000; 
  SHCNE_DRIVEADDGUI = $10000; 
  SHCNE_RENAMEFOLDER = $20000; 
  SHCNE_FREESPACE = $40000; 
  SHCNE_ASSOCCHANGED = $8000000; 
  SHCNE_DISKEVENTS = $2381F;
  SHCNE_GLOBALEVENTS = $C0581E0;
  SHCNE_ALLEVENTS = $7FFFFFFF;
  SHCNE_INTERRUPT = $80000000;
  SHCNF_IDLIST = 0; 
  // LPITEMIDLIST 
  SHCNF_PATHA = $1; 
  // path name 
  SHCNF_PRINTERA = $2; 
  // printer friendly name 
  SHCNF_DWORD = $3; 
  // DWORD 
  SHCNF_PATHW = $5; 
  // path name 
  SHCNF_PRINTERW = $6; 
  // printer friendly name 
  SHCNF_TYPE = $FF; 
  SHCNF_FLUSH = $1000; 
  SHCNF_FLUSHNOWAIT = $2000;
  SHCNF_PATH = SHCNF_PATHW; 
  SHCNF_PRINTER = SHCNF_PRINTERW; 
  WM_SHNOTIFY = $401; 
  NOERROR = 0;
 
type
  TForm1 = class(TForm)
    mmo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    WRITE_LOG : TRTLCriticalSection;
    FLogWriterSetupForm: TTbLogFile;
  public
    procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY;
  end;

      MSExcel.Range['A1'].Select;
      MSExcel.Selection.Font.Size :=24;

type
  PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;
  SHNOTIFYSTRUCT = record
    dwItem1 : PItemIDList;
    dwItem2 : PItemIDList;
  end;

      J:=0 ;
      for i:=0 to vdataset.fieldcount-1 do
          if vDataSet.fields[I].visible  then
             J:=J+1;

Type
  PSHFileInfoByte=^SHFileInfoByte;
  _SHFileInfoByte = record
    hIcon :Integer;
    iIcon :Integer;
    dwAttributes : Integer;
    szDisplayName : array [0..259] of char;
    szTypeName : array [0..79] of char;
  end;

      VL_I :=J;
      MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Select;
      MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Merge;
  end
  else
    Result:=false;
end;

    SHFileInfoByte=_SHFileInfoByte;

 

  Type PIDLSTRUCT = ^IDLSTRUCT; 
  _IDLSTRUCT = record
    pidl : PItemIDList;
    bWatchSubFolders : Integer;
  end;

 

  IDLSTRUCT = _IDLSTRUCT;
 
  function SHNotify_Register(hWnd : Integer) : Bool;
  function SHNotify_UnRegister:Bool; 
  function SHEventName(strPath1,strPath2:string;lParam:Integer):string;
  Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;external 'Shell32.dll' index 4; 
  Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2; 
  Function SHGetFileInfoPidl(pidl : PItemIDList;dwFileAttributes : Integer;psfib : PSHFILEINFOBYTE;cbFileInfo : Integer;uFlags : Integer):Integer;stdcall;external 'Shell32.dll' name 'SHGetFileInfoA'; 

转别人的组件
unit OleExcel;

var
  Form1: TForm1;
  m_hSHNotify:Integer;
  m_pidlDesktop : PItemIDList;

interface

implementation

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  comobj, DBTables, Grids;
type
  TOLEExcel = class(TComponent)
  private
    FExcelCreated: Boolean;
    FVisible: Boolean;
    FExcel: Variant;
    FWorkBook: Variant;
    FWorkSheet: Variant;
    FCellFont: TFont;
    FTitleFont: TFont;
    FFontChanged: Boolean;
    FIgnoreFont: Boolean;
    FFileName: TFileName;
    procedure SetExcelCellFont(var Cell: Variant);
    procedure SetExcelTitleFont(var Cell: Variant);
    procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
    procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
    procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
  protected
    procedure SetCellFont(NewFont: TFont);
    procedure SetTitleFont(NewFont: TFont);
    procedure SetVisible(DoShow: Boolean);
    function GetCell(ACol, ARow: Integer): string;
    procedure SetCell(ACol, ARow: Integer; const Value: string);

{$R *.dfm}

    function GetDateCell(ACol, ARow: Integer): TDateTime;
    procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateExcelInstance;
    property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
    property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
    function IsCreated: Boolean;
    procedure TableToExcel(const Table: TTable);
    procedure QueryToExcel(const Query: TQuery);
    procedure StringGridToExcel(const StringGrid: TStringGrid);
    procedure SaveToExcel(const FileName: string);
  published
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property CellFont: TFont read FCellFont write SetCellFont;
    property Visible: Boolean read FVisible write SetVisible;
    property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
    property FileName: TFileName read FFileName write FFileName;
  end;

function SHEventName(strPath1, strPath2: string; lParam: Integer): string;
var 
  sEvent:String; 
begin 
  case lParam of        //根据参数设置提示消息
    SHCNE_RENAMEITEM: sEvent := '重命名文件' + strPath1 + '为' + strpath2;
    SHCNE_CREATE: sEvent := '建立文件 文件名:' + strPath1;
    SHCNE_DELETE: sEvent := '删除文件 文件名:' + strPath1;
    SHCNE_MKDIR: sEvent := '新建目录 目录名:' + strPath1;
    SHCNE_RMDIR: sEvent := '删除目录 目录名:' + strPath1;
    SHCNE_MEDIAINSERTED: sEvent := strPath1 + '中插入可移动存储介质';
    SHCNE_MEDIAREMOVED: sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' '+strpath2;
    SHCNE_DRIVEREMOVED: sEvent := '移去驱动器' + strPath1;
    SHCNE_DRIVEADD: sEvent := '添加驱动器' + strPath1;
    SHCNE_NETSHARE: sEvent := '改变目录' + strPath1 + '的共享属性';
 
    SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名' + strPath1;
    SHCNE_UPDATEDIR: sEvent := '更新目录' + strPath1;
    SHCNE_UPDATEITEM: sEvent := '更新文件 文件名:' + strPath1;
    SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接' + strPath1 + ' ' + strpath2;
    SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';
    SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI'; 
    SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹' + strPath1 + '为' + strpath2;
    SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';
    SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';
  else 
    sEvent := '未知操作' + IntToStr(lParam);
  end; 
  Result := sEvent; 
end; 

procedure Register;

function SHNotify_Register(hWnd: Integer): Bool;
var 
  ps: pidlstruct;
begin 
  {$R-} 
  result := false; 
  if m_hshnotify = 0 then
  begin
    //获取桌面文件夹的pidl 
    if shgetspecialfolderlocation(0, CSIDL_DESKTOP, m_pidldesktop) <> noerror then 
    form1.close; 
    if boolean(m_pidldesktop) then begin 
      new(ps); 
      try
        ps.bwatchsubfolders := 1;
        ps.pidl := m_pidldesktop; 
         
        // 利用shchangenotifyregister函数注册系统消息处理 
        m_hshnotify := shchangenotifyregister(hwnd, (shcnf_type or shcnf_idlist), 
        (shcne_allevents or shcne_interrupt), 
        wm_shnotify, 1, ps); 
        result := boolean(m_hshnotify); 
      finally
        FreeMem(ps);
      end;
    end
    else
    begin
      // 如果出现错误就使用 cotaskmemfree函数来释放句柄
      cotaskmemfree(m_pidldesktop);
    end;  
  end;
    {$R+} 
end;
 
function SHNotify_UnRegister: Bool;
begin 
  Result := False;
  If Boolean(m_hSHNotify) Then
  begin
    //取消系统消息监视,同时释放桌面的Pidl 
    If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin
      {$R-}
      m_hSHNotify := 0;
      CoTaskMemFree(m_pidlDesktop);
      Result := True;
      {$R-}
    End;
  end;
end;

implementation

procedure TForm1.WMShellReg(var Message: TMessage); 
//file://系统消息处理函数 
var 
  strPath1,strPath2:String; 
  charPath:array[0..259]of char; 
  pidlItem:PSHNOTIFYSTRUCT; 
begin 
  pidlItem := PSHNOTIFYSTRUCT(Message.wParam);
  //file://获得系统消息相关得路径
  SHGetPathFromIDList(pidlItem.dwItem1, charPath);
  strPath1 := charPath;
  SHGetPathFromIDList(pidlItem.dwItem2, charPath);
  strPath2 := charPath;
 
  try
    EnterCriticalSection(WRITE_LOG);
    FLogWriterSetupForm.WriteLnLog(SHEvEntName(strPath1, strPath2, Message.lParam) + chr(13) + chr(10));
  finally
    LeaveCriticalSection(WRITE_LOG);
  end;
//  mmo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam)+chr(13)+chr(10));
end;

constructor TOLEExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreFont := True;
  FCellFont := TFont.Create;
  FTitleFont := TFont.Create;
  FExcelCreated := False;
  FVisible := False;
  FFontChanged := False;
end;

{获得计算机名}
function GetComputerName: string;
var
  buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
  Size: Cardinal;
begin
  Size := MAX_COMPUTERNAME_LENGTH + 1;
  Windows.GetComputerName(@buffer, Size);
  Result := strpas(buffer);
end;

destructor TOLEExcel.Destroy;
begin
  FCellFont.Free;
  FTitleFont.Free;
  inherited Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := GetComputerName;

procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FCellFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;

  InitializeCriticalSection(WRITE_LOG);
  FLogWriterSetupForm := TTbLogFile.Create(nil);
  FLogWriterSetupForm.AutoRenameByDay := True;
  FLogWriterSetupForm.Open(ExtractFilePath(ParamStr(0)) + ' 操作.log', otAppend);
end;

procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FTitleFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //在程序退出的同时删除监视 
  if Boolean(m_pidlDesktop) then 
    SHNotify_Unregister;
end;

procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
  if not FExcelCreated then exit;
  if DoShow then
    FExcel.Visible := True
  else
    FExcel.Visible := False;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  m_hSHNotify:=0; 
  if SHNotify_Register(Form1.Handle) then begin //file://注册Shell监视 
    ShowMessage('Shell监视程序成功注册'); 
    Button1.Enabled := False;
  end 
  else
    ShowMessage('Shell监视程序注册失败');
end;

function TOLEExcel.GetCell(ACol, ARow: Integer): string;
begin
  if not FExcelCreated then exit;
  result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(WRITE_LOG);
  FreeAndNil(FLogWriterSetupForm);
end;

procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := Value;
end;

end.

function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
  if not FExcelCreated then
    begin
      result := 0;
      exit;
    end;
  result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

运行程序,点击“打开监视”按钮,如果出现一个显示“Shell监视程序成功注册”的对话框,说明Form1已经加入到系统操作监视链中了,你可以试着在资源管理器中建立、删除文件夹,移动文件等操作,你可以发现这些操作都被记录下来并显示在文本框中。

procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := '' + DateTimeToStr(Value);
end;

在上面的程序中多次使用到了一个PItemIDList的结构,这个数据结构指定Windows下得一个“项目”,在Windows下资源实现统一管理一个“项目”可以是一个文件或者一个文件夹,也可以是一个打印机等资源。另外一些API函数也涉及到了Shell(Windows外壳)操作,各位读者可以参考相应的参考资料。

procedure TOLEExcel.CreateExcelInstance;
begin
  try
    FExcel := CreateOLEObject('Excel.Application');
    FWorkBook := FExcel.WorkBooks.Add;
    FWorkSheet := FWorkBook.WorkSheets.Add;
    FExcelCreated := True;
  except
    FExcelCreated := False;
  end;
end;

function TOLEExcel.IsCreated: Boolean;
begin
  result := FExcelCreated;
end;

procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
  if NewFont <> FTitleFont then
    FTitleFont.Assign(NewFont);
end;

procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
  if NewFont <> FCellFont then
    FCellFont.Assign(NewFont);
end;

procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Table.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Table.Fields[Col].FieldName;
    end;
end;

procedure TOLEExcel.TableToExcel(const Table: TTable);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Table.Active = False then exit;

  GetTableColumnName(Table, Cell);
  Row := 2;
  with Table do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Query.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Query.Fields[Col].FieldName;
    end;
end;

procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Query.Active = False then exit;

  GetQueryColumnName(Query, Cell);
  Row := 2;
  with Query do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Col := 0 to StringGrid.FixedCols - 1 do
    for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Row := 0 to StringGrid.FixedRows - 1 do
    for Col := 0 to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row, x, y: LongInt;
begin
  Col := StringGrid.FixedCols;
  Row := StringGrid.FixedRows;
  for x := Row to StringGrid.RowCount - 1 do
    for y := Col to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[x + 1, y + 1];
        SetExcelCellFont(Cell);
        Cell.Value := StringGrid.Cells[y, x];
      end;
end;

procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  GetFixedCols(StringGrid, Cell);
  GetFixedRows(StringGrid, Cell);
  GetStringGridBody(StringGrid, Cell);
end;

procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
  if not FExcelCreated then exit;
  FWorkSheet.SaveAs(FileName);
end;

procedure Register;
begin
  RegisterComponents('Tanglu', [TOLEExcel]);
end;

end.

 

 

 

根据别人的组件改写的支持ADO

unit AdoToOleExcel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  comobj, DBTables, Grids,ADODB;
type
  TAdoToOleExcel = class(TComponent)
  private
    FExcelCreated: Boolean;
    FVisible: Boolean;
    FExcel: Variant;
    FWorkBook: Variant;
    FWorkSheet: Variant;
    FCellFont: TFont;
    FTitleFont: TFont;
    FFontChanged: Boolean;
    FIgnoreFont: Boolean;
    FFileName: TFileName;
    procedure SetExcelCellFont(var Cell: Variant);
    procedure SetExcelTitleFont(var Cell: Variant);
    procedure GetTableColumnName(const AdoTable: TAdoTable; var Cell: Variant);
    procedure GetQueryColumnName(const AdoQuery: TAdoQuery; var Cell: Variant);
    procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
  protected
    procedure SetCellFont(NewFont: TFont);
    procedure SetTitleFont(NewFont: TFont);
    procedure SetVisible(DoShow: Boolean);
    function GetCell(ACol, ARow: Integer): string;
    procedure SetCell(ACol, ARow: Integer; const Value: string);

    function GetDateCell(ACol, ARow: Integer): TDateTime;
    procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateExcelInstance;
    property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
    property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
    function IsCreated: Boolean;
    procedure ADOTableToExcel(const ADOTable: TADOTable);
    procedure ADOQueryToExcel(const ADOQuery: TADOQuery);
    procedure StringGridToExcel(const StringGrid: TStringGrid);
    procedure SaveToExcel(const FileName: string);
  published
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property CellFont: TFont read FCellFont write SetCellFont;
    property Visible: Boolean read FVisible write SetVisible;
    property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
    property FileName: TFileName read FFileName write FFileName;
  end;

procedure Register;

implementation

constructor TAdoToOleExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreFont := True;
  FCellFont := TFont.Create;
  FTitleFont := TFont.Create;
  FExcelCreated := False;
  FVisible := False;
  FFontChanged := False;
end;

destructor TAdoToOleExcel.Destroy;
begin
  FCellFont.Free;
  FTitleFont.Free;
  inherited Destroy;
end;

procedure TAdoToOleExcel.SetExcelCellFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FCellFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;

procedure TAdoToOleExcel.SetExcelTitleFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FTitleFont do
    begin
      Cell.Font.Name := Name;
      Cell.Font.Size := Size;
      Cell.Font.Color := Color;
      Cell.Font.Bold := fsBold in Style;
      Cell.Font.Italic := fsItalic in Style;
      Cell.Font.UnderLine := fsUnderline in Style;
      Cell.Font.Strikethrough := fsStrikeout in Style;
    end;
end;

procedure TAdoToOleExcel.SetVisible(DoShow: Boolean);
begin
  if not FExcelCreated then exit;
  if DoShow then
    FExcel.Visible := True
  else
    FExcel.Visible := False;
end;

function TAdoToOleExcel.GetCell(ACol, ARow: Integer): string;
begin
  if not FExcelCreated then exit;
  result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TAdoToOleExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := Value;
end;

function TAdoToOleExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
  if not FExcelCreated then
    begin
      result := 0;
      exit;
    end;
  result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

procedure TAdoToOleExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := '' + DateTimeToStr(Value);
end;

procedure TAdoToOleExcel.CreateExcelInstance;
begin
  try
    FExcel := CreateOLEObject('Excel.Application');
    FWorkBook := FExcel.WorkBooks.Add;
    FWorkSheet := FWorkBook.WorkSheets.Add;
    FExcelCreated := True;
  except
    FExcelCreated := False;
  end;
end;

function TAdoToOleExcel.IsCreated: Boolean;
begin
  result := FExcelCreated;
end;

procedure TAdoToOleExcel.SetTitleFont(NewFont: TFont);
begin
  if NewFont <> FTitleFont then
    FTitleFont.Assign(NewFont);
end;

procedure TAdoToOleExcel.SetCellFont(NewFont: TFont);
begin
  if NewFont <> FCellFont then
    FCellFont.Assign(NewFont);
end;

procedure TAdoToOleExcel.GetTableColumnName(const ADOTable: TADOTable; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to ADOTable.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := ADOTable.Fields[Col].FieldName;
    end;
end;

procedure TAdoToOleExcel.ADOTableToExcel(const ADOTable: TADOTable);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if ADOTable.Active = False then exit;

  GetTableColumnName(ADOTable, Cell);
  Row := 2;
  with ADOTable do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

procedure TAdoToOleExcel.GetQueryColumnName(const ADOQuery: TADOQuery; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to ADOQuery.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := ADOQuery.Fields[Col].FieldName;
    end;
end;

procedure TAdoToOleExcel.ADOQueryToExcel(const ADOQuery: TADOQuery);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if ADOQuery.Active = False then exit;

  GetQueryColumnName(ADOQuery, Cell);
  Row := 2;
  with ADOQuery do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

procedure TAdoToOleExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Col := 0 to StringGrid.FixedCols - 1 do
    for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TAdoToOleExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Row := 0 to StringGrid.FixedRows - 1 do
    for Col := 0 to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TAdoToOleExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row, x, y: LongInt;
begin
  Col := StringGrid.FixedCols;
  Row := StringGrid.FixedRows;
  for x := Row to StringGrid.RowCount - 1 do
    for y := Col to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[x + 1, y + 1];
        SetExcelCellFont(Cell);
        Cell.Value := StringGrid.Cells[y, x];
      end;
end;

procedure TAdoToOleExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  GetFixedCols(StringGrid, Cell);
  GetFixedRows(StringGrid, Cell);
  GetStringGridBody(StringGrid, Cell);
end;

procedure TAdoToOleExcel.SaveToExcel(const FileName: string);
begin
  if not FExcelCreated then exit;
  FWorkSheet.SaveAs(FileName);
end;

procedure Register;
begin
  RegisterComponents('Freeman', [TAdoToOleExcel]);
end;

end.


 

数据导出为Excel格式
首先要创建一个公共单元,名字你们可以随便起。
以下是我创建的公共单元的全部代码:
unit UnitDatatoExcel;
interface
uses
  Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
  DB, ComObj;
type
  TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;
    var CustomAttrs, CellData: string) of object;
  TDataSetToExcel = class(TComponent)
  private
    FDataSet: TDataSet;
    FOnFormatCell: TKHTMLFormatCellEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Transfer(const FileName: string; Title: string = ');
  published
    property DataSet: TDataSet read FDataSet write FDataSet;
  end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
  inherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ');
var
  ExcelApp, MyWorkBook: Variant;
  i: byte;
  j, a: integer;
  s, k, b, CustomAttrs: string;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
    MyWorkBook := CreateOleObject('Excel.Sheet');
  except
    on Exception do raise exception.Create('无法打开Excel文件,请确认已经安装Execl')
  end;
  MyWorkBook := ExcelApp.WorkBooks.Add;
  MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);
  MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;
  MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;
  with FDataSet do
  begin
    i := 2;
    for j := 0 to FieldCount - 1 do
    begin
      if Fields[j].Visible then
      begin
        b := Fields[j].DisplayLabel;
        CustomAttrs := ';
        if Assigned(FOnFormatCell) then
          FOnFormatCell(Self, 1, i,
            Fields[j].FieldName, CustomAttrs, b);
        MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
      end;
    end;
    i := 3;
    Close;
    Open;
    First;
    a := 2;
    while not Eof do
    begin
      for j := 0 to FieldCount - 1 do
      begin
        if Fields[j].Visible then
        begin
          CustomAttrs := ';
          k := Fields[j].Text;
          if Assigned(FOnFormatCell) then
            FOnFormatCell(Self, i, a,
              Fields[j].FieldName, CustomAttrs, k);
          MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
          inc(a);
        end;
      end;
      Inc(i);
      Next;
    end;
  end;
  s := 'A3:D' + IntToStr(i - 1);
  s := 'A1:D' + IntToStr(i - 1);
  MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;
  MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;
  MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;
  MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;
  MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋';
  s := 'A2:D' + IntToStr(i - 1);
  MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
  MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;
  MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';
  try
    MyWorkBook.Saveas(FileName);
    MyWorkBook.Close;
  except
    MyWorkBook.Close;
  end;
  ExcelApp.Quit;
  ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码:
procedure ToGetherExcel(NewData: TDataSet; NewString: string);
var
  DataExcel: TDataSetToExcel;
  saveDlg: TSaveDialog;
begin
  saveDlg := TSaveDialog.Create(nil);  //创建一个存储对话框
  DataExcel := TDataSetToExcel.Create(nil);
  try
    saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';
    saveDlg.DefaultExt := 'XLS';
    saveDlg.FileName := NewString;
    if saveDlg.Execute then
    begin
      DataExcel.DataSet := NewData;  //连接的数据集
      DataExcel.DataSet.DisableControls;
      DataExcel.Transfer(saveDlg.FileName, NewString);
      DataExcel.DataSet.EnableControls;
      AlterMesg('导出完毕', '提示信息');
    end;
  finally
    saveDlg.Free;
    DataExcel.Free;
  end;
end;
如果谁还有比着更好的办法,请告诉我,咱们共同进步:)


 

我给大伙发一个吧,调用过程,很方便,
这里DBGrid可更改为Query等与数据库相关的
procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);
//uses ComObj;
//sDBGrid:数据源
//Title:标题
//Fn:保存文件
var
  ExcelApp: Variant;
  i,j,k: Integer;
  __ColStr,__s:String;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    //on Exception do raise exception.Create('无法创建Xls文件,请确认是否安装EXCEL');
    application.MessageBox('系统中的MS Excel软件没有安装或安装不正确!', '错误', MB_ICONERROR + MB_OK);
    exit;
  end;
  ExcelApp.visible := False;
  ExcelApp.WorkBooks.Add;
  ExcelApp.caption := Title;
  __ColStr:=Chr(65+sDBGrid.FieldCount-1);
  ExcelApp.worksheets[1].range['A1:'+__ColStr+'1'].Merge(True);
  //写入标题行
  ExcelApp.Cells[1, 1].Value := Title;
  ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].HorizontalAlignment := $FFFFEFF4;
  ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].VerticalAlignment := $FFFFEFF4;
  ExcelApp.worksheets[1].range['A2:B2'].Merge(True);
  ExcelApp.worksheets[1].range['C2:D2'].Merge(True);
  ExcelApp.Cells[2, 1].Value := '制表人:'+Myvalue.FUserName;
  ExcelApp.Cells[2, 3].Value := '制表日期:'+DateToStr(Date());
  for i := 1 to sDBGrid.FieldCount do begin
    //各个字段的宽度
    ExcelApp.worksheets[1].Columns[i].ColumnWidth:=sDBGrid.Fields[i-1].DisplayWidth;
    //字段标题
    ExcelApp.Cells[3, i].Value := sDBGrid.Columns[i-1].Title.caption;
  end;
  ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Name := '黑体';
  ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Size := 16;
  ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].font.bold:=true;
  ExcelApp.worksheets[1].Range['A2:'+__ColStr+'3'].Font.Size := 10;
  i := 4;
  k := 0;
  sDBGrid.DataSource.DataSet.First;
  while not sDBGrid.DataSource.DataSet.Eof do begin
    for j := 0 to sDBGrid.FieldCount - 1 do begin
      ExcelApp.Cells[i, j + 1].Value := sDBGrid.Fields[j].AsString;
    end;
    sDBGrid.DataSource.DataSet.Next;
    i := i + 1;
    k:=k+1;
    __s:= 'A3:'+__ColStr+IntToStr(i-1);
  end;
  sDBGrid.DataSource.DataSet.First;
  ExcelApp.worksheets[1].Range[__s].HorizontalAlignment := $FFFFEFF4;
  ExcelApp.worksheets[1].Range[__s].VerticalAlignment := $FFFFEFF4;
  ExcelApp.worksheets[1].Range[__s].Font.Name := '宋体';
  ExcelApp.worksheets[1].Range[__s].Font.Size := 10;
  ExcelApp.worksheets[1].Range[__s].Borders.LineStyle := 1;
  ExcelApp.ActiveSheet.PageSetup.RightMargin := 0.5/0.035;
  ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
  ExcelApp.ActiveSheet.PageSetup.BottomMargin := 0.5/0.035;
  ExcelApp.visible := True;
  ExcelApp.ActiveCell.Cells.Select;
  ExcelApp.Selection.Columns.AutoFit;
  try
    ExcelApp.ActiveWorkBook.SaveAs(Fn);
  except
  end;  
end;

//导出数据到Excel
procedure ToExcel(DBGrid:TDBGrid);
var
  ExcelApp: Variant;
  i,j,k:integer;
  FileName:string;
  DlgSave:TsaveDialog;
Begin
  DlgSave:=TsaveDialog.Create(nil);
  DlgSave.Filter:='*.xls|*.xls';
  if DlgSave.Execute then
  Begin
    application.ProcessMessages;
    Filename:=DlgSave.FileName;
    ExcelApp := CreateOleObject( 'Excel.Application' );
    ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    application.ProcessMessages;
    ExcelApp.WorkSheets[1].Activate;
    K:=1;
    For i:=0 To DBGrid.Columns.Count-1 Do
    Begin
      if DBGrid.Columns[i].Visible Then
      Begin
        ExcelApp.Cells[1,K]:=DBGrid.Columns[i].Title.Caption;
        k:=k+1;
      End;{if}
    End;{for}
    ExcelApp.rows[1].font.name:='宋体';
    ExcelApp.rows[1].font.size:=10;
    ExcelApp.rows[1].Font.Color:=clBlack;
    ExcelApp.rows[1].Font.Bold:=true;
    j:=1;
    For i:=0 To DBGrid.Columns.Count-1 Do
    Begin
      If DBGrid.Columns[i].Visible Then
      Begin
        ADOQuery_DB.First;
        for k:=1 To ADOQuery_DB.RecordCount-1 Do
        Begin
          ExcelApp.Cells[K+1,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;
          ADOQuery_DB.Next;
        End;{for}
      j:=j+1;
    End;{if}
    End;{for}
    For I:=1 To ADOQuery_DB.recordcount Do
    ExcelApp.rows[i].Font.SIZE:=9;
    ExcelApp.Columns.AutoFit;
    ExcelApp.ActiveWorkBook.SaveAs(FileName);
    ExcelApp.WorkBooks.Close;
    Application.MessageBox('数据导出成功....','数据导出',0);
    ExcelApp.Quit;
    ExcelApp:=Unassigned;
    DlgSave.Destroy;
  End;
end;
测试通过!


 

我可以发一段给你
先在程序上放上三个控件,TExcelApplication,TExcelWorkbook,TExcelWorkSheet,它们都在Server组件板上。
要控制Excel,就是采用自动化编程。以Excel作为自动化服务器。
首先,建立与自动化服务器的连接:
   Excelapplication1.Connect;
   Excelapplication1.Visible[0]:=true;
   Excelapplication1.Caption:='你要的标题';
   ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,0) );
   Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[0] as _worksheet) ;

然后就可以对Excel进行控件了:
  从数据库导入数据:
  Excel.cells.item[row,col]:=table1.field[i].value;
  ....
最后不要忘了断开连接
  Excelapplication1.disconnect;
  Excelapplication1.quit;
至今是delphi菜鸟

 

 

******************************************************************

如何把在dbgrid的指定几列导到excel表里?
我的做法:用listbox1显示dbgrid的所用供选择列,listbox2用来显示要导出的列:
procedure TForm1.FormCreate(Sender: TObject);
begin
 if kadaoTable1.Active then
 kadaoTable1.GetFieldNames(Listbox1.Items);
end;
procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段
begin
  try
  if listbox1.Items.Count=0 then exit;
  if listbox1.Selected[listbox1.ItemIndex] then
  begin
  Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
  Listbox1.Items.Delete(Listbox1.ItemIndex);
  if Listbox2.Items.Count>=1 then
  DeleteBitBtn.Enabled:=True;
  end;
  except
  showmessage('你没有选择相应字段!');
  end;
end;
procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择
begin
 try
 if Listbox2.Items.Count=0 then exit;
 if listbox2.Selected[Listbox2.ItemIndex] then
   begin
   Listbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);
   Listbox2.Items.Delete(Listbox2.itemindex);
   end;
   if Listbox2.Items.Count=0 then
   DeleteBitBtn.Enabled:=False;
 except
 showmessage('你没有选择相应字段!');
 end;
 end;
procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;
   try
    XLApp := CreateOleObject('excel.Application');
  except
    Screen.Cursor := crDefault;
  Exit;
  end;

  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) + 1;
   for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;
     TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
     jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
       Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
  end;
   XlApp.Visible := True;
  Screen.Cursor := crDefault;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);//导出操作
begin
CopyDbDataToExcel([DBGrid4]);
end;
我 想解决问题有两种办法:一、直接修改CopyDbDataToExcel。二、实现dbgrid4显示的字段列与listbox2中字段同步, dbgrid4中的其余字段要删除掉,不是隐藏。也就是用listbox2中字段来控制哪些字段导入到excel表中呀,如何实现呀?  请高手指点! 

 

*****************************

将dbgrid中数据导出到excel后,如何编写程序使excel的列宽调整为最适合的列宽?
ExcelWorkSheet1.Columns.AutoFit;

************************************

var
  s:string;
  i,j:integer;
begin
  s:='d:/aa/aa.xls'; //文件名
  if fileexists(s) then deletefile(s);
  v:=CreateOLEObject('Excel.Application'); //建立OLE对象
  V.WorkBooks.Add;
  if Checkbox1.Checked then
    begin
      V.Visible:=False;
      
      //使Excel可见,并将本程序最小化,以观察Excel的运行情况
    end
  else
    begin
      V.Visible:=True;    //True
    end;
    //使Excel窗口不可见

    //Application.BringToFront; //程序前置
  try
  try
    Cursor:=crSQLWait;
    query1.DisableControls;
    For i:=0 to query1.FieldCount-1 do //字段数
    //注意:Delphi中的数组的下标是从0开始的,
    // 而Excel的表格是从1开始编号
      begin
      V.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号
      V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名
      end;
    j:=2;
    query1.First;
    while not query1.EOF do
      begin
      For i:=0 to query1.FieldCount-1 do //字段数
        begin
          V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));
          V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容
        end;
      query1.Next;
      j:=j+1;
     end;
    //设置保护
    ShowMessage('数据库到Excel的数据传输完毕!');
    
    except //发生错误时
    ShowMessage('没有发现Excel!');
    end;
    finally
    Cursor:=crDefault;
    query1.First;
    query1.EnableControls;
    end;
end;

//和上面的差不多,不过不是从DBGrid中导出的!上面的也不是,只是从Query中
  导出来。我也想知从DBGrid 中怎么样导出来,或直接打印也行!
************************************************

直接使用Excel对象,它是标准的COM对象,可以在Delphi中引用的。
我给你一个函数:
function ExportDataToExcel(cds: TClientDataSet; dbGrid: TDBGrid; ExcelAppData: TExcelApplication;
  Title, strWhere: String): Boolean;
var
  sheet,Range: Variant;
  i,j: Integer;
  str,fVal: String;
begin
  Result := False;
  if (cds = nil) or (not cds.Active) then Exit;
  try
    if ExcelAppData.Tag = 1 then
    begin
      ExcelAppData.Disconnect;
      ExcelAppData.Tag := 0;
    end;
    ExcelAppData.Connect;
    ExcelAppData.Visible[0] := True;
    ExcelAppData.Tag := 1;
  except
    ShowMessage('启动Excel失败,Excel可能没有安装。');
    Abort;
  end;
  cds.DisableControls;
  try
    if Trim(Title) = ' then Title := '查询结果';
    ExcelAppData.Caption := Title;
    ExcelAppData.Workbooks.Add(emptyparam,0);
    sheet := ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[1];

    sheet.name := Title;
    i := (dbGrid.Columns.Count div 2) - 1;
    if i < 1 then i:=1;
    Sheet.Cells[1,i] := Title;
    ExcelAppData.StandardFontSize[0] := 9; //设置表格字体
    if dbGrid.Columns.Count < 24 then
    begin
      str := Char(Ord('A') + dbGrid.Columns.Count -1); // 计算最后一列的列标
      Range := Sheet.Range['A3:' + str + '3'];  //取出表头的边界
      Range.Columns.Interior.ColorIndex := 8;   //设置表头的颜色
      //计算表格区域
      str := 'A3:' + str + IntToStr(cds.RecordCount + 3);
      Range := Sheet.Range[str]; //取出表格数据区域边界
      Range.Borders.LineStyle := xlContinuous;   // 设置表格的线条
    end;
    Sheet.Cells[2,1] := strWhere;//'日期:' + DateToStr(Date);
    //写表头
    for j := 0 to dbGrid.Columns.Count -1 do
    begin
      Sheet.Cells[3,j + 1] := dbGrid.Columns.Items[j].Title.Caption;
      Sheet.Columns.Columns[j+1].ColumnWidth := dbGrid.Columns.Items[j].Width div 6;
    end;

    //写表的内容
    cds.First;
    for i:= 4 to cds.RecordCount + 3 do
    begin
      for j := 0 to dbGrid.Columns.Count - 1 do
      begin
        fVal := Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);
        Sheet.Cells[i,j + 1] := fVal;
      end;
      cds.Next;
    end;
    Sleep(1000);   //延时1秒,等待Excel处理完成
    Result := True;
  except on E: Exception do
    ShowMessage('数据导出时出现异常!' + E.Message);
  end;
  ExcelAppData.Disconnect;
  cds.EnableControls;
end;

本文由10bet手机官网发布于多线程,转载请注明出处:监控系统文件操作,语句中使用字符串

上一篇:没有了 下一篇:捕获几个事件,各种手机的全局按键
猜你喜欢
热门排行
精彩图文