Delphi多线程学习,美丽人生论坛看贴工具delphi版
分类:微服架构

ADO八线程数据库查询普通会现出3个难题:

程序分界面

{*******************************************************}
{                                                       }
{       图形分析                                        }
{                                                       }
{       版权全数 (C卡塔尔(قطر‎ 二〇一〇 咏南工作室(陈新光State of Qatar            }
{                                                       }
{*******************************************************}

1、CoInitialize 未有调用 (CoInitialize was not called);所以,在使用别的dbGo对象前,必得手 调用CoInitialize和CoUninitialize。调用CoInitialize失败会发出"CoInitialize was not called"例外。

测量试验是在本机测验的,注意不能是127.0.0.1要么localhost,不然idhttp会罢工。由于测量试验论坛未有几篇作品,所以“下一页”,其实只读取了第一页。上一页还未做吧,呵。

unit uChart;

2、画布不容许摄影 (Canvas does not allow drawing);所以,必得经过Synchronize进程来文告主线程访谈主窗体上的别的控件。

源代码:

interface

3、不能够使用主ADO连接 (Main TADoConnection cannot be used!);所以,线程中不能运用主线程中TADOConnection对象,各种线程必需创立协和的数据库连接。

unit Unit1;

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, DBChart, StdCtrls,db,Series,
  Buttons;

     Delphi二〇〇六设置后在X:/Program Files/Common Files/CodeGear Shared/Data目录下有叁个dbdemos.mdb文件,用来作为测量检验的例子。dbdemos.mdb中的customer表保存了客商信 息,orders表中保留了订单音讯。

interface

type
  TColParams = record
    FieldName: string;
    Title: string;
  end;
  TFormChart = class(TForm)
    Panel1: TPanel;
    DBChart1: TDBChart;
    RadioGroup1: TRadioGroup;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FFirstRun:Boolean;
    ColArray,ColArray2: array of TColParams;
    FDataSet:TDataSet;
    FTitle:string;
    Bar:TBarSeries;              //柱形
    Pie:TPieSeries;              //饼形
    Area:TAreaSeries;            //领域图
    FastLine:TFastLineSeries;    //曲线图
    procedure CreateSeries;
    procedure CreateChart;
    procedure FillField;
    function GetLableFieldName:string;
    function GetValueFieldName:string;
    { Private declarations }
  public
    { Public declarations }
  end;

       测量检验程序流程差不离是这么的:在主窗体上放TADOConnection和TQuery控件,运转时这么些TQuery从Customer表中得悉顾客编码 CustNo和供销合作社名称Company,放到多少个Combox框中,分别在八个列表框中选定顾客公司名称,依据公司名称所对应的客商代码建立多少个线程同不经常候 在orders表中询问贩卖日期SaleDate分别填入ListBox中

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP,perlregex,SHDocVw;

var
  FormChart: TFormChart;

unit
 Main;

type
    bbslist=record
    flName:string;
    flUrl:string;
end;

const
  FLable='请录入标志字段';
  FValue='请录入总结字段';

interface

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    ListView1: TListView;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    IdHTTP1: TIdHTTP;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  *******
    { Private declarations }
  public
    { Public declarations }

//==============================================================================
// ATitle: TDBChart.title
//==============================================================================

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

  end;

procedure ShowChart(ADataSet:TDataSet;ATitle:string='');

type
  TForm2 =class (TForm)
    ComboBox1:  TComboBox;
    ComboBox2:  TComboBox;
    ComboBox3:   TComboBox;
    ListBox1:    TListBox;
    ListBox2:   TListBox;
    ListBox3:    TListBox;
    Button1:  TButton;
    ADOConnection1:  TADOConnection;
    ADOQuery1:  TADOQuery;
    Label1: TLabel;
    Label2:  TLabel;
    Label3: TLabel;

var
  Form1: TForm1;
  bbsfl:array of bbslist;
  reg:tperlregex;
  userSelect:string;

implementation

    procedure  FormCreate(Sender: TObject) ;
    procedure  Button1Click(Sender: TObject) ;
  private
    { Private declarations }
  public
    { Public declarations }
  end    ;
var
  Form2:    TForm2;
implementation

implementation

{$R *.dfm}

uses
 ADOThread;

{$R *.dfm}
{$APPTYPE CONSOLE}

procedure ShowChart(ADataSet:TDataSet;ATitle:string='');
begin
  FormChart:=TFormChart.Create(nil);
  try
    FormChart.FDataSet:=ADataSet;
    FormChart.FTitle:=ATitle;
    FormChart.RadioGroup1.ItemIndex:=0;
    FormChart.DBChart1.Title.Text.Clear;
    FormChart.DBChart1.Title.Text.Add(FormChart.FTitle);
    FormChart.ShowModal;
  finally
    FormChart.Free;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  url: string;
  idhttp1: TIdhttp;
  streamstr1: TStringStream;
  html: string;
  i: Integer;
  n: Integer;
begin
  //下一页
  //即使listbox未有选用则赶回
  if(Length(userSelect)<2)then
    exit;

procedure TFormChart.BitBtn1Click(Sender: TObject);
begin
//  DBChart1.FreeAllSeries();
  FFirstRun:=False;
  CreateChart;
end;

procedure   TForm2.Button1Click(Sender: TObject);
const
  SQL_CONST= 'Select SaleDate from orders where CustNo = %d' ;
var
  c1,c2,c3: Integer  ;
  s1, s2,s3: string ;
begin

  streamstr1:=TStringStream.Create('');
  idhttp1:=TIdHTTP.Create(nil);
  idhttp1.ConnectTimeout:=12000;
  idhttp1.ReadTimeout:=12000;

procedure TFormChart.CheckBox1Click(Sender: TObject);
begin
  DBChart1.View3D:=CheckBox1.Checked;
end;

  //得到四个选项框客商的编码

  //按栏目取url
  for I := 0 to 19 do
    begin
      if(bbsfl[i].flName=userSelect) then
        url:=trim(form1.Edit1.Text)+ bbsfl[i].flUrl;
    end;
  writeln(url);
  //exit;
  //url:='';

procedure TFormChart.CreateChart;
begin
  if FFirstRun then exit;

  c1:= Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
  c2:= Integer(ComboBox2.Items.Objects[ComboBox2.ItemIndex]);
  c3:= Integer(ComboBox3.Items.Objects[ComboBox3.ItemIndex]);
  //生成SQL 查询语句
  s1:=Format(SQL_CONST,[c1]);
  s2:=Format(SQL_CONST,[c2]);
  s3:=Format(SQL_CONST,[c3]);
  //七个线程同不常间询问
  TADOThread.Create(s1,ListBox1,Label1) ;
  TADOThread.Create(s2,ListBox2,Label2);
  TADOThread.Create(s3,ListBox3,Label3);
end ;

  idhttp1.Get(url,streamstr1);
  html:=streamstr1.DataString;
  //Writeln(html);
  //正则解析
  reg:=TPerlRegEx.Create(nil);
  reg.Subject:=html;
  reg.RegEx:='^<as|href=''([wd.?_=&]+)''>([^<^>]+)</a>';

  if Trim(ComboBox1.Text)='' then
  begin
    ShowMessage(FLable);
    Exit;
  end;
  if Trim(ComboBox2.Text)='' then
  begin
    ShowMessage(FValue);
    Exit;
  end;

procedure TForm2.FormCreate(Sender: TObject);
var
  strSQL:string ;
begin
  strSQL:='SELECT CustNo,Company FROM customer';
  ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.Add(strSQL);
  ADOQuery1.Open;
  ComboBox1.Clear;
  ComboBox2.Clear;
  ComboBox3.Clear;
  //将客户Company和相关CustNo填到ComboBox中
  while  not  ADOQuery1.Eof  do
  begin
    ComboBox1.AddItem(ADOQuery1.Fields[1].asString, TObject(ADOQuery1.Fields[0].AsInteger));
    ADOQuery1.Next;
  end ;
  ComboBox2.Items.Assign(ComboBox1.Items);
  ComboBox3.Items.Assign(ComboBox1.Items);
  // 暗中同意选中率先个
  ComboBox1.ItemIndex := 0;
  ComboBox2.ItemIndex := 0;
  ComboBox3.ItemIndex := 0;
end ;

  //清空litview
  n:=ListView1.Items.Count;
  for i := 0 to n - 1 do
    listview1.items.delete(0);
  i:=0;

  DBChart1.SeriesList.Clear;

end.
{ADO查询七十三十二线程单元}

  while reg.MatchAgain do
  begin
    //写入listview
    inc(i);

  DBChart1.View3D:=CheckBox1.Checked;
 
  case RadioGroup1.ItemIndex of
    0:
    begin
      with Bar do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FDataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    1:
    begin
      with Pie do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FDataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    2:
    begin
      with Area do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FDataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
    3:
    begin
      with FastLine do
      begin
        ParentChart := DBChart1;
        marks.Style:= smsvalue;
        DataSource := FDataSet;
        XLabelsSource :=GetLableFieldName;
        YValues.ValueSource :=GetValueFieldName;
      end;
    end;
  end;
  FFirstRun:=False;
end;

unit
 ADOThread;

  with listview1.items.add do
  begin
    //编号
    Caption:=inttostr(i);
    //标题
    SubItems.Add(reg.SubExpressions[2]);
    //点击
    SubItems.Add('0');
    //地址
    SubItems.Add(trim(form1.Edit1.Text)+reg.SubExpressions[1]);
  end;

procedure TFormChart.CreateSeries;
begin
  Bar:=TBarSeries.Create(Self);
  Pie:=TPieSeries.Create(Self);
  Area:=TAreaSeries.Create(Self);
  FastLine:=TFastLineSeries.Create(Self);
end;

interface

    //Writeln(reg.SubExpressions[2]);
  end;

procedure TFormChart.FillField;
var
  i:Integer;
begin
  ComboBox1.Items.Clear;
  ComboBox2.Items.Clear;

uses
  Classes,StdCtrls,ADODB;
type
  TADOThread = class(TThread)
  private
    { Private declarations }
    FListBox:TListBox;
    FLabel:TLabel;
    ConnString:WideString;
    FSQLString:string;
    procedure  UpdateCount;
  protected
    procedure  Execute; override;
  public
    constructor  Create(SQL:string;LB:TListBox;Lab:TLabel);
  end   ;

  streamstr1.Free;
  idhttp1.Free;
  reg.Free;
end;

  SetLength(ColArray,FDataSet.FieldCount);
  SetLength(ColArray2,FDataSet.FieldCount);
 
  for i:=0 to FDataSet.FieldCount-1 do
  begin
    if not (FDataSet.Fields[i] is TNumericField)
      or (FDataSet.Fields[i] is TIntegerField) then
    begin
      ColArray[i].FieldName:=FDataSet.Fields[i].FieldName;
      ColArray[i].Title:=FDataSet.Fields[i].DisplayLabel;
      ComboBox1.Items.Add(ColArray[i].Title);
      if ComboBox1.Items.Count>0 then
        ComboBox1.ItemIndex:=0;
    end else
    begin
      ColArray2[i].FieldName:=FDataSet.Fields[i].FieldName;
      ColArray2[i].Title:=FDataSet.Fields[i].DisplayLabel;
      ComboBox2.Items.Add(ColArray2[i].Title);
      if ComboBox2.Items.Count>0 then
        ComboBox2.ItemIndex:=0;
    end; 
  end;
end;

implementation

procedure TForm1.Button3Click(Sender: TObject);
begin
  //bbsfl=nil;
  halt;
end;

procedure TFormChart.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

uses  Main,SysUtils,ActiveX;

procedure TForm1.Button4Click(Sender: TObject);
var
  idhttp1:TIdHTTP;
  streamHtml:TStringStream;
  htmlStr:string;
  s1: string;
  s2: string;
  i: Integer;

procedure TFormChart.FormCreate(Sender: TObject);
begin
  FFirstRun:=True;
  CreateSeries;
end;

{ TADOThread }

begin
  //读论坛栏目列表
  idhttp1.ReadTimeout:=12000;
  idhttp1.ConnectTimeout:=12000;
  //idhttp1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)';

procedure TFormChart.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Bar);
  FreeAndNil(Pie);
  FreeAndNil(Area);
  FreeAndNil(FastLine);
  FormChart:=nil;
end;

constructor  TADOThread.Create(SQL: string; LB: TListBox;Lab:TLabel);
begin
  ConnString:=Form2.ADOConnection1.ConnectionString;
  FListBox:=LB;
    FLabel:=Lab;
  FSQLString:=SQL;
  Inherited  Create(False);
end  ;

  idhttp1:=TIdHTTP.Create(nil);
  streamHtml:=TStringStream.Create('',TEncoding.GetEncoding(936));

procedure TFormChart.FormShow(Sender: TObject);
begin
  FillField;
end;

procedure  TADOThread.Execute;
var
  Qry:TADOQuery;
  i:Integer;
begin
  { Place thread code here }
  FreeOnTerminate:=True;
  CoInitialize(nil);
    //必需调用(需Uses ActiveX)
  Qry:=TADOQuery.Create(nil);
  try
    Qry.ConnectionString:=ConnString;   //必得有友好的连接
    Qry.Close;
    Qry.SQL.Clear;
    Qry.SQL.Add(FSQLString);
    Qry.Open;
    FListBox.Clear;
    for  i := 0 to 100 do     //为了实施久点重复历遍数据集101次
      begin
        while  not Qry.Eof And  not Terminated do
        begin
        FListBox.AddItem(Qry.Fields[0].asstring,nil);
          //假如不调用Synchronize,会现出Canvas Does NOT Allow Drawing
          Synchronize(UpdateCount);
          Qry.Next;
        end ;
        Qry.First;
        FListBox.AddItem('*******',nil);
      end ;
  finally
    Qry.Free;
  end ;
  CoUninitialize;
end  ;

  try
    idhttp1.Get(trim(form1.Edit1.Text),streamHtml);
    htmlStr:=streamHtml.DataString;
    //writeln(htmlStr);
    //正则深入分析
    reg:=tperlregex.Create(nil);
    reg.Subject:=htmlStr;
    reg.RegEx:='<as+href=''([w.?_=d]+)''><fonts+color=#[wd]+><b>(.+)</b>';
    //设置动态数组bbsfl

function TFormChart.GetLableFieldName: string;
var
  i:Integer;
begin
  for i := Low(ColArray) to High(ColArray) do
  begin
    if ColArray[i].Title=ComboBox1.Text then
      Result:=ColArray[i].FieldName;
  end;   
end;

procedure   TADOThread.UpdateCount;
begin
  FLabel.Caption:=IntToStr(FListBox.Items.Count);
end;

    SetLength(bbsfl,20);

function TFormChart.GetValueFieldName: string;
var
  i:Integer;
begin
  for i := Low(ColArray2) to High(ColArray2) do
  begin
    if ColArray2[i].Title=ComboBox2.Text then
      Result:=ColArray2[i].FieldName;
  end;   
end;

end.

    i:=0;
    while reg.MatchAgain do
    begin
       s1:=reg.SubExpressions[1];
       s2:=reg.SubExpressions[2];
       //writeln(reg.SubExpressions[0]);
       bbsfl[i].flName:=s2;
       bbsfl[i].flUrl:=s1;
       form1.ListBox1.Items.Add(s2);
       inc(i);
    end;

procedure TFormChart.RadioGroup1Click(Sender: TObject);
begin
//  DBChart1.FreeAllSeries();
  CreateChart;
end;

  except
    on e:Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;
  streamHtml.Free;

end.

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ListView1.Clear;
  ListView1.Columns.Clear;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Items[0].Caption:='编号';
  ListView1.Columns.Items[1].Caption:='主题';
  ListView1.Columns.Items[2].Caption:='点击/回复';
  ListView1.Columns.Items[3].Caption:='地址';
  ListView1.Columns.Items[0].Width:=40;
  ListView1.Columns.Items[1].Width:=210;
  ListView1.Columns.Items[2].Width:=80;
  ListView1.Columns.Items[3].Width:=120;
  Listview1.ViewStyle:=vsreport;
  Listview1.GridLines:=true;

  edit1.Text:='';
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
if   ListBox1.Selected[ListBox1.ItemIndex]   then
      userSelect:=ListBox1.Items[ListBox1.ItemIndex];
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
  url: string;
  ie:OleVariant;
begin
  //双击阅读贴子
  //writeln(ListView1.Selected.SubItems.Strings[0]);
  [url:=ListView1.Selected.SubItems.Strings[2](];
  ie:=CoInternetExplorer.Create;
  ie.Visible := True;
  ie.Navigate2(url);

end;

end.

分界面代码:


object Form1: TForm1
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = #32654#20029#20154#29983#35770#22363#35835#36148'  '#29482#24735#33021
  ClientHeight = 299
  ClientWidth = 346
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 36
    Width = 36
    Height = 13
    Caption = #36873#29256#65306
  end
  object Label2: TLabel
    Left = 9
    Top = 9
    Width = 23
    Height = 13
    Caption = 'URL:'
  end
  object ListBox1: TListBox
    Left = 42
    Top = 36
    Width = 224
    Height = 46
    ItemHeight = 13
    TabOrder = 0
    OnClick = ListBox1Click
  end
  object ListView1: TListView
    Left = 8
    Top = 88
    Width = 329
    Height = 169
    Columns = <>
    FlatScrollBars = True
    GridLines = True
    HideSelection = False
    RowSelect = True
    TabOrder = 1
    OnDblClick = ListView1DblClick
  end
  object Edit1: TEdit
    Left = 42
    Top = 9
    Width = 224
    Height = 21
    TabOrder = 2
  end
  object Button1: TButton
    Left = 202
    Top = 263
    Width = 65
    Height = 28
    Caption = #19979#19968#39029
    TabOrder = 3
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 131
    Top = 263
    Width = 65
    Height = 28
    Caption = #19978#19968#39029
    TabOrder = 4
  end
  object Button3: TButton
    Left = 273
    Top = 263
    Width = 65
    Height = 28
    Caption = #36864#20986
    TabOrder = 5
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 273
    Top = 8
    Width = 49
    Height = 21
    Caption = 'GO'
    TabOrder = 6
    OnClick = Button4Click
  end
  object IdHTTP1: TIdHTTP
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 8
    Top = 256
  end
end  

源代码下载:

本文由10bet手机官网发布于微服架构,转载请注明出处:Delphi多线程学习,美丽人生论坛看贴工具delphi版

上一篇:查找与删除表中重复记录的步骤方法,自动编号的实现 下一篇:没有了
猜你喜欢
热门排行
精彩图文