bas_outputipdata.pas
来自「这是一个为友人所写的小程序, 实现了分段模糊查询, 网页生成等小功能!」· PAS 代码 · 共 159 行
PAS
159 行
unit Bas_OutPutIPData;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Math, OleServer,
Excel2000, comobj, DB, MemDS, DBAccess, MSAccess, ComCtrls, Grids,
DBGridEh, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit,
cxButtonEdit, DBRBEdit, StdCtrls, RzTabs, RzPanel, RzButton, ExtCtrls,
ToolWin;
type
TBas_OutPutIPDataForm = class(TForm)
CoolBar1: TCoolBar;
RzToolbar1: TRzToolbar;
ToolButton1: TRzToolButton;
ToolButton3: TRzToolButton;
ToolButton5: TRzToolButton;
RzSpacer1: TRzSpacer;
RzSpacer2: TRzSpacer;
RzSpacer4: TRzSpacer;
RzSpacer6: TRzSpacer;
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
GroupBox1: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label1: TLabel;
Edit1: TDBRBEdit;
Edit2: TDBRBEdit;
Edit3: TDBRBEdit;
Edit4: TDBRBEdit;
Edit5: TDBRBEdit;
Edit6: TDBRBEdit;
Edit7: TDBRBEdit;
Edit8: TDBRBEdit;
Edit9: TDBRBEdit;
TabSheet2: TRzTabSheet;
StatusBar1: TStatusBar;
DataSource1: TDataSource;
DataQuery: TMSQuery;
DBGridEh1: TDBGridEh;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Bas_OutPutIPDataForm: TBas_OutPutIPDataForm;
implementation
uses Main;
{$R *.dfm}
procedure TBas_OutPutIPDataForm.ToolButton1Click(Sender: TObject);
var
SQL_Str : string;
ConStr : string;
begin
ConStr := '';
if (Edit1.Text <> '') then
begin
ConStr := ConStr + ' AND (SortName Like ' + #39 + '%' + Edit1.Text + '%' + #39 + ')';
end;
if (Edit2.Text <> '') then
begin
ConStr := ConStr + ' AND (EnlishName Like ' + #39 + '%' + Edit2.Text + '%' + #39 + ')';
end;
if (Edit3.Text <> '') then
begin
ConStr := ConStr + ' AND (ChineseName Like ' + #39 + '%' + Edit3.Text + '%' + #39 + ')';
end;
if (Edit4.Text <> '') then
begin
ConStr := ConStr + ' AND (WebSite Like ' + #39 + '%' + Edit4.Text + '%' + #39 + ')';
end;
if (Edit5.Text <> '') then
begin
ConStr := ConStr + ' AND (ServiceAndProduct Like ' + #39 + '%' + Edit5.Text + '%' + #39 + ')';
end;
if (Edit9.Text <> '') then
begin
ConStr := ConStr + ' AND (Address Like ' + #39 + '%' + Edit9.Text + '%' + #39 + ')';
end;
if (Edit6.Text <> '') then
begin
ConStr := ConStr + ' AND (PhoneNo Like ' + #39 + '%' + Edit6.Text + '%' + #39 + ')';
end;
if (Edit7.Text <> '') then
begin
ConStr := ConStr + ' AND (FaxNo Like ' + #39 + '%' + Edit7.Text + '%' + #39 + ')';
end;
if (Edit8.Text <> '') then
begin
ConStr := ConStr + ' AND (EmailAddress Like ' + #39 + '%' + Edit8.Text + '%' + #39 + ')';
end;
SQL_Str := 'Select * From Bas_IPRecord Where (WebSite<>' + #39 + #39 + ')'
+ ConStr
+ ' Order By WebSite';
DataQuery.Active := False;
DataQuery.SQL.Clear;
DataQuery.SQL.Add(SQL_Str);
DataQuery.Open;
TabSheet2.Show;
end;
procedure TBas_OutPutIPDataForm.ToolButton5Click(Sender: TObject);
begin
Close;
end;
procedure TBas_OutPutIPDataForm.ToolButton3Click(Sender: TObject);
var
myexcel : variant;
workbook: olevariant;
worksheet: olevariant;
I, J, n : Integer;
begin
try
myexcel := createoleobject('excel.application');
myexcel.Application.workbooks.Add;
myexcel.Application.Visible := True;
workbook := myexcel.Application.workbooks[1];
worksheet := workbook.worksheets.item[1];
except
ShowMessage('你没有安装微软件的EXCEL200以上程序!不存在!');
end;
I := 2; //EXECL表行号
J := 1; //EXECL表列号
DataQuery.First;
for n := 0 to DataQuery.FieldCount - 1 do
begin
worksheet.Cells(I, J) := DataQuery.Fields[n].DisplayLabel; //在EXCEL第一行写上字段名。
J := J + 1;
end;
DataQuery.First;
while not DataQuery.Eof do
begin
inc(I);
for J := 0 to DataQuery.FieldCount - 1 do
worksheet.Cells[I, J + 1] := DataQuery.Fields[J].AsString;
DataQuery.Next;
end;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?