bas_inputipdata.pas

这是一个为友人所写的小程序, 实现了分段模糊查询, 网页生成等小功能!

unit Bas_InputIPData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Grids, DBGridEh, MemDS, VirtualTable, ComCtrls, RzPanel,
  RzButton, ExtCtrls, ToolWin, DBAccess, MSAccess, OleServer, Excel2000, ComObj,
  TFlatGaugeUnit, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze;

type
  TBas_InputIPDataForm = class(TForm)
    CoolBar1: TCoolBar;
    RzToolbar1: TRzToolbar;
    ToolButton1: TRzToolButton;
    ToolButton3: TRzToolButton;
    ToolButton5: TRzToolButton;
    RzSpacer1: TRzSpacer;
    RzSpacer2: TRzSpacer;
    RzSpacer4: TRzSpacer;
    RzSpacer6: TRzSpacer;
    StatusBar1: TStatusBar;
    OpenDialog1: TOpenDialog;
    SubTable: TVirtualTable;
    SubTableField: TStringField;
    SubTableField2: TStringField;
    SubTableField3: TStringField;
    SubTableField4: TStringField;
    SubTableField5: TStringField;
    SubTableField6: TStringField;
    SubTableField7: TStringField;
    SubTableField8: TStringField;
    SubTableField9: TStringField;
    DBGridEh1: TDBGridEh;
    DataSource1: TDataSource;
    WorkQuery: TMSQuery;
    IdAntiFreeze1: TIdAntiFreeze;
    FlatGauge1: TFlatGauge;
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Bas_InputIPDataForm: TBas_InputIPDataForm;

implementation
uses Main;
{$R *.dfm}

procedure TBas_InputIPDataForm.ToolButton1Click(Sender: TObject);
var
  MSExcel : variant;
  ExeclFileName: string;
  I, MaxRow: Integer;
begin
  if (OpenDialog1.Execute) then
  begin
    if (OpenDialog1.FileName <> '') then
    begin
      try
        ExeclFileName := OpenDialog1.FileName;
        MSExcel := createoleobject('excel.application');
        MSExcel.workbooks.Open(ExeclFileName);
        MSExcel.Application.Visible := False;
        MaxRow := MSExcel.worksheets[1].UsedRange.Rows.Count;
        //开始读入数据
        SubTable.Active := True;
        SubTable.DisableControls;
        SubTable.Clear;
        FlatGauge1.Progress := 0;
        FlatGauge1.Visible := True;
        I := 2;
        while I <= MaxRow do
        begin
          SubTable.Append;
          SubTable.FieldByName('类别').AsString := MSExcel.Cells[I, 1].Value;
          SubTable.FieldByName('英文名称').AsString := MSExcel.Cells[I, 2].Value;
          SubTable.FieldByName('中文名称').AsString := MSExcel.Cells[I, 3].Value;
          SubTable.FieldByName('网址').AsString := MSExcel.Cells[I, 4].Value;
          SubTable.FieldByName('产品服务').AsString := MSExcel.Cells[I, 5].Value;
          SubTable.FieldByName('地址').AsString := MSExcel.Cells[I, 6].Value;
          SubTable.FieldByName('电话').AsString := MSExcel.Cells[I, 7].Value;
          SubTable.FieldByName('传真').AsString := MSExcel.Cells[I, 8].Value;
          SubTable.FieldByName('电邮').AsString := MSExcel.Cells[I, 9].Value;
          SubTable.Post;
          I := I + 1;
          FlatGauge1.Progress := Round(I * 100 / MaxRow);
        end;
      except
        ShowMessage('第' + IntToStr(I) + '行出错');
        MSExcel.Quit;
      end;
    end;
    MSExcel.Quit;
    SubTable.EnableControls;
    SubTable.First;
    ShowMessage('数据已成功导入临时数据表，请按保存保存到数据库！');
    FlatGauge1.Visible := False;
  end;
end;

procedure TBas_InputIPDataForm.ToolButton3Click(Sender: TObject);
var
  SQL_Str : string;
  I       : Integer;
begin
  if (SubTable.RecordCount <= 0) then
  begin
    ShowMessage('您还没有将EXECL表的数据导入临时表格，请先选择EXECL文件导入临时表格再进行保存！');
    Abort;
  end; 
  SubTable.First;
  SubTable.DisableControls;
  SQL_Str := 'Select TOP 1 * From Bas_IPRecord Order By ID';
  WorkQuery.Active := False;
  WorkQuery.SQL.Clear;
  WorkQuery.SQL.Add(SQL_Str);
  WorkQuery.Open;
  I := 0;
  FlatGauge1.Progress := 0;
  FlatGauge1.Visible := True;
  while SubTable.Eof = False do
  begin
    if (SubTable.FieldByName('网址').AsString <> '') then
    begin
      WorkQuery.Append;
      WorkQuery.FieldByName('SortName').AsString := SubTable.FieldByName('类别').AsString;
      WorkQuery.FieldByName('EnglishName').AsString := SubTable.FieldByName('英文名称').AsString;
      WorkQuery.FieldByName('ChineseName').AsString := SubTable.FieldByName('中文名称').AsString;
      WorkQuery.FieldByName('WebSite').AsString := SubTable.FieldByName('网址').AsString;
      WorkQuery.FieldByName('ServiceAndProduct').AsString := SubTable.FieldByName('产品服务').AsString;
      WorkQuery.FieldByName('Address').AsString := SubTable.FieldByName('地址').AsString;
      WorkQuery.FieldByName('PhoneNo').AsString := SubTable.FieldByName('电话').AsString;
      WorkQuery.FieldByName('FaxNo').AsString := SubTable.FieldByName('传真').AsString;
      WorkQuery.FieldByName('EMailAddress').AsString := SubTable.FieldByName('电邮').AsString;
      WorkQuery.Post;
    end;
    SubTable.Next;
    I := I + 1;
    FlatGauge1.Progress := Round(I * 100 / SubTable.RecordCount);
  end;
  SubTable.First;
  SubTable.EnableControls;
  ShowMessage('所有的网址数据已经保存到数据库！');
  FlatGauge1.Visible := False;
end;

procedure TBas_InputIPDataForm.ToolButton5Click(Sender: TObject);
begin
  WorkQuery.Close;
  Close;
end;

procedure TBas_InputIPDataForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := CaFree;
end;

procedure TBas_InputIPDataForm.FormCreate(Sender: TObject);
begin
  SubTable.Active := True;
  SubTable.Clear;
end;

end.